Thread: [pure-lang-svn] SF.net SVN: pure-lang: [204] pure/trunk (Page 4)
Status: Beta
Brought to you by:
agraef
From: <ag...@us...> - 2008-06-13 09:59:31
|
Revision: 204 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=204&view=rev Author: agraef Date: 2008-06-13 02:59:39 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Refactoring of host-specific setup, add support for -dynamiclib on OSX. Modified Paths: -------------- pure/trunk/Makefile.in pure/trunk/configure pure/trunk/configure.ac Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-06-13 09:34:55 UTC (rev 203) +++ pure/trunk/Makefile.in 2008-06-13 09:59:39 UTC (rev 204) @@ -74,6 +74,10 @@ sharedlib = @sharedlib@ +# Flag needed to create shared libraries. On most systems this is just -shared. + +shared = @shared@ + # On some systems -fPIC is needed for code linked as a shared library. ifeq ($(sharedlib), yes) @@ -122,7 +126,7 @@ endif $(libpure): $(OBJECT) - $(CXX) -shared -o $@ $(LDFLAGS) $(OBJECT) $(LLVM_LIBS) $(LIBS) + $(CXX) $(shared) -o $@ $(LDFLAGS) $(OBJECT) $(LLVM_LIBS) $(LIBS) ln -sf $(libpure) $(libpurelnk) pure.o: pure.cc Modified: pure/trunk/configure =================================================================== --- pure/trunk/configure 2008-06-13 09:34:55 UTC (rev 203) +++ pure/trunk/configure 2008-06-13 09:59:39 UTC (rev 204) @@ -657,8 +657,9 @@ host_cpu host_vendor host_os +shared +rdynamic PIC -RDYNAMIC DLLEXT AUXLIBS INSTALL_PROGRAM @@ -1847,25 +1848,24 @@ _ACEOF +shared="-shared" +rdynamic="-rdynamic" PIC= -RDYNAMIC= DLLEXT=".so" -AUX_LIBS= +AUXLIBS= case "$host" in - *-*-mingw*) RDYNAMIC="-rdynamic"; DLLEXT=".dll"; - AUXLIBS="-DLIBGLOB='\"libglob.dll\"' -DLIBREGEX='\"libgnurx-0.dll\"'"; + *-*-mingw*) AUXLIBS="-DLIBGLOB='\"libglob.dll\"' -DLIBREGEX='\"libgnurx-0.dll\"'"; LIBS="$LIBS -limagehlp -lpsapi"; - LDFLAGS="-Wl,--enable-auto-import";; - x86_64-*-linux*) RDYNAMIC="-rdynamic"; PIC="-fPIC";; - *-*-linux*) RDYNAMIC="-rdynamic";; - *-*-freebsd*) RDYNAMIC="-rdynamic";; - *-*-darwin*) DLLEXT=".dylib";; - hppa*-hp-hpux*) DLLEXT=".sl";; + LDFLAGS="-Wl,--enable-auto-import"; DLLEXT=".dll";; + x86_64-*-linux*) PIC="-fPIC";; + *-*-darwin*) rdynamic=""; shared="-dynamiclib"; DLLEXT=".dylib";; + hppa*-hp-hpux*) rdynamic=""; DLLEXT=".sl";; esac + # 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: @@ -4296,7 +4296,7 @@ # Check whether --enable-shared was given. if test "${enable_shared+set}" = set; then enableval=$enable_shared; case "${enableval}" in - no) LDFLAGS="$LDFLAGS $RDYNAMIC"; sharedlib=no ;; + no) LDFLAGS="$LDFLAGS $rdynamic"; sharedlib=no ;; esac fi @@ -6029,8 +6029,9 @@ host_cpu!$host_cpu$ac_delim host_vendor!$host_vendor$ac_delim host_os!$host_os$ac_delim +shared!$shared$ac_delim +rdynamic!$rdynamic$ac_delim PIC!$PIC$ac_delim -RDYNAMIC!$RDYNAMIC$ac_delim DLLEXT!$DLLEXT$ac_delim AUXLIBS!$AUXLIBS$ac_delim INSTALL_PROGRAM!$INSTALL_PROGRAM$ac_delim @@ -6056,7 +6057,7 @@ LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF - if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 70; then + if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 71; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 Modified: pure/trunk/configure.ac =================================================================== --- pure/trunk/configure.ac 2008-06-13 09:34:55 UTC (rev 203) +++ pure/trunk/configure.ac 2008-06-13 09:59:39 UTC (rev 204) @@ -9,25 +9,24 @@ AC_DEFINE_UNQUOTED(HOST, "${host}", [Define to the name of the host system.]) AC_SUBST(host) dnl Figure out extra build flags and filename extensions for various systems. -dnl XXXFIXME: -fPIC is acurrently assumed for Linux x86-64 only. There might -dnl be other Unix systems which need this. +dnl XXXFIXME: This is probably incomplete. Please let me know about options +dnl needed for other Unix flavours. +shared="-shared" +rdynamic="-rdynamic" PIC= -RDYNAMIC= DLLEXT=".so" -AUX_LIBS= +AUXLIBS= case "$host" in - *-*-mingw*) RDYNAMIC="-rdynamic"; DLLEXT=".dll"; - AUXLIBS="-DLIBGLOB='\"libglob.dll\"' -DLIBREGEX='\"libgnurx-0.dll\"'"; + *-*-mingw*) AUXLIBS="-DLIBGLOB='\"libglob.dll\"' -DLIBREGEX='\"libgnurx-0.dll\"'"; LIBS="$LIBS -limagehlp -lpsapi"; - LDFLAGS="-Wl,--enable-auto-import";; - x86_64-*-linux*) RDYNAMIC="-rdynamic"; PIC="-fPIC";; - *-*-linux*) RDYNAMIC="-rdynamic";; - *-*-freebsd*) RDYNAMIC="-rdynamic";; - *-*-darwin*) DLLEXT=".dylib";; - hppa*-hp-hpux*) DLLEXT=".sl";; + LDFLAGS="-Wl,--enable-auto-import"; DLLEXT=".dll";; + x86_64-*-linux*) PIC="-fPIC";; + *-*-darwin*) rdynamic=""; shared="-dynamiclib"; DLLEXT=".dylib";; + hppa*-hp-hpux*) rdynamic=""; DLLEXT=".sl";; esac +AC_SUBST(shared) +AC_SUBST(rdynamic) AC_SUBST(PIC) -AC_SUBST(RDYNAMIC) AC_SUBST(DLLEXT) AC_SUBST(AUXLIBS) dnl Check for programs. @@ -55,7 +54,7 @@ AC_ARG_ENABLE(shared, [ --disable-shared link the interpreter statically], [case "${enableval}" in - no) LDFLAGS="$LDFLAGS $RDYNAMIC"; sharedlib=no ;; + no) LDFLAGS="$LDFLAGS $rdynamic"; sharedlib=no ;; esac]) AC_SUBST(sharedlib) AC_ARG_ENABLE(warnings, This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-13 10:33:42
|
Revision: 205 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=205&view=rev Author: agraef Date: 2008-06-13 03:33:49 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Add support for installing different Pure versions in parallel. Modified Paths: -------------- pure/trunk/Makefile.in pure/trunk/lexer.ll pure/trunk/pure.cc Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-06-13 09:59:39 UTC (rev 204) +++ pure/trunk/Makefile.in 2008-06-13 10:33:49 UTC (rev 205) @@ -57,9 +57,9 @@ CXXFLAGS = @CXXFLAGS@ # Pure library name. Currently we use a simple versioning scheme, which -# requires that the library version matches that of the interpreter. With some -# fiddling, this enables you to install different versions of the Pure -# interpreter on the same system. +# requires that the library version matches that of the interpreter. This +# enables you to install different versions of the Pure interpreter on the +# same system. libpure_base = $(name) libpure_vers = $(libpure_base)-$(version) @@ -130,7 +130,7 @@ ln -sf $(libpure) $(libpurelnk) pure.o: pure.cc - $(CXX) $(CXXFLAGS) $(CPPFLAGS) $(LLVM_FLAGS) -DPURELIB='"$(libdir)/pure"' -c -o $@ $< + $(CXX) $(CXXFLAGS) $(CPPFLAGS) $(LLVM_FLAGS) -DPURELIB='"$(libdir)/pure-$(version)"' -c -o $@ $< interpreter.o: interpreter.cc $(CXX) $(CXXFLAGS) $(PIC) $(CPPFLAGS) $(LLVM_FLAGS) $(AUXLIBS) -c -o $@ $< @@ -190,17 +190,20 @@ # installation install: pure$(EXE) - for x in $(addprefix $(DESTDIR), $(bindir) $(libdir)/pure $(man1dir)); do $(INSTALL) -d $$x; done - $(INSTALL) pure$(EXE) $(DESTDIR)$(bindir)/pure$(EXE) + for x in $(addprefix $(DESTDIR), $(bindir) $(libdir)/pure-$(version) $(man1dir)); do $(INSTALL) -d $$x; done + $(INSTALL) pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) + ln -sf $(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(bindir)/pure$(EXE) ifeq ($(sharedlib), yes) $(INSTALL) $(libpure) $(DESTDIR)$(libdir)/$(libpure) ln -sf $(libdir)/$(libpure) $(DESTDIR)$(libdir)/$(libpurelnk) endif - for x in $(srcdir)/lib/*.pure; do $(INSTALL) -m 644 $$x $(DESTDIR)$(libdir)/pure; done - $(INSTALL) -m 644 pure.1 $(DESTDIR)$(man1dir)/pure.1 + for x in $(srcdir)/lib/*.pure; do $(INSTALL) -m 644 $$x $(DESTDIR)$(libdir)/pure-$(version); done + ln -sf $(libdir)/pure-$(version) $(DESTDIR)$(libdir)/pure + $(INSTALL) -m 644 pure.1 $(DESTDIR)$(man1dir)/pure-$(version).1 + ln -sf $(man1dir)/pure-$(version).1 $(DESTDIR)$(man1dir)/pure.1 uninstall: - rm -rf $(DESTDIR)$(bindir)/pure$(EXE) $(DESTDIR)$(libdir)/$(libpure) $(DESTDIR)$(libdir)/$(libpurelnk) $(DESTDIR)$(libdir)/pure $(DESTDIR)$(man1dir)/pure.1 + rm -rf $(DESTDIR)$(bindir)/pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(libdir)/$(libpure) $(DESTDIR)$(libdir)/$(libpurelnk) $(DESTDIR)$(libdir)/pure $(DESTDIR)$(libdir)/pure-$(version) $(DESTDIR)$(man1dir)/pure.1 $(DESTDIR)$(man1dir)/pure-$(version).1 # roll a distribution tarball Modified: pure/trunk/lexer.ll =================================================================== --- pure/trunk/lexer.ll 2008-06-13 09:59:39 UTC (rev 204) +++ pure/trunk/lexer.ll 2008-06-13 10:33:49 UTC (rev 205) @@ -12,6 +12,8 @@ #include "parser.hh" #include "util.hh" +#include "config.h" + /* Work around an incompatibility in flex (at least versions 2.5.31 through 2.5.33): it generates code that does not conform to C89. See Debian bug 333231 <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=333231>. */ @@ -196,7 +198,7 @@ if (*s && !isspace(*s)) REJECT; while (isspace(*s)) ++s; yylloc->step(); - string cmd = string("man ") + ((*s)?s:"pure"); + string cmd = string("man ") + ((*s)?s:("pure-" PACKAGE_VERSION)); system(cmd.c_str()); } ^ls.* { Modified: pure/trunk/pure.cc =================================================================== --- pure/trunk/pure.cc 2008-06-13 09:59:39 UTC (rev 204) +++ pure/trunk/pure.cc 2008-06-13 10:33:49 UTC (rev 205) @@ -25,7 +25,7 @@ #define PACKAGE_VERSION "0.0" #endif #ifndef PURELIB -#define PURELIB "/usr/local/lib/pure" +#define PURELIB "/usr/local/lib/pure-" PACKAGE_VERSION #endif #define COPYRIGHT "Copyright (c) 2008 by Albert Graef" This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-13 10:47:29
|
Revision: 206 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=206&view=rev Author: agraef Date: 2008-06-13 03:47:29 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Bump version number. Modified Paths: -------------- pure/trunk/INSTALL pure/trunk/configure pure/trunk/configure.ac Modified: pure/trunk/INSTALL =================================================================== --- pure/trunk/INSTALL 2008-06-13 10:33:49 UTC (rev 205) +++ pure/trunk/INSTALL 2008-06-13 10:47:29 UTC (rev 206) @@ -76,7 +76,7 @@ section. STEP 5. Configure, build and install Pure as follows (x.y denotes the current -Pure version number, 0.3 at the time of this writing): +Pure version number, 0.4 at the time of this writing): $ cd pure-x.y $ ./configure @@ -102,10 +102,10 @@ Run Pure interactively as: $ pure -Pure 0.3 (i686-pc-linux-gnu) Copyright (c) 2008 by Albert Graef +Pure 0.4 (i686-pc-linux-gnu) Copyright (c) 2008 by Albert Graef This program is free software distributed under the GNU Public License (GPL V3 or later). Please see the COPYING file for details. -Loaded prelude from /usr/local/lib/pure/prelude.pure. +Loaded prelude from /usr/local/lib/pure-0.4/prelude.pure. Check that it works: Modified: pure/trunk/configure =================================================================== --- pure/trunk/configure 2008-06-13 10:33:49 UTC (rev 205) +++ pure/trunk/configure 2008-06-13 10:47:29 UTC (rev 206) @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.61 for pure 0.3. +# Generated by GNU Autoconf 2.61 for pure 0.4. # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. @@ -572,8 +572,8 @@ # Identity of this package. PACKAGE_NAME='pure' PACKAGE_TARNAME='pure' -PACKAGE_VERSION='0.3' -PACKAGE_STRING='pure 0.3' +PACKAGE_VERSION='0.4' +PACKAGE_STRING='pure 0.4' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. @@ -1198,7 +1198,7 @@ # 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 pure 0.3 to adapt to many kinds of systems. +\`configure' configures pure 0.4 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1263,7 +1263,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of pure 0.3:";; + short | recursive ) echo "Configuration of pure 0.4:";; esac cat <<\_ACEOF @@ -1356,7 +1356,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -pure configure 0.3 +pure configure 0.4 generated by GNU Autoconf 2.61 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1370,7 +1370,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by pure $as_me 0.3, which was +It was created by pure $as_me 0.4, which was generated by GNU Autoconf 2.61. Invocation command line was $ $0 $@ @@ -5764,7 +5764,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by pure $as_me 0.3, which was +This file was extended by pure $as_me 0.4, which was generated by GNU Autoconf 2.61. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -5813,7 +5813,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -pure config.status 0.3 +pure config.status 0.4 configured by $0, generated by GNU Autoconf 2.61, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Modified: pure/trunk/configure.ac =================================================================== --- pure/trunk/configure.ac 2008-06-13 10:33:49 UTC (rev 205) +++ pure/trunk/configure.ac 2008-06-13 10:47:29 UTC (rev 206) @@ -1,5 +1,5 @@ -AC_INIT(pure, 0.3) +AC_INIT(pure, 0.4) AC_CONFIG_HEADERS(config.h) dnl Determine host information. AC_CANONICAL_HOST This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-13 11:21:09
|
Revision: 208 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=208&view=rev Author: agraef Date: 2008-06-13 04:21:12 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Include proper version number in manpage. Modified Paths: -------------- pure/trunk/Makefile.in pure/trunk/pure.1 Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-06-13 11:07:04 UTC (rev 207) +++ pure/trunk/Makefile.in 2008-06-13 11:21:12 UTC (rev 208) @@ -146,6 +146,15 @@ parser.hh location.hh position.hh stack.hh: parser.cc +# create the manpage from pure.1.in + +edit = sed -e 's,@version\@,$(version),g' + +pure.1: configure pure.1.in + rm -f pure.1 pure.1.tmp + $(edit) pure.1.in >pure.1.tmp + mv pure.1.tmp pure.1 + # documentation in various formats (requires groff) html: pure.html Modified: pure/trunk/pure.1 =================================================================== --- pure/trunk/pure.1 2008-06-13 11:07:04 UTC (rev 207) +++ pure/trunk/pure.1 2008-06-13 11:21:12 UTC (rev 208) @@ -1,4 +1,4 @@ -.TH Pure 1 "March 2008" "Pure Version 0.x" +.TH Pure 1 "March 2008" "Pure Version @version@" .SH NAME pure \- the Pure interpreter .SH SYNOPSIS This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-13 11:33:05
|
Revision: 210 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=210&view=rev Author: agraef Date: 2008-06-13 04:33:13 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Include proper version number in manpage. Modified Paths: -------------- pure/trunk/Makefile.in pure/trunk/pure.1.in Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-06-13 11:21:35 UTC (rev 209) +++ pure/trunk/Makefile.in 2008-06-13 11:33:13 UTC (rev 210) @@ -106,8 +106,8 @@ DISTFILES = COPYING ChangeLog INSTALL NEWS README TODO \ Makefile.in aclocal.m4 configure.ac configure config.h.in \ -config.guess config.sub install-sh \ -$(SOURCE) $(EXTRA_SOURCE) w3centities.c pure.cc pure.1 pure.xml pure.vim \ +config.guess config.sub install-sh $(SOURCE) $(EXTRA_SOURCE) w3centities.c \ +pure.cc pure.1 pure.1.in pure.xml pure.vim \ examples/*.pure lib/*.pure test/*.pure test/*.log .PHONY: all html dvi ps pdf clean realclean depend install uninstall strip \ @@ -115,7 +115,7 @@ # compilation -all: pure$(EXE) +all: pure$(EXE) pure.1 ifeq ($(sharedlib), yes) pure$(EXE): pure.o $(libpure) @@ -150,7 +150,7 @@ edit = sed -e 's,@version\@,$(version),g' -pure.1: configure pure.1.in +pure.1: configure.ac pure.1.in rm -f pure.1 pure.1.tmp $(edit) pure.1.in >pure.1.tmp mv pure.1.tmp pure.1 @@ -189,7 +189,7 @@ rm -f Makefile config.h config.log config.status $(dist).tar.gz realclean: distclean - rm -f $(addprefix $(srcdir)/, test/*.log $(EXTRA_SOURCE)) + rm -f $(addprefix $(srcdir)/, test/*.log $(EXTRA_SOURCE) pure.1) # dependencies (rerun configure after this) @@ -198,7 +198,7 @@ # installation -install: pure$(EXE) +install: pure$(EXE) pure.1 for x in $(addprefix $(DESTDIR), $(bindir) $(libdir)/pure-$(version) $(man1dir)); do $(INSTALL) -d $$x; done $(INSTALL) pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) ln -sf $(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(bindir)/pure$(EXE) Modified: pure/trunk/pure.1.in =================================================================== --- pure/trunk/pure.1.in 2008-06-13 11:21:35 UTC (rev 209) +++ pure/trunk/pure.1.in 2008-06-13 11:33:13 UTC (rev 210) @@ -1,4 +1,4 @@ -.TH Pure 1 "March 2008" "Pure Version @version@" +.TH Pure 1 "June 2008" "Pure Version @version@" .SH NAME pure \- the Pure interpreter .SH SYNOPSIS This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-13 11:21:32
|
Revision: 209 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=209&view=rev Author: agraef Date: 2008-06-13 04:21:35 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Include proper version number in manpage. Added Paths: ----------- pure/trunk/pure.1.in Removed Paths: ------------- pure/trunk/pure.1 Deleted: pure/trunk/pure.1 =================================================================== --- pure/trunk/pure.1 2008-06-13 11:21:12 UTC (rev 208) +++ pure/trunk/pure.1 2008-06-13 11:21:35 UTC (rev 209) @@ -1,1218 +0,0 @@ -.TH Pure 1 "March 2008" "Pure Version @version@" -.SH NAME -pure \- the Pure interpreter -.SH SYNOPSIS -\fBpure\fP [-h] [-i] [-n] [-v[\fIlevel\fP]] [\fIscript\fP ...] [-- \fIargs\fP ...] -.SH OPTIONS -.TP -.B -h -Print help message and exit. -.TP -.B -i -Force interactive mode (read commands from stdin). -.TP -.B -n -Suppress automatic inclusion of the prelude. -.TP -.B -v -Set verbosity level. See below for details. -.TP -.B -- -Stop option processing and pass the remaining command line arguments in the -.B argv -variable. -.SH DESCRIPTION -Pure is a modern-style functional programming language based on term -rewriting. Pure programs are basically collections of equational rules used to -evaluate expressions in a symbolic fashion by reducing them to normal form. A -brief overview of the language can be found in the \fBPURE OVERVIEW\fP section -below. (In case you're wondering, the name ``Pure'' actually refers to the -adjective. But you can also write it as ``PURE'' and take this as a recursive -acronym for the ``Pure Universal Rewriting Engine''.) -.PP -.B pure -is the Pure interpreter. The interpreter has an LLVM backend which -JIT-compiles Pure programs to machine code, hence programs run blazingly fast -and interfacing to C modules is easy, while the interpreter still provides a -convenient, fully interactive environment for running Pure scripts and -evaluating expressions. -.PP -If any source scripts are specified on the command line, they are loaded and -executed, after which the interpreter exits. Otherwise the interpreter enters -the interactive read-eval-print loop. You can also use the -.B -i -option to enter the interactive loop (continue reading from stdin) even after -processing some source scripts. To exit the interpreter, just type the -.B quit -command or the end-of-file character (^D on Unix) at the beginning of the -command line. -.PP -When the interpreter is in interactive mode and reads from a tty, commands are -read using -.BR readline (3) -(providing completion for all commands listed in section -.B INTERACTIVE USAGE -below, as well as for global function and variable symbols) and, when exiting -the interpreter, the command history is stored in -.BR ~/.pure_history , -from where it is restored the next time you run the interpreter. -.PP -Options and source files are processed in the order in which they are given on -the command line. Processing of options and source files ends when the -.B -- -option is encountered. Any following parameters are passed to the executing -script by means of the global -.B argc -and -.B argv -variables. Moreover, the -.B version -variable is set to the Pure interpreter version, and the -.B sysinfo -variable provides information about the host system. -.PP -If available, the prelude script -.B prelude.pure -is loaded by the interpreter prior to any other other definitions, unless the -.B -n -option is specified. The prelude as well as other source scripts specified -with a relative pathname are first searched for in the current directory and -then in the directory specified with the -.B PURELIB -environment variable. If the -.B PURELIB -variable is not set, a system-specific default is used. -.PP -The -.B -v -option is most useful for debugging the interpreter, or if you are interested -in the code your program gets compiled to. The -.I level -argument is optional; it defaults to 1. Six different levels are implemented -at this time (two more bits are reserved for future extensions). For most -purposes, only the first two levels will be useful for the average Pure -programmer; the remaining levels are most likely to be used by the Pure -interpreter developers. -.TP -.B 1 (0x1) -denotes echoing of parsed definitions and expressions; -.TP -.B 2 (0x2) -adds special annotations concerning local bindings (de Bruijn indices, subterm -paths; this can be helpful to debug tricky variable binding issues); -.TP -.B 4 (0x4) -adds abstract code snippets (matching automata etc.; you probably want to see -this only when working on the guts of the interpreter). -.TP -.B 8 (0x8) -dumps the ``real'' output code (LLVM assembler, which is as close to the -native machine code for your program as it gets; you \fIdefinitely\fP don't -want to see this unless you have to inspect the generated code for bugs or -performance issues). -.TP -.B 16 (0x10) -adds debugging messages from the -.BR bison (1) -parser; useful for debugging the parser. -.TP -.B 32 (0x20) -adds debugging messages from the -.BR flex (1) -lexer; useful for debugging the lexer. -.PP -These values can be or'ed together, and, for convenience, can be specified in -either decimal or hexadecimal. Thus 0xff always gives you full debugging -output (which isn't most likely be used by anyone but the Pure developers). -.PP -Note that the -.B -v -option is only applied \fIafter\fP the prelude has been loaded. If you want to -debug the prelude, use the -.B -n -option and specify the -.B prelude.pure -file explicitly on the command line. Alternatively, you can also use the -interactive -.B list -command (see the \fBINTERACTIVE USAGE\fP section below) to list definitions -along with additional debugging information. -.SH PURE OVERVIEW -.PP -Pure is a fairly simple language. Programs are simply collections of -equational rules defining functions, \fBlet\fP commands binding global -variables, and expressions to be evaluated. Here's a simple example, entered -interactively in the interpreter: -.sp -.nf -> // my first Pure example -> fact 1 = 1; -> fact n::int = n*fact (n-1) \fBif\fP n>1; -> \fBlet\fP x = fact 10; x; -3628800 -.fi -.PP -The language is free-format (blanks are insignificant). As indicated, -definitions and expressions at the toplevel have to be terminated with a -semicolon. Comments have the same syntax as in C++ (using // for line-oriented -and /* ... */ for multiline comments; the latter may not be nested). -.PP -On the surface, Pure is quite similar to other modern functional languages -like Haskell and ML. But under the hood it is a much more dynamic and -reflective language, more akin to Lisp. In particular, Pure is dynamically -typed, so functions can be fully polymorphic and you can add to the definition -of an existing function at any time: -.sp -.nf -> fact 1.0 = 1.0; -> fact n::double = n*fact (n-1) \fBif\fP n>1; -> fact 10.0; -3628800.0 -> fact 10; -3628800 -.fi -.sp -Also, due to its term rewriting semantics, Pure can do symbolic evaluations: -.sp -.nf -> square x = x*x; -> square (a+b); -(a+b)*(a+b) -.fi -.PP -The Pure language provides built-in support for machine integers (32 bit), -bigints (implemented using GMP), floating point values (double precision -IEEE), character strings (UTF-8 encoded) and generic C pointers (these don't -have a syntactic representation in Pure, though, so they need to be created -with external C functions). Truth values are encoded as machine integers (as -you might expect, zero denotes ``false'' and any non-zero value ``true''). -.PP -Expressions are generally evaluated from left to right, innermost expressions -first, i.e., using -.I call by value -semantics. Pure also has a few built-in special forms (most notably, -conditional expressions and the short-circuit logical connectives && and ||) -which take some of their arguments using -.I call by name -semantics. -.PP -Expressions consist of the following elements: -.TP -.B Constants: \fR4711, 4711L, 1.2e-3, \(dqHello,\ world!\en\(dq -The usual C'ish notations for integers (decimal, hexadecimal, octal), floating -point values and double-quoted strings are all provided, although the Pure -syntax differs in some minor ways, as discussed in the following. First, there -is a special notation for denoting bigints. Note that an integer constant that -is too large to fit into a machine integer will be interpreted as a bigint -automatically. Moreover, as in Python an integer literal immediately followed -by the uppercase letter ``L'' will always be interpreted as a bigint constant, -even if it fits into a machine integer. This notation is also used when -printing bigint constants. Second, character escapes in Pure strings have a -more flexible syntax borrowed from the author's Q language, which provides -notations to specify any Unicode character. In particular, the notation -.BR \e\fIn\fP , -where \fIn\fP is an integer literal written in decimal (no prefix), -hexadecimal (`0x' prefix) or octal (`0' prefix) notation, denotes the Unicode -character (code point) #\fIn\fP. Since these escapes may consist of a varying -number of digits, parentheses may be used for disambiguation purposes; thus, -e.g. -.B \(dq\e(123)4\(dq -denotes character #123 followed by the character `4'. The usual C-like escapes -for special non-printable characters such as -.B \en -are also supported. Moreover, you can use symbolic character escapes of the -form -.BR \e&\fIname\fP; , -where \fIname\fP is any of the XML single character entity names specified in -the ``XML Entity definitions for Characters'', see -.IR http://www.w3.org/TR/xml-entity-names/ . -Thus, e.g., \(dq\e©\(dq denotes the copyright character (code point -0x000A9). -.TP -.B Function and variable symbols: \fRfoo, foo_bar, BAR, bar2 -These consist of the usual sequence of ASCII letters (including the -underscore) and digits, starting with a letter. Case is significant, but it -doesn't carry any meaning (that's in contrast to languages like Prolog and Q, -where variables must be capitalized). Pure simply distinguishes function and -variable symbols on the left-hand side of an equation by the ``head = -function'' rule: Any symbol which occurs as the head symbol of a function -application is a function symbol, all other symbols are variables -- except -symbols explicitly declared as ``constant'' a.k.a. -.B nullary -symbols, see below. Another important thing to know is that in Pure, keeping -with the tradition of term rewriting, there's no distinction between -``defined'' and ``constructor'' function symbols; any function symbol can also -act as a constructor if it happens to occur in a normal form term. -.TP -.B Operator and constant symbols: \fRx+y, x==y, \fBnot\fP\ x -As indicated, these take the form of an identifier or a sequence of ASCII -punctuation symbols, as defined in the source using corresponding -\fBprefix\fP, \fBpostfix\fP and \fBinfix\fP declarations, which are discussed -in section DECLARATIONS. Enclosing an operator in parentheses, such as (+) or -(\fBnot\fP), turns it into an ordinary function symbol. Symbols can also be -defined as \fBnullary\fP to denote special constant symbols. See the prelude -for examples. -.TP -.B Lists and tuples: \fR[x,y,z], x..y, x:xs, x,y,z -The necessary constructors to build lists and tuples are actually defined in -the prelude: `[]' and `()' are the empty list and tuple, `:' produces list -``conses'', and `,' produces ``pairs''. As indicated, Pure provides the usual -syntactic sugar for list values in brackets, such as [x,y,z], which is exactly -the same as x:y:z:[]. Moreover, the prelude also provides an infix `..' -operator to denote arithmetic sequences such as 1..10 or 1.0,1.2..3.0. Pure's -tuples are a bit unusual, however: They are constructed by just ``paring'' -things using the `,' operator, for which the empty tuple acts as a neutral -element (i.e., (),x is just x, as is x,()). The pairing operator is -associative, which implies that tuples are completely flat (i.e., x,(y,z) is -just x,y,z, as is (x,y),z). This means that there are no nested tuples (tuples -of tuples), if you need such constructs then you should use lists -instead. Also note that the parentheses are \fInot\fP part of the tuple syntax -in Pure, although you \fIcan\fP use parentheses, just as with any other -expression, for the usual purpose of grouping expressions and overriding -default precedences and associativity. This means that a list of tuples will -be printed (and must also be entered) using the ``canonical'' representation -(x1,y1):(x2,y2):...:[] rather than [(x1,y1),(x2,y2),...] (which denotes just -[x1,y1,x2,y2,...]). -.TP -.B List comprehensions: \fR[x,y; x = 1..n; y = 1..m; x<y] -Pure also has list comprehensions which generate lists from an expression and -one or more ``generator'' and ``filter'' clauses (the former bind a pattern to -values drawn from a list, the latter are just predicates determining which -generated elements should actually be added to the output list). List -comprehensions are in fact syntactic sugar for a combination of nested -lambdas, conditional expressions and ``catmaps'' (a list operation which -combines list concatenation and mapping a function over a list, defined in the -prelude), but they are often much easier to write. -.TP -.B Function applications: \fRfoo\ x\ y\ z -As in other modern FPLs, these are written simply as juxtaposition (i.e., in -``curried'' form) and associate to the left. Operator applications are written -using prefix, postfix or infix notation, as the declaration of the operator -demands, but are just ordinary function applications in disguise. E.g., x+y is -exactly the same as (+) x y. -.TP -.B Conditional expressions: if\fR\ x\ \fBthen\fR\ y\ \fBelse\fR\ z -Evaluates to y or z depending on whether x is ``true'' (i.e., a nonzero -integer). An exception is generated if the condition is not an -integer. Conditional expressions are special forms with call-by-name arguments -y and z; only one of the branches is actually evaluated. (The logical -operators && and || are treated in a similar fashion, in order to implement -short-circuit semantics.) -.TP -.B Lambdas: \fR\ex\ ->\ y -These work pretty much like in Haskell. More than one variable may be bound -(e.g, \ex\ y\ ->\ x*y), which is equivalent to a nested lambda -(\ex\ ->\ \ey\ ->\ x*y). Pure also fully supports pattern-matching lambda -abstractions which match a pattern against the lambda argument and bind -multiple lambda variables in one go, such as \e(x,y)\ ->\ x*y. -.TP -.B Case expressions: case\fR\ x\ \fBof\fR\ \fIrule\fR;\ ...\ \fBend -Matches an expression, discriminating over a number of different patterns; -similar to the Haskell \fBcase\fP construct. -.TP -.B When expressions: \fRx\ \fBwhen\fR\ \fIrule\fR;\ ...\ \fBend -An alternative way to bind local variables by matching a collection of subject -terms against corresponding patterns. Similar to Aardappel's \fBwhen\fP -construct, but Pure allows more than one definition. Note that multiple -definitions in a \fBwhen\fP clause are processed from left to right, so that -later definitions may refer to the variables in earlier ones. In fact, a -\fBwhen\fP expression with multiple definitions is treated like several -nested \fBwhen\fP expressions, with the first binding being the ``outermost'' -one. -.TP -.B With expressions: \fRx\ \fBwith\fR\ \fIrule\fR;\ ...\ \fBend\fR -Defines local functions. Like Haskell's \fBwhere\fP construct, but can be used -anywhere inside an expression (just like Aardappel's \fBwhere\fP, but Pure -uses the keyword \fBwith\fP which better lines up with \fBcase\fP and -\fBwhen\fP). Also note that while Haskell lets you do \fIboth\fP function -definitions and ``pattern bindings'' in its \fBwhere\fP clauses, in Pure you -have to use \fBwith\fP for the former and \fBwhen\fP for the latter. This is -necessary because Pure, in contrast to Haskell, does not distinguish between -defined functions and constructors and thus there is no magic to figure out -whether an equation is meant as a function definition or a pattern binding. -.PP -At the toplevel, a Pure program basically consists of rules a.k.a. equations -defining functions, variable definitions a.k.a. global ``pattern bindings'', -and expressions to be evaluated. -.TP -.B Rules: \fIlhs\fR = \fIrhs\fR; -The basic form can also be augmented with a condition \fBif\ \fIguard\fR -tacked on to the end of the rule (which restricts the applicability of the -rule to the case that the guard evaluates to a nonzero integer), or the -keyword -.B otherwise -denoting an empty guard which is always true (this is nothing but syntactic -sugar useful to point out the ``default'' case of a definition; the -interpreter just treats -.B otherwise -as a comment, so it can always be omitted). Moreover, the left-hand side can -be omitted if it is the same as for the previous rule. This provides a -convenient means to write out a collection of equations for the same left-hand -side which discriminates over different conditions: -.sp -.nf -\fIlhs\fR = \fIrhs\fB if \fIguard\fR; - = \fIrhs\fB if \fIguard\fR; - ... - = \fIrhs\fB otherwise\fR; -.fi -.sp -Rules are used to define functions at the toplevel and in \fBwith\fP -expressions, as well as inside \fBcase\fP and \fBwhen\fP expressions for the -purpose of performing pattern bindings (however, for obvious reasons the forms -without a left-hand side or including a guard are not permitted in \fBwhen\fP -expressions). When matching against a function call or the subject term in a -\fBcase\fP expression, the rules are always considered in the order in which -they are written, and the first matching rule (whose guard evaluates to a -nonzero value, if applicable) is picked. (Again, the \fBwhen\fP construct is -treated differently, because each rule is actually a separate pattern -binding.) -.sp -In any case, the left-hand side pattern must not contain repeated variables -(i.e., rules must be ``left-linear''), except for the ``anonymous'' variable -`_' which matches an arbitrary value without binding a variable -symbol. Moreover, a left-hand side variable may be followed by one of the -special type tags \fB::int\fP, \fB::bigint\fP, \fB::double\fP, \fB::string\fP, -to indicate that it can only match a constant value of the corresponding -built-in type. (This is useful if you want to write rules matching \fIany\fP -object of one of these types; note that there is no way to write out all -``constructors'' for the built-in types, as there are infinitely many.) -.TP -.B Global variable bindings: let\fR \fIlhs\fR = \fIrhs\fR; -This binds every variable in the left-hand side pattern to the corresponding -subterm of the evaluated right-hand side. -.TP -.B Toplevel expressions: \fIexpr\fR; -A singleton expression at the toplevel, terminated with a semicolon, simply -causes the given value to be evaluated (and the result to be printed, when -running in interactive mode). -.PP -Expressions are parsed according to the following precedence rules: Lambda -binds most weakly, followed by -.BR when , -.B with -and -.BR case , -followed by conditional expressions (\fBif\fP-\fBthen\fP-\fBelse\fP), followed -by the ``simple'' expressions (i.e., all other kinds of expressions involving -operators, function applications, constants, symbols and other primary -expressions). Precedence and associativity of operator symbols are given by -their declarations (in the prelude or the user's program), and function -application binds stronger than all operators. Parentheses can be used to -override default precedences and associativities as usual. -.PP -For instance, here are two more function definitions showing most of these -elements in action: -.sp -.nf -fact n = n*fact (n-1) \fBif\fP n>0; - = 1 \fBotherwise\fP; - -fib n = a \fBwhen\fP a, b = fibs n \fBend\fP - \fBwith\fP fibs n = 0, 1 \fBif\fP n<=0; - = \fBcase\fP fibs (n-1) \fBof\fP - a, b = b, a+b; - \fBend\fP; - \fBend\fP; - -\fBlet\fP facts = map fact (1..10); \fBlet\fP fibs = map fib (1..100); -facts; fibs; -.fi -.PP -And here's a little list comprehension example: Erathosthenes' classical prime -sieve. -.sp -.nf -primes n = sieve (2..n) \fBwith\fP - sieve [] = []; - sieve (p:qs) = p : sieve [q; q = qs; q mod p]; -\fBend\fP; -.fi -.sp -For instance: -.sp -.nf -> primes 100; -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97] -.fi -.PP -If you dare, you can actually have a look at the catmap-lambda-if-then-else -expression the comprehension expanded to: -.sp -.nf -> list primes -primes n = sieve (2..n) with sieve [] = []; sieve (p:qs) = p:sieve -(catmap (\eq -> if q mod p then [q] else []) qs) end; -.fi -.PP -List comprehensions are also a useful device to organize backtracking -searches. For instance, here's an algorithm for the n queens problem, which -returns the list of all placements of n queens on an n x n board (encoded as -lists of n pairs (i,j) with i = 1..n), so that no two queens hold each other -in check. -.sp -.nf -queens n = search n 1 [] \fBwith\fP - search n i p = [reverse p] \fBif\fP i>n; - = cat [search n (i+1) ((i,j):p); j = 1..n; safe (i,j) p]; - safe (i,j) p = not any (check (i,j)) p; - check (i1,j1) (i2,j2) - = i1==i2 || j1==j2 || i1+j1==i2+j2 || i1-j1==i2-j2; -\fBend\fP; -.fi -.SH EXCEPTION HANDLING -Pure also offers a useful exception handling facility. To raise an exception, -you just invoke the built-in function -.B throw -with the value to be thrown as the argument. To catch an exception, you use -the built-in special form -.B catch -with the exception handler (a function to be applied to the exception value) -as the first and the expression to be evaluated as the second (call-by-name) -argument. For instance: -.sp -.nf -> catch error (throw hello_world); -error hello_world -.fi -.PP -Exceptions are also generated by the runtime system if the program runs out of -stack space, when a guard does not evaluate to a truth value, and when the -subject term fails to match the pattern in a pattern-matching lambda -abstraction, or a \fBlet\fP, \fBcase\fP or \fBwhen\fP construct. These types -of exceptions are reported using the symbols -.BR stack_fault , -.B failed_cond -and -.BR failed_match , -respectively, which are declared as constant symbols in the standard -prelude. You can use -.B catch -to handle these kinds of exceptions just like any other. For instance: -.sp -.nf -> fact n = \fBif\fP n>0 \fBthen\fP n*fact(n-1) \fBelse\fP 1; -> catch error (fact foo); -error failed_cond -> catch error (fact 100000); -error stack_fault -.fi -.PP -(You'll only get the latter kind of exception if the interpreter does stack -checks, see the discussion of the -.B PURE_STACK -environment variable in the CAVEATS AND NOTES section.) -.PP -Note that unhandled exceptions are reported by the interpreter with a -corresponding error message: -.sp -.nf -> fact foo; -<stdin>:2.0-7: unhandled exception 'failed_cond' while evaluating 'fact foo' -.fi -.PP -Exceptions can also be used to implement non-local value returns. For -instance, here's a variation of our n queens algorithm which only returns the -first solution. Note the use of -.B throw -in the recursive search routine to bail out with a solution as soon as we -found one. The value thrown there is caught in the main routine. If no value -gets thrown, the function regularly returns with () to indicate that there is -no solution. -.sp -.nf -queens1 n = catch reverse (search n 1 []) \fBwith\fP - search n i p = throw p \fBif\fP i>n; - = void [search n (i+1) ((i,j):p); j = 1..n; safe (i,j) p]; - safe (i,j) p = not any (check (i,j)) p; - check (i1,j1) (i2,j2) - = i1==i2 || j1==j2 || i1+j1==i2+j2 || i1-j1==i2-j2; -\fBend\fP; -.fi -.PP -E.g., let's compute a solution for a standard 8x8 board: -.sp -.nf -> queens 8; -(1,1):(2,5):(3,8):(4,6):(5,3):(6,7):(7,2):(8,4):[] -.fi -.SH DECLARATIONS -As you probably noticed, Pure is very terse. That's because, in contrast to -hopelessly verbose languages like Java, you don't declare much stuff in Pure, -you just define it and be done with it. Usually, all necessary information -about the defined symbols is inferred automatically. However, there are a few -toplevel constructs which let you declare special symbol attributes and manage -programs consisting of several source modules. These are: operator and -constant symbol declarations, -.B extern -declarations for external C functions (described in the next section), and -.B using -clauses which provide a simple include file mechanism. -.TP -.B Operator and constant declarations: infix \fIlevel\fP \fIop\fR ...; -Ten different precedence levels are available for user-defined operators, -numbered 0 (lowest) thru 9 (highest). On each precedence level, you can -declare (in order of increasing precedence) -.BR infix " (binary non-associative)," -.BR infixl " (binary left-associative)," -.BR infixr " (binary right-associative)," -.BR prefix " (unary prefix) and" -.BR postfix " (unary postfix)" -operators. For instance: -.sp -.nf -\fBinfixl\fP 6 + - ; -\fBinfixl\fP 7 * / div mod ; -.fi -.sp -Moreover, constant symbols are introduced using a declaration of -the form: -.sp -.nf -\fBnullary \fIsymbol\fR ...; -.fi -.sp -Examples for all of these can be found in the prelude which declares a bunch -of standard (arithmetic, relational, logical) operator symbols as well as the -list and pair constructors `:' and `,' and the constant symbols `[]' and `()' -denoting the empty list and tuple, respectively. -.TP -.B Using clause: using \fIname\fR ...; -Causes each given script to be included, at the position of the -.B using -clause, but only if the script was not included already. The script name can -be specified either as a string denoting the proper filename (possibly -including path and/or filename extension), or as an identifier. In the latter -case, the -.B .pure -filename extension is added automatically. In both cases, the script is -searched for in the current directory and the directory named by the -.B PURELIB -environment variable. (The -.B using -clause also has an alternative form which allows dynamic libraries to be -loaded, this will be discussed in the following section.) -.SH C INTERFACE -Accessing C functions from Pure programs is dead simple. You just need an -.B extern -declaration of the function, which is a simplified kind of C prototype. The -function can then be called in Pure just like any other. For instance, the -following commands, entered interactively in the interpreter, let you use the -.B sin -function from the C library (of course you could just as well put the -.B extern -declaration into a script): -.sp -.nf -> \fBextern\fP double sin(double); -> sin 0.3; -0.29552020666134 -.fi -.sp -For clarity, the parameter types can also be annotated with parameter names, -e.g.: -.sp -.nf -\fBextern\fP double sin(double x); -.fi -.sp -Parameter names in prototypes only serve informational purposes and are for -the human reader; they are effectively treated as comments by the compiler. -.PP -The interpreter makes sure that the parameters in a call match; if not, the -call is treated as a normal form expression. The range of supported C types is -a bit limited right now (void, bool, char, short, int, long, double, as well -as arbitrary pointer types, i.e.: void*, char*, etc.), but in practice these -should cover most kinds of calls that need to be done when interfacing to C -libraries. -.PP -Since Pure only has 32 bit machine integers and GMP bigints, a variety of C -integer types are provided which are converted from/to the Pure types in a -straightfoward way. The short type indicates 16 bit integers which are -converted from/to Pure machine ints using truncation and sign extension, -respectively. The long type -.I always -denotes 64 bit integers, even if the corresponding C type is actually 32 bit -(as it usually is on most contemporary systems). This type is to be used if a -C function takes or returns 64 bit integer values. For a long parameter you -can either pass a Pure machine int (which is sign-extended to 64 bit) or a -Pure bigint (which is truncated to 64 bit if necessary). 64 bit return values -are always converted to (signed) Pure bigints. -.PP -Concerning the pointer types, char* is for string arguments and return values -which need translation between Pure's internal utf-8 representation and the -system encoding, while void* is for any generic kind of pointer (including -strings, which are \fInot\fP translated when passed/returned as void*). Any -other kind of pointer (except expr*, see below) is effectively treated as -void* right now, although in a future version the interpreter may keep track -of the type names for the purpose of checking parameter types. -.PP -The expr* pointer type is special; it indicates a Pure expression parameter or -return value which is just passed through unchanged. All other types of values -have to be ``unboxed'' when they are passed as arguments (i.e., from Pure to -C) and ``boxed'' again when they are returned as function results (from C to -Pure). All of this is handled by the runtime system in a transparent way, of -course. -.PP -It is even possible to augment an external C function with ordinary Pure -equations, but in this case you have to make sure that the -.B extern -declaration of the function comes first. For instance, we might want to extend -our imported -.B sin -function with a rule to handle integers: -.sp -.nf -> sin 0; -sin 0 -> sin x::int = sin (double x); -> sin 0; -0.0 -.fi -.PP -Sometimes it is preferable to replace a C function with a wrapper function -written in Pure. In such a case you can specify an \fIalias\fP under which the -original C function is known to the Pure program, so that you can still call -the C function from the wrapper. An alias is introduced by terminating the -.B extern -declaration with a clause of the form ``= \fIalias\fP''. For instance: -.sp -.nf -> \fBextern\fP double sin(double) = c_sin; -> sin x::double = c_sin x; -> sin x::int = c_sin (double x); -> sin 0.3; sin 0; -0.29552020666134 -0.0 -.fi -.PP -External C functions are resolved by the LLVM runtime, which first looks for -the symbol in the C library and Pure's runtime library (or the interpreter -executable, if the interpreter was linked statically). Thus all C library and -Pure runtime functions are readily available in Pure programs. Other functions -can be provided by including them in the runtime, or by linking the -interpreter against the corresponding modules. Or, better yet, you can just -``dlopen'' shared libraries at runtime with a special form of the -.B using -clause: -.sp -.nf -\fBusing\fP "lib:\fIlibname\fR[.\fIext\fP]"; -.fi -.sp -For instance, if you want to call the GMP functions directly from Pure: -.sp -.nf -\fBusing\fP "lib:libgmp"; -.fi -.sp -After this declaration the GMP functions will be ready to be imported into -your Pure program by means of corresponding -.B extern -declarations. -.PP -Shared libraries opened with \fBusing\fP clauses are searched for on the usual -system linker path (\fBLD_LIBRARY_PATH\fP on Linux). The necessary filename -suffix (e.g., \fB.so\fP on Linux or \fB.dll\fP on Windows) will also be -supplied automatically. You can also specify a full pathname for the library -if you prefer that. If a library file cannot be found, or if an -.B extern -declaration names a function symbol which cannot be resolved, an appropriate -error message is printed. -.SH STANDARD LIBRARY -Pure comes with a collection of Pure library modules, which includes the -standard prelude. Right now the library is pretty rudimentary, but it offers -the necessary functions to work with the built-in types (including arithmetic -and logical operations) and to do most kind of list processing you can find in -ML- and Haskell-like languages. Please refer to the -.B prelude.pure -file for details on the provided operations. Also, the beginnings of a system -interface can be found in the -.B system.pure -module. In particular, this also includes operations to do basic I/O. More -stuff will be provided in future releases. -.SH INTERACTIVE USAGE -In interactive mode, the interpreter reads definitions and expressions and -processes them as usual. The input language is just the same as for source -scripts, and hence individual definitions and expressions \fImust\fP be -terminated with a semicolon before they are processed. For instance, here is a -simple interaction which defines the factorial and then uses that definition -in some evaluations. Input lines begin with ``>'', which is the interpreter's -default command prompt: -.sp -.nf -> fact 1 = 1; -> fact n = n*fact (n-1) \fBif\fP n>1; -> \fBlet\fP x = fact 10; x; -3628800 -> map fact (1..10); -[1,2,6,24,120,720,5040,40320,362880,3628800] -.fi -.PP -When running interactively, the interpreter also accepts a number of special -commands useful for interactive purposes. Here is a quick rundown of the -currently supported operations: -.TP -.B "! \fIcommand\fP" -Shell escape. -.TP -.B "cd \fIdir\fP" -Change the current working dir. -.TP -.B "clear \fR[\fIsymbol\fP ...]\fP" -Purge the definitions of the given symbols (functions or global variables). If -no symbols are given, purge \fIall\fP definitions (after confirmation) made -after the most recent -.B save -command (or the beginning of the interactive session). -See the \fBDEFINITION LEVELS AND OVERRIDE MODE\fP section below for details. -.TP -.B "help \fR[\fIargs\fP]\fP" -Display the -.BR pure (1) -manpage, or invoke -.BR man (1) -with the given arguments. -.TP -.B "list \fR[\fIoption\fP ...]\fP \fR[\fIsymbol\fP ...]\fP" -List defined symbols in various formats. -See the \fBLIST COMMAND\fP section below for details. -.TP -.B "ls \fR[\fIargs\fP]\fP" -List files (shell \fBls\fP(1) command). -.TP -.B override -Enter ``override'' mode. This allows you to add equations ``above'' existing -definitions in the source script, possibly overriding existing equations. -See the \fBDEFINITION LEVELS AND OVERRIDE MODE\fP section below for details. -.TP -.B pwd -Print the current working dir (shell \fBpwd\fP(1) command). -.TP -.B quit -Exits the interpreter. -.TP -.B "run \fIscript\fP" -Loads the given script file and adds its definitions to the current -environment. This works more or less like a -.B using -clause, but loads the script ``anonymously'', as if the contents of the script -had been typed at the command prompt. That is, -.B run -doesn't check whether the script is being used already and it puts the -definitions on the current temporary level (so that -.B clear -can be used to remove them again). -.TP -.B save -Begin a new level of temporary definitions. A subsequent -.B clear -command (see above) will purge all definitions made after the most recent -.B save -(or the beginning of the interactive session). -See the \fBDEFINITION LEVELS AND OVERRIDE MODE\fP section below for details. -.TP -.B "stats \fR[on|off]\fP" -Enables (default) or disables ``stats'' mode, in which various statistics are -printed after an expression has been evaluated. Currently, this just prints -the cpu time in seconds for each evaluation, but in the future additional -profiling information may be provided. -.TP -.B underride -Exits ``override'' mode. This returns you to the normal mode of operation, -where new equations are added `below'' previous rules of an existing function. -See the \fBDEFINITION LEVELS AND OVERRIDE MODE\fP section below for details. -.PP -Note that these special commands are only recognized at the beginning of the -interactive command line. (Thus you can escape a symbol looking like a command -by prefixing it with a space.) -.PP -Some commands which are especially important for effective operation of the -interpreter are discussed in more detail in the following sections. -.SH LIST COMMAND -In interactive mode, the -.B list -command can be used to obtain information about defined symbols in various -formats. This command recognizes the following options. Options may be -combined, thus, e.g., \fBlist\fP -tvl is the same as \fBlist\fP -t -v -l. -.TP -.B -c -Annotate printed definitions with compiled code (matching automata). Works -like the -.B -v4 -option of the interpreter. -.TP -.B -d -Disassembles LLVM IR, showing the generated LLVM assembler code of a -function. Works like the -.B -v8 -option of the interpreter. -.TP -.B -e -Annotate printed definitions with lexical environment information (de Bruijn -indices, subterm paths). Works like the -.B -v2 -option of the interpreter. -.TP -.B -f -Print information about function symbols only. -.TP -.B -g -Indicates that the following symbols are actually shell glob patterns and that -all matching symbols should be listed. -.TP -.B -h -Print a short help message. -.TP -.B -l -Long format, prints definitions along with the summary symbol information. -This implies \fB-s\fP. -.TP -.B -s -Summary format, print just summary information about listed symbols. -.TP -.B -t[\fIlevel\fP] -List only ``temporary'' symbols and definitions at the given \fIlevel\fP (the -current level by default) or above. The \fIlevel\fP parameter, if given, must -immediately follow the option character. A \fIlevel\fP of 1 denotes all -temporary definitions, whereas 0 indicates \fIall\fP definitions (which is the -default if \fB-t\fP is not specified). See the \fBDEFINITION LEVELS AND -OVERRIDE MODE\fP section below for information about the notion of temporary -definition levels. -.TP -.B -v -Print information about variable symbols only. -.PP -Output is piped through the -.BR more (1) -program to make it easier to read, as some of the options (in particular, -.B -c -and -.BR -d ) -may produce excessive amounts of information. -.PP -For instance, to list all definitions in all loaded scripts (including the -prelude), simply say: -.sp -.nf -> \fBlist\fP -.fi -.PP -This may produce quite a lot of output, depending on which scripts are -loaded. The following command will only show summary information about the -variable symbols along with their current values (using the ``long format''): -.sp -.nf -> \fBlist\fP -lv -argc var argc = 0; -argv var argv = []; -sysinfo var sysinfo = "i686-pc-linux-gnu"; -version var version = "0.1"; -4 variables -.fi -.PP -If you're like me then you'll frequently have to look up how some operations -are defined. No sweat, with the Pure interpreter there's no need to dive into -the sources, the -.B list -command can easily do it for you. For instance, here's how you can list the -definitions of all list ``zipping'' operations from the prelude in one go: -.sp -.nf -> \fBlist\fP -g zip* -zip (x:xs) (y:ys) = (x,y):zip xs ys; -zip _ _ = []; -zip3 (x:xs) (y:ys) (z:zs) = (x,y,z):zip3 xs ys zs; -zip3 _ _ _ = []; -zipwith f (x:xs) (y:ys) = f x y:zipwith f xs ys; -zipwith f _ _ = []; -zipwith3 f (x:xs) (y:ys) (z:zs) = f x y z:zipwith3 f xs ys zs; -zipwith3 f _ _ _ = []; -.fi -.SH DEFINITION LEVELS AND OVERRIDE MODE -To help with incremental development, the interpreter also offers some -facilities to manipulate the current set of definitions interactively. To -these ends, defined symbols and their definitions are organized into different -subsets called \fIlevels\fP. The prelude, as well as other source programs -specified when invoking the interpreter, are always at level 0, while the -interactive environment starts at level 1. -.PP -Each \fBsave\fP command introduces a new temporary level, and each subsequent -\fBclear\fP command ``pops'' the symbols and definitions on the current level -(including any definitions read using the -.B run -command) and returns you to the previous one. This gives you a ``stack'' of up -to 255 temporary environments which enables you to ``plug and play'' in a safe -fashion, without affecting the rest of your program. Example: -.sp -.nf -> \fBsave\fP -save: now at temporary definitions level #2 -> foo (x:xs) = x+foo xs; -> foo [] = 0; -> \fBlist\fP foo -foo (x:xs) = x+foo xs; -foo [] = 0; -> foo (1..10); -55 -> \fBclear\fP -This will clear all temporary definitions at level #2. Continue (y/n)? y -clear: now at temporary definitions level #1 -> \fBlist\fP foo -> foo (1..10); -foo [1,2,3,4,5,6,7,8,9,10] -.fi -.PP -We've seen already that normally, if you enter a sequence of equations, they -will be recorded in the order in which they were written. However, it is also -possible to override definitions in lower levels with the -.B override -command: -.sp -.nf -> foo (x:xs) = x+foo xs; -> foo [] = 0; -> \fBlist\fP foo -foo (x:xs) = x+foo xs; -foo [] = 0; -> foo (1..10); -55 -> \fBsave\fP -save: now at temporary definitions level #2 -> \fBoverride\fP -> foo (x:xs) = x*foo xs; -> \fBlist\fP foo -foo (x:xs) = x*foo xs; -foo (x:xs) = x+foo xs; -foo [] = 0; -> foo (1..10); -0 -.fi -.PP -Note that the equation `foo (x:xs) = x*foo xs;' was inserted before the -previous `foo (x:xs) = x+foo xs;' rule, which is at level #1. -.PP -Even in override mode, new definitions will be added \fIafter\fP other -definitions at the \fIcurrent\fP level. This allows us to just continue adding -more high-priority definitions overriding lower-priority ones: -.sp -.nf -> foo [] = 1; -> \fBlist\fP foo -foo (x:xs) = x*foo xs; -foo [] = 1; -foo (x:xs) = x+foo xs; -foo [] = 0; -> foo (1..10); -3628800 -.fi -.PP -Again, the new equation was inserted \fIabove\fP the existing lower-priority -rules, but \fIbelow\fP our previous `foo (x:xs) = x*foo xs;' equation entered -at the same level. As you can see, we have now effectively replaced our -original definition of `foo' with a version that calculates list products -instead of sums, but of course we can easily go back one level to restore the -previous definition: -.sp -.nf -> \fBclear\fP -This will clear all temporary definitions at level #2. Continue (y/n)? y -clear: now at temporary definitions level #1 -clear: override mode is on -> \fBlist\fP foo -foo (x:xs) = x+foo xs; -foo [] = 0; -> foo (1..10); -55 -.fi -.PP -Note that -.B clear -reminded us that override mode is still enabled (\fBsave\fP will do the same -if override mode is on while pushing a new definitions level). To turn it off -again, use the -.B underride -command. This will revert to the normal behaviour of adding new equations -below existing ones: -.sp -.nf -> \fBunderride\fP -.fi -.SH CAVEATS AND NOTES -.B Debugging. -There's no symbolic debugger yet. So -.BR printf (3) -(available in the -.B system -standard library module) should be your friend. ;-) -.PP -.B Tuples and parentheses. -Please note that parentheses are really only used to group expressions and are -\fInot\fP part of the tuple syntax; tuples are in fact not really part of the -Pure language at all, but are implemented in the prelude. As you can see -there, the pairing operator `,' used to construct tuples is -(right-)associative. We call these the ``poor man's tuples'' since they are -always flat and thus there are no nested tuples (if you need this then you -should use lists instead). This also implies that an expression like -[(1,2),(3,4)] is in fact exactly the same as [1,2,3,4]. If you want to denote -a list of tuples, you must use the syntax (1,2):(3,4):[] instead; this is also -the notation used when the interpreter prints such objects. -.PP -.B Special forms. -Special forms are recognized at compile time only. Thus the catch function as -well as the short-circuit logical connectives && and || are only treated as -special forms in direct (saturated) calls. They can still be used if you pass -them around as function values or partial applications, but in this case they -lose all their special call-by-name argument processing. -.PP -.B Manipulating function applications. -The ``head = function'' rule means that the head symbol f of an application f -x1 ... xn occurring on (or inside) the left-hand side of an equation, pattern -binding, or pattern-matching lambda expression, is always interpreted as a -literal function symbol (not a variable). This implies that you cannot match -the ``function'' component of an application against a variable, and thus you -cannot directly define a generic function which operates on arbitrary function -applications. As a remedy, the prelude provides three operations to handle -such objects: -.BR applp , -a predicate which checks whether a given expression is a function application, -and -.B fun -and -.BR arg , -which determine the function and argument parts of such an expression, -respectively. (This may seem a little awkward, but as a matter of fact the -``head = function'' rule is quite convenient since it covers the common cases -without forcing the programmer to declare ``constructor'' symbols (except -nullary symbols). Also note that in standard term rewriting you do not have -rules parameterizing over the head symbol of a function application either.) -.PP -.B Numeric types. -If possible, you should always decorate numeric variables on the left-hand -sides of function definitions with the appropriate type tags, like -.B ::int -or -.BR ::double . -This often helps the compiler to generate better code and makes your programs -run faster. -.PP -Talking about the built-in types, please note that -.B int -(the machine integers) and -.B bigint -(the GMP ``big'' integers) are really different kinds of objects, and thus if -you want to define a function operating on both kinds of integers, you'll also -have to provide equations for both. This also applies to equations matching -against constant values of these types; in particular, a small integer -constant like `0' only matches machine integers, not bigints; for the latter -you'll have to use the ``big L'' notation `0L'. -.PP -.B External C functions. -The interpreter always takes your -.B extern -declarations of C routines at face value. It will not go and read any C header -files to determine whether you actually declared the function correctly! So -you have to be careful to give the proper declarations, otherwise your program -will probably segfault calling the function. -.PP -You also have to be careful when passing generic pointer values to external C -routines, since currently there is no type checking for these; any pointer -type other than char* and expr* is effectively treated as void*. This -considerably simplifies lowlevel programming and interfacing to C libraries, -but also makes it very easy to have your program segfault all over the place! -Therefore it is highly recommended that you wrap your lowlevel code in Pure -routines and data structures which do all the checks necessary to ensure that -only the right kind of data is passed to C routines. -.PP -.B Stack size and tail recursion. -Pure programs may need a considerable amount of stack space to handle -recursive function calls, and the interpreter itself also takes its toll. So -you may have to configure your system accordingly (8 MB of stack space is -recommended for 32 bit systems, systems with 64 bit pointers probably need -more). If the -.B PURE_STACK -environment variable is defined, the interpreter performs advisory stack -checks and raises a Pure exception if the current stack size exceeds the given -limit. The value of -.B PURE_STACK -should be the maximum stack size in kilobytes. Please note that this is only -an advisory limit which does \fInot\fP change the program's physical stack -size. Your operating system should supply you with a command such as -.BR ulimit (1) -to set the real process stack size. Also note that this feature isn't 100% -foolproof yet, since for performance reasons the stack will be checked only on -certain occasions, such as entry into a global function. -.PP -Fortunately, Pure normally does proper tail calls (if LLVM provides that -feature on the platform at hand), so most tail-recursive definitions should -work fine in limited stack space. For instance, the following little program -will loop forever if your platform supports the required optimizations: -.sp -.nf -loop = loop; -.fi -.PP -In the current implementation, a tail call will be eliminated \fIonly\fP if -the call is done \fIdirectly\fP, i.e., through an explicit call, not through a -(global or local) function variable. Otherwise the call will be handled by the -runtime system which is written in C and can't do proper tail calls because C -can't (at least not in a portable way). This also affects mutually recursive -global function calls, since there the calls are handled in an indirect way, -too, through an anonymous global variable. (This is done so that a global -function definition can be changed at any time during an interactive session, -without having to recompile the entire program.) However, mutual tail -recursion does work with \fIlocal\fP functions, so it's easy to work around -this limitation. -.PP -Scheme programmers should note that conditional expressions -(\fBif\fP-\fBthen\fP-\fBelse\fP) are tail-recursive in both branches, just -like in Scheme, while the logical operators && and || are -.I not -tail-recursive. This is because the logical operators always return a proper -truth value (0 or 1) which wouldn't be possible with tail call semantics. -.SH FILES -.TP -.B ~/.pure_history -Interactive command history. -.TP -.B prelude.pure -Standard prelude. If available, this script is loaded before any other -definitions, unless -.B -n -was specified. -.SH ENVIRONMENT -.TP -.B PURELIB -Directory to search for source files, including the prelude. If -.B PURELIB -is not set, it defaults to some default location specified at installation -time. -.TP -.B PURE_PS -Command prompt used in the interactive command loop (">\ " by default). -.TP -.B PURE_STACK -Maximum stack size in kilobytes (default: 0 = unlimited). -.SH LICENSE -GPL V3 or later. See the accompanying COPYING file for details. -.SH AUTHOR -Albert Graef <Dr....@t-...>, Dept. of Computer Music, Johannes -Gutenberg University of Mainz, Germany. -.SH SEE ALSO -.TP -.B Aardappel -Another functional programming language based on term rewriting, -\fIhttp://wouter.fov120.com/aardappel\fP. -.TP -.B Haskell -A popular non-strict FPL, \fIhttp://www.haskell.org\fP. -.TP -.B LLVM -The LLVM code generator framework, \fIhttp://llvm.org\fP. -.TP -.B ML -A popular strict FPL. See Robin Milner, Mads Tofte, Robert Harper, -D. MacQueen: \fIThe Definition of Standard ML (Revised)\fP. MIT Press, 1997. -.TP -.B Q -Another term rewriting language by yours truly, \fIhttp://q-lang.sf.net\fP. Copied: pure/trunk/pure.1.in (from rev 208, pure/trunk/pure.1) =================================================================== --- pure/trunk/pure.1.in (rev 0) +++ pure/trunk/pure.1.in 2008-06-13 11:21:35 UTC (rev 209) @@ -0,0 +1,1218 @@ +.TH Pure 1 "March 2008" "Pure Version @version@" +.SH NAME +pure \- the Pure interpreter +.SH SYNOPSIS +\fBpure\fP [-h] [-i] [-n] [-v[\fIlevel\fP]] [\fIscript\fP ...] [-- \fIargs\fP ...] +.SH OPTIONS +.TP +.B -h +Print help message and exit. +.TP +.B -i +Force interactive mode (read commands from stdin). +.TP +.B -n +Suppress automatic inclusion of the prelude. +.TP +.B -v +Set verbosity level. See below for details. +.TP +.B -- +Stop option processing and pass the remaining command line arguments in the +.B argv +variable. +.SH DESCRIPTION +Pure is a modern-style functional programming language based on term +rewriting. Pure programs are basically collections of equational rules used to +evaluate expressions in a symbolic fashion by reducing them to normal form. A +brief overview of the language can be found in the \fBPURE OVERVIEW\fP section +below. (In case you're wondering, the name ``Pure'' actually refers to the +adjective. But you can also write it as ``PURE'' and take this as a recursive +acronym for the ``Pure Universal Rewriting Engine''.) +.PP +.B pure +is the Pure interpreter. The interpreter has an LLVM backend which +JIT-compiles Pure programs to machine code, hence programs run blazingly fast +and interfacing to C modules is easy, while the interpreter still provides a +convenient, fully interactive environment for running Pure scripts and +evaluating expressions. +.PP +If any source scripts are specified on the command line, they are loaded and +executed, after which the interpreter exits. Otherwise the interpreter enters +the interactive read-eval-print loop. You can also use the +.B -i +option to enter the interactive loop (continue reading from stdin) even after +processing some source scripts. To exit the interpreter, just type the +.B quit +command or the end-of-file character (^D on Unix) at the beginning of the +command line. +.PP +When the interpreter is in interactive mode and reads from a tty, commands are +read using +.BR readline (3) +(providing completion for all commands listed in section +.B INTERACTIVE USAGE +below, as well as for global function and variable symbols) and, when exiting +the interpreter, the command history is stored in +.BR ~/.pure_history , +from where it is restored the next time you run the interpreter. +.PP +Options and source files are processed in the order in which they are given on +the command line. Processing of options and source files ends when the +.B -- +option is encountered. Any following parameters are passed to the executing +script by means of the global +.B argc +and +.B argv +variables. Moreover, the +.B version +variable is set to the Pure interpreter version, and the +.B sysinfo +variable provides information about the host system. +.PP +If available, the prelude script +.B prelude.pure +is loaded by the interpreter prior to any other other definitions, unless the +.B -n +option is specified. The prelude as well as other source scripts specified +with a relative pathname are first searched for in the current directory and +then in the directory specified with the +.B PURELIB +environment variable. If the +.B PURELIB +variable is not set, a system-specific default is used. +.PP +The +.B -v +option is most useful for debugging the interpreter, or if you are interested +in the code your program gets compiled to. The +.I level +argument is optional; it defaults to 1. Six different levels are implemented +at this time (two more bits are reserved for future extensions). For most +purposes, only the first two levels will be useful for the average Pure +programmer; the remaining levels are most likely to be used by the Pure +interpreter developers. +.TP +.B 1 (0x1) +denotes echoing of parsed definitions and expressions; +.TP +.B 2 (0x2) +adds special annotations concerning local bindings (de Bruijn indices, subterm +paths; this can be helpful to debug tricky variable binding issues); +.TP +.B 4 (0x4) +adds abstract code snippets (matching automata etc.; you probably want to see +this only when working on the guts of the interpreter). +.TP +.B 8 (0x8) +dumps the ``real'' output code (LLVM assembler, which is as close to the +native machine code for your program as it gets; you \fIdefinitely\fP don't +want to see this unless you have to inspect the generated code for bugs or +performance issues). +.TP +.B 16 (0x10) +adds debugging messages from the +.BR bison (1) +parser; useful for debugging the parser. +.TP +.B 32 (0x20) +adds debugging messages from the +.BR flex (1) +lexer; useful for debugging the lexer. +.PP +These values can be or'ed together, and, for convenience, can be specified in +either decimal or hexadecimal. Thus 0xff always gives you full debugging +output (which isn't most likely be used by anyone but the Pure developers). +.PP +Note that the +.B -v +option is only applied \fIafter\fP the prelude has been loaded. If you want to +debug the prelude, use the +.B -n +option and specify the +.B prelude.pure +file explicitly on the command line. Alternatively, you can also use the +interactive +.B list +command (see the \fBINTERACTIVE USAGE\fP section below) to list definitions +along with additional debugging information. +.SH PURE OVERVIEW +.PP +Pure is a fairly simple language. Programs are simply collections of +equational rules defining functions, \fBlet\fP commands binding global +variables, and expressions to be evaluated. Here's a simple example, entered +interactively in the interpreter: +.sp +.nf +> // my first Pure example +> fact 1 = 1; +> fact n::int = n*fact (n-1) \fBif\fP n>1; +> \fBlet\fP x = fact 10; x; +3628800 +.fi +.PP +The language is free-format (blanks are insignificant). As indicated, +definitions and expressions at the toplevel have to be terminated with a +semicolon. Comments have the same syntax as in C++ (using // for line-oriented +and /* ... */ for multiline comments; the latter may not be nested). +.PP +On the surface, Pure is quite similar to other modern functional languages +like Haskell and ML. But under the hood it is a much more dynamic and +reflective language, more akin to Lisp. In particular, Pure is dynamically +typed, so functions can be fully polymorphic and you can add to the definition +of an existing function at any time: +.sp +.nf +> fact 1.0 = 1.0; +> fact n::double = n*fact (n-1) \fBif\fP n>1; +> fact 10.0; +3628800.0 +> fact 10; +3628800 +.fi +.sp +Also, due to its term rewriting semantics, Pure can do symbolic evaluations: +.sp +.nf +> square x = x*x; +> square (a+b); +(a+b)*(a+b) +.fi +.PP +The Pure language provides built-in support for machine integers (32 bit), +bigints (implemented using GMP), floating point values (double precision +IEEE), character strings (UTF-8 encoded) and generic C pointers (these don't +have a syntactic representation in Pure, though, so they need to be created +with external C functions). Truth values are encoded as machine integers (as +you might expect, zero denotes ``false'' and any non-zero value ``true''). +.PP +Expressions are generally evaluated from left to right, innermost expressions +first, i.e., using +.I call by value +semantics. Pure also has a few built-in special forms (most notably, +conditional expressions and the short-circuit logical connectives && and ||) +which take some of their arguments using +.I call by name +semantics. +.PP +Expressions consist of the following elements: +.TP +.B Constants: \fR4711, 4711L, 1.2e-3, \(dqHello,\ world!\en\(dq +The usual C'ish notations for integers (decimal, hexadecimal, octal), floating +point values and double-quoted strings are all provided, although the Pure +syntax differs in some minor ways, as discussed in the following. First, there +is a special notation for denoting bigints. Note that an integer constant that +is too large to fit into a machine integer will be interpreted as a bigint +automatically. Moreover, as in Python an integer literal immediately followed +by the uppercase letter ``L'' will always be interpreted as a bigint constant, +even if it fits into a machine integer. This notation is also used when +printing bigint constants. Second, character escapes in Pure strings have a +more flexible syntax borrowed from the author's Q language, which provides +notations to specify any Unicode character. In particular, the notation +.BR \e\fIn\fP , +where \fIn\fP is an integer literal written in decimal (no prefix), +hexadecimal (`0x' prefix) or octal (`0' prefix) notation, denotes the Unicode +character (code point) #\fIn\fP. Since these escapes may consist of a varying +number of digits, parentheses may be used for disambiguation purposes; thus, +e.g. +.B \(dq\e(123)4\(dq +denotes character #123 followed by the character `4'. The usual C-like escapes +for special non-printable characters such as +.B \en +are also supported. Moreover, you can use symbolic character escapes of the +form +.BR \e&\fIname\fP; , +where \fIname\fP is any of the XML single character entity names specified in +the ``XML Entity definitions for Characters'', see +.IR http://www.w3.org/TR/xml-entity-names/ . +Thus, e.g., \(dq\e©\(dq denotes the copyright character (code point +0x000A9). +.TP +.B Function and variable symbols: \fRfoo, foo_bar, BAR, bar2 +These consist of the usual sequence of ASCII letters (including the +underscore) and digits, starting with a letter. Case is significant, but it +doesn't carry any meaning (that's in contrast to languages like Prolog and Q, +where variables must be capitalized). Pure simply distinguishes function and +variable symbols on the left-hand side of an equation by the ``head = +function'' rule: Any symbol which occurs as the head symbol of a function +application is a function symbol, all other symbols are variables -- exc... [truncated message content] |
From: <ag...@us...> - 2008-06-14 00:27:07
|
Revision: 214 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=214&view=rev Author: agraef Date: 2008-06-13 17:27:15 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Add a Pure Emacs mode. Modified Paths: -------------- pure/trunk/Makefile.in Added Paths: ----------- pure/trunk/pure-mode.el.in Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-06-13 23:45:33 UTC (rev 213) +++ pure/trunk/Makefile.in 2008-06-14 00:27:15 UTC (rev 214) @@ -107,7 +107,7 @@ DISTFILES = COPYING ChangeLog INSTALL NEWS README TODO \ Makefile.in aclocal.m4 configure.ac configure config.h.in \ config.guess config.sub install-sh $(SOURCE) $(EXTRA_SOURCE) w3centities.c \ -pure.cc pure.1 pure.1.in pure.xml pure.vim \ +pure.cc pure.1 pure.1.in pure-mode.el.in pure.xml pure.vim \ examples/*.pure lib/*.pure test/*.pure test/*.log .PHONY: all html dvi ps pdf clean realclean depend install uninstall strip \ @@ -115,7 +115,7 @@ # compilation -all: pure$(EXE) pure.1 +all: pure$(EXE) pure-mode.el pure.1 ifeq ($(sharedlib), yes) pure$(EXE): pure.o $(libpure) @@ -146,13 +146,18 @@ parser.hh location.hh position.hh stack.hh: parser.cc +# create pure-mode.el from pure-mode.el.in + +pure-mode.el: Makefile pure-mode.el.in + rm -f pure-mode.el pure-mode.el.tmp + sed -e 's,@bindir\@,$(bindir),g' -e 's,@libdir\@,$(libdir),g' pure-mode.el.in >pure-mode.el.tmp + mv pure-mode.el.tmp pure-mode.el + # create the manpage from pure.1.in -edit = sed -e 's,@version\@,$(version),g' - pure.1: configure.ac pure.1.in rm -f pure.1 pure.1.tmp - $(edit) pure.1.in >pure.1.tmp + sed -e 's,@version\@,$(version),g' pure.1.in >pure.1.tmp mv pure.1.tmp pure.1 # documentation in various formats (requires groff) @@ -186,7 +191,7 @@ rm -f *~ *.bak *.html *.dvi *.ps *.pdf pure$(EXE) $(OBJECT) pure.o $(libpurelnk) $(libpure) parser.output distclean: clean - rm -f Makefile config.h config.log config.status $(dist).tar.gz + rm -f Makefile config.h config.log config.status pure-mode.el $(dist).tar.gz realclean: distclean rm -f $(addprefix $(srcdir)/, test/*.log $(EXTRA_SOURCE) pure.1) @@ -198,7 +203,7 @@ # installation -install: pure$(EXE) pure.1 +install: pure$(EXE) pure-mode.el pure.1 for x in $(addprefix $(DESTDIR), $(bindir) $(libdir)/pure-$(version) $(man1dir)); do $(INSTALL) -d $$x; done $(INSTALL) pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) ln -sf $(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(bindir)/pure$(EXE) Added: pure/trunk/pure-mode.el.in =================================================================== --- pure/trunk/pure-mode.el.in (rev 0) +++ pure/trunk/pure-mode.el.in 2008-06-14 00:27:15 UTC (rev 214) @@ -0,0 +1,1716 @@ +;;; pure-mode.el --- edit and run Pure scripts -*- Emacs-Lisp -*- + +;; Copyright (C) 1997-2002 Free Software Foundation, Inc. +;; Copyright (C) 1999-2002 Albert Graef +;; Copyright (C) 2008 Albert Graef + +;; Distributed under GPL V3 (or later; see the accompanying COPYING file). + +;; Author/Maintainer: Albert Graef +;; <ag...@mu..., Dr....@t-...> + +;; This is a quick and dirty hack of Q mode, which in turn was based on +;; various different language modes like Prolog mode and Emacs Lisp mode. It +;; desperately needs an overhaul; in particular, auto-indentation is pretty +;; much broken right now. (Watch out for XXXFIXME.) + +;; INSTALLATION: If necessary, edit the values of the `pure-prog' and +;; `pure-lib-dir' variables below. + +(defvar pure-prog "@bindir@/pure") +(defvar pure-lib-dir "@libdir@/pure") + +;; Then copy this file to your site-lisp directory. The easiest way to make +;; Pure mode available in emacs is to add the following to your emacs startup +;; file: + +;; (require 'pure-mode) + +;; To enable Pure mode for *.pure files, add the following to your emacs +;; startup file: + +;; (setq auto-mode-alist (cons '("\\.pure$" . pure-mode) auto-mode-alist)) + +;; Furthermore, you can enable font lock (syntax highlighting) as follows: + +;; (add-hook 'pure-mode-hook 'turn-on-font-lock) +;; (add-hook 'pure-eval-mode-hook 'turn-on-font-lock) + +;; Well, that's the way it works with XEmacs and newer GNU Emacs versions. For +;; older versions of GNU Emacs you might have to try something like: + +;; (global-font-lock-mode t) +;; (add-hook 'pure-mode-hook (lambda () (font-lock-mode 1))) +;; (add-hook 'pure-eval-mode-hook (lambda () (font-lock-mode 1))) + +;; Using the Pure-Eval hook you can also rebind the cursor up and down keys to +;; the history cycling commands: + +;; (add-hook 'pure-eval-mode-hook +;; (lambda () +;; (define-key pure-eval-mode-map [up] 'comint-previous-input) +;; (define-key pure-eval-mode-map [down] 'comint-next-input))) + +;; Finally, you might wish to add some global key bindings, e.g.: + +;; (global-set-key "\C-c\M-p" 'run-pure) + +;; NOTE: For reading the Pure online documentation, simply use Emacs' built-in +;; manpage reader (M-? RET in XEmacs). Pure's 'help' command won't work in an +;; Emacs buffer. + +(require 'comint) + +;; customizable variables + +(defgroup pure nil "Major mode for editing and running Pure scripts." + :group 'languages) + +(defcustom pure-default-rhs-indent 32 + "*Default indentation of the right-hand side of a rule." + :type 'integer + :group 'pure ) + +(defcustom pure-extra-decl-indent 2 + "*Extra indentation of continuation lines in declarations." + :type 'integer + :group 'pure ) + +(defcustom pure-extra-qual-indent 2 + "*Extra indentation of qualifiers in rules." + :type 'integer + :group 'pure ) + +(defcustom pure-hanging-comment-ender-p t + "*Controls what \\[fill-paragraph] does to Pure block comment enders. +When set to nil, Pure block comment enders are left on their own line. +When set to t, block comment enders will be placed at the end of the +previous line (i.e. they `hang' on that line)." + :type 'boolean + :group 'pure) + +(defcustom pure-hanging-comment-starter-p t + "*Controls what \\[fill-paragraph] does to Pure block comment starters. +When set to nil, Pure block comment starters are left on their own line. +When set to t, text that follows a block comment starter will be +placed on the same line as the block comment starter (i.e. the text +`hangs' on that line)." + :type 'boolean + :group 'pure) + +(defcustom pure-prog-name pure-prog + "*Name of the interpreter executable." + :type 'string + :group 'pure) + +(defcustom pure-histfile "~/.pure_history" + "*Name of the command history file." + :type 'string + :group 'pure) + +(defcustom pure-histsize 500 + "*Size of the command history." + :type 'integer + :group 'pure) + +(defcustom pure-query-before-kill nil + "*Indicates that the user should be prompted before zapping an existing +interpreter process when starting a new one." + :type 'boolean + :group 'pure) + +(defcustom pure-prompt-regexp "^> \\|^[A-Za-z_0-9-]*> \\|^: " + "*Regexp to match prompts in the Pure interpreter. If you customize the +interpreter's default prompt, you will have to change this value accordingly." + :type 'regexp + :group 'pure) + +(defcustom pure-msg-regexp + "^[ \t]*\\(\\([^:\n]+\\):\\([0-9]+\\)\\(\\.[0-9]+\\)?\\):" +"*Regexp to match error and warning messages with source line references in +the Pure eval buffer. Expression 1 denotes the whole source line info, +expression 2 the file name and expression 3 the corresponding line number." + :type 'regexp + :group 'pure) + +(defcustom pure-mode-hook nil + "*Hook for customising Pure mode. +For instance, add `turn-on-font-lock' to enable syntax highlighting." + :type 'hook + :group 'pure) + +(defcustom pure-eval-mode-hook nil + "*Hook for customising Pure eval mode. +For instance, add `turn-on-font-lock' to enable syntax highlighting." + :type 'hook + :group 'pure) + +;; the following are used internally + +(defvar pure-output-list nil) +(defvar pure-output-string nil) +(defvar pure-receive-in-progress nil) +(defvar pure-last-dir nil) +(defvar pure-last-script nil) +(defvar pure-last-path nil) + +;; font-lock support + +(defvar pure-eval-font-lock-keywords + (list +; (list pure-prompt-regexp 0 'font-lock-preprocessor-face t) + (list pure-msg-regexp 0 'font-lock-warning-face t) + (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list + (concat "\\<\\(" + "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" + "nullary\\|o\\(f\\|therwise\\)\\|p\\(refix\\|ostfix\\)\\|" + "then\\|using\\|w\\(hen\\|ith\\)" + "\\)\\>") + 0 'font-lock-keyword-face)) + "Rules for fontifying in Pure-Eval mode.") + +(defvar pure-font-lock-keywords + (list + (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list + (concat "\\<\\(" + "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" + "nullary\\|o\\(f\\|therwise\\)\\|p\\(refix\\|ostfix\\)\\|" + "then\\|using\\|w\\(hen\\|ith\\)" + "\\)\\>") + 0 'font-lock-keyword-face)) + "Rules for fontifying Pure scripts.") + +;; keymaps + +(defvar pure-mode-map nil) +(cond ((not pure-mode-map) + (setq pure-mode-map (make-sparse-keymap)) + (define-key pure-mode-map "\C-c\C-c" 'pure-run-script) + (define-key pure-mode-map "\C-c\C-u" 'pure-current-msg) + (define-key pure-mode-map "\C-c\C-n" 'pure-next-msg) + (define-key pure-mode-map "\C-c\C-p" 'pure-prev-msg) + (define-key pure-mode-map "\C-c\C-e" 'pure-last-msg) + (define-key pure-mode-map "\C-c\C-a" 'pure-first-msg) + (define-key pure-mode-map "\C-c\C-f" 'pure-find-script) + (define-key pure-mode-map "\C-c\C-v" 'pure-goto-input-line) + (define-key pure-mode-map "\t" 'pure-indent-line) + (define-key pure-mode-map "(" 'pure-electric-delim) + (define-key pure-mode-map ")" 'pure-electric-delim) + (define-key pure-mode-map "[" 'pure-electric-delim) + (define-key pure-mode-map "]" 'pure-electric-delim) + (define-key pure-mode-map "=" 'pure-electric-delim) + (define-key pure-mode-map "\e\C-i" 'pure-move-to-indent-column) + (define-key pure-mode-map "\e\C-q" 'pure-indent-current-rule))) + +(defvar pure-eval-mode-map nil) +(cond ((not pure-eval-mode-map) + (setq pure-eval-mode-map (copy-keymap comint-mode-map)) + (define-key pure-eval-mode-map "\t" 'comint-dynamic-complete) + (define-key pure-eval-mode-map "\C-a" 'comint-bol) + (define-key pure-eval-mode-map [home] 'comint-bol) +;; (define-key pure-eval-mode-map [up] 'comint-previous-input) +;; (define-key pure-eval-mode-map [down] 'comint-next-input) + (define-key pure-eval-mode-map [return] 'pure-current-msg-or-send) + (if (string-match "XEmacs\\|Lucid" emacs-version) + (define-key pure-eval-mode-map [button2] 'pure-mouse-msg) + (define-key pure-eval-mode-map [mouse-2] 'pure-mouse-msg)) + (define-key pure-eval-mode-map "\C-c\C-u" 'pure-current-msg) + (define-key pure-eval-mode-map "\C-c\C-n" 'pure-next-msg) + (define-key pure-eval-mode-map "\C-c\C-p" 'pure-prev-msg) + (define-key pure-eval-mode-map "\C-c\C-e" 'pure-last-msg) + (define-key pure-eval-mode-map "\C-c\C-a" 'pure-first-msg) + (define-key pure-eval-mode-map "\C-c\C-f" 'pure-find-script) + (define-key pure-eval-mode-map "\C-c\C-v" 'pure-goto-input-line))) + +;; menus + +(defsubst pure-region-is-active-p () + ;; Return t when the region is active. The determination of region + ;; activeness is different in both Emacs and XEmacs. + (cond + ;; XEmacs + ((and (fboundp 'region-active-p) + zmacs-regions) + (region-active-p)) + ;; Emacs + ((boundp 'mark-active) mark-active) + ;; fallback; shouldn't get here + (t (mark t)))) + +(defvar pure-mode-menu + (list "Pure" + ["Describe Pure Mode" describe-mode t] + ["Customize" (customize-group 'pure) t] + "-" + ["Move to `=' Column" pure-move-to-indent-column t] + ["Indent Current Rule" pure-indent-current-rule t] + ["Indent Line or Region" pure-indent-line-or-region t] + ["Comment Out Region" comment-region (pure-region-is-active-p)] + ["Uncomment Region" uncomment-region (pure-region-is-active-p)] + ["Fill Comment Paragraph" pure-fill-paragraph t] + "-" + ["Run Script" pure-run-script t] + ["Find Main Script" pure-find-script pure-last-script] + ["Goto Input Line" pure-goto-input-line + (get-process "pure-eval")] + "-" + ["Current Message" pure-current-msg + (get-buffer "*pure-eval*")] + ["First Message" pure-first-msg + (get-buffer "*pure-eval*")] + ["Next Message" pure-next-msg + (get-buffer "*pure-eval*")] + ["Previous Message" pure-prev-msg + (get-buffer "*pure-eval*")] + ["Last Message" pure-last-msg + (get-buffer "*pure-eval*")]) + "Menu for Pure mode.") + +(defvar pure-eval-mode-menu + (list "Pure-Eval" + ["Describe Pure-Eval Mode" describe-mode t] + ["Customize" (customize-group 'pure) t] + "-" + ["Find Main Script" pure-find-script pure-last-script] + ["Goto Input Line" pure-goto-input-line + (get-process "pure-eval")] + "-" + ["Current Message" pure-current-msg + (get-buffer "*pure-eval*")] + ["First Message" pure-first-msg + (get-buffer "*pure-eval*")] + ["Next Message" pure-next-msg + (get-buffer "*pure-eval*")] + ["Previous Message" pure-prev-msg + (get-buffer "*pure-eval*")] + ["Last Message" pure-last-msg + (get-buffer "*pure-eval*")] + "-" + ["Complete Symbol" comint-dynamic-complete + (pure-at-command-prompt-p)]) + "Menu for Pure-Eval mode.") + +;; some helper functions for pure/pure-eval-mode: check that we're on the +;; command resp. debugger prompt + +(defun pure-at-pmark-p () + (and (get-buffer "*pure-eval*") + (get-process "pure-eval") + (progn (set-buffer "*pure-eval*") (comint-after-pmark-p)))) + +(defun pure-at-command-prompt-p () + (and + (pure-at-pmark-p) + (save-excursion + (forward-line 0) + (looking-at pure-prompt-regexp)))) + +(defun pure-at-debug-prompt-p () + (and + (pure-at-pmark-p) + (save-excursion + (forward-line 0) + (looking-at ":")))) + +;; Pure mode + +;;;###autoload +(defun pure-mode () + "Major mode for editing Pure scripts. + +Provides the `pure-run-script' (\\[pure-run-script]) command to run the +interpreter on the script in the current buffer. It will be verified that the +buffer has a file associated with it, and you will be prompted to save edited +buffers when invoking this command. Special commands to quickly locate the +main script and the input line of the Pure eval buffer, and to visit the +source lines shown in error messages are provided as well (see +`pure-eval-mode'). + +These operations can be selected from the Pure mode menu (accessible from +the menu bar), which also provides commands for reading the online +help and customizing the Pure/Pure-Eval mode setup. + +Command list: + +\\{pure-mode-map} +Entry to this mode calls the value of pure-mode-hook if that value is +non-nil." + (interactive) + (kill-all-local-variables) + (set-syntax-table (make-syntax-table)) + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?\. "_") + (modify-syntax-entry ?\+ ".") + (modify-syntax-entry ?\- ".") + (modify-syntax-entry ?\= ".") + (modify-syntax-entry ?\< ".") + (modify-syntax-entry ?\> ".") + (modify-syntax-entry ?\$ ".") + (modify-syntax-entry ?\| ".") + ;; comment syntax a la C++ mode +; (cond +; ;; XEmacs 19 & 20 +; ((memq '8-bit c-emacs-features) +; (modify-syntax-entry ?/ ". 1456") +; (modify-syntax-entry ?* ". 23")) +; ;; Emacs 19 & 20 +; ((memq '1-bit c-emacs-features) +; (modify-syntax-entry ?/ ". 124b") +; (modify-syntax-entry ?* ". 23")) +; ;; incompatible +; (t (error "Pure Mode is incompatible with this version of Emacs"))) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (modify-syntax-entry ?/ ". 1456") + (modify-syntax-entry ?* ". 23")) + (t + (modify-syntax-entry ?/ ". 124b") + (modify-syntax-entry ?* ". 23"))) + (modify-syntax-entry ?\n "> b") + (modify-syntax-entry ?\^m "> b") + (setq major-mode 'pure-mode) + (setq mode-name "Pure") + (use-local-map pure-mode-map) + (make-local-variable 'paragraph-start) +;; (setq paragraph-start (concat "^$\\|" page-delimiter)) +;; (setq paragraph-start (concat "^//\\|^$\\|" page-delimiter)) + (setq paragraph-start (concat page-delimiter "\\|$")) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (if (boundp 'fill-paragraph-function) + (progn + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'pure-fill-paragraph))) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'pure-indent-line) + (make-local-variable 'indent-region-function) + (setq indent-region-function 'pure-indent-region) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-multi-line) + (setq comment-column 48 + comment-start "// " + comment-end "" + comment-start-skip "/\\*+ *\\|// *\\|^#! *" + comment-multi-line nil + ) + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'pure-comment-indent) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(pure-font-lock-keywords nil nil ((?_ . "w")))) + (require 'easymenu) + (easy-menu-define pure-mode-menu-map pure-mode-map + "Menu keymap for Pure mode." pure-mode-menu) + (easy-menu-add pure-mode-menu-map pure-mode-map) + (run-hooks 'pure-mode-hook)) + +;; Pure eval mode + +(defun pure-eval-mode () + + "Major mode for interacting with the Pure interpreter, based on comint-mode. + +Provides the `pure-current-msg-or-send' (\\[pure-current-msg-or-send]) +command, which, when point is at an error message describing a source +reference, visits the given line in the corresponding source file in another +window. Otherwise it runs the `comint-send-input' command, which usually +submits a command line to the interpreter, or copies it to the command prompt +when point is not at the current command line. + +Error messages are indicated with a special font, and in XEmacs they will also +be highlighted when the mouse passes over them. Moreover, pressing the middle +mouse button (button2) over such a message visits the corresponding source +line in another window (`pure-mouse-msg' command); anywhere else, the middle +mouse button invokes the usual `mouse-yank' command, so that you can also use +the mouse to perform xterm-like cut and paste in the Pure-Eval buffer. + +You can also use the `pure-first-msg' (\\[pure-first-msg]), `pure-next-msg' +(\\[pure-next-msg]), `pure-prev-msg' (\\[pure-prev-msg]) and `pure-last-msg' +(\\[pure-last-msg]) commands to scan through error messages found in the +buffer. The `pure-find-script' (\\[pure-find-script]) command lets you visit +the script that is currently running, and `pure-goto-input-line' +(\\[pure-goto-input-line]) quickly takes you to the prompt at the current +input line in the Pure eval buffer. (These commands are also provided in Pure +mode. If you like, you can bind them globally, so that you can invoke them +from other kinds of buffers as well.) + +Besides this, you can use the usual comint commands, see the description of +`comint-mode' for details. Some important commands are listed below: + +\\[comint-previous-input] and \\[comint-next-input] cycle through the command history. +\\[comint-previous-matching-input] and \\[comint-next-matching-input] search the command history. +\\[comint-interrupt-subjob] sends a Ctl-C to the interpreter. +\\[comint-send-eof] sends a Ctl-D to the interpreter. +\\[comint-dynamic-list-input-ring] lists the command history. +\\[comint-dynamic-complete] performs symbol and filename completion. + +Note that in difference to standard comint mode, the C-a/home keys are rebound +to `comint-bol', to mimic the behaviour of the default binding of these keys +in the interpreter. + +Most of these operations can also be selected from the Comint and Pure-Eval +mode menus accessible from the menu bar. The Pure-Eval menu also provides +operations for reading the online help and customizing Pure/Pure-Eval mode +setup. Moreover, a History menu is provided from which the most recent +commands can be selected. + +The interpreter's prompt and lines containing error messages are described by +the variables `pure-prompt-regexp' and `pure-msg-regexp'. The history file and +size is given by the `pure-histfile' and `pure-histsize' variables. Note that +when the `pure-gnuclient' customization option is enabled, then Pure-Eval mode +automatically tracks the current prompt string and hence you can safely use +the `prompt' command in the interpreter. + +A complete command list is given below: + +\\{pure-eval-mode-map} +Entry to this mode runs the hooks on `comint-mode-hook' and +`pure-eval-mode-hook' (in that order)." + + (interactive) + (kill-all-local-variables) + (comint-mode) + (set-syntax-table (make-syntax-table)) + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?\. "_") + (modify-syntax-entry ?\+ ".") + (modify-syntax-entry ?\- ".") + (modify-syntax-entry ?\= ".") + (modify-syntax-entry ?\< ".") + (modify-syntax-entry ?\> ".") + (modify-syntax-entry ?\| ".") + (modify-syntax-entry ?\$ ".") + (modify-syntax-entry ?\/ ". 12") + (modify-syntax-entry ?\* ".") + (modify-syntax-entry ?\n ">") + (modify-syntax-entry ?\^m ">") + (setq major-mode 'pure-eval-mode) + (setq mode-name "Pure-Eval") + (use-local-map pure-eval-mode-map) + (setq comint-prompt-regexp pure-prompt-regexp) + (make-local-variable 'paragraph-start) + (setq paragraph-start comint-prompt-regexp) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-multi-line) + (setq comment-column 48 + comment-start-skip "// *\\|^#! *" + comment-multi-line nil) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(pure-eval-font-lock-keywords nil nil ((?_ . "w")))) + (setq comint-input-ring-file-name pure-histfile + comint-input-ring-size pure-histsize + comint-dynamic-complete-functions + '(pure-complete comint-dynamic-complete-filename)) + ;; mouse-sensitive messages (requires XEmacs) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (require 'mode-motion) + (setq mode-motion-hook 'pure-motion-hook))) + (comint-read-input-ring t) + (require 'easymenu) + (easy-menu-define pure-eval-mode-menu-map pure-eval-mode-map + "Menu keymap for Pure mode." pure-eval-mode-menu) + (easy-menu-add pure-eval-mode-menu-map pure-eval-mode-map) + (run-hooks 'pure-eval-mode-hook)) + +(if (string-match "XEmacs" emacs-version) +(defun pure-motion-hook (event) + (mode-motion-highlight-internal + event + #'beginning-of-line + #'(lambda () + (if (looking-at pure-msg-regexp) + (end-of-line)))) +)) + +;; run a Q script in a Q eval buffer + +;; make sure win32 XEmacs quotes arguments containing whitespace + +(if (string-match "XEmacs.*-win32" (emacs-version)) + (defun pure-quote-arg (x) + (if (string-match "[ \t]" x) (concat "\"" x "\"") x)) + (defun pure-quote-arg (x) x)) + +;;;###autoload +(defun run-pure (&rest args) + + "Run the interpreter with given arguments, in buffer *pure-eval*. + +The interpreter is invoked in the directory of the current buffer (current +default directory if no file is associated with the current buffer). +If buffer exists but process is not running, make new process. +If buffer exists and process is running, kill it and start a new one. + +Program used comes from variable `pure-prog-name'. The buffer is put in Pure +eval mode, giving commands for visiting source files, sending input, +manipulating the command history, etc. See `pure-eval-mode'. + +\(Type \\[describe-mode] in the Pure eval buffer for a list of commands.)" + + (interactive) + (let* ((dir (if buffer-file-name + (file-name-directory (buffer-file-name)) + default-directory)) + (pure-eval-active (not (null (get-buffer "*pure-eval*")))) + (pure-eval-running (comint-check-proc "*pure-eval*")) + (pure-eval-buffer (get-buffer-create "*pure-eval*"))) + (if (and pure-eval-running + pure-query-before-kill + (not + (y-or-n-p + "An interpreter process is still running. Start a new one? "))) + (message "Aborted") + (set-buffer pure-eval-buffer) + ;; give process some time to terminate, then blast it away + (if pure-eval-running + (progn + (comint-send-eof) + (sleep-for .5))) + (if (comint-check-proc "*pure-eval*") + (progn + (comint-kill-subjob) + (sleep-for .1))) + (cd dir) + (if (not pure-eval-active) + (pure-eval-mode) + (if (and pure-eval-running + (or (not (string-equal + comint-input-ring-file-name pure-histfile)) + (not (= comint-input-ring-size pure-histsize)))) + ;; reset history in case any of the options have changed + (progn + (comint-write-input-ring) + (setq comint-input-ring-file-name pure-histfile + comint-input-ring-size pure-histsize) + (comint-read-input-ring t)))) + (goto-char (point-max)) + ;; invoke the interpreter + (comint-exec pure-eval-buffer "pure-eval" pure-prog-name nil + (append (list "-i") args)) + ;; set up process parameters + (setq pure-output-list nil + pure-output-string nil + pure-receive-in-progress nil + pure-last-script nil + pure-last-dir dir + pure-last-path nil) + (set-process-sentinel (get-process "pure-eval") 'pure-eval-sentinel) + (if (not pure-query-before-kill) + (process-kill-without-query (get-process "pure-eval"))) + ;; switch to and go to the end of the eval buffer + (pop-to-buffer "*pure-eval*") + (goto-char (point-max)))) + ) + +(defun pure-run-script () + "Run the interpreter with the script in the current buffer, in buffer +*pure-eval*. See `run-pure' for details." + (interactive) + (let ((script-file + (if (buffer-file-name) + (file-name-nondirectory (buffer-file-name)) + (error "Buffer is not associated with any file")))) + (save-some-buffers) + (run-pure script-file) + (setq pure-last-script script-file))) + +;; find a script in the current directory or on the Pure library path + +(defun pure-locate-script (file) + (let ((script (locate-library file t (list "." pure-lib-dir)))) + (if script + script + (error (concat "File " file " not found"))))) + +;; visit source lines of error and debugging messages + +(defun pure-current-msg () + "Show the source line referenced by an error message on the current line +in the Pure eval buffer." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (cond + ((save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (forward-line 0) (recenter 0) + (let (visit-buffer + visit-line + (file (match-string 2)) (line (match-string 3))) + (setq visit-buffer (find-file-noselect (pure-locate-script file))) + (setq visit-line (string-to-number line)) + (message "%s, line %s" file line) + (switch-to-buffer-other-window visit-buffer) + (goto-line visit-line))) + (t + (select-window actwindow) + (error "No message found"))))) + +(defun pure-current-msg-or-send () + "Depending on whether point is at an error message, either execute a +`pure-current-msg' or a `comint-send-input' command. This must be invoked +from the Pure eval buffer." + (interactive) + (if (save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (pure-current-msg) + (comint-send-input))) + +(defun pure-next-msg (&optional count) + "Advance to the next Pure error message below the current line in the Pure +eval buffer, and show the referenced source line in another window. When used +with a numeric argument n, advance to the nth message below the current line +(move backwards if numeric argument is negative). + +Note that this command can easily be fooled if the running script produces +some output, or you insert some text, which looks like an error message, so +you should take care what you're doing." + (interactive "P") + (if (and (numberp count) (< count 0)) + (pure-prev-msg (- count)) + (if (null count) (setq count 1)) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (if (looking-at pure-msg-regexp) + (if (save-excursion (end-of-line) (not (eobp))) + (forward-line 1) + (error "No more messages"))) + (let ((pos (re-search-forward pure-msg-regexp nil t count))) + (if pos + (let ((file (match-string 2)) (line (match-string 3))) + (goto-char pos) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line)) + (select-window actwindow) + (error "No more messages")))))) + +(defun pure-prev-msg (&optional count) + "Advance to previous Pure error messages above the current line in the Pure +eval buffer, and show the referenced source line in another window. Like +`pure-next-msg', but moves backward." + (interactive "P") + (if (and (numberp count) (< count 0)) + (pure-next-msg (- count)) + (if (null count) (setq count 1)) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos (re-search-backward pure-msg-regexp nil t count))) + (if pos + (let ((file (match-string 2)) (line (match-string 3))) + (goto-char pos) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line)) + (select-window actwindow) + (error "No more messages")))))) + +(defun pure-last-msg () + "Advance to the last message in a contiguous sequence of error messages at +or below the current line, and show the referenced source line in another +window." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos + (if (looking-at pure-msg-regexp) + (point) + (re-search-forward pure-msg-regexp nil t)))) + (if pos + (progn + (goto-char pos) + (while (and (save-excursion (end-of-line) (not (eobp))) + (save-excursion (forward-line 1) + (looking-at pure-msg-regexp))) + (forward-line 1)) + (let ((file (match-string 2)) (line (match-string 3))) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line))) + (select-window actwindow) + (error "No more messages"))))) + +(defun pure-first-msg () + "Advance to the first message in a contiguous sequence of error messages at +or above the current line, and show the referenced source line in another +window." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos + (if (looking-at pure-msg-regexp) + (point) + (re-search-backward pure-msg-regexp nil t)))) + (if pos + (progn + (goto-char pos) + (while (and (not (bobp)) + (save-excursion (forward-line -1) + (looking-at pure-msg-regexp))) + (forward-line -1)) + (let ((file (match-string 2)) (line (match-string 3))) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line))) + (select-window actwindow) + (error "No more messages"))))) + +(defun pure-mouse-msg (event) + "Show the source line referenced by an error message under the mouse." + (interactive "e") + (mouse-set-point event) + (if (save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (progn (forward-line 0) (pure-current-msg)) + (mouse-yank event))) + +;; visit main script and the eval buffer + +(defun pure-find-script () + "Visit the script currently running in the Pure eval buffer." + (interactive) + (if (and pure-last-dir pure-last-script) + (if (not (string-equal (concat pure-last-dir pure-last-script) + (buffer-file-name))) + (find-file-other-window (concat pure-last-dir pure-last-script))) + (error "No script is running"))) + +(defun pure-goto-input-line () + "Move to the prompt in the Pure eval buffer." + (interactive) + (if (get-buffer "*pure-eval*") + (progn (pop-to-buffer "*pure-eval*") (goto-char (point-max))) + (error "No script is running"))) + +;; completion + +;; XXXFIXME: Currently this just calls the comint-dynamic-complete function, +;; as the Pure interpreter doesn't understand the completion_matches command +;; right now. + +(defun pure-complete () + "Perform completion on the token preceding point." + (interactive) + (comint-dynamic-complete)) + +; (defun pure-complete () +; "Perform completion on the token preceding point." +; (interactive) +; (if (pure-at-command-prompt-p) +; (let* ((end (point)) +; (command +; (save-excursion +; ;; skip over anything but whitespace, quotes and parentheses +; (skip-syntax-backward "w_.\\$'<>") +; (and (looking-at pure-prompt-regexp) +; (goto-char (match-end 0))) +; (buffer-substring-no-properties (point) end)))) +; (pure-send-list-and-digest +; (list (concat "completion_matches \"" command "\"\n"))) +; ;; Sort the list +; (setq pure-output-list +; (sort pure-output-list 'string-lessp)) +; ;; Remove duplicates +; (let* ((x pure-output-list) +; (y (cdr x))) +; (while y +; (if (string-equal (car x) (car y)) +; (setcdr x (setq y (cdr y))) +; (setq x y +; y (cdr y))))) +; ;; And let comint handle the rest +; (comint-dynamic-simple-complete command pure-output-list)))) + +;; send commands to the Q interpreter and digest their results + +(defun pure-output-digest (proc string) + (setq string (concat pure-output-string string)) + (while (string-match "\n" string) + (setq pure-output-list + (append pure-output-list + (list (substring string 0 (match-beginning 0)))) + string (substring string (match-end 0)))) + (if (string-match pure-prompt-regexp string) + (setq pure-receive-in-progress nil)) + (setq pure-output-string string)) + +(defun pure-send-list-and-digest (list) + (let* ((pure-eval-buffer (get-buffer "*pure-eval*")) + (proc (get-buffer-process pure-eval-buffer)) + (filter (process-filter proc)) + string) + (set-process-filter proc 'pure-output-digest) + (setq pure-output-list nil) + (unwind-protect + (while (setq string (car list)) + (setq pure-output-string nil + pure-receive-in-progress t) + (comint-send-string proc string) + (while pure-receive-in-progress + (accept-process-output proc)) + (setq list (cdr list))) + (set-process-filter proc filter)))) + +;; perform cleanup when the interpreter process is killed + +(defun pure-eval-sentinel (proc msg) + (if (null (buffer-name (process-buffer proc))) + ;; buffer has been killed + (set-process-buffer proc nil) + (set-buffer (process-buffer proc)) + (comint-write-input-ring) + (setq pure-last-dir nil + pure-last-script nil) + (goto-char (point-max)) + (insert "\n*** Process Pure-Eval finished ***\n"))) + +;; make sure that the history is written when exiting emacs +(add-hook 'kill-emacs-hook + (lambda () + (let ((pure-eval-buffer (get-buffer "*pure-eval*"))) + (cond + (pure-eval-buffer + (set-buffer pure-eval-buffer) + (comint-write-input-ring)))))) + +;; autoindent and fill support (preliminary) + +;; XXXFIXME: This needs to be completely rewritten. We still use the Q +;; indentation rules here (with some minor tweaks), which don't work all that +;; well even in Q mode. + +(defun pure-electric-delim (arg) + "Insert character and correct line's indentation." + (interactive "P") + (if (and (not arg) + (save-excursion + (skip-chars-backward " \t") + (bolp))) + (progn + (insert last-command-char) + (pure-indent-line) + (delete-char -1))) + (self-insert-command (prefix-numeric-value arg))) + +;; find the position of the previous rule's rhs (`=' delimiter) +(defun pure-prev-rhs () + (if (not (pure-backward-to-delim "=")) + nil + ;; back up to beginning of rule, then find 1st `=' at toplevel + (beginning-of-rule) + (if (not (pure-forward-to-delim "=")) + nil ; this shouldn't happen + (backward-char) + (point)))) + +(defvar pure-qual-keywords "\\<\\(if\\|otherwise\\|when\\|with\\)\\>") + +(defun pure-at-qual () + (and (looking-at pure-qual-keywords) + (or (not (looking-at "else")) + (save-excursion + (backward-word 1) + (not (looking-at "or")))))) + +;; find the position of the previous qualifier or conditional keyword (if, +;; else, otherwise, etc.) +(defun pure-prev-qual () + (if (not (pure-backward-to-regexp pure-qual-keywords)) nil + (let ((success t) (done nil)) + (while (and success (not done)) + (setq done (pure-at-qual)) + (setq success (or done (pure-backward-to-regexp pure-qual-keywords)))) + (if (not done) nil + (let* ((p0 (point)) + (p (progn (beginning-of-line) + (if (pure-forward-to-regexp pure-qual-keywords) + (backward-word 1)) + (if (pure-at-qual) (point) p0)))) + (goto-char p)))))) + +(defun pure-move-to-indent-column () + "At end of line, move forward to the current `=' indentation column, as +given by the most recent rule or the \\[pure-default-rhs-indent] variable." + (interactive) + (if (save-excursion + (skip-chars-forward " \t") + (eolp)) + (let ((col (current-column)) + (icol (save-excursion + (if (pure-prev-rhs) + (current-column) + pure-default-rhs-indent)))) + (if (> icol col) + (move-to-column icol t))))) + +(defun pure-comment-indent () + "Compute Pure comment indentation." + (cond ((looking-at "^#!") 0) + ((looking-at "/[/*]") + (let ((indent (pure-calculate-indent))) + (if (consp indent) (car indent) indent))) + (t + (save-excursion + (skip-chars-backward " \t") + (max (current-column) +;; (max (1+ (current-column)) ;Insert one space at least + comment-column))) + )) + +;; FIXME: This stuff (beginning-of-rule, end-of-rule) is broken. It gets +;; caught in block comments easily -- unfortunately, Pure definitions may look a +;; lot like plain comment text ;-). There really seems to be no good way of +;; doing this, because these routines need to be fast, so we can't just parse +;; the whole file any time they are invoked. + +;; As implemented, beginning-of-rule looks for a line starting with a +;; word/symbol constituent, open parentheses, string, or optional whitespace +;; followed by a `=' character, whereas end-of-rule searches for a semicolon +;; at line end (with maybe some single-line comments and whitespace in +;; between). So reasonable formatting styles should all be parsed correctly. + +(defun beginning-of-rule () + "Move backward to beginning of current or previous rule." + (interactive) + (if (or + (if (and (> (current-column) 0) + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*="))) + (progn (beginning-of-line) t) + nil) + (re-search-backward "^\\w\\|^\\s_\\|^\\s(\\|^\\s\"\\|^[ \t]*=" + (point-min) 'mv)) + (let ((p (point))) + (pure-backward-to-noncomment (point-min)) + (if (and (not (bobp)) + (/= (preceding-char) ?\;) + (/= (preceding-char) ?\:)) + (beginning-of-rule) + (goto-char p))))) + +(defun end-of-rule () + "Move forward to end of current or next rule." + (interactive) + (let ((p (point))) + (while (and (re-search-forward +;;; match ";" + whitespace/comment sequence + "\n" +";\\([ \t]+\\|/\\*+\\([^\n\\*]\\|\\*[^\n/]\\)*\\*+/\\)*\\(//.*\\)?\n" + nil 'move) + (/= (1+ (match-beginning 0)) + (save-excursion + (pure-backward-to-noncomment p) + (point))))))) + +(defun pure-indent-line () + "Indent current line as Pure code. +Return the amount the indentation changed by." + (interactive) + (let ((indent (pure-calculate-indent nil)) + start-of-block + beg shift-amt + (case-fold-search nil) + (pos (- (point-max) (point)))) + (if (listp indent) + (progn + (setq start-of-block (cdr indent)) + (setq indent (car indent))) + (setq start-of-block 0)) + (beginning-of-line) + (setq beg (point)) + (setq indent + (cond ((eq indent nil) (current-indentation)) + ((eq indent t) (pure-calculate-indent-within-comment)) + (t + (skip-chars-forward " \t") + (cond ((looking-at "^#!") 0) + ((= (following-char) ?\)) start-of-block) + (t indent))))) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt)) + +(defvar pure-decl-keywords + (concat "\\<\\(" + "infix[lr]?\\|let\\|nullary\\|p\\(refix\\|ostfix\\)\\|using" + "\\)\\>")) + +(defun pure-indent-col (col pos) + (if pos + (let ((col2 (save-excursion (goto-char pos) (current-column)))) + (cons col col2)) + col) +) + +;; TODO: proper indentation of parenthesized if-then-else constructs +(defun pure-calculate-indent (&optional parse-start) + "Return appropriate indentation for current line as Pure code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment, +\(indent . start-of-block\) if line is within a paren block." + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + (case-fold-search nil) + state + containing-sexp + (at-decl nil) + (lhs-extra-indent 0) + (rhs-extra-indent + (save-excursion + (skip-chars-forward " \t") + (if (pure-at-qual) pure-extra-qual-indent 0))) + (following-character + (save-excursion (skip-chars-forward " \t") (following-char)))) + (if parse-start + (goto-char parse-start) + (let ((p (point))) + (pure-backward-to-noncomment (point-min)) + (if (and (not (bobp)) + (/= (preceding-char) ?\;)) + (beginning-of-rule) + (goto-char p)))) + ;; extra indent for continuation lines in declarations + (if (and (< (point) indent-point) + (looking-at pure-decl-keywords)) + (setq at-decl t + lhs-extra-indent pure-extra-decl-indent)) + (while (< (point) indent-point) + (setq parse-start (point)) + (setq state (parse-partial-sexp (point) indent-point 0)) + (setq containing-sexp (car (cdr state)))) + ;; the above sometimes craps out even if we're inside a balanced pair + ;; of parens, but the following should work in any case + (if (null containing-sexp) + (setq containing-sexp + (condition-case nil + (scan-lists indent-point -1 1) + (error nil)))) + (if (or (nth 3 state) (nth 4 state)) + ;; return nil or t if should not change this line + (nth 4 state) + ;; Check to see whether we are inside a sexp, on the lhs, rhs, + ;; qualifier, or at the = of a rule. + (goto-char indent-point) + (pure-backward-to-noncomment (or parse-start (point-min))) + (let (p0 p1 p2 p3 col1 col2 col3) + (setq p0 containing-sexp + p1 (save-excursion + (pure-backward-to-delim ";") + (point)) + p2 (save-excursion + (if (pure-prev-rhs) (point) 0)) + p3 (save-excursion + (if (pure-prev-qual) (point) 0))) + (if (> p2 0) + (setq col1 (save-excursion + (goto-char p2) + (current-column)) + col2 (save-excursion + (goto-char p2) + (forward-char) + (skip-chars-forward " \t") + (current-column)) + col3 (save-excursion + (goto-char p3) + (current-column))) + (setq col1 pure-default-rhs-indent + col2 pure-default-rhs-indent + col3 pure-default-rhs-indent)) + (cond + ((and (not (null p0)) (>= p0 (max p1 p2 p3))) + ;; inside a sexp (pair of balanced parens): indent at the column + ;; to the right of the paren + (let ((col (save-excursion (goto-char p0) (current-column)))) + (cons (1+ col) col))) + ((or (= following-character ?=) + (= following-character ?\;) + (and at-decl (= following-character ?|))) + ;; followup eqns (initial =), initial semi, and initial | + ;; in declarations are indented at preceding = + (pure-indent-col col1 p0)) + ((or at-decl (> p1 p2)) + ;; lhs: indent at lhs-extra-indent + (pure-indent-col lhs-extra-indent p0)) + ((> p3 p2) + ;; qualifier/conditional: indent at column of previous qualifier + ;; keyword plus pure-extra-qual-indent if no keyword at bol + (pure-indent-col + (+ col3 (if (= 0 rhs-extra-indent) pure-extra-qual-indent 0)) p0)) + (t + ;; rhs: indent at first token behind preceding = + ;; add rhs-extra-indent for initial qualifier keyword + (pure-indent-col (+ col2 rhs-extra-indent) p0)))))))) + +(defun pure-calculate-indent-within-comment () + "Return the indentation amount for line, assuming that +the current line is to be regarded as part of a block comment." + (let (end star-start) + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (setq star-start (= (following-char) ?\*)) + (skip-chars-backward " \t\n") + (setq end (point)) + (beginning-of-line) + (skip-chars-forward " \t") + (and (re-search-forward "/\\*[ \t]*" end t) + star-start + (goto-char (1+ (match-beginning 0)))) + (current-column)))) + +(defun pure-backward-to-noncomment (lim) + (let (opoint stop) + (while (not stop) + (skip-chars-backward " \t\n\f" lim) + (setq opoint (point)) + (if (and (>= (point) (+ 2 lim)) + (= (preceding-char) ?/) (= (char-after (- (point) 2)) ?*)) + (search-backward "/*" lim 'mv) + (let ((p (max lim (save-excursion (beginning-of-line) (point))))) + (if (nth 4 (parse-partial-sexp p (point))) + (re-search-backward "^#!\\|//" p 'mv) + (goto-char opoint) + (setq stop t))))))) + +(defun pure-forward-to-noncomment (lim) + (forward-char 1) + (while (progn + (skip-chars-forward " \t\n" lim) + (looking-at "^#!\\|//\\|/\\*")) + ;; Skip over comments and labels following openparen. + (if (looking-at "^#!\\|//") + (forward-line 1) + (forward-char 2) + (search-forward "*/" lim 'mv)))) + +;; some added stuff for finding = and ; delimiters in rules + +(defun pure-at-toplevel-p () + (let (p state) + (save-excursion + (setq p (save-excursion + (beginning-of-rule) + (point))) + (setq state (parse-partial-sexp p (point))) + (not (or (nth 1 state) + (nth 3 state) + (nth 4 state)))))) + +(defun pure-backward-to-delim (delim-str) + (let ((success nil)) + (while (and (search-backward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (bobp)))) + (if success (point) nil))) + +(defun pure-forward-to-delim (delim-str) + (let ((success nil)) + (while (and (search-forward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (eobp)))) + (if success (point) nil))) + +(defun pure-backward-to-regexp (delim-str) + (let ((success nil)) + (while (and (re-search-backward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (bobp)))) + (if success (point) nil))) + +(defun pure-forward-to-regexp (delim-str) + (let ((success nil)) + (while (and (re-search-forward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (eobp)))) + (if success (point) nil))) + +(defun pure-indent-current-rule () + "Indent all lines in the current rule." + (interactive) + (let (p) + (save-excursion + (end-of-rule) + (setq p (point-marker)) + (beginning-of-rule) + (while (< (point) p) + (pure-indent-line) + (forward-line 1))))) + +;; this stuff is from (XEmacs) cc-mode + +(defun pure-indent-region (start end) + ;; Indent every line whose first char is between START and END inclusive. + (let (p) + (save-excursion + (goto-char start) + (setq p (copy-marker end)) + (while (and (bolp) + (not (eobp)) + (< (point) p)) + (pure-indent-line) + (forward-line 1))))) + +(defun pure-indent-line-or-region () + "When the region is active, indent it. Otherwise indent the current line." + (interactive) + (if (pure-region-is-active-p) + (pure-indent-region (region-beginning) (region-end)) + (pure-indent-line))) + +;; paragraph fill from (XEmacs) cc-mode, boiled down for Pure mode + +(defmacro pure-safe (&rest body) + ;; safely execute BODY, return nil if an error occurred + (` (condition-case nil + (progn (,@ body)) + (error nil)))) + +(defmacro pure-forward-sexp (&optional arg) + ;; like forward-sexp except + ;; 1. this is much stripped down from the XEmacs version + ;; 2. this cannot be used as a command, so we're insulated from + ;; XEmacs' losing efforts to make forward-sexp more user + ;; friendly + ;; 3. Preserves the semantics most of CC Mode is based on + (or arg (setq arg 1)) + `(goto-char (or (scan-sexps (point) ,arg) + ,(if (numberp arg) + (if (> arg 0) `(point-max) `(point-min)) + `(if (> ,arg 0) (point-max) (point-min)))))) + +(defmacro pure-backward-sexp (&optional arg) + ;; See pure-forward-sexp and reverse directions + (or arg (setq arg 1)) + `(pure-forward-sexp ,(if (numberp arg) (- arg) `(- ,arg)))) + +(defsubst pure-point (position) + ;; Returns the value of point at certain commonly referenced POSITIONs. + ;; POSITION can be one of the following symbols: + ;; + ;; bol -- beginning of line + ;; eol -- end of line + ;; + ;; This function does not modify point or mark. + (let ((here (point))) + (cond + ((eq position 'bol) (beginning-of-line)) + ((eq position 'eol) (end-of-line)) + (t (error "unknown buffer position requested: %s" position)) + ) + (prog1 + (point) + (goto-char here)))) + +(defun pure-literal-limits (&optional lim near) + ;; Returns a cons of the beginning and end positions of the comment + ;; or string surrounding point (including both delimiters), or nil + ;; if point isn't in one. If LIM is non-nil, it's used as the + ;; "safe" position to start parsing from. If NEAR is non-nil, then + ;; the limits of any literal next to point is returned. "Next to" + ;; means there's only [ \t] between point and the literal. The + ;; search for such a literal is done first in forward direction. + ;; + ;; This is the Emacs 19 version. + (save-excursion + (let* ((pos (point)) +;;; FIXME: need a reasonable replacement for `beginning-of-defun' (bod) here. +;;; (lim (or lim (pure-point 'bod))) + (lim (or lim (point-min))) + (state (parse-partial-sexp lim (point)))) + (cond ((nth 3 state) + ;; String. Search backward for the start. + (while (nth 3 state) + (search-backward (make-string 1 (nth 3 state))) + (setq state (parse-partial-sexp lim (point)))) + (cons (point) (or (pure-safe (pure-forward-sexp 1) (point)) + (point-max)))) + ((nth 7 state) + ;; Line comment. Search from bol for the comment starter. + (beginning-of-line) + (setq state (parse-partial-sexp lim (point)) + lim (point)) + (while (not (nth 7 state)) + (search-forward "//") ; Should never fail. + (setq state (parse-partial-sexp + lim (point) nil nil state) + lim (point))) + (backward-char 2) + (cons (point) (progn (forward-comment 1) (point)))) + ((nth 4 state) + ;; Block comment. Search backward for the comment starter. + (while (nth 4 state) + (search-backward "/*") ; Should never fail. + (setq state (parse-partial-sexp lim (point)))) + (cons (point) (progn (forward-comment 1) (point)))) + ((pure-safe (nth 4 (parse-partial-sexp ; Can't use prev state due + lim (1+ (point))))) ; to bug in Emacs 19.34. + ;; We're standing in a comment starter. + (backward-char 2) + (cons (point) (progn (forward-comment 1) (point)))) + (near + (goto-char pos) + ;; Search forward for a literal. + (skip-chars-forward " \t") + (cond + ((eq (char-syntax (or (char-after) ?\ )) ?\") ; String. + (cons (point) (or (pure-safe (pure-forward-sexp 1) (point)) + (point-max)))) + ((looking-at pure-comment-start-regexp) ; Line or block comment. + (cons (point) (progn (forward-comment 1) (point)))) + (t + ;; Search backward. + (skip-chars-backward " \t") + (let ((end (point)) beg) + (cond + ((eq (char-syntax (or (char-before) ?\ )) ?\") ; String. + (setq beg (pure-safe (pure-backward-sexp 1) (point)))) + ((and (pure-safe (forward-char -2) t) + (looking-at "*/")) + ;; Block comment. Due to the nature of line + ;; comments, they will always be covered by the + ;; normal case above. + (goto-char end) + (forward-comment -1) + ;; If LIM is bogus, beg will be bogus. + (setq beg (point)))) + (if beg (cons beg end)))))) + )))) + +(defconst pure-comment-start-regexp "\\(/[/*]\\|^#!\\)") + +;; FIXME: I'm wondering why this code messes up the fontification of comment +;; paragraphs since the same code apparently works in C/C++ mode, and the +;; comment syntax is also the same. :( This only happens with XEmacs +;; (21.1p10), no problems with GNU Emacs. Maybe the XEmacs font-lock stuff is +;; broken, or has some special built-in support for the C modes? Anyway, if +;; anyone knows how to fix this please let me know. -AG + +(defun pure-fill-paragraph (&optional arg) + "Like \\[fill-paragraph] but handles Pure (i.e., C/C++) style +comments. If any of the current line is a comment or within a comment, +fill the comment or the paragraph of it that point is in, +preserving the comment indentation or line-starting decorations. + +If point is inside multiline string literal, fill it. This currently +does not respect escaped newlines, except for the special case when it +is the very first thing in the string. The intended use for this rule +is in situations like the following: + +description = \"\\ +A very long description of something that you want to fill to make +nicely formatted output.\"\; + +If point is in any other situation, i.e. in normal code, do nothing. + +Optional prefix ARG means justify paragraph as well." + (interactive "*P") + (let* ((point-save (point-marker)) + limits + comment-start-place + (first-line + ;; Check for obvious entry to comment. + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (and (looking-at comment-start-skip) + (setq comment-start-place (point))))) + (re1 "\\|\\([ \t]*/\\*[ \t]*\\|[ \t]*\\*/[ \t]*\\|[ \t/*]*\\)")) + (if (save-excursion + (beginning-of-line) + (looking-at "#!\\|.*//")) + (let ((fill-prefix fill-prefix) + ;; Lines containing just a comment start or just an end + ;; should not be filled into paragraphs they are next + ;; to. + (paragraph-start (concat paragraph-start re1 "$")) + (paragraph-separate (concat paragraph-separate re1 "$"))) + (save-excursion + (beginning-of-line) + ;; Move up to first line of this comment. + (while (and (not (bobp)) + (looking-at "[ \t]*//[ \t]*[^ \t\n]")) + (forward-line -1)) + (if (not (looking-at ".*//[ \t]*[^ \t\n]")) + (forward-line 1)) + ;; Find the comment start in this line. + (re-search-forward "[ \t]*//[ \t]*") + ;; Set the fill-prefix to be what all lines except the first + ;; should start with. But do not alter a user set fill-prefix. + (if (null fill-prefix) + (setq fill-prefix (buffer-substring (match-beginning 0) + (match-end 0)))) + (save-restriction + ;; Narrow down to just the lines of this comment. + (narrow-to-region (pure-point 'bol) + (save-excursion + (forward-line 1) + (while + (looking-at (regexp-quote fill-prefix)) + (forward-line 1)) + (point))) + (or (pure-safe + ;; fill-paragraph sometimes fails to detect when we + ;; are between paragraphs. + (beginning-of-line) + (search-forward fill-prefix (pure-point 'eol)) + (looking-at paragraph-separate)) + ;; Avoids recursion + (let (fill-paragraph-function) + (fill-paragraph arg)))))) + ;; else C style comments + (if (or first-line + ;; t if we enter a comment between start of function and + ;; this line. + (save-excursion + (setq limits (pure-literal-limits)) + (and (consp limits) + (save-excursion + (goto-char (car limits)) + (looking-at pure-comment-start-regexp)))) + ;; t if this line contains a comment starter. + (setq first-line + (save-excursion + (beginning-of-line) + (prog1 + (re-search-forward comment-start-skip + (save-excursion (end-of-line) + (point)) + t) + (setq comment-start-place (point))))) + ;; t if we're in the whitespace after a comment ender + ;; which ends its line. + (and (not limits) + (when (and (looking-at "[ \t]*$") + (save-excursion + (beginning-of-line) + (looking-at ".*\\*/[ \t]*$"))) + (save-excursion + (forward-comment -1) + (setq comment-start-place (point))) + t))) + ;; Inside a comment: fill one comment paragraph. + (let ((fill-prefix + (or + ;; Keep user set fill prefix if any. + fill-prefix + ;; The prefix for each line of this paragraph + ;; is the appropriate part of the start of this line, + ;; up to the column at which text should be indented. + (save-excursion + (beginning-of-line) + (if (looking-at ".*/\\*.*\\*/") + (progn (re-search-forward comment-start-skip) + (make-string (current-column) ?\ )) + (if first-line + (forward-line 1) + (if (and (looking-at "[ \t]*\\*/") + (not (save-excursion + (forward-line -1) + (looking-at ".*/\\*")))) + (forward-line -1))) + + (let ((line-width (progn (end-of-line) + (current-column)))) + (beginning-of-line) + (prog1 + (buffer-substring + (point) + + ;; How shall we decide where the end of the + ;; fill-prefix is? + (progn + (skip-chars-forward " \t*" (pure-point 'eol)) + ;; kludge alert, watch out for */, in + ;; which case fill-prefix should *not* + ;; be "*"! + (if (and (eq (char-after) ?/) + (eq (char-before) ?*)) + (forward-char -1)) + (point))) + + ;; If the comment is only one line followed + ;; by a blank line, calling move-to-column + ;; above may have added some spaces and tabs + ;; to the end of the line; the fill-paragraph + ;; function will then delete it and the + ;; newline following it, so we'll lose a + ;; blank line when we shouldn't. So delete + ;; anything move-to-column added to the end + ;; of the line. We record the line width + ;; instead of the position of the old line + ;; end because move-to-column might break a + ;; tab into spaces, and the new characters + ;; introduced there shouldn't be deleted. + + ;; If you can see a better way to do this, + ;; please make the change. This seems very + ;; messy to me. + (delete-region (progn (move-to-column line-width) + (point)) + (progn (end-... [truncated message content] |
From: <ag...@us...> - 2008-06-14 06:59:30
|
Revision: 216 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=216&view=rev Author: agraef Date: 2008-06-13 23:59:34 -0700 (Fri, 13 Jun 2008) Log Message: ----------- Add -q (quiet startup) option and PURE_MORE environment variable. Modified Paths: -------------- pure/trunk/lexer.ll pure/trunk/pure.cc Modified: pure/trunk/lexer.ll =================================================================== --- pure/trunk/lexer.ll 2008-06-14 00:32:38 UTC (rev 215) +++ pure/trunk/lexer.ll 2008-06-14 06:59:34 UTC (rev 216) @@ -449,8 +449,9 @@ sout << nfuns << " functions, " << nrules << " rules\n"; } FILE *fp; + const char *more = getenv("PURE_MORE"); // FIXME: We should check that 'more' actually exists here. - if (isatty(fileno(stdin)) && (fp = popen("more", "w"))) { + if (more && isatty(fileno(stdin)) && (fp = popen(more, "w"))) { fputs(sout.str().c_str(), fp); pclose(fp); } else Modified: pure/trunk/pure.cc =================================================================== --- pure/trunk/pure.cc 2008-06-14 00:32:38 UTC (rev 215) +++ pure/trunk/pure.cc 2008-06-14 06:59:34 UTC (rev 216) @@ -34,10 +34,12 @@ -h: Print this message and exit.\n\ -i: Force interactive mode (read commands from stdin).\n\ -n: Suppress automatic inclusion of the prelude.\n\ +-q: Quiet startup (suppresses sign-on message).\n\ -v: Set verbosity level (useful for debugging purposes).\n\ --: Stop option processing, pass remaining args in argv variable.\n\ Environment:\n\ PURELIB: Directory to search for source scripts including the prelude.\n\ +PURE_MORE: Shell command for paging through output of the 'list' command.\n\ PURE_PS: Command prompt to be used in the interactive command loop.\n\ PURE_STACK: Maximum stack size in kilobytes (default: 0 = unlimited).\n" #define LICENSE "This program is free software distributed under the GNU Public License\n(GPL V3 or later). Please see the COPYING file for details.\n" @@ -152,7 +154,8 @@ char base; interpreter interp; int count = 0; - bool force_interactive = false, want_prelude = true, have_prelude = false; + bool quiet = false, force_interactive = false, + want_prelude = true, have_prelude = false; // This is used in advisory stack checks. interpreter::baseptr = &base; // make sure that SIGPIPE is ignored @@ -200,6 +203,8 @@ force_interactive = true; else if (*args == string("-n")) want_prelude = false; + else if (*args == string("-q")) + quiet = true; else if (string(*args).substr(0,2) == "-v") { string s = string(*args).substr(2); if (s.empty()) continue; @@ -256,10 +261,12 @@ interp.interactive = true; if (isatty(fileno(stdin))) { // connected to a terminal, print sign-on and initialize readline - cout << "Pure " << PACKAGE_VERSION << " (" << HOST << ") " - << COPYRIGHT << endl << LICENSE; - if (have_prelude) - cout << "Loaded prelude from " << prelude << ".\n\n"; + if (!quiet) { + cout << "Pure " << PACKAGE_VERSION << " (" << HOST << ") " + << COPYRIGHT << endl << LICENSE; + if (have_prelude) + cout << "Loaded prelude from " << prelude << ".\n\n"; + } rl_readline_name = "Pure"; rl_attempted_completion_function = pure_completion; using_history(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-14 08:23:55
|
Revision: 222 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=222&view=rev Author: agraef Date: 2008-06-14 01:24:02 -0700 (Sat, 14 Jun 2008) Log Message: ----------- Add -x option, shebang support. Modified Paths: -------------- pure/trunk/lexer.ll pure/trunk/pure.cc Modified: pure/trunk/lexer.ll =================================================================== --- pure/trunk/lexer.ll 2008-06-14 07:41:05 UTC (rev 221) +++ pure/trunk/lexer.ll 2008-06-14 08:24:02 UTC (rev 222) @@ -154,6 +154,7 @@ {blank}+ yylloc->step(); [\n]+ yylloc->lines(yyleng); yylloc->step(); +^"#!".* | "//".* yylloc->step(); "/*" BEGIN(comment); Modified: pure/trunk/pure.cc =================================================================== --- pure/trunk/pure.cc 2008-06-14 07:41:05 UTC (rev 221) +++ pure/trunk/pure.cc 2008-06-14 08:24:02 UTC (rev 222) @@ -31,11 +31,13 @@ #define COPYRIGHT "Copyright (c) 2008 by Albert Graef" #define USAGE \ "Usage: pure [-h] [-i] [-n] [-q] [-v[level]] [script ...] [-- args ...]\n\ + pure [-h] [-i] [-n] [-q] [-v[level]] -x script [args ...]\n\ -h: Print this message and exit.\n\ -i: Force interactive mode (read commands from stdin).\n\ -n: Suppress automatic inclusion of the prelude.\n\ -q: Quiet startup (suppresses sign-on message).\n\ -v: Set verbosity level (useful for debugging purposes).\n\ +-x: Execute script with given command line arguments.\n\ --: Stop option processing, pass remaining args in argv variable.\n\ Environment:\n\ PURELIB: Directory to search for source scripts including the prelude.\n\ @@ -214,6 +216,9 @@ interp.error(prog + ": invalid option " + *args); return 1; } + } else if (*args == string("-x")) { + while (*++args) myargs.push_back(*args); + break; } else if (*args == string("--")) { while (*++args) myargs.push_back(*args); break; @@ -244,6 +249,12 @@ string s = string(*argv).substr(2); if (!s.empty()) level = (uint8_t)strtoul(s.c_str(), 0, 0); interp.verbose = level; + } else if (*argv == string("-x")) { + if (*++argv) { + if (count++ == 0) interp.modname = *argv; + interp.run(*argv); + } + break; } else if (*argv == string("--")) break; else if (**argv == '-') This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-15 09:25:36
|
Revision: 236 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=236&view=rev Author: agraef Date: 2008-06-15 02:25:43 -0700 (Sun, 15 Jun 2008) Log Message: ----------- gcc 4.3 compatibility fixes. Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/matcher.hh Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-14 22:33:14 UTC (rev 235) +++ pure/trunk/ChangeLog 2008-06-15 09:25:43 UTC (rev 236) @@ -1,3 +1,8 @@ +2008-06-15 Albert Graef <Dr....@t-...> + + * matcher.hh: gcc 4.3 compatibility fixes. Suggested by Toni + Graffy. + 2008-06-14 Albert Graef <Dr....@t-...> * lexer.ll: Various changes in order to facilitate script Modified: pure/trunk/matcher.hh =================================================================== --- pure/trunk/matcher.hh 2008-06-14 22:33:14 UTC (rev 235) +++ pure/trunk/matcher.hh 2008-06-15 09:25:43 UTC (rev 236) @@ -4,6 +4,7 @@ #include <iostream> #include <string> +#include <cstring> #include <list> #include <vector> #include "expr.hh" This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 07:43:02
|
Revision: 238 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=238&view=rev Author: agraef Date: 2008-06-16 00:43:07 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Move auxiliary configure files to separate config directory. Added Paths: ----------- pure/trunk/config/aclocal.m4 pure/trunk/config/config.guess pure/trunk/config/config.sub pure/trunk/config/install-sh Removed Paths: ------------- pure/trunk/aclocal.m4 pure/trunk/config.guess pure/trunk/config.sub pure/trunk/install-sh Deleted: pure/trunk/aclocal.m4 =================================================================== --- pure/trunk/aclocal.m4 2008-06-16 07:41:30 UTC (rev 237) +++ pure/trunk/aclocal.m4 2008-06-16 07:43:07 UTC (rev 238) @@ -1,84 +0,0 @@ -dnl iconv check from Bruno Haible. - -AC_DEFUN([AM_ICONV], -[ - dnl Some systems have iconv in libc, some have it in libiconv (OSF/1 and - dnl those with the standalone portable GNU libiconv installed). - - am_cv_lib_iconv_ldpath= - AC_ARG_WITH([libiconv-prefix], -[ --with-libiconv-prefix=DIR search for libiconv in DIR/include and DIR/lib], [ - for dir in `echo "$withval" | tr : ' '`; do - if test -d $dir/include; then CPPFLAGS="$CPPFLAGS -I$dir/include"; fi - if test -d $dir/lib; then am_cv_lib_iconv_ldpath="-L$dir/lib"; fi - done - ]) - - AC_CACHE_CHECK(for iconv, am_cv_func_iconv, [ - am_cv_func_iconv="no, consider installing GNU libiconv" - am_cv_lib_iconv=no - AC_TRY_LINK([#include <stdlib.h> -#include <iconv.h>], - [iconv_t cd = iconv_open("",""); - iconv(cd,NULL,NULL,NULL,NULL); - iconv_close(cd);], - am_cv_func_iconv=yes) - if test "$am_cv_func_iconv" != yes; then - am_save_LIBS="$LIBS" - LIBS="$LIBS $am_cv_libiconv_ldpath -liconv" - AC_TRY_LINK([#include <stdlib.h> -#include <iconv.h>], - [iconv_t cd = iconv_open("",""); - iconv(cd,NULL,NULL,NULL,NULL); - iconv_close(cd);], - am_cv_lib_iconv=yes - am_cv_func_iconv=yes) - LIBS="$am_save_LIBS" - fi - ]) - if test "$am_cv_func_iconv" = yes; then - AC_DEFINE(HAVE_ICONV, 1, [Define if you have the iconv() function.]) - AC_MSG_CHECKING([for iconv declaration]) - AC_CACHE_VAL(am_cv_proto_iconv, [ - AC_TRY_COMPILE([ -#include <stdlib.h> -#include <iconv.h> -extern -#ifdef __cplusplus -"C" -#endif -#if defined(__STDC__) || defined(__cplusplus) -size_t iconv (iconv_t cd, char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft); -#else -size_t iconv(); -#endif -], [], am_cv_proto_iconv_arg1="", am_cv_proto_iconv_arg1="const") - am_cv_proto_iconv="extern size_t iconv (iconv_t cd, $am_cv_proto_iconv_arg1 char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);"]) - am_cv_proto_iconv=`echo "[$]am_cv_proto_iconv" | tr -s ' ' | sed -e 's/( /(/'` - AC_MSG_RESULT([$]{ac_t:- - }[$]am_cv_proto_iconv) - AC_DEFINE_UNQUOTED(ICONV_CONST, $am_cv_proto_iconv_arg1, - [Define as const if the declaration of iconv() needs const.]) - fi - LIBICONV= - if test "$am_cv_lib_iconv" = yes; then - LIBICONV="$am_cv_lib_iconv_ldpath -liconv" - fi - AC_SUBST(LIBICONV) -]) - -dnl nl_langinfo/CODESET check from Bruno Haible. - -AC_DEFUN([AM_LANGINFO_CODESET], -[ - AC_CACHE_CHECK([for nl_langinfo and CODESET], am_cv_langinfo_codeset, - [AC_TRY_LINK([#include <langinfo.h>], - [char* cs = nl_langinfo(CODESET);], - am_cv_langinfo_codeset=yes, - am_cv_langinfo_codeset=no) - ]) - if test $am_cv_langinfo_codeset = yes; then - AC_DEFINE(HAVE_LANGINFO_CODESET, 1, - [Define if you have <langinfo.h> and nl_langinfo(CODESET).]) - fi -]) Copied: pure/trunk/config/aclocal.m4 (from rev 200, pure/trunk/aclocal.m4) =================================================================== --- pure/trunk/config/aclocal.m4 (rev 0) +++ pure/trunk/config/aclocal.m4 2008-06-16 07:43:07 UTC (rev 238) @@ -0,0 +1,84 @@ +dnl iconv check from Bruno Haible. + +AC_DEFUN([AM_ICONV], +[ + dnl Some systems have iconv in libc, some have it in libiconv (OSF/1 and + dnl those with the standalone portable GNU libiconv installed). + + am_cv_lib_iconv_ldpath= + AC_ARG_WITH([libiconv-prefix], +[ --with-libiconv-prefix=DIR search for libiconv in DIR/include and DIR/lib], [ + for dir in `echo "$withval" | tr : ' '`; do + if test -d $dir/include; then CPPFLAGS="$CPPFLAGS -I$dir/include"; fi + if test -d $dir/lib; then am_cv_lib_iconv_ldpath="-L$dir/lib"; fi + done + ]) + + AC_CACHE_CHECK(for iconv, am_cv_func_iconv, [ + am_cv_func_iconv="no, consider installing GNU libiconv" + am_cv_lib_iconv=no + AC_TRY_LINK([#include <stdlib.h> +#include <iconv.h>], + [iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd);], + am_cv_func_iconv=yes) + if test "$am_cv_func_iconv" != yes; then + am_save_LIBS="$LIBS" + LIBS="$LIBS $am_cv_libiconv_ldpath -liconv" + AC_TRY_LINK([#include <stdlib.h> +#include <iconv.h>], + [iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd);], + am_cv_lib_iconv=yes + am_cv_func_iconv=yes) + LIBS="$am_save_LIBS" + fi + ]) + if test "$am_cv_func_iconv" = yes; then + AC_DEFINE(HAVE_ICONV, 1, [Define if you have the iconv() function.]) + AC_MSG_CHECKING([for iconv declaration]) + AC_CACHE_VAL(am_cv_proto_iconv, [ + AC_TRY_COMPILE([ +#include <stdlib.h> +#include <iconv.h> +extern +#ifdef __cplusplus +"C" +#endif +#if defined(__STDC__) || defined(__cplusplus) +size_t iconv (iconv_t cd, char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft); +#else +size_t iconv(); +#endif +], [], am_cv_proto_iconv_arg1="", am_cv_proto_iconv_arg1="const") + am_cv_proto_iconv="extern size_t iconv (iconv_t cd, $am_cv_proto_iconv_arg1 char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);"]) + am_cv_proto_iconv=`echo "[$]am_cv_proto_iconv" | tr -s ' ' | sed -e 's/( /(/'` + AC_MSG_RESULT([$]{ac_t:- + }[$]am_cv_proto_iconv) + AC_DEFINE_UNQUOTED(ICONV_CONST, $am_cv_proto_iconv_arg1, + [Define as const if the declaration of iconv() needs const.]) + fi + LIBICONV= + if test "$am_cv_lib_iconv" = yes; then + LIBICONV="$am_cv_lib_iconv_ldpath -liconv" + fi + AC_SUBST(LIBICONV) +]) + +dnl nl_langinfo/CODESET check from Bruno Haible. + +AC_DEFUN([AM_LANGINFO_CODESET], +[ + AC_CACHE_CHECK([for nl_langinfo and CODESET], am_cv_langinfo_codeset, + [AC_TRY_LINK([#include <langinfo.h>], + [char* cs = nl_langinfo(CODESET);], + am_cv_langinfo_codeset=yes, + am_cv_langinfo_codeset=no) + ]) + if test $am_cv_langinfo_codeset = yes; then + AC_DEFINE(HAVE_LANGINFO_CODESET, 1, + [Define if you have <langinfo.h> and nl_langinfo(CODESET).]) + fi +]) Copied: pure/trunk/config/config.guess (from rev 200, pure/trunk/config.guess) =================================================================== --- pure/trunk/config/config.guess (rev 0) +++ pure/trunk/config/config.guess 2008-06-16 07:43:07 UTC (rev 238) @@ -0,0 +1,1513 @@ +#! /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, 2006 Free Software Foundation, +# Inc. + +timestamp='2007-01-15' + +# 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 <pe...@bo...>. +# Please send patches to <con...@gn...>. 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 <con...@gn...>." + +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. +# (gh...@no... 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 ;; + sh5el) machine=sh5le-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 powerpc-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*:*:*) + # ak...@wp... (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 <stdio.h> /* 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 <sys/systemcfg.h> + + 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 <stdlib.h> + #include <unistd.h> + + 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 <unistd.h> + 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/[-(].*//'` ;; + amd64) + echo x86_64-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 ;; + *: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*:[3456]*) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + EM64T:Interix*:[3456]* | authenticamd:Interix*:[3456]*) + 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 ;; + avr32*: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 ;; + xtensa:Linux:*:*) + echo xtensa-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 <features.h> + #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(__SUNPRO_C) || defined(__SUNPRO_CC) + 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' </usr/options/cb.name` + echo ${UNAME_MACHINE}-pc-isc$UNAME_REL + elif /bin/uname -X 2>/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 <Ric...@cc...> + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes <he...@op...>. + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From se...@sw.... + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Pau...@st.... + echo ${UNAME_MACHINE}-stratus-vos + exit ;; + *:VOS:*:*) + # From Pau...@st.... + 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 ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-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 <<EOF +#ifdef _SEQUENT_ +# include <sys/types.h> +# include <sys/utsname.h> +#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 <sys/param.h> + 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 <sys/param.h> +# 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 <<EOF +$0: unable to guess system type + +This script, last modified $timestamp, has failed to recognize +the operating system you are using. It is advised that you +download the most up to date version of the config scripts from + + http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess +and + http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + +If the version you run ($0) is already up to date, please +send the following data and any information you think might be +pertinent to <con...@gn...> 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: Copied: pure/trunk/config/config.sub (from rev 200, pure/trunk/config.sub) =================================================================== --- pure/trunk/config/config.sub (rev 0) +++ pure/trunk/config/config.sub 2008-06-16 07:43:07 UTC (rev 238) @@ -0,0 +1,1622 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, +# Inc. + +timestamp='2007-01-18' + +# 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 <con...@gn...>. 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 <con...@gn...>." + +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 + ... [truncated message content] |
From: <ag...@us...> - 2008-06-16 07:56:56
|
Revision: 242 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=242&view=rev Author: agraef Date: 2008-06-16 00:57:01 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Move syntax highlighting stuff to a separate etc directory. Added Paths: ----------- pure/trunk/etc/ pure/trunk/etc/pure-mode.el.in pure/trunk/etc/pure.vim pure/trunk/etc/pure.xml Removed Paths: ------------- pure/trunk/pure-mode.el.in pure/trunk/pure.vim pure/trunk/pure.xml Copied: pure/trunk/etc/pure-mode.el.in (from rev 233, pure/trunk/pure-mode.el.in) =================================================================== --- pure/trunk/etc/pure-mode.el.in (rev 0) +++ pure/trunk/etc/pure-mode.el.in 2008-06-16 07:57:01 UTC (rev 242) @@ -0,0 +1,1711 @@ +;;; pure-mode.el --- edit and run Pure scripts -*- Emacs-Lisp -*- + +;; Copyright (C) 1997-2002 Free Software Foundation, Inc. +;; Copyright (C) 1999-2002 Albert Graef +;; Copyright (C) 2008 Albert Graef + +;; Distributed under GPL V3 (or later; see the accompanying COPYING file). + +;; Author/Maintainer: Albert Graef +;; <ag...@mu..., Dr....@t-...> + +;; This is a quick and dirty hack of Q mode, which in turn was based on +;; various different language modes like Prolog mode and Emacs Lisp mode. It +;; desperately needs an overhaul; in particular, auto-indentation is pretty +;; much broken right now. (Watch out for XXXFIXME.) + +;; INSTALLATION: If necessary, edit the values of the `pure-prog' and +;; `pure-lib-dir' variables below. + +(defvar pure-prog "@bindir@/pure") +(defvar pure-lib-dir "@libdir@/pure") + +;; Then copy this file to your site-lisp directory. The easiest way to make +;; Pure mode available in emacs is to add the following to your emacs startup +;; file: + +;; (require 'pure-mode) + +;; To enable Pure mode for *.pure files, add the following to your emacs +;; startup file: + +;; (setq auto-mode-alist (cons '("\\.pure$" . pure-mode) auto-mode-alist)) + +;; Furthermore, you can enable font lock (syntax highlighting) as follows: + +;; (add-hook 'pure-mode-hook 'turn-on-font-lock) +;; (add-hook 'pure-eval-mode-hook 'turn-on-font-lock) + +;; Well, that's the way it works with XEmacs and newer GNU Emacs versions. For +;; older versions of GNU Emacs you might have to try something like: + +;; (global-font-lock-mode t) +;; (add-hook 'pure-mode-hook (lambda () (font-lock-mode 1))) +;; (add-hook 'pure-eval-mode-hook (lambda () (font-lock-mode 1))) + +;; Using the Pure-Eval hook you can also rebind the cursor up and down keys to +;; the history cycling commands: + +;; (add-hook 'pure-eval-mode-hook +;; (lambda () +;; (define-key pure-eval-mode-map [up] 'comint-previous-input) +;; (define-key pure-eval-mode-map [down] 'comint-next-input))) + +;; Finally, you might wish to add some global key bindings, e.g.: + +;; (global-set-key "\C-c\M-p" 'run-pure) + +;; NOTE: For reading the Pure online documentation, simply use Emacs' built-in +;; manpage reader (M-? RET in XEmacs). Pure's 'help' command won't work in an +;; Emacs buffer. + +(require 'comint) + +;; customizable variables + +(defgroup pure nil "Major mode for editing and running Pure scripts." + :group 'languages) + +(defcustom pure-default-rhs-indent 32 + "*Default indentation of the right-hand side of a rule." + :type 'integer + :group 'pure ) + +(defcustom pure-extra-decl-indent 2 + "*Extra indentation of continuation lines in declarations." + :type 'integer + :group 'pure ) + +(defcustom pure-extra-qual-indent 2 + "*Extra indentation of qualifiers in rules." + :type 'integer + :group 'pure ) + +(defcustom pure-hanging-comment-ender-p t + "*Controls what \\[fill-paragraph] does to Pure block comment enders. +When set to nil, Pure block comment enders are left on their own line. +When set to t, block comment enders will be placed at the end of the +previous line (i.e. they `hang' on that line)." + :type 'boolean + :group 'pure) + +(defcustom pure-hanging-comment-starter-p t + "*Controls what \\[fill-paragraph] does to Pure block comment starters. +When set to nil, Pure block comment starters are left on their own line. +When set to t, text that follows a block comment starter will be +placed on the same line as the block comment starter (i.e. the text +`hangs' on that line)." + :type 'boolean + :group 'pure) + +(defcustom pure-prog-name pure-prog + "*Name of the interpreter executable." + :type 'string + :group 'pure) + +(defcustom pure-histfile "~/.pure_history" + "*Name of the command history file." + :type 'string + :group 'pure) + +(defcustom pure-histsize 500 + "*Size of the command history." + :type 'integer + :group 'pure) + +(defcustom pure-query-before-kill nil + "*Indicates that the user should be prompted before zapping an existing +interpreter process when starting a new one." + :type 'boolean + :group 'pure) + +(defcustom pure-prompt-regexp "^> \\|^[A-Za-z_0-9-]*> \\|^: " + "*Regexp to match prompts in the Pure interpreter. If you customize the +interpreter's default prompt, you will have to change this value accordingly." + :type 'regexp + :group 'pure) + +(defcustom pure-msg-regexp + "^[ \t]*\\(\\([^:\n]+\\):\\([0-9]+\\)\\(\\.[0-9]+\\)?\\):" +"*Regexp to match error and warning messages with source line references in +the Pure eval buffer. Expression 1 denotes the whole source line info, +expression 2 the file name and expression 3 the corresponding line number." + :type 'regexp + :group 'pure) + +(defcustom pure-mode-hook nil + "*Hook for customising Pure mode. +For instance, add `turn-on-font-lock' to enable syntax highlighting." + :type 'hook + :group 'pure) + +(defcustom pure-eval-mode-hook nil + "*Hook for customising Pure eval mode. +For instance, add `turn-on-font-lock' to enable syntax highlighting." + :type 'hook + :group 'pure) + +;; the following are used internally + +(defvar pure-output-list nil) +(defvar pure-output-string nil) +(defvar pure-receive-in-progress nil) +(defvar pure-last-dir nil) +(defvar pure-last-script nil) +(defvar pure-last-path nil) + +;; font-lock support + +(defvar pure-eval-font-lock-keywords + (list +; (list pure-prompt-regexp 0 'font-lock-preprocessor-face t) + (list pure-msg-regexp 0 'font-lock-warning-face t) + (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list + (concat "\\<\\(" + "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" + "nullary\\|o\\(f\\|therwise\\)\\|p\\(refix\\|ostfix\\)\\|" + "then\\|using\\|w\\(hen\\|ith\\)" + "\\)\\>") + 0 'font-lock-keyword-face)) + "Rules for fontifying in Pure-Eval mode.") + +(defvar pure-font-lock-keywords + (list + (list "^#!.*" 0 'font-lock-comment-face t) + (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list + (concat "\\<\\(" + "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" + "nullary\\|o\\(f\\|therwise\\)\\|p\\(refix\\|ostfix\\)\\|" + "then\\|using\\|w\\(hen\\|ith\\)" + "\\)\\>") + 0 'font-lock-keyword-face)) + "Rules for fontifying Pure scripts.") + +;; keymaps + +(defvar pure-mode-map nil) +(cond ((not pure-mode-map) + (setq pure-mode-map (make-sparse-keymap)) + (define-key pure-mode-map "\C-c\C-c" 'pure-run-script) + (define-key pure-mode-map "\C-c\C-u" 'pure-current-msg) + (define-key pure-mode-map "\C-c\C-n" 'pure-next-msg) + (define-key pure-mode-map "\C-c\C-p" 'pure-prev-msg) + (define-key pure-mode-map "\C-c\C-e" 'pure-last-msg) + (define-key pure-mode-map "\C-c\C-a" 'pure-first-msg) + (define-key pure-mode-map "\C-c\C-f" 'pure-find-script) + (define-key pure-mode-map "\C-c\C-v" 'pure-goto-input-line) + (define-key pure-mode-map "\t" 'pure-indent-line) + (define-key pure-mode-map "(" 'pure-electric-delim) + (define-key pure-mode-map ")" 'pure-electric-delim) + (define-key pure-mode-map "[" 'pure-electric-delim) + (define-key pure-mode-map "]" 'pure-electric-delim) + (define-key pure-mode-map "=" 'pure-electric-delim) + (define-key pure-mode-map "\e\C-i" 'pure-move-to-indent-column) + (define-key pure-mode-map "\e\C-q" 'pure-indent-current-rule))) + +(defvar pure-eval-mode-map nil) +(cond ((not pure-eval-mode-map) + (setq pure-eval-mode-map (copy-keymap comint-mode-map)) + (define-key pure-eval-mode-map "\t" 'comint-dynamic-complete) + (define-key pure-eval-mode-map "\C-a" 'comint-bol) + (define-key pure-eval-mode-map [home] 'comint-bol) +;; (define-key pure-eval-mode-map [up] 'comint-previous-input) +;; (define-key pure-eval-mode-map [down] 'comint-next-input) + (define-key pure-eval-mode-map [return] 'pure-current-msg-or-send) + (if (string-match "XEmacs\\|Lucid" emacs-version) + (define-key pure-eval-mode-map [button2] 'pure-mouse-msg) + (define-key pure-eval-mode-map [mouse-2] 'pure-mouse-msg)) + (define-key pure-eval-mode-map "\C-c\C-u" 'pure-current-msg) + (define-key pure-eval-mode-map "\C-c\C-n" 'pure-next-msg) + (define-key pure-eval-mode-map "\C-c\C-p" 'pure-prev-msg) + (define-key pure-eval-mode-map "\C-c\C-e" 'pure-last-msg) + (define-key pure-eval-mode-map "\C-c\C-a" 'pure-first-msg) + (define-key pure-eval-mode-map "\C-c\C-f" 'pure-find-script) + (define-key pure-eval-mode-map "\C-c\C-v" 'pure-goto-input-line))) + +;; menus + +(defsubst pure-region-is-active-p () + ;; Return t when the region is active. The determination of region + ;; activeness is different in both Emacs and XEmacs. + (cond + ;; XEmacs + ((and (fboundp 'region-active-p) + zmacs-regions) + (region-active-p)) + ;; Emacs + ((boundp 'mark-active) mark-active) + ;; fallback; shouldn't get here + (t (mark t)))) + +(defvar pure-mode-menu + (list "Pure" + ["Describe Pure Mode" describe-mode t] + ["Customize" (customize-group 'pure) t] + "-" + ["Move to `=' Column" pure-move-to-indent-column t] + ["Indent Current Rule" pure-indent-current-rule t] + ["Indent Line or Region" pure-indent-line-or-region t] + ["Comment Out Region" comment-region (pure-region-is-active-p)] + ["Uncomment Region" uncomment-region (pure-region-is-active-p)] + ["Fill Comment Paragraph" pure-fill-paragraph t] + "-" + ["Run Script" pure-run-script t] + ["Find Main Script" pure-find-script pure-last-script] + ["Goto Input Line" pure-goto-input-line + (get-process "pure-eval")] + "-" + ["Current Message" pure-current-msg + (get-buffer "*pure-eval*")] + ["First Message" pure-first-msg + (get-buffer "*pure-eval*")] + ["Next Message" pure-next-msg + (get-buffer "*pure-eval*")] + ["Previous Message" pure-prev-msg + (get-buffer "*pure-eval*")] + ["Last Message" pure-last-msg + (get-buffer "*pure-eval*")]) + "Menu for Pure mode.") + +(defvar pure-eval-mode-menu + (list "Pure-Eval" + ["Describe Pure-Eval Mode" describe-mode t] + ["Customize" (customize-group 'pure) t] + "-" + ["Find Main Script" pure-find-script pure-last-script] + ["Goto Input Line" pure-goto-input-line + (get-process "pure-eval")] + "-" + ["Current Message" pure-current-msg + (get-buffer "*pure-eval*")] + ["First Message" pure-first-msg + (get-buffer "*pure-eval*")] + ["Next Message" pure-next-msg + (get-buffer "*pure-eval*")] + ["Previous Message" pure-prev-msg + (get-buffer "*pure-eval*")] + ["Last Message" pure-last-msg + (get-buffer "*pure-eval*")] + "-" + ["Complete Symbol" comint-dynamic-complete + (pure-at-command-prompt-p)]) + "Menu for Pure-Eval mode.") + +;; some helper functions for pure/pure-eval-mode: check that we're on the +;; command resp. debugger prompt + +(defun pure-at-pmark-p () + (and (get-buffer "*pure-eval*") + (get-process "pure-eval") + (progn (set-buffer "*pure-eval*") (comint-after-pmark-p)))) + +(defun pure-at-command-prompt-p () + (and + (pure-at-pmark-p) + (save-excursion + (forward-line 0) + (looking-at pure-prompt-regexp)))) + +(defun pure-at-debug-prompt-p () + (and + (pure-at-pmark-p) + (save-excursion + (forward-line 0) + (looking-at ":")))) + +;; Pure mode + +;;;###autoload +(defun pure-mode () + "Major mode for editing Pure scripts. + +Provides the `pure-run-script' (\\[pure-run-script]) command to run the +interpreter on the script in the current buffer. It will be verified that the +buffer has a file associated with it, and you will be prompted to save edited +buffers when invoking this command. Special commands to quickly locate the +main script and the input line of the Pure eval buffer, and to visit the +source lines shown in error messages are provided as well (see +`pure-eval-mode'). + +These operations can be selected from the Pure mode menu (accessible from +the menu bar), which also provides commands for reading the online +help and customizing the Pure/Pure-Eval mode setup. + +Command list: + +\\{pure-mode-map} +Entry to this mode calls the value of pure-mode-hook if that value is +non-nil." + (interactive) + (kill-all-local-variables) + (set-syntax-table (make-syntax-table)) + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?\. "_") + (modify-syntax-entry ?\+ ".") + (modify-syntax-entry ?\- ".") + (modify-syntax-entry ?\= ".") + (modify-syntax-entry ?\< ".") + (modify-syntax-entry ?\> ".") + (modify-syntax-entry ?\$ ".") + (modify-syntax-entry ?\| ".") + ;; comment syntax a la C++ mode +; (cond +; ;; XEmacs 19 & 20 +; ((memq '8-bit c-emacs-features) +; (modify-syntax-entry ?/ ". 1456") +; (modify-syntax-entry ?* ". 23")) +; ;; Emacs 19 & 20 +; ((memq '1-bit c-emacs-features) +; (modify-syntax-entry ?/ ". 124b") +; (modify-syntax-entry ?* ". 23")) +; ;; incompatible +; (t (error "Pure Mode is incompatible with this version of Emacs"))) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (modify-syntax-entry ?/ ". 1456") + (modify-syntax-entry ?* ". 23")) + (t + (modify-syntax-entry ?/ ". 124b") + (modify-syntax-entry ?* ". 23"))) + (modify-syntax-entry ?\n "> b") + (modify-syntax-entry ?\^m "> b") + (setq major-mode 'pure-mode) + (setq mode-name "Pure") + (use-local-map pure-mode-map) + (make-local-variable 'paragraph-start) +;; (setq paragraph-start (concat "^$\\|" page-delimiter)) +;; (setq paragraph-start (concat "^//\\|^$\\|" page-delimiter)) + (setq paragraph-start (concat page-delimiter "\\|$")) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (if (boundp 'fill-paragraph-function) + (progn + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'pure-fill-paragraph))) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'pure-indent-line) + (make-local-variable 'indent-region-function) + (setq indent-region-function 'pure-indent-region) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-multi-line) + (setq comment-column 48 + comment-start "// " + comment-end "" + comment-start-skip "/\\*+ *\\|// *\\|^#! *" + comment-multi-line nil + ) + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'pure-comment-indent) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(pure-font-lock-keywords nil nil ((?_ . "w")))) + (require 'easymenu) + (easy-menu-define pure-mode-menu-map pure-mode-map + "Menu keymap for Pure mode." pure-mode-menu) + (easy-menu-add pure-mode-menu-map pure-mode-map) + (run-hooks 'pure-mode-hook)) + +;; Pure eval mode + +(defun pure-eval-mode () + + "Major mode for interacting with the Pure interpreter, based on comint-mode. + +Provides the `pure-current-msg-or-send' (\\[pure-current-msg-or-send]) +command, which, when point is at an error message describing a source +reference, visits the given line in the corresponding source file in another +window. Otherwise it runs the `comint-send-input' command, which usually +submits a command line to the interpreter, or copies it to the command prompt +when point is not at the current command line. + +Error messages are indicated with a special font, and in XEmacs they will also +be highlighted when the mouse passes over them. Moreover, pressing the middle +mouse button (button2) over such a message visits the corresponding source +line in another window (`pure-mouse-msg' command); anywhere else, the middle +mouse button invokes the usual `mouse-yank' command, so that you can also use +the mouse to perform xterm-like cut and paste in the Pure-Eval buffer. + +You can also use the `pure-first-msg' (\\[pure-first-msg]), `pure-next-msg' +(\\[pure-next-msg]), `pure-prev-msg' (\\[pure-prev-msg]) and `pure-last-msg' +(\\[pure-last-msg]) commands to scan through error messages found in the +buffer. The `pure-find-script' (\\[pure-find-script]) command lets you visit +the script that is currently running, and `pure-goto-input-line' +(\\[pure-goto-input-line]) quickly takes you to the prompt at the current +input line in the Pure eval buffer. (These commands are also provided in Pure +mode. If you like, you can bind them globally, so that you can invoke them +from other kinds of buffers as well.) + +Besides this, you can use the usual comint commands, see the description of +`comint-mode' for details. Some important commands are listed below: + +\\[comint-previous-input] and \\[comint-next-input] cycle through the command history. +\\[comint-previous-matching-input] and \\[comint-next-matching-input] search the command history. +\\[comint-interrupt-subjob] sends a Ctl-C to the interpreter. +\\[comint-send-eof] sends a Ctl-D to the interpreter. +\\[comint-dynamic-list-input-ring] lists the command history. +\\[comint-dynamic-complete] performs symbol and filename completion. + +Note that in difference to standard comint mode, the C-a/home keys are rebound +to `comint-bol', to mimic the behaviour of the default binding of these keys +in the interpreter. + +Most of these operations can also be selected from the Comint and Pure-Eval +mode menus accessible from the menu bar. The Pure-Eval menu also provides +operations for reading the online help and customizing Pure/Pure-Eval mode +setup. Moreover, a History menu is provided from which the most recent +commands can be selected. + +The interpreter's prompt and lines containing error messages are described by +the variables `pure-prompt-regexp' and `pure-msg-regexp'. The history file and +size is given by the `pure-histfile' and `pure-histsize' variables. Note that +when the `pure-gnuclient' customization option is enabled, then Pure-Eval mode +automatically tracks the current prompt string and hence you can safely use +the `prompt' command in the interpreter. + +A complete command list is given below: + +\\{pure-eval-mode-map} +Entry to this mode runs the hooks on `comint-mode-hook' and +`pure-eval-mode-hook' (in that order)." + + (interactive) + (kill-all-local-variables) + (comint-mode) + (set-syntax-table (make-syntax-table)) + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?\. "_") + (modify-syntax-entry ?\+ ".") + (modify-syntax-entry ?\- ".") + (modify-syntax-entry ?\= ".") + (modify-syntax-entry ?\< ".") + (modify-syntax-entry ?\> ".") + (modify-syntax-entry ?\| ".") + (modify-syntax-entry ?\$ ".") + (modify-syntax-entry ?\/ ". 12") + (modify-syntax-entry ?\* ".") + (modify-syntax-entry ?\n ">") + (modify-syntax-entry ?\^m ">") + (setq major-mode 'pure-eval-mode) + (setq mode-name "Pure-Eval") + (use-local-map pure-eval-mode-map) + (setq comint-prompt-regexp pure-prompt-regexp) + (make-local-variable 'paragraph-start) + (setq paragraph-start comint-prompt-regexp) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-multi-line) + (setq comment-column 48 + comment-start-skip "// *\\|^#! *" + comment-multi-line nil) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(pure-eval-font-lock-keywords nil nil ((?_ . "w")))) + (setq comint-input-ring-file-name pure-histfile + comint-input-ring-size pure-histsize + comint-dynamic-complete-functions + '(pure-complete comint-dynamic-complete-filename)) + ;; mouse-sensitive messages (requires XEmacs) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (require 'mode-motion) + (setq mode-motion-hook 'pure-motion-hook))) + (comint-read-input-ring t) + (require 'easymenu) + (easy-menu-define pure-eval-mode-menu-map pure-eval-mode-map + "Menu keymap for Pure mode." pure-eval-mode-menu) + (easy-menu-add pure-eval-mode-menu-map pure-eval-mode-map) + (run-hooks 'pure-eval-mode-hook)) + +(if (string-match "XEmacs" emacs-version) +(defun pure-motion-hook (event) + (mode-motion-highlight-internal + event + #'beginning-of-line + #'(lambda () + (if (looking-at pure-msg-regexp) + (end-of-line)))) +)) + +;; run a Q script in a Q eval buffer + +;; make sure win32 XEmacs quotes arguments containing whitespace + +(if (string-match "XEmacs.*-win32" (emacs-version)) + (defun pure-quote-arg (x) + (if (string-match "[ \t]" x) (concat "\"" x "\"") x)) + (defun pure-quote-arg (x) x)) + +;;;###autoload +(defun run-pure (&rest args) + + "Run the interpreter with given arguments, in buffer *pure-eval*. + +The interpreter is invoked in the directory of the current buffer (current +default directory if no file is associated with the current buffer). +If buffer exists but process is not running, make new process. +If buffer exists and process is running, kill it and start a new one. + +Program used comes from variable `pure-prog-name'. The buffer is put in Pure +eval mode, giving commands for visiting source files, sending input, +manipulating the command history, etc. See `pure-eval-mode'. + +\(Type \\[describe-mode] in the Pure eval buffer for a list of commands.)" + + (interactive) + (let* ((dir (if buffer-file-name + (file-name-directory (buffer-file-name)) + default-directory)) + (pure-eval-active (not (null (get-buffer "*pure-eval*")))) + (pure-eval-running (comint-check-proc "*pure-eval*")) + (pure-eval-buffer (get-buffer-create "*pure-eval*"))) + (if (and pure-eval-running + pure-query-before-kill + (not + (y-or-n-p + "An interpreter process is still running. Start a new one? "))) + (message "Aborted") + (set-buffer pure-eval-buffer) + ;; give process some time to terminate, then blast it away + (if pure-eval-running + (progn + (comint-send-eof) + (sleep-for .5))) + (if (comint-check-proc "*pure-eval*") + (progn + (comint-kill-subjob) + (sleep-for .1))) + (cd dir) + (if (not pure-eval-active) + (pure-eval-mode) + (if (and pure-eval-running + (or (not (string-equal + comint-input-ring-file-name pure-histfile)) + (not (= comint-input-ring-size pure-histsize)))) + ;; reset history in case any of the options have changed + (progn + (comint-write-input-ring) + (setq comint-input-ring-file-name pure-histfile + comint-input-ring-size pure-histsize) + (comint-read-input-ring t)))) + (goto-char (point-max)) + ;; invoke the interpreter + (setenv "PURE_MORE" nil) ; disable paging in the interpreter + (comint-exec pure-eval-buffer "pure-eval" pure-prog-name nil + (append (list "-q" "-i") args)) + ;; set up process parameters + (setq pure-output-list nil + pure-output-string nil + pure-receive-in-progress nil + pure-last-script nil + pure-last-dir dir + pure-last-path nil) + (set-process-sentinel (get-process "pure-eval") 'pure-eval-sentinel) + (if (not pure-query-before-kill) + (process-kill-without-query (get-process "pure-eval"))) + ;; switch to and go to the end of the eval buffer + (pop-to-buffer "*pure-eval*") + (goto-char (point-max)))) + ) + +(defun pure-run-script () + "Run the interpreter with the script in the current buffer, in buffer +*pure-eval*. See `run-pure' for details." + (interactive) + (let ((script-file + (if (buffer-file-name) + (file-name-nondirectory (buffer-file-name)) + (error "Buffer is not associated with any file")))) + (save-some-buffers) + (run-pure script-file) + (setq pure-last-script script-file))) + +;; find a script in the current directory or on the Pure library path + +(defun pure-locate-script (file) + (let ((script (locate-library file t (list "." pure-lib-dir)))) + (if script + script + (error (concat "File " file " not found"))))) + +;; visit source lines of error and debugging messages + +(defun pure-current-msg () + "Show the source line referenced by an error message on the current line +in the Pure eval buffer." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (cond + ((save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (forward-line 0) (recenter 0) + (let (visit-buffer + visit-line + (file (match-string 2)) (line (match-string 3))) + (setq visit-buffer (find-file-noselect (pure-locate-script file))) + (setq visit-line (string-to-number line)) + (message "%s, line %s" file line) + (switch-to-buffer-other-window visit-buffer) + (goto-line visit-line))) + (t + (select-window actwindow) + (error "No message found"))))) + +(defun pure-current-msg-or-send () + "Depending on whether point is at an error message, either execute a +`pure-current-msg' or a `comint-send-input' command. This must be invoked +from the Pure eval buffer." + (interactive) + (if (save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (pure-current-msg) + (comint-send-input))) + +(defun pure-next-msg (&optional count) + "Advance to the next Pure error message below the current line in the Pure +eval buffer, and show the referenced source line in another window. When used +with a numeric argument n, advance to the nth message below the current line +(move backwards if numeric argument is negative). + +Note that this command can easily be fooled if the running script produces +some output, or you insert some text, which looks like an error message, so +you should take care what you're doing." + (interactive "P") + (if (and (numberp count) (< count 0)) + (pure-prev-msg (- count)) + (if (null count) (setq count 1)) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (if (looking-at pure-msg-regexp) + (if (save-excursion (end-of-line) (not (eobp))) + (forward-line 1) + (error "No more messages"))) + (let ((pos (re-search-forward pure-msg-regexp nil t count))) + (if pos + (let ((file (match-string 2)) (line (match-string 3))) + (goto-char pos) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line)) + (select-window actwindow) + (error "No more messages")))))) + +(defun pure-prev-msg (&optional count) + "Advance to previous Pure error messages above the current line in the Pure +eval buffer, and show the referenced source line in another window. Like +`pure-next-msg', but moves backward." + (interactive "P") + (if (and (numberp count) (< count 0)) + (pure-next-msg (- count)) + (if (null count) (setq count 1)) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos (re-search-backward pure-msg-regexp nil t count))) + (if pos + (let ((file (match-string 2)) (line (match-string 3))) + (goto-char pos) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line)) + (select-window actwindow) + (error "No more messages")))))) + +(defun pure-last-msg () + "Advance to the last message in a contiguous sequence of error messages at +or below the current line, and show the referenced source line in another +window." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos + (if (looking-at pure-msg-regexp) + (point) + (re-search-forward pure-msg-regexp nil t)))) + (if pos + (progn + (goto-char pos) + (while (and (save-excursion (end-of-line) (not (eobp))) + (save-excursion (forward-line 1) + (looking-at pure-msg-regexp))) + (forward-line 1)) + (let ((file (match-string 2)) (line (match-string 3))) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line))) + (select-window actwindow) + (error "No more messages"))))) + +(defun pure-first-msg () + "Advance to the first message in a contiguous sequence of error messages at +or above the current line, and show the referenced source line in another +window." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos + (if (looking-at pure-msg-regexp) + (point) + (re-search-backward pure-msg-regexp nil t)))) + (if pos + (progn + (goto-char pos) + (while (and (not (bobp)) + (save-excursion (forward-line -1) + (looking-at pure-msg-regexp))) + (forward-line -1)) + (let ((file (match-string 2)) (line (match-string 3))) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line))) + (select-window actwindow) + (error "No more messages"))))) + +(defun pure-mouse-msg (event) + "Show the source line referenced by an error message under the mouse." + (interactive "e") + (mouse-set-point event) + (if (save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (progn (forward-line 0) (pure-current-msg)) + (mouse-yank event))) + +;; visit main script and the eval buffer + +(defun pure-find-script () + "Visit the script currently running in the Pure eval buffer." + (interactive) + (if (and pure-last-dir pure-last-script) + (if (not (string-equal (concat pure-last-dir pure-last-script) + (buffer-file-name))) + (find-file-other-window (concat pure-last-dir pure-last-script))) + (error "No script is running"))) + +(defun pure-goto-input-line () + "Move to the prompt in the Pure eval buffer." + (interactive) + (if (get-buffer "*pure-eval*") + (progn (pop-to-buffer "*pure-eval*") (goto-char (point-max))) + (error "No script is running"))) + +;; completion + +(defun pure-complete () + "Perform completion on the token preceding point." + (interactive) + (if (pure-at-command-prompt-p) + (let* ((end (point)) + (command + (save-excursion + ;; skip back one word/identifier or operator (punctuation) + (skip-syntax-backward "w_") + (and (eq (point) end) + (skip-syntax-backward ".")) + (and (looking-at pure-prompt-regexp) + (goto-char (match-end 0))) + (buffer-substring-no-properties (point) end)))) + (pure-send-list-and-digest + (list (concat "completion_matches " command "\n"))) + ;; Sort the list + (setq pure-output-list + (sort pure-output-list 'string-lessp)) + ;; Remove duplicates + (let* ((x pure-output-list) + (y (cdr x))) + (while y + (if (string-equal (car x) (car y)) + (setcdr x (setq y (cdr y))) + (setq x y + y (cdr y))))) + ;; And let comint handle the rest + (comint-dynamic-simple-complete command pure-output-list)))) + +;; send commands to the Q interpreter and digest their results + +(defun pure-output-digest (proc string) + (setq string (concat pure-output-string string)) + (while (string-match "\n" string) + (setq pure-output-list + (append pure-output-list + (list (substring string 0 (match-beginning 0)))) + string (substring string (match-end 0)))) + (if (string-match pure-prompt-regexp string) + (setq pure-receive-in-progress nil)) + (setq pure-output-string string)) + +(defun pure-send-list-and-digest (list) + (let* ((pure-eval-buffer (get-buffer "*pure-eval*")) + (proc (get-buffer-process pure-eval-buffer)) + (filter (process-filter proc)) + string) + (set-process-filter proc 'pure-output-digest) + (setq pure-output-list nil) + (unwind-protect + (while (setq string (car list)) + (setq pure-output-string nil + pure-receive-in-progress t) + (comint-send-string proc string) + (while pure-receive-in-progress + (accept-process-output proc)) + (setq list (cdr list))) + (set-process-filter proc filter)))) + +;; perform cleanup when the interpreter process is killed + +(defun pure-eval-sentinel (proc msg) + (if (null (buffer-name (process-buffer proc))) + ;; buffer has been killed + (set-process-buffer proc nil) + (set-buffer (process-buffer proc)) + (comint-write-input-ring) + (setq pure-last-dir nil + pure-last-script nil) + (goto-char (point-max)) + (insert "\n*** Process Pure-Eval finished ***\n"))) + +;; make sure that the history is written when exiting emacs +(add-hook 'kill-emacs-hook + (lambda () + (let ((pure-eval-buffer (get-buffer "*pure-eval*"))) + (cond + (pure-eval-buffer + (set-buffer pure-eval-buffer) + (comint-write-input-ring)))))) + +;; autoindent and fill support (preliminary) + +;; XXXFIXME: This needs to be completely rewritten. We still use the Q +;; indentation rules here (with some minor tweaks), which don't work all that +;; well even in Q mode. + +(defun pure-electric-delim (arg) + "Insert character and correct line's indentation." + (interactive "P") + (if (and (not arg) + (save-excursion + (skip-chars-backward " \t") + (bolp))) + (progn + (insert last-command-char) + (pure-indent-line) + (delete-char -1))) + (self-insert-command (prefix-numeric-value arg))) + +;; find the position of the previous rule's rhs (`=' delimiter) +(defun pure-prev-rhs () + (if (not (pure-backward-to-delim "=")) + nil + ;; back up to beginning of rule, then find 1st `=' at toplevel + (beginning-of-rule) + (if (not (pure-forward-to-delim "=")) + nil ; this shouldn't happen + (backward-char) + (point)))) + +(defvar pure-qual-keywords "\\<\\(if\\|otherwise\\|when\\|with\\)\\>") + +(defun pure-at-qual () + (and (looking-at pure-qual-keywords) + (or (not (looking-at "else")) + (save-excursion + (backward-word 1) + (not (looking-at "or")))))) + +;; find the position of the previous qualifier or conditional keyword (if, +;; else, otherwise, etc.) +(defun pure-prev-qual () + (if (not (pure-backward-to-regexp pure-qual-keywords)) nil + (let ((success t) (done nil)) + (while (and success (not done)) + (setq done (pure-at-qual)) + (setq success (or done (pure-backward-to-regexp pure-qual-keywords)))) + (if (not done) nil + (let* ((p0 (point)) + (p (progn (beginning-of-line) + (if (pure-forward-to-regexp pure-qual-keywords) + (backward-word 1)) + (if (pure-at-qual) (point) p0)))) + (goto-char p)))))) + +(defun pure-move-to-indent-column () + "At end of line, move forward to the current `=' indentation column, as +given by the most recent rule or the \\[pure-default-rhs-indent] variable." + (interactive) + (if (save-excursion + (skip-chars-forward " \t") + (eolp)) + (let ((col (current-column)) + (icol (save-excursion + (if (pure-prev-rhs) + (current-column) + pure-default-rhs-indent)))) + (if (> icol col) + (move-to-column icol t))))) + +(defun pure-comment-indent () + "Compute Pure comment indentation." + (cond ((looking-at "^#!") 0) + ((looking-at "/[/*]") + (let ((indent (pure-calculate-indent))) + (if (consp indent) (car indent) indent))) + (t + (save-excursion + (skip-chars-backward " \t") + (max (current-column) +;; (max (1+ (current-column)) ;Insert one space at least + comment-column))) + )) + +;; FIXME: This stuff (beginning-of-rule, end-of-rule) is broken. It gets +;; caught in block comments easily -- unfortunately, Pure definitions may look a +;; lot like plain comment text ;-). There really seems to be no good way of +;; doing this, because these routines need to be fast, so we can't just parse +;; the whole file any time they are invoked. + +;; As implemented, beginning-of-rule looks for a line starting with a +;; word/symbol constituent, open parentheses, string, or optional whitespace +;; followed by a `=' character, whereas end-of-rule searches for a semicolon +;; at line end (with maybe some single-line comments and whitespace in +;; between). So reasonable formatting styles should all be parsed correctly. + +(defun beginning-of-rule () + "Move backward to beginning of current or previous rule." + (interactive) + (if (or + (if (and (> (current-column) 0) + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*="))) + (progn (beginning-of-line) t) + nil) + (re-search-backward "^\\w\\|^\\s_\\|^\\s(\\|^\\s\"\\|^[ \t]*=" + (point-min) 'mv)) + (let ((p (point))) + (pure-backward-to-noncomment (point-min)) + (if (and (not (bobp)) + (/= (preceding-char) ?\;) + (/= (preceding-char) ?\:)) + (beginning-of-rule) + (goto-char p))))) + +(defun end-of-rule () + "Move forward to end of current or next rule." + (interactive) + (let ((p (point))) + (while (and (re-search-forward +;;; match ";" + whitespace/comment sequence + "\n" +";\\([ \t]+\\|/\\*+\\([^\n\\*]\\|\\*[^\n/]\\)*\\*+/\\)*\\(//.*\\)?\n" + nil 'move) + (/= (1+ (match-beginning 0)) + (save-excursion + (pure-backward-to-noncomment p) + (point))))))) + +(defun pure-indent-line () + "Indent current line as Pure code. +Return the amount the indentation changed by." + (interactive) + (let ((indent (pure-calculate-indent nil)) + start-of-block + beg shift-amt + (case-fold-search nil) + (pos (- (point-max) (point)))) + (if (listp indent) + (progn + (setq start-of-block (cdr indent)) + (setq indent (car indent))) + (setq start-of-block 0)) + (beginning-of-line) + (setq beg (point)) + (setq indent + (cond ((eq indent nil) (current-indentation)) + ((eq indent t) (pure-calculate-indent-within-comment)) + (t + (skip-chars-forward " \t") + (cond ((looking-at "^#!") 0) + ((= (following-char) ?\)) start-of-block) + (t indent))))) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt)) + +(defvar pure-decl-keywords + (concat "\\<\\(" + "infix[lr]?\\|let\\|nullary\\|p\\(refix\\|ostfix\\)\\|using" + "\\)\\>")) + +(defun pure-indent-col (col pos) + (if pos + (let ((col2 (save-excursion (goto-char pos) (current-column)))) + (cons col col2)) + col) +) + +;; TODO: proper indentation of parenthesized if-then-else constructs +(defun pure-calculate-indent (&optional parse-start) + "Return appropriate indentation for current line as Pure code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment, +\(indent . start-of-block\) if line is within a paren block." + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + (case-fold-search nil) + state + containing-sexp + (at-decl nil) + (lhs-extra-indent 0) + (rhs-extra-indent + (save-excursion + (skip-chars-forward " \t") + (if (pure-at-qual) pure-extra-qual-indent 0))) + (following-character + (save-excursion (skip-chars-forward " \t") (following-char)))) + (if parse-start + (goto-char parse-start) + (let ((p (point))) + (pure-backward-to-noncomment (point-min)) + (if (and (not (bobp)) + (/= (preceding-char) ?\;)) + (beginning-of-rule) + (goto-char p)))) + ;; extra indent for continuation lines in declarations + (if (and (< (point) indent-point) + (looking-at pure-decl-keywords)) + (setq at-decl t + lhs-extra-indent pure-extra-decl-indent)) + (while (< (point) indent-point) + (setq parse-start (point)) + (setq state (parse-partial-sexp (point) indent-point 0)) + (setq containing-sexp (car (cdr state)))) + ;; the above sometimes craps out even if we're inside a balanced pair + ;; of parens, but the following should work in any case + (if (null containing-sexp) + (setq containing-sexp + (condition-case nil + (scan-lists indent-point -1 1) + (error nil)))) + (if (or (nth 3 state) (nth 4 state)) + ;; return nil or t if should not change this line + (nth 4 state) + ;; Check to see whether we are inside a sexp, on the lhs, rhs, + ;; qualifier, or at the = of a rule. + (goto-char indent-point) + (pure-backward-to-noncomment (or parse-start (point-min))) + (let (p0 p1 p2 p3 col1 col2 col3) + (setq p0 containing-sexp + p1 (save-excursion + (pure-backward-to-delim ";") + (point)) + p2 (save-excursion + (if (pure-prev-rhs) (point) 0)) + p3 (save-excursion + (if (pure-prev-qual) (point) 0))) + (if (> p2 0) + (setq col1 (save-excursion + (goto-char p2) + (current-column)) + col2 (save-excursion + (goto-char p2) + (forward-char) + (skip-chars-forward " \t") + (current-column)) + col3 (save-excursion + (goto-char p3) + (current-column))) + (setq col1 pure-default-rhs-indent + col2 pure-default-rhs-indent + col3 pure-default-rhs-indent)) + (cond + ((and (not (null p0)) (>= p0 (max p1 p2 p3))) + ;; inside a sexp (pair of balanced parens): indent at the column + ;; to the right of the paren + (let ((col (save-excursion (goto-char p0) (current-column)))) + (cons (1+ col) col))) + ((or (= following-character ?=) + (= following-character ?\;) + (and at-decl (= following-character ?|))) + ;; followup eqns (initial =), initial semi, and initial | + ;; in declarations are indented at preceding = + (pure-indent-col col1 p0)) + ((or at-decl (> p1 p2)) + ;; lhs: indent at lhs-extra-indent + (pure-indent-col lhs-extra-indent p0)) + ((> p3 p2) + ;; qualifier/conditional: indent at column of previous qualifier + ;; keyword plus pure-extra-qual-indent if no keyword at bol + (pure-indent-col + (+ col3 (if (= 0 rhs-extra-indent) pure-extra-qual-indent 0)) p0)) + (t + ;; rhs: indent at first token behind preceding = + ;; add rhs-extra-indent for initial qualifier keyword + (pure-indent-col (+ col2 rhs-extra-indent) p0)))))))) + +(defun pure-calculate-indent-within-comment () + "Return the indentation amount for line, assuming that +the current line is to be regarded as part of a block comment." + (let (end star-start) + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (setq star-start (= (following-char) ?\*)) + (skip-chars-backward " \t\n") + (setq end (point)) + (beginning-of-line) + (skip-chars-forward " \t") + (and (re-search-forward "/\\*[ \t]*" end t) + star-start + (goto-char (1+ (match-beginning 0)))) + (current-column)))) + +(defun pure-backward-to-noncomment (lim) + (let (opoint stop) + (while (not stop) + (skip-chars-backward " \t\n\f" lim) + (setq opoint (point)) + (if (and (>= (point) (+ 2 lim)) + (= (preceding-char) ?/) (= (char-after (- (point) 2)) ?*)) + (search-backward "/*" lim 'mv) + (let ((p (max lim (save-excursion (beginning-of-line) (point))))) + (if (nth 4 (parse-partial-sexp p (point))) + (re-search-backward "^#!\\|//" p 'mv) + (goto-char opoint) + (setq stop t))))))) + +(defun pure-forward-to-noncomment (lim) + (forward-char 1) + (while (progn + (skip-chars-forward " \t\n" lim) + (looking-at "^#!\\|//\\|/\\*")) + ;; Skip over comments and labels following openparen. + (if (looking-at "^#!\\|//") + (forward-line 1) + (forward-char 2) + (search-forward "*/" lim 'mv)))) + +;; some added stuff for finding = and ; delimiters in rules + +(defun pure-at-toplevel-p () + (let (p state) + (save-excursion + (setq p (save-excursion + (beginning-of-rule) + (point))) + (setq state (parse-partial-sexp p (point))) + (not (or (nth 1 state) + (nth 3 state) + (nth 4 state)))))) + +(defun pure-backward-to-delim (delim-str) + (let ((success nil)) + (while (and (search-backward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (bobp)))) + (if success (point) nil))) + +(defun pure-forward-to-delim (delim-str) + (let ((success nil)) + (while (and (search-forward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (eobp)))) + (if success (point) nil))) + +(defun pure-backward-to-regexp (delim-str) + (let ((success nil)) + (while (and (re-search-backward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (bobp)))) + (if success (point) nil))) + +(defun pure-forward-to-regexp (delim-str) + (let ((success nil)) + (while (and (re-search-forward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (eobp)))) + (if success (point) nil))) + +(defun pure-indent-current-rule () + "Indent all lines in the current rule." + (interactive) + (let (p) + (save-excursion + (end-of-rule) + (setq p (point-marker)) + (beginning-of-rule) + (while (< (point) p) + (pure-indent-line) + (forward-line 1))))) + +;; this stuff is from (XEmacs) cc-mode + +(defun pure-indent-region (start end) + ;; Indent every line whose first char is between START and END inclusive. + (let (p) + (save-excursion + (goto-char start) + (setq p (copy-marker end)) + (while (and (bolp) + (not (eobp)) + (< (point) p)) + (pure-indent-line) + (forward-line 1))))) + +(defun pure-indent-line-or-region () + "When the region is active, indent it. Otherwise indent the current line." + (interactive) + (if (pure-region-is-active-p) + (pure-indent-region (region-beginning) (region-end)) + (pure-indent-line))) + +;; paragraph fill from (XEmacs) cc-mode, boiled down for Pure mode + +(defmacro pure-safe (&rest body) + ;; safely execute BODY, return nil if an error occurred + (` (condition-case nil + (progn (,@ body)) + (error nil)))) + +(defmacro pure-forward-sexp (&optional arg) + ;; like forward-sexp except + ;; 1. this is much stripped down from the XEmacs version + ;; 2. this cannot be used as a command, so we're insulated from + ;; XEmacs' losing efforts to make forward-sexp more user + ;; friendly + ;; 3. Preserves the semantics most of CC Mode is based on + (or arg (setq arg 1)) + `(goto-char (or (scan-sexps (point) ,arg) + ,(if (numberp arg) + (if (> arg 0) `(point-max) `(point-min)) + `(if (> ,arg 0) (point-max) (point-min)))))) + +(defmacro pure-backward-sexp (&optional arg) + ;; See pure-forward-sexp and reverse directions + (or arg (setq arg 1)) + `(pure-forward-sexp ,(if (numberp arg) (- arg) `(- ,arg)))) + +(defsubst pure-point (position) + ;; Returns the value of point at certain commonly referenced POSITIONs. + ;; POSITION can be one of the following symbols: + ;; + ;; bol -- beginning of line + ;; eol -- end of line + ;; + ;; This function does not modify point or mark. + (let ((here (point))) + (cond + ((eq position 'bol) (beginning-of-line)) + ((eq position 'eol) (end-of-line)) + (t (error "unknown buffer position requested: %s" position)) + ) + (prog1 + (point) + (goto-char here)))) + +(defun pure-literal-limits (&optional lim near) + ;; Returns a cons of the beginning and end positions of the comment + ;; or string surrounding point (including both delimiters), or nil + ;; if point isn't in one. If LIM is non-nil, it's used as the + ;; "safe" position to start parsing from. If NEAR is non-nil, then + ;; the limits of any literal next to point is returned. "Next to" + ;; means there's only [ \t] between point and the literal. The + ;; search for such a literal is done first in forward direction. + ;; + ;; This is the Emacs 19 version. + (save-excursion + (let* ((pos (point)) +;;; FIXME: need a reasonable replacement for `beginning-of-defun' (bod) here. +;;; (lim (or lim (pure-point 'bod))) + (lim (or lim (point-min))) + (state (parse-partial-sexp lim (point)))) + (cond ((nth 3 state) + ;; String. Search backward for the start. + (while (nth 3 state) + (search-backward (make-string 1 (nth 3 state))) + (setq state (parse-partial-sexp lim (point)))) + (cons (point) (or (pure-safe (pure-forward-sexp 1) (point)) + (point-max)))) + ((nth 7 state) + ;; Line comment. Search from bol for the comment starter. + (beginning-of-line) + (setq state (parse-partial-sexp lim (point)) + lim (point)) + (while (not (nth 7 state)) + (search-forward "//") ; Should never fail. + (setq state (parse-partial-sexp + lim (point) nil nil state) + lim (point))) + (backward-char 2) + (cons (point) (progn (forward-comment 1) (point)))) + ((nth 4 state) + ;; Block comment. Search backward for the comment starter. + (while (nth 4 state) + (search-backward "/*") ; Should never fail. + (setq state (parse-partial-sexp lim (point)))) + (cons (point) (progn (forward-comment 1) (point)))) + ((pure-safe (nth 4 (parse-partial-sexp ; Can't use prev state due + lim (1+ (point))))) ; to bug in Emacs 19.34. + ;; We're standing in a comment starter. + (backward-char 2) + (cons (point) (progn (forward-comment 1) (point)))) + (near + (goto-char pos) + ;; Search forward for a literal. + (skip-chars-forward " \t") + (cond + ((eq (char-syntax (or (char-after) ?\ )) ?\") ; String. + (cons (point) (or (pure-safe (pure-forward-sexp 1) (point)) + (point-max)))) + ((looking-at pure-comment-start-regexp) ; Line or block comment. + (cons (point) (progn (forward-comment 1) (point)))) + (t + ;; Search backward. + (skip-chars-backward " \t") + (let ((end (point)) beg) + (cond + ((eq (char-syntax (or (char-before) ?\ )) ?\") ; String. + (setq beg (pure-safe (pure-backward-sexp 1) (point)))) + ((and (pure-safe (forward-char -2) t) + (looking-at "*/")) + ;; Block comment. Due to the nature of line + ;; comments, they will always be covered by the + ;; normal case above. + (goto-char end) + (forward-comment -1) + ;; If LIM is bogus, beg will be bogus. + (setq beg (point)))) + (if beg (cons beg end)))))) + )))) + +(defconst pure-comment-start-regexp "\\(/[/*]\\|^#!\\)") + +;; FIXME: I'm wondering why this code messes up the fontification of comment +;; paragraphs since the same code apparently works in C/C++ mode, and the +;; comment syntax is also the same. :( This only happens with XEmacs +;; (21.1p10), no problems with GNU Emacs. Maybe the XEmacs font-lock stuff is +;; broken, or has some special built-in support for the C modes? Anyway, if +;; anyone knows how to fix this please let me know. -AG + +(defun pure-fill-paragraph (&optional arg) + "Like \\[fill-paragraph] but handles Pure (i.e., C/C++) style +comments. If any of the current line is a comment or within a comment, +fill the comment or the paragraph of it that point is in, +preserving the comment indentation or line-starting decorations. + +If point is inside multiline string literal, fill it. This currently +does not respect escaped newlines, except for the special case when it +is the very first thing in the string. The intended use for this rule +is in situations like the following: + +description = \"\\ +A very long description of something that you want to fill to make +nicely formatted output.\"\; + +If point is in any other situation, i.e. in normal code, do nothing. + +Optional prefix ARG means justify paragraph as well." + (interactive "*P") + (let* ((point-save (point-marker)) + limits + comment-start-place + (first-line + ;; Check for obvious entry to comment. + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (and (looking-at comment-start-skip) + (setq comment-start-place (point))))) + (re1 "\\|\\([ \t]*/\\*[ \t]*\\|[ \t]*\\*/[ \t]*\\|[ \t/*]*\\)")) + (if (save-excursion + (beginning-of-line) + (looking-at "#!\\|.*//")) + (let ((fill-prefix fill-prefix) + ;; Lines containing just a comment start or just an end + ;; should not be filled into paragraphs they are next + ;; to. + (paragraph-start (concat paragraph-start re1 "$")) + (paragraph-separate (concat paragraph-separate re1 "$"))) + (save-excursion + (beginning-of-line) + ;; Move up to first line of this comment. + (while (and (not (bobp)) + (looking-at "[ \t]*//[ \t]*[^ \t\n]")) + (forward-line -1)) + (if (not (looking-at ".*//[ \t]*[^ \t\n]")) + (forward-line 1)) + ;; Find the comment start in this line. + (re-search-forward "[ \t]*//[ \t]*") + ;; Set the fill-prefix to be what all lines except the first + ;; should start with. But do not alter a user set fill-prefix. + (if (null fill-prefix) + (setq fill-prefix (buffer-substring (match-beginning 0) + (match-end 0)))) + (save-restriction + ;; Narrow down to just the lines of this comment. + (narrow-to-region (pure-point 'bol) + (save-excursion + (forward-line 1) + (while + (looking-at (regexp-quote fill-prefix)) + (forward-line 1)) + (point))) + (or (pure-safe + ;; fill-paragraph sometimes fails to detect when we + ;; are between paragraphs. + (beginning-of-line) + (search-forward fill-prefix (pure-point 'eol)) + (looking-at paragraph-separate)) + ;; Avoids recursion + (let (fill-paragraph-function) + (fill-paragraph arg)))))) + ;; else C style comments + (if (or first-line + ;; t if we enter a comment between start of function and + ;; this line. + (save-excursion + (setq limits (pure-literal-limits)) + (and (consp limits) + (save-excursion + (goto-char (car limits)) + (looking-at pure-comment-start-regexp)))) + ;; t if this line contains a comment starter. + (setq first-line + (save-excursion + (beginning-of-line) + (prog1 + (re-search-forward comment-start-skip + (save-excursion (end-of-line) + (point)) + t) + (setq comment-start-place (point))))) + ;; t if we're in the whitespace after a comment ender + ;; which ends its line. + (and (not limits) + (when (and (looking-at "[ \t]*$") + (save-excursion + (beginning-of-line) + (looking-at ".*\\*/[ \t]*$"))) + (save-excursion + (forward-comment -1) + (setq comment-start-place (point))) + t))) + ;; Inside a comment: fill one comment paragraph. + (let ((fill-prefix + (or + ;; Keep user set fill prefix if any. + fill-prefix + ;; The prefix for each line of this paragraph + ;; is the appropriate part of the start of this line, + ;; up to the column at which text should be indented. + (save-excursion + (beginning-of-line) + (if (looking-at ".*/\\*.*\\*/") + (progn (re-search-forward comment-start-skip) + (make-string (current-column) ?\ )) + (if first-line + (forward-line 1) + (if (and (looking-at "[ \t]*\\*/") + (not (save-excursion + (forward-line -1) + (looking-at ".*/\\*")))) + (forward-line -1))) + + (let ((line-width (progn (end-of-line) + (current-column)))) + (beginning-of-line) + (prog1 + (buffer-substring + (point) + + ;; How shall we decide where the end of the + ;; fill-prefix is? + (progn + (skip-chars-forward " \t*" (pure-point 'eol)) + ;; kludge alert, watch out for */, in + ;; which case fill-prefix should *not* + ;; be "*"! + (if (and (eq (char-after) ?/) + (eq (char-before) ?*)) + (forward-char -1)) + (point))) + + ;; If the comment is only one line followed + ;; by a blank line, calling move-to-column + ;; above may have added some spaces and tabs + ;; to the end of the line; the fill-paragraph + ;; function will then delete it and the + ;; newline following it, so we'll lose a + ;; blank line when we shouldn't. So delete + ;; anything move-to-column added to the end + ;; of the line. We record the line width + ;; instead of the position of the old line + ;; end because move-to-column might break a + ;; tab into spaces, and the new characters + ;; introduced there shouldn't be deleted. + + ;; If you can see a better way to do this, + ;; please make the change. This seems very + ;; messy to me. + (delete-region (progn (move-to-column line-width) + (point)) + (progn (end-of-line) (point))))))))) + + ;; Lines containing just a comment start or just an end + ;; should not be filled into paragraphs they are next + ;; to. + (paragraph-start (concat paragraph-start re1 "$")) + (paragraph-separate (concat paragraph-separate re1 "$")) + (chars-to-delete 0) + ) + (save-restriction + ;; Don't fill the comment together with the code + ;; following it. So temporarily exclude everything + ;; before the comment start, and everything after the + ;; line where the comment ends. If comment-start-place + ;; is non-nil, the comment starter is there. Otherwise, + ;; point is inside the comment. + (narrow-to-region (save-excursion + (if comment-start-place + (goto-char comment-start-place) + (search-backward "/*")) + (if (and (not pure-hanging-comment-starter-p) + (looking-at + (concat pure-comment-start-regexp + "[ \t]*$"))) + (forward-line 1)) + ;; Protect text before the comment + ;; start by excluding it. Add + ;; spaces to bring back proper + ;; indentation of that point. + (let ((column (current-column))) + (prog1 (point) + (setq chars-to-delete column) + (insert-char ?\ column)))) + (save-excursion + (if comment-start-place + (goto-char (+ comment-start-place 2))) + (search-forward "*/" nil 'move) + (if (and (not pure-hanging-comment-ender-p) + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*\\*/"))) + (beginning-of-line) + (forward-line 1)) + (point))) + (or (pure-safe + ;; fill-paragraph sometimes fails to detect when we + ;; are between paragraphs. + (beginning-of-line) + (search-forward fill-prefix (pure-point 'eol)) + (looking-at paragraph-separate)) + ;; Avoids recursion + (let (fill-paragraph-function) + (fill-paragraph arg))) + (save-excursion + ;; Delete the chars we inserted to avoid clobbering + ;; the stuff before the comment start. + (goto-char (point-min)) + (if (> chars-to-delete 0) + (delete-region (point) (+ (point) chars-t... [truncated message content] |
From: <ag...@us...> - 2008-06-16 10:01:59
|
Revision: 246 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=246&view=rev Author: agraef Date: 2008-06-16 02:44:43 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Update usage and installation instructions. Modified Paths: -------------- pure/trunk/INSTALL pure/trunk/README Modified: pure/trunk/INSTALL =================================================================== --- pure/trunk/INSTALL 2008-06-16 09:44:02 UTC (rev 245) +++ pure/trunk/INSTALL 2008-06-16 09:44:43 UTC (rev 246) @@ -324,12 +324,15 @@ documentation in a variety of formats (this requires groff); see the Makefile for details. -Last but not least, maintainers can roll distribution tarballs with 'make -dist' and 'make distcheck' (the latter is like 'make dist', but also does a -test build and installation to verify that your tarball contains all needed -bits and pieces). +Maintainers can roll distribution tarballs with 'make dist' and 'make +distcheck' (the latter is like 'make dist', but also does a test build and +installation to verify that your tarball contains all needed bits and pieces). +Last but not least, if you modify configure.ac for some reason then you +regenerate the configure script and config.h.in with 'make config'. This needs +autoconf, of course. (The distribution was prepared using autoconf 2.61.) + SYSTEM NOTES ====== ===== Modified: pure/trunk/README =================================================================== --- pure/trunk/README 2008-06-16 09:44:02 UTC (rev 245) +++ pure/trunk/README 2008-06-16 09:44:43 UTC (rev 246) @@ -70,27 +70,23 @@ > Pure scripts are just ordinary text files, which can be created with any text -editor. For Emacs users, the most convenient way to edit and run Pure scripts -is Emacs Pure mode which works with both GNU Emacs and XEmacs. You'll have to -install the pure-mode.el file from the Pure source directory into your Emacs -site-lisp directory, and enable the mode in your .emacs file as explained at -the beginning of the pure-mode.el file. Then you can just open and edit a Pure -script in Emacs, and run it inside an Emacs buffer with Ctrl-C Ctrl-C. Syntax -highlighting, auto-indentation and command line completion are also supported. +editor. The distribution contains some language definition files and +programming modes to provide syntax highlighting in various popular text +editors, such as Emacs, Kate and Vim. The Emacs mode also lets you run the +Pure interpreter in an Emacs buffer, this is probably the most convenient +interface to the interpreter if you're friends with Emacs. A syntax file for +Andre Simon's highlight program is also included, this lets you pretty-print +Pure source in various output formats such as HTML and LaTeX. You can find all +this stuff in the etc subdirectory in the source distribution, installation +instructions are included in the files. -The source directory also contains Pure syntax highlighting files for Kate and -Vim. You can install these into your .kde/share/apps/katepart/syntax and -.vim/syntax directories, respectively. (The Vim mode must also be enabled in -your vim startup file; see the comments at the beginning of pure.vim for -details.) +Online documentation is available as a manual page, which contains detailed +information on how to use the interpreter and a description of the Pure +language. You can invoke the manpage with 'man pure' after installation or +using the 'help' command inside the interpreter. When using Emacs, it can be +displayed using Emacs' built-in manpage reader (the 'help' command won't work +if the interpreter is running in an Emacs buffer). -Online documentation is available as a manpage, which contains detailed -information on how to use the interpreter and a brief description of the Pure -language. You can invoke the manpage with 'man pure' after installation, or -using the 'help' command inside the interpreter, or with Emacs' built-in -manpage reader (the 'help' command won't work if the interpreter is running -inside an Emacs buffer). - Some example programs can be found in the examples subdir in the sources; in particular, have a look at the hello.pure program which will quickly give you an idea how Pure programs look like. You should also browse the scripts in the @@ -100,7 +96,7 @@ This is currently all you get; more elaborate documentation of the Pure language still needs to be written. But Pure is a really simple language; if you have some experience using FPLs then you should be able to find your way -with the manpage and the provided examples. Of course, you can also post +with the manual page and the provided examples. Of course, you can also post questions to the Pure mailing list (see http://pure-lang.sf.net). Enjoy! :) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-17 13:44:09
|
Revision: 250 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=250&view=rev Author: agraef Date: 2008-06-17 06:44:16 -0700 (Tue, 17 Jun 2008) Log Message: ----------- Eliminate unused optional argument. Modified Paths: -------------- pure/trunk/interpreter.cc pure/trunk/interpreter.hh Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-16 14:29:41 UTC (rev 249) +++ pure/trunk/interpreter.cc 2008-06-17 13:44:16 UTC (rev 250) @@ -873,7 +873,7 @@ } } -void interpreter::add_rule(rulel &rl, rule *r, bool b, yy::location* yylloc) +void interpreter::add_rule(rulel &rl, rule *r, bool b) { rule r1 = *r; if (r->lhs.is_null()) { Modified: pure/trunk/interpreter.hh =================================================================== --- pure/trunk/interpreter.hh 2008-06-16 14:29:41 UTC (rev 249) +++ pure/trunk/interpreter.hh 2008-06-17 13:44:16 UTC (rev 250) @@ -352,7 +352,7 @@ void exec(expr *x); void clear(int32_t f = 0); void clearsym(int32_t f); - void add_rule(rulel &rl, rule *r, bool b, yy::location* yylloc = 0); + void add_rule(rulel &rl, rule *r, bool b); void add_rule(env &e, expr &l, rule *r, bool toplevel = false); void add_simple_rule(rulel &rl, rule *r); void promote_ttags(expr f, expr x, expr u); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 07:45:14
|
Revision: 254 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=254&view=rev Author: agraef Date: 2008-06-18 00:45:21 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Add syntax for multiple left-hand sides in function definitions and 'case' rules. Modified Paths: -------------- pure/trunk/interpreter.cc pure/trunk/interpreter.hh pure/trunk/lexer.ll pure/trunk/parser.yy Added Paths: ----------- pure/trunk/test/test012.log pure/trunk/test/test012.pure Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/interpreter.cc 2008-06-18 07:45:21 UTC (rev 254) @@ -768,7 +768,7 @@ void interpreter::exec(expr *x) { - last = expr(); + last.clear(); if (result) pure_free(result); result = 0; pure_expr *e, *res = eval(*x, e); if ((verbose&verbosity::defs) != 0) cout << *x << ";\n"; @@ -793,7 +793,7 @@ void interpreter::define(rule *r) { - last = expr(); + last.clear(); pure_expr *e, *res = defn(r->lhs, r->rhs, e); if ((verbose&verbosity::defs) != 0) cout << "let " << r->lhs << " = " << r->rhs << ";\n"; @@ -873,41 +873,60 @@ } } -void interpreter::add_rule(rulel &rl, rule *r, bool b) +rulel *interpreter::default_lhs(exprl &l, rulel *rl) { - rule r1 = *r; - if (r->lhs.is_null()) { - // empty lhs, repeat the one from the previous rule - rulel::reverse_iterator last = rl.rbegin(); - if (last == rl.rend()) { - delete r; - throw err("error in function definition (missing left-hand side)"); - } else - r1 = rule(last->lhs, r->rhs, r->qual); + assert(!rl->empty()); + rule& r = rl->front(); + if (r.lhs.is_null()) { + // empty lhs, repeat the ones from the previous rule + assert(rl->size() == 1); + if (l.empty()) { + delete rl; + throw err("error in rule (missing left-hand side)"); + } else { + expr rhs = r.rhs, qual = r.qual; + rl->clear(); + for (exprl::iterator i = l.begin(), end = l.end(); i != end; i++) + rl->push_back(rule(*i, rhs, qual)); + } + } else { + l.clear(); + for (rulel::iterator i = rl->begin(), end = rl->end(); i != end; i++) + l.push_back(i->lhs); } + return rl; +} + +void interpreter::add_rules(rulel &rl, rulel *r, bool b) +{ + for (rulel::iterator ri = r->begin(), end = r->end(); ri != end; ri++) + add_rule(rl, *ri, b); delete r; - closure(r1, b); - rl.push_back(r1); } -void interpreter::add_rule(env &e, expr &l, rule *r, bool toplevel) +void interpreter::add_rules(env &e, rulel *r, bool toplevel) { - rule r1 = *r; - if (r->lhs.is_null()) { - // empty lhs, repeat the one from the previous rule - if (l.is_null()) { - delete r; - throw err("error in function definition (missing left-hand side)"); - } else - r1 = rule(l, r->rhs, r->qual); - } + for (rulel::iterator ri = r->begin(), end = r->end(); ri != end; ri++) + add_rule(e, *ri, toplevel); delete r; - closure(r1, false); +} + +void interpreter::add_rule(rulel &rl, rule &r, bool b) +{ + assert(!r.lhs.is_null()); + closure(r, b); + rl.push_back(r); +} + +void interpreter::add_rule(env &e, rule &r, bool toplevel) +{ + assert(!r.lhs.is_null()); + closure(r, false); if (toplevel) { - compile(r1.rhs); - compile(r1.qual); + compile(r.rhs); + compile(r.qual); } - int32_t f; uint32_t argc = count_args(r1.lhs, f); + int32_t f; uint32_t argc = count_args(r.lhs, f); if (f <= 0) throw err("error in function definition (invalid head symbol)"); env::iterator it = e.find(f); @@ -936,27 +955,25 @@ info = env_info(argc, rulel(), toplevel?temp:0); assert(info.argc == argc); if (toplevel) { - r1.temp = temp; + r.temp = temp; if (override) { rulel::iterator p = info.rules->begin(); for (; p != info.rules->end() && p->temp >= temp; p++) ; - info.rules->insert(p, r1); + info.rules->insert(p, r); } else - info.rules->push_back(r1); + info.rules->push_back(r); } else { - r1.temp = 0; - info.rules->push_back(r1); + r.temp = 0; + info.rules->push_back(r); } - if (l != r1.lhs) l = r1.lhs; - if (toplevel && (verbose&verbosity::defs) != 0) cout << r1 << ";\n"; + if (toplevel && (verbose&verbosity::defs) != 0) cout << r << ";\n"; if (toplevel) mark_dirty(f); } void interpreter::add_simple_rule(rulel &rl, rule *r) { assert(!r->lhs.is_null()); - rule r1 = *r; - rl.push_back(r1); + rl.push_back(*r); delete r; } Modified: pure/trunk/interpreter.hh =================================================================== --- pure/trunk/interpreter.hh 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/interpreter.hh 2008-06-18 07:45:21 UTC (rev 254) @@ -268,7 +268,7 @@ symtable symtab; // the symbol table pure_expr *result; // last computed result clock_t clocks; // last evaluation time, if stats is set - expr last; // last processed lhs + exprl last; // last processed lhs collection env globenv; // global function and variable environment funset dirty; // "dirty" function entries which need a recompile pure_mem *mem; // runtime expression memory @@ -352,8 +352,11 @@ void exec(expr *x); void clear(int32_t f = 0); void clearsym(int32_t f); - void add_rule(rulel &rl, rule *r, bool b); - void add_rule(env &e, expr &l, rule *r, bool toplevel = false); + rulel *default_lhs(exprl &l, rulel *rl); + void add_rules(rulel &rl, rulel *r, bool b); + void add_rules(env &e, rulel *r, bool toplevel = false); + void add_rule(rulel &rl, rule &r, bool b); + void add_rule(env &e, rule &r, bool toplevel = false); void add_simple_rule(rulel &rl, rule *r); void promote_ttags(expr f, expr x, expr u); void promote_ttags(expr f, expr x, expr u, expr v); Modified: pure/trunk/lexer.ll =================================================================== --- pure/trunk/lexer.ll 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/lexer.ll 2008-06-18 07:45:21 UTC (rev 254) @@ -755,7 +755,7 @@ return token::ID; } } -[=;()\[\]\\] return yy::parser::token_type(yytext[0]); +[=|;()\[\]\\] return yy::parser::token_type(yytext[0]); "->" return token::MAPSTO; [[:punct:]]+ { if (yytext[0] == '/' && yytext[1] == '*') REJECT; // comment starter Modified: pure/trunk/parser.yy =================================================================== --- pure/trunk/parser.yy 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/parser.yy 2008-06-18 07:45:21 UTC (rev 254) @@ -59,9 +59,13 @@ sym_info(prec_t p, fix_t f) : prec(p), fix(f) { } }; struct rule_info { - expr l; + exprl l; env e; }; +struct pat_rule_info { + exprl l; + rulel rl; +}; typedef pair<expr,expr> comp_clause; typedef list<comp_clause> comp_clause_list; %} @@ -79,6 +83,7 @@ rule *rval; rulel *rlval; rule_info *rinfo; + pat_rule_info *prinfo; list<string> *slval; comp_clause_list *clauselval; comp_clause *clauseval; @@ -224,23 +229,24 @@ %type <slval> ids names ctypes opt_ctypes %type <info> fixity %type <xval> expr cond simple app prim op qual -%type <xlval> args +%type <xlval> args lhs %type <clauselval> comp_clauses comp_clause_list %type <clauseval> comp_clause -%type <rval> rule simple_rule %type <rinfo> rules rulel -%type <rlval> pat_rules pat_rulel simple_rules simple_rulel +%type <prinfo> pat_rules pat_rulel +%type <rval> simple_rule +%type <rlval> rule simple_rules simple_rulel %destructor { delete $$; } ID fixity expr cond simple app prim op - comp_clauses comp_clause_list args qual rules rulel rule pat_rules pat_rulel - simple_rules simple_rulel simple_rule ids names name + comp_clauses comp_clause_list args lhs qual rules rulel rule + pat_rules pat_rulel simple_rules simple_rulel simple_rule ids names name optalias opt_ctypes ctypes ctype %destructor { mpz_clear(*$$); free($$); } BIGINT %destructor { free($$); } STR %printer { debug_stream() << *$$; } ID name optalias ctype expr cond simple app - prim op args qual rule pat_rules pat_rulel simple_rules simple_rulel - simple_rule + prim op args lhs qual rule simple_rules simple_rulel simple_rule %printer { debug_stream() << $$->e; } rules rulel +%printer { debug_stream() << $$->rl; } pat_rules pat_rulel %printer { debug_stream() << $$; } INT DBL STR %printer { char *s = mpz_get_str(NULL, 10, *$$); debug_stream() << s; free(s); } BIGINT @@ -269,7 +275,8 @@ | LET simple_rule { action(interp.define($2), delete $2); } | rule -{ action(interp.add_rule(interp.globenv, interp.last, $1, true), delete $1); } +{ rulel *rl = interp.default_lhs(interp.last, $1); + action(interp.add_rules(interp.globenv, rl, true), delete rl); } | fixity /* Lexical tie-in: We need to tell the lexer that we're defining new operator symbols (interp.declare_op = true) instead of searching for existing ones @@ -361,7 +368,7 @@ { try { $$ = interp.mklambda_expr($2, $4); } catch (err &e) { interp.error(yyloc, e.what()); $$ = new expr; } } | CASE cond OF pat_rules END -{ $$ = interp.mkcase_expr($2, $4); } +{ $$ = interp.mkcase_expr($2, new rulel($4->rl)); delete $4; } | expr WHEN simple_rules END { try { $$ = interp.mkwhen_expr($1, $3); } catch (err &e) { interp.error(yyloc, e.what()); $$ = new expr; } } @@ -535,16 +542,27 @@ /* Rewriting rule syntax. These generally take the form l = r [if g]; ... For convenience, we also allow a semicolon at the end of a rule list. Moreover, - the left-hand side may be omitted, in which case the left-hand side of the - previous rule is repeated. */ + multiple left-hand sides are permitted (denoting a collection of rules for + the same right-hand side), and the left-hand side may also be omitted, in + which case the left-hand sides of the previous rule are repeated. */ rule -: expr '=' expr qual -{ $$ = new rule(*$1, *$3, *$4); delete $1; delete $3; delete $4; } +: lhs '=' expr qual +{ $$ = new rulel; + for (exprl::iterator l = $1->begin(), end = $1->end(); l != end; l++) + $$->push_back(rule(*l, *$3, *$4)); + delete $1; delete $3; delete $4; } | '=' expr qual -{ $$ = new rule(expr(), *$2, *$3); delete $2; delete $3; } +{ $$ = new rulel(1, rule(expr(), *$2, *$3)); delete $2; delete $3; } ; +lhs +: expr +{ $$ = new exprl; $$->push_back(*$1); delete $1; } +| lhs '|' expr +{ $$ = $1; $$->push_back(*$3); delete $3; } +; + qual : /* empty */ { $$ = new expr(); } | OTHERWISE { $$ = new expr(); } @@ -558,11 +576,15 @@ rulel : rule -{ $$ = new rule_info; try { interp.add_rule($$->e, $$->l, $1); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = new rule_info; + rulel *rl = interp.default_lhs($$->l, $1); + try { interp.add_rules($$->e, rl); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } | rulel ';' rule -{ $$ = $1; try { interp.add_rule($$->e, $$->l, $3); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = $1; + rulel *rl = interp.default_lhs($$->l, $3); + try { interp.add_rules($$->e, rl); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } ; /* Same for pattern rules (pattern binding in 'case' clauses). */ @@ -574,11 +596,15 @@ pat_rulel : rule -{ $$ = new rulel; try { interp.add_rule(*$$, $1, true); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = new pat_rule_info; + rulel *rl = interp.default_lhs($$->l, $1); + try { interp.add_rules($$->rl, rl, true); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } | pat_rulel ';' rule -{ $$ = $1; try { interp.add_rule(*$$, $3, true); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = $1; + rulel *rl = interp.default_lhs($$->l, $3); + try { interp.add_rules($$->rl, rl, true); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } ; /* Same for simple rules (pattern binding in 'when' clauses, no guards). */ Added: pure/trunk/test/test012.log =================================================================== --- pure/trunk/test/test012.log (rev 0) +++ pure/trunk/test/test012.log 2008-06-18 07:45:21 UTC (rev 254) @@ -0,0 +1,45 @@ +fact n/*0:1*/::int = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0; +fact n/*0:1*/::double = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0; +fact n/*0:1*/ = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0; +fact n/*0:1*/::int = 1; +fact n/*0:1*/::double = 1; +fact n/*0:1*/ = 1; +{ + rule #0: fact n::int = n*fact (n-1) if n>0 + rule #1: fact n::double = n*fact (n-1) if n>0 + rule #2: fact n = n*fact (n-1) if n>0 + rule #3: fact n::int = 1 + rule #4: fact n::double = 1 + rule #5: fact n = 1 + state 0: #0 #1 #2 #3 #4 #5 + <var> state 1 + <var>::int state 2 + <var>::double state 3 + state 1: #2 #5 + state 2: #0 #2 #3 #5 + state 3: #1 #2 #4 #5 +} +fact 10; +3628800 +fact 10L; +3628800L +fact 10.0; +3628800.0 +foo x/*0:1*/ = x/*0:1*/*y; +bar y/*0:1*/ = x*y/*0:1*/; +{ + rule #0: foo x = x*y + state 0: #0 + <var> state 1 + state 1: #0 +} +{ + rule #0: bar y = x*y + state 0: #0 + <var> state 1 + state 1: #0 +} +foo 99; +99*y +bar 99; +x*99 Added: pure/trunk/test/test012.pure =================================================================== --- pure/trunk/test/test012.pure (rev 0) +++ pure/trunk/test/test012.pure 2008-06-18 07:45:21 UTC (rev 254) @@ -0,0 +1,11 @@ + +fact n::int | +fact n::double | +fact n = n*fact (n-1) if n>0; + = 1 otherwise; + +fact 10; fact 10L; fact 10.0; + +foo x | bar y = x*y; + +foo 99; bar 99; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 16:38:11
|
Revision: 259 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=259&view=rev Author: agraef Date: 2008-06-18 09:38:20 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Add hash function to compute 32 bit hash codes of Pure expressions. Modified Paths: -------------- pure/trunk/lib/primitives.pure pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/lib/primitives.pure =================================================================== --- pure/trunk/lib/primitives.pure 2008-06-18 15:44:34 UTC (rev 258) +++ pure/trunk/lib/primitives.pure 2008-06-18 16:38:20 UTC (rev 259) @@ -65,6 +65,10 @@ extern expr* fun(expr*), expr* arg(expr*); +/* Compute a 32 bit hash code of a Pure expression. */ + +extern int hash(expr*); + /* Conversions between the different numeric and pointer types. */ extern expr* pure_intval(expr*), expr* pure_dblval(expr*), Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-06-18 15:44:34 UTC (rev 258) +++ pure/trunk/runtime.cc 2008-06-18 16:38:20 UTC (rev 259) @@ -1474,7 +1474,83 @@ return res; } +static uint32_t mpz_hash(const mpz_t z) +{ + uint32_t h = 0; + int i, len = z->_mp_size; + if (len < 0) len = -len; + if (sizeof(mp_limb_t) == 8) { + for (i=0; i<len; i++) { + h ^= (uint32_t)(uint64_t)z->_mp_d[i]; + h ^= (uint32_t)(((uint64_t)z->_mp_d[i])>>32); + } + } else { + for (i=0; i<len; i++) + h ^= z->_mp_d[i]; + } + if (z->_mp_size < 0) + h = -h; + return h; +} + +static uint32_t double_hash(double d) +{ + uint32_t h; + char *c; + size_t i; + c = (char*)&d; + for (h=0, i=0; i<sizeof(double); i++) { + h += c[i] * 971; + } + return h; +} + +static uint32_t string_hash(char *s) +{ + uint32_t h = 0, g; + while (*s) { + h = (h<<4)+*(s++); + if ((g = (h & 0xf0000000))) { + h = h^(g>>24); + h = h^g; + } + } + return h; +} + extern "C" +uint32_t hash(const pure_expr *x) +{ + char test; + switch (x->tag) { + case EXPR::INT: + return (uint32_t)x->data.i; + case EXPR::BIGINT: + return mpz_hash(x->data.z); + case EXPR::DBL: + return double_hash(x->data.d); + case EXPR::STR: + return string_hash(x->data.s); + case EXPR::PTR: +#if SIZEOF_VOID_P==8 + return ((uint32_t)(uint64_t)x->data.p) ^ ((uint32_t)(((uint64_t)p)>>32)); +#else + return (uint32_t)x->data.p; +#endif + case EXPR::APP: { + checkstk(test); + int h; + h = hash(x->data.x[0]); + h = (h<<1) | (h<0 ? 1 : 0); + h ^= hash(x->data.x[1]); + return (uint32_t)h; + } + default: + return (uint32_t)x->tag; + } +} + +extern "C" bool same(const pure_expr *x, const pure_expr *y) { char test; Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-06-18 15:44:34 UTC (rev 258) +++ pure/trunk/runtime.h 2008-06-18 16:38:20 UTC (rev 259) @@ -280,6 +280,11 @@ pure_expr *str(const pure_expr *x); pure_expr *eval(const char *s); +/* Compute a 32 bit hash code of a Pure expression. This makes it possible to + use arbitary Pure values as keys in a hash table. */ + +uint32_t hash(const pure_expr *x); + /* Check whether two objects are the "same" (syntactically). */ bool same(const pure_expr *x, const pure_expr *y); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 23:33:44
|
Revision: 265 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=265&view=rev Author: agraef Date: 2008-06-18 16:33:49 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Final touches for 0.4 release. Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/NEWS Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-18 23:04:34 UTC (rev 264) +++ pure/trunk/ChangeLog 2008-06-18 23:33:49 UTC (rev 265) @@ -1,5 +1,7 @@ 2008-06-19 Albert Graef <Dr....@t-...> + * 0.4 release. + * examples/symbolic.pure: Fix DNF example to accommodate changes in the operator system. Modified: pure/trunk/NEWS =================================================================== --- pure/trunk/NEWS 2008-06-18 23:04:34 UTC (rev 264) +++ pure/trunk/NEWS 2008-06-18 23:33:49 UTC (rev 265) @@ -1,4 +1,25 @@ +** Pure 0.4 2008-06-19 + +This release features some more bug and portability fixes, a cleanup of the +source tree and an overhaul of the build system, see the ChangeLog for +details. Building a separate runtime lib on x86-64 works now (but requires a +patched LLVM, see the INSTALL file for details). Moreover, it is now possible +to install different Pure versions in parallel. + +An Emacs mode for Pure and support for executing Pure scripts using "shebangs" +has been added. Paging of the 'list' command is now implemented using the +program specified with the PURE_MORE environment variable. This allows you to +disable this option (if PURE_MORE is undefined) or choose any pager program +and options that you prefer. Define PURE_MORE=more in your shell startup files +to get back the old behaviour of piping 'list' output through 'more'. + +There's also a new syntax for multiple left-hand sides in function definitions +and 'case' rules, as suggested by Jiri Spitz and discussed on the mailing +list. Please refer to the manual page for details. To accommodate this change, +the bitwise operators '&' and '|' were renamed to 'and' and 'or', +respectively. + ** Pure 0.3 2008-06-06 This release sports a lot of improvements as well as bug and portability This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-20 01:54:46
|
Revision: 268 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=268&view=rev Author: agraef Date: 2008-06-19 18:54:54 -0700 (Thu, 19 Jun 2008) Log Message: ----------- Fake interactive mode when we're not connected to a terminal but -i is specified. Modified Paths: -------------- pure/trunk/lexer.ll pure/trunk/pure.cc Modified: pure/trunk/lexer.ll =================================================================== --- pure/trunk/lexer.ll 2008-06-19 00:15:28 UTC (rev 267) +++ pure/trunk/lexer.ll 2008-06-20 01:54:54 UTC (rev 268) @@ -824,18 +824,41 @@ static char *my_buf = NULL, *my_bufptr = NULL; static int len = 0; +bool using_readline = false; + void my_readline(const char *prompt, char *buf, int &result, int max_size) { if (!my_buf) { - // read a new line using readline() - my_bufptr = my_buf = readline(prompt); - if (!my_buf) { - // EOF, bail out - result = 0; - return; + if (using_readline) { + // read a new line using readline() + my_bufptr = my_buf = readline(prompt); + if (!my_buf) { + // EOF, bail out + result = 0; + return; + } + add_history(my_buf); + } else { + // read a new line from stdin + char s[10000]; + fputs(prompt, stdout); fflush(stdout); + if (!fgets(s, 10000, stdin)) { + // EOF, bail out + result = 0; + return; + } + // get rid of the trailing newline + size_t l = strlen(s); + if (l>0 && s[l-1] == '\n') + s[l-1] = 0; + my_bufptr = my_buf = strdup(s); + if (!my_buf) { + // memory allocation error, bail out + result = 0; + return; + } } len = strlen(my_buf); - add_history(my_buf); } // how many chars we got int l = len-(my_bufptr-my_buf); Modified: pure/trunk/pure.cc =================================================================== --- pure/trunk/pure.cc 2008-06-19 00:15:28 UTC (rev 267) +++ pure/trunk/pure.cc 2008-06-20 01:54:54 UTC (rev 268) @@ -273,22 +273,28 @@ interp.symtab.init_builtins(); // enter the interactive command loop interp.interactive = true; - if (isatty(fileno(stdin))) { - // connected to a terminal, print sign-on and initialize readline + if (isatty(fileno(stdin)) || force_interactive) { + // We're connected to a terminal (or pretend that we are), print the + // sign-on message. if (!quiet) { cout << "Pure " << PACKAGE_VERSION << " (" << HOST << ") " << COPYRIGHT << endl << LICENSE; if (have_prelude) cout << "Loaded prelude from " << prelude << ".\n\n"; } + interp.compile(); + interp.ttymode = true; + } + if (isatty(fileno(stdin))) { + // initialize readline + extern bool using_readline; + using_readline = true; rl_readline_name = "Pure"; rl_attempted_completion_function = pure_completion; using_history(); read_history(interp.histfile.c_str()); stifle_history(600); histfile = strdup(interp.histfile.c_str()); - interp.compile(); - interp.ttymode = true; } interp.temp = 1; interp.run(""); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-21 21:43:45
|
Revision: 277 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=277&view=rev Author: agraef Date: 2008-06-21 14:43:52 -0700 (Sat, 21 Jun 2008) Log Message: ----------- Cosmetic changes, all modes now highlight catch/throw. Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/etc/pure-mode.el.in pure/trunk/etc/pure.lang pure/trunk/etc/pure.vim pure/trunk/etc/pure.xml Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-21 13:18:27 UTC (rev 276) +++ pure/trunk/ChangeLog 2008-06-21 21:43:52 UTC (rev 277) @@ -1,5 +1,8 @@ 2008-06-21 Albert Graef <Dr....@t-...> + * etc/pure-mode.el.in, etc/pure.vim, etc/pure.xml, etc/pure.lang: + Cosmetic changes, all modes now highlight catch/throw. + * lib/prelude.pure: Fixed a glitch in the definition of foldr1 which caused list elements to be processed in the wrong order. Modified: pure/trunk/etc/pure-mode.el.in =================================================================== --- pure/trunk/etc/pure-mode.el.in 2008-06-21 13:18:27 UTC (rev 276) +++ pure/trunk/etc/pure-mode.el.in 2008-06-21 21:43:52 UTC (rev 277) @@ -161,6 +161,7 @@ ; (list pure-prompt-regexp 0 'font-lock-preprocessor-face t) (list pure-msg-regexp 0 'font-lock-warning-face t) (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list "\\<\\(catch\\|throw\\)\\>" 0 'font-lock-builtin-face) (list (concat "\\<\\(" "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" @@ -174,6 +175,7 @@ (list (list "^#!.*" 0 'font-lock-comment-face t) (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list "\\<\\(catch\\|throw\\)\\>" 0 'font-lock-builtin-face) (list (concat "\\<\\(" "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" Modified: pure/trunk/etc/pure.lang =================================================================== --- pure/trunk/etc/pure.lang 2008-06-21 13:18:27 UTC (rev 276) +++ pure/trunk/etc/pure.lang 2008-06-21 21:43:52 UTC (rev 277) @@ -7,6 +7,9 @@ $KW_LIST(kwa)=infix infixl infixr prefix postfix nullary case else end extern if let of otherwise then using when with +# These aren't really keywords but we want them to stick out anyway. +$KW_LIST(kwb)=catch throw + # Type identifiers used as tags and in extern declarations. $KW_LIST(kwc)=bigint bool char short int long double expr string pointer void Modified: pure/trunk/etc/pure.vim =================================================================== --- pure/trunk/etc/pure.vim 2008-06-21 13:18:27 UTC (rev 276) +++ pure/trunk/etc/pure.vim 2008-06-21 21:43:52 UTC (rev 277) @@ -35,8 +35,9 @@ syn keyword pureKeyword infix infixl infixr prefix postfix nullary syn keyword pureKeyword case else end extern if let of otherwise then syn keyword pureKeyword using when with -syn keyword pureIdentifier bigint bool char short int long double -syn keyword pureIdentifier expr string pointer void +syn keyword pureSpecial catch throw +syn keyword pureType bigint bool char short int long double +syn keyword pureType expr string pointer void syn match pureNumber "\<[0-9]*\>" syn match pureHexNumber "\<0[Xx][0-9A-Fa-f]*\>" @@ -68,6 +69,8 @@ HiLink pureSpecialCharacter Special HiLink pureNumber Number HiLink pureHexNumber Number + HiLink pureType Type + HiLink pureSpecial Identifier HiLink pureIdentifier Identifier HiLink pureCommentError Error HiLink pureString String Modified: pure/trunk/etc/pure.xml =================================================================== --- pure/trunk/etc/pure.xml 2008-06-21 13:18:27 UTC (rev 276) +++ pure/trunk/etc/pure.xml 2008-06-21 21:43:52 UTC (rev 277) @@ -22,6 +22,10 @@ <item> when </item> <item> with </item> </list> + <list name="special"> + <item> catch </item> + <item> throw </item> + </list> <list name="types"> <item> bigint </item> <item> bool </item> @@ -38,7 +42,8 @@ <contexts> <context attribute="Normal Text" lineEndContext="#stay" name="Normal"> <keyword attribute="Keyword" context="#stay" String="keywords"/> - <keyword attribute="Conid" context="#stay" String="types"/> + <keyword attribute="Function" context="#stay" String="special"/> + <keyword attribute="Type" context="#stay" String="types"/> <RegExpr attribute="Normal Text" context="#stay" String="[A-Za-z_][A-Za-z0-9_]*"/> <RegExpr attribute="Number" context="#stay" String="0x[A-Za-z0-9]+"/> <Float attribute="Number" context="#stay"/> @@ -59,7 +64,8 @@ <itemDatas> <itemData name="Normal Text" defStyleNum="dsNormal" /> <itemData name="Keyword" defStyleNum="dsKeyword" /> - <itemData name="Conid" defStyleNum="dsDataType"/> + <itemData name="Function" defStyleNum="dsFunction"/> + <itemData name="Type" defStyleNum="dsDataType"/> <itemData name="Number" defStyleNum="dsDecVal" /> <itemData name="String" defStyleNum="dsString" /> <itemData name="Comment" defStyleNum="dsComment" /> This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-22 08:09:24
|
Revision: 276 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=276&view=rev Author: agraef Date: 2008-06-21 06:18:27 -0700 (Sat, 21 Jun 2008) Log Message: ----------- Fix a glitch in the definition of foldr1 which caused list elements to be processed in the wrong order. Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/lib/prelude.pure Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-21 11:13:10 UTC (rev 275) +++ pure/trunk/ChangeLog 2008-06-21 13:18:27 UTC (rev 276) @@ -1,3 +1,8 @@ +2008-06-21 Albert Graef <Dr....@t-...> + + * lib/prelude.pure: Fixed a glitch in the definition of foldr1 + which caused list elements to be processed in the wrong order. + 2008-06-20 Albert Graef <Dr....@t-...> * 0.4 release. Modified: pure/trunk/lib/prelude.pure =================================================================== --- pure/trunk/lib/prelude.pure 2008-06-21 11:13:10 UTC (rev 275) +++ pure/trunk/lib/prelude.pure 2008-06-21 13:18:27 UTC (rev 276) @@ -252,7 +252,7 @@ = f x (foldl (flip f) a (reverse xs)); foldr1 f [x] = x; -foldr1 f (x:xs) = foldr f x xs; +foldr1 f (x:xs) = f x (foldl1 (flip f) (reverse xs)); head (x:xs) = x; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-22 21:07:09
|
Revision: 279 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=279&view=rev Author: agraef Date: 2008-06-22 14:07:18 -0700 (Sun, 22 Jun 2008) Log Message: ----------- Implement Haskell-like "as" patterns. Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/expr.cc pure/trunk/expr.hh pure/trunk/interpreter.cc pure/trunk/interpreter.hh pure/trunk/lexer.ll pure/trunk/parser.yy pure/trunk/printer.cc Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/ChangeLog 2008-06-22 21:07:18 UTC (rev 279) @@ -1,3 +1,8 @@ +2008-06-22 Albert Graef <Dr....@t-...> + + * expr.cc, interpreter.cc, parser.yy, lexer.ll: Implement + Haskell-like "as" patterns. + 2008-06-21 Albert Graef <Dr....@t-...> * etc/pure-mode.el.in, etc/pure.vim, etc/pure.xml, etc/pure.lang: Modified: pure/trunk/expr.cc =================================================================== --- pure/trunk/expr.cc 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/expr.cc 2008-06-22 21:07:18 UTC (rev 279) @@ -44,6 +44,7 @@ if (data.c.e) delete data.c.e; break; } + if (aspath) delete aspath; } map<EXPR*,uint32_t> expr::h; Modified: pure/trunk/expr.hh =================================================================== --- pure/trunk/expr.hh 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/expr.hh 2008-06-22 21:07:18 UTC (rev 279) @@ -146,60 +146,64 @@ // extra built-in type tag used in code generation: int8_t ttag; + // "as" patterns: + int32_t astag; + path *aspath; + EXPR *incref() { refc++; return this; } uint32_t decref() { if (refc > 0) --refc; return refc; } void del() { if (decref() == 0) delete this; } static EXPR *newref(EXPR *x) { return x?x->incref():0; } EXPR(int32_t _tag) : - refc(0), tag(_tag), m(0), ttag(0) { } + refc(0), tag(_tag), m(0), ttag(0), astag(0), aspath(0) { } EXPR(int32_t _tag, int32_t _vtag, uint8_t _idx, int8_t _ttag = 0, const path& _p = path()) : - refc(0), tag(_tag), m(0), ttag(_ttag) + refc(0), tag(_tag), m(0), ttag(_ttag), astag(0), aspath(0) { assert(_tag == VAR || _tag == FVAR); data.v.vtag = _vtag; data.v.idx = _idx; data.v.p = (_tag == VAR)?new path(_p):0; } EXPR(int32_t _tag, int32_t _i) : - refc(0), tag(_tag), m(0), ttag(_tag) + refc(0), tag(_tag), m(0), ttag(_tag), astag(0), aspath(0) { assert(_tag == INT); data.i = _i; } EXPR(int32_t _tag, mpz_t _z) : - refc(0), tag(_tag), m(0), ttag(_tag) + refc(0), tag(_tag), m(0), ttag(_tag), astag(0), aspath(0) { assert(_tag == BIGINT); mpz_init_set(data.z, _z); mpz_clear(_z); } EXPR(int32_t _tag, double _d) : - refc(0), tag(_tag), m(0), ttag(_tag) + refc(0), tag(_tag), m(0), ttag(_tag), astag(0), aspath(0) { assert(_tag == DBL); data.d = _d; } explicit EXPR(int32_t _tag, char *_s) : - refc(0), tag(_tag), m(0), ttag(_tag) + refc(0), tag(_tag), m(0), ttag(_tag), astag(0), aspath(0) { assert(_tag == STR); data.s = _s; } explicit EXPR(int32_t _tag, void *_p) : - refc(0), tag(_tag), m(0), ttag(_tag) + refc(0), tag(_tag), m(0), ttag(_tag), astag(0), aspath(0) { assert(_tag == PTR); data.p = _p; } EXPR(int32_t _tag, EXPR *_arg1, EXPR *_arg2, EXPR *_arg3) : - refc(0), tag(_tag), m(0), ttag(0) + refc(0), tag(_tag), m(0), ttag(0), astag(0), aspath(0) { assert(_tag == COND); data.x[0] = newref(_arg1); data.x[1] = newref(_arg2); data.x[2] = newref(_arg3); } EXPR(int32_t _tag, EXPR *_arg, EXPR *_body) : - refc(0), tag(_tag), m(0), ttag(0) + refc(0), tag(_tag), m(0), ttag(0), astag(0), aspath(0) { assert(_tag == LAMBDA); data.x[0] = newref(_arg); data.x[1] = newref(_body); } EXPR(int32_t _tag, EXPR *_arg, rulel *_rules) : - refc(0), tag(_tag), m(0), ttag(0) + refc(0), tag(_tag), m(0), ttag(0), astag(0), aspath(0) { assert(_tag == CASE || _tag == WHEN); data.c.x = newref(_arg); data.c.r = _rules; } EXPR(int32_t _tag, EXPR *_arg, env *_e) : - refc(0), tag(_tag), m(0), ttag(0) + refc(0), tag(_tag), m(0), ttag(0), astag(0), aspath(0) { assert(_tag == WITH); data.c.x = newref(_arg); data.c.e = _e; } EXPR(EXPR *_fun, EXPR *_arg) : - refc(0), tag(APP), m(0), ttag(0) + refc(0), tag(APP), m(0), ttag(0), astag(0), aspath(0) { data.x[0] = newref(_fun); data.x[1] = newref(_arg); } EXPR(EXPR *_fun, EXPR *_arg1, EXPR *_arg2) : - refc(0), tag(APP), m(0), ttag(0) + refc(0), tag(APP), m(0), ttag(0), astag(0), aspath(0) { data.x[0] = new EXPR(_fun, _arg1); data.x[0]->incref(); data.x[1] = newref(_arg2); } EXPR(EXPR *_fun, EXPR *_arg1, EXPR *_arg2, EXPR *_arg3) : - refc(0), tag(APP), m(0), ttag(0) + refc(0), tag(APP), m(0), ttag(0), astag(0), aspath(0) { data.x[0] = new EXPR(_fun, _arg1, _arg2); data.x[0]->incref(); data.x[1] = newref(_arg3); } @@ -333,8 +337,13 @@ p->tag == EXPR::CASE || p->tag == EXPR::WHEN); return p->m; } + int32_t astag() const { return p->astag; } + path &aspath() const { assert(p->aspath); return *p->aspath; } void set_ttag(int8_t tag) { p->ttag = tag; } + void set_astag(int32_t tag) { p->astag = tag; } + void set_aspath(const path& _p) + { if (p->aspath) delete p->aspath; p->aspath = new path(_p); } bool is_null() const { return p==0; } bool is_fun() const { return p->tag > 0; } Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/interpreter.cc 2008-06-22 21:07:18 UTC (rev 279) @@ -671,6 +671,10 @@ void interpreter::build_env(env& vars, expr x) { assert(!x.is_null()); + if (x.astag() > 0) { + const symbol& sym = symtab.sym(x.astag()); + if (sym.s != "_") vars[sym.f] = env_info(0, x.aspath()); + } switch (x.tag()) { case EXPR::VAR: { const symbol& sym = symtab.sym(x.vtag()); @@ -999,6 +1003,7 @@ expr interpreter::bind(env& vars, expr x, bool b, path p) { assert(!x.is_null()); + expr y; switch (x.tag()) { case EXPR::VAR: { // previously bound variable (successor rule) @@ -1007,7 +1012,8 @@ assert(p == x.vpath()); vars[sym.f] = env_info(x.ttag(), p); } - return x; + y = x; + break; } // constants: case EXPR::FVAR: @@ -1016,26 +1022,33 @@ case EXPR::DBL: case EXPR::STR: case EXPR::PTR: - return x; + y = x; + break; // application: case EXPR::APP: { if (p.len() >= MAXDEPTH) throw err("error in pattern (nesting too deep)"); expr u = bind(vars, x.xval1(), 1, path(p, 0)), v = bind(vars, x.xval2(), 1, path(p, 1)); - return expr(u, v); + y = expr(u, v); + break; } // these must not occur on the lhs: case EXPR::LAMBDA: throw err("lambda expression not permitted in pattern"); + break; case EXPR::COND: throw err("conditional expression not permitted in pattern"); + break; case EXPR::CASE: throw err("case expression not permitted in pattern"); + break; case EXPR::WHEN: throw err("when expression not permitted in pattern"); + break; case EXPR::WITH: throw err("with expression not permitted in pattern"); + break; default: assert(x.tag() > 0); const symbol& sym = symtab.sym(x.tag()); @@ -1043,17 +1056,37 @@ p.len() > 0 && p.last() == 0) { // constant or constructor if (x.ttag() != 0) - throw err("error in expression (misplaced type tag)"); - return x; + throw err("error in pattern (misplaced type tag)"); + y = x; + } else { + env::iterator it = vars.find(sym.f); + if (sym.s != "_") { // '_' = anonymous variable + if (it != vars.end()) + throw err("error in pattern (repeated variable '"+sym.s+"')"); + vars[sym.f] = env_info(x.ttag(), p); + } + y = expr(EXPR::VAR, sym.f, 0, x.ttag(), p); } - env::iterator it = vars.find(sym.f); - if (sym.s != "_") { // '_' = anonymous variable - if (it != vars.end()) + break; + } + // check for "as" patterns + if (x.astag() > 0) { + const symbol& sym = symtab.sym(x.astag()); + if (sym.s != "_") { + if (sym.prec < 10 || sym.fix == nullary) + throw err("error in pattern (bad variable symbol '"+sym.s+"')"); + if (p.len() == 0 && !b) + throw err("error in pattern (misplaced variable '"+sym.s+"')"); + env::iterator it = vars.find(sym.f); + if (it != vars.end()) { throw err("error in pattern (repeated variable '"+sym.s+"')"); - vars[sym.f] = env_info(x.ttag(), p); + } + vars[sym.f] = env_info(0, p); + y.set_astag(x.astag()); + y.set_aspath(p); } - return expr(EXPR::VAR, sym.f, 0, x.ttag(), p); } + return y; } void interpreter::promote_ttags(expr f, expr x, expr u) @@ -1124,6 +1157,8 @@ expr interpreter::subst(const env& vars, expr x, uint8_t idx) { if (x.is_null()) return x; + if (x.astag() > 0) + throw err("error in expression (misplaced \"as\" pattern)"); switch (x.tag()) { // constants: case EXPR::VAR: @@ -1373,7 +1408,12 @@ expr *x; const symbol &sym = symtab.sym(*s); if (tag == 0) - x = new expr(sym.x); + if (*s == "_") + // Return a new instance here, since the anonymous variable may have + // multiple occurrences on the lhs. + x = new expr(sym.f); + else + x = new expr(sym.x); else if (sym.f <= 0 || sym.prec < 10 || sym.fix == nullary) throw err("error in expression (misplaced type tag)"); else { @@ -1385,6 +1425,22 @@ return x; } +expr *interpreter::mkas_expr(string *s, expr *x) +{ + const symbol &sym = symtab.sym(*s); + if (sym.f <= 0 || sym.prec < 10 || sym.fix == nullary) + throw err("error in pattern (bad variable symbol '"+sym.s+"')"); + if (x->tag() > 0) { + // Avoid globbering cached function symbols. + expr *y = new expr(x->tag()); + delete x; + x = y; + } + x->set_astag(sym.f); + delete s; + return x; +} + expr *interpreter::mkcond_expr(expr *x, expr *y, expr *z) { expr *u = new expr(expr::cond(*x, *y, *z)); Modified: pure/trunk/interpreter.hh =================================================================== --- pure/trunk/interpreter.hh 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/interpreter.hh 2008-06-22 21:07:18 UTC (rev 279) @@ -369,6 +369,7 @@ expr *mkexpr(expr *x, expr *y); expr *mkexpr(expr *x, expr *y, expr *z); expr *mksym_expr(string *s, int8_t tag = 0); + expr *mkas_expr(string *s, expr *x); expr *mkcond_expr(expr *x, expr *y, expr *z); expr *mklambda_expr(exprl *args, expr *body); expr *mkcase_expr(expr *x, rulel *rules); Modified: pure/trunk/lexer.ll =================================================================== --- pure/trunk/lexer.ll 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/lexer.ll 2008-06-22 21:07:18 UTC (rev 279) @@ -755,7 +755,7 @@ return token::ID; } } -[=|;()\[\]\\] return yy::parser::token_type(yytext[0]); +[@=|;()\[\]\\] return yy::parser::token_type(yytext[0]); "->" return token::MAPSTO; [[:punct:]]+ { if (yytext[0] == '/' && yytext[1] == '*') REJECT; // comment starter Modified: pure/trunk/parser.yy =================================================================== --- pure/trunk/parser.yy 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/parser.yy 2008-06-22 21:07:18 UTC (rev 279) @@ -498,6 +498,11 @@ interp.error(yyloc, e.what()); $$ = interp.mksym_expr($1); } } +| ID '@' prim { try { $$ = interp.mkas_expr($1, $3); } + catch (err &e) { + interp.error(yyloc, e.what()); + $$ = $3; + } } | INT { $$ = new expr(EXPR::INT, $1); } | BIGINT { $$ = new expr(EXPR::BIGINT, *$1); free($1); } | DBL { $$ = new expr(EXPR::DBL, $1); } Modified: pure/trunk/printer.cc =================================================================== --- pure/trunk/printer.cc 2008-06-21 22:23:15 UTC (rev 278) +++ pure/trunk/printer.cc 2008-06-22 21:07:18 UTC (rev 279) @@ -53,9 +53,9 @@ } } -static prec_t expr_nprec(expr x) +static prec_t expr_nprec(expr x, bool aspat = true) { - if (x.is_null()) return 100; + if (x.is_null() || aspat && x.astag()>0) return 100; switch (x.tag()) { case EXPR::VAR: case EXPR::STR: @@ -119,7 +119,8 @@ : x(_x), pat(_pat) { } }; -static ostream& printx(ostream& os, const expr& x, bool pat); +static ostream& printx(ostream& os, const expr& x, bool pat, + bool aspat = true); ostream& operator << (ostream& os, const pattern& p) { @@ -162,11 +163,23 @@ } } -static ostream& printx(ostream& os, const expr& x, bool pat) +static ostream& printx(ostream& os, const expr& x, bool pat, bool aspat) { char buf[64]; if (x.is_null()) return os << "<<NULL>>"; //os << "{" << x.refc() << "}"; + // handle "as" patterns + if (aspat && x.astag()>0) { + const symbol& sym = interpreter::g_interp->symtab.sym(x.astag()); + if (expr_nprec(x, false) < 100) { + os << sym.s << "@("; + printx(os, x, pat, false); + return os << ")"; + } else { + os << sym.s << "@"; + return printx(os, x, pat, false); + } + } switch (x.tag()) { case EXPR::VAR: { const symbol& sym = interpreter::g_interp->symtab.sym(x.vtag()); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-23 13:07:17
|
Revision: 290 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=290&view=rev Author: agraef Date: 2008-06-23 06:07:26 -0700 (Mon, 23 Jun 2008) Log Message: ----------- Make pure_invoke() callable from C. Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/interpreter.cc pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-23 11:10:39 UTC (rev 289) +++ pure/trunk/ChangeLog 2008-06-23 13:07:26 UTC (rev 290) @@ -1,3 +1,7 @@ +2008-06-23 Albert Graef <Dr....@t-...> + + * runtime.h, runtime.cc: Make pure_invoke() callable from C. + 2008-06-22 Albert Graef <Dr....@t-...> * expr.cc, interpreter.cc, parser.yy, lexer.ll, printer.cc: Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-23 11:10:39 UTC (rev 289) +++ pure/trunk/interpreter.cc 2008-06-23 13:07:26 UTC (rev 290) @@ -2743,7 +2743,7 @@ assert(f.fp); e = 0; clock_t t0 = clock(); - pure_expr *res = pure_invoke(f.fp, e); + pure_expr *res = pure_invoke(f.fp, &e); if (interactive && stats) clocks = clock()-t0; // Get rid of our anonymous function. JIT->freeMachineCodeForFunction(f.f); @@ -2829,7 +2829,7 @@ assert(f.fp); e = 0; clock_t t0 = clock(); - pure_expr *res = pure_invoke(f.fp, e); + pure_expr *res = pure_invoke(f.fp, &e); if (interactive && stats) clocks = clock()-t0; // Get rid of our anonymous function. JIT->freeMachineCodeForFunction(f.f); Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-06-23 11:10:39 UTC (rev 289) +++ pure/trunk/runtime.cc 2008-06-23 13:07:26 UTC (rev 290) @@ -755,8 +755,10 @@ } extern "C" -pure_expr *pure_invoke(void *f, pure_expr*& e) +pure_expr *pure_invoke(void *f, pure_expr** _e) { + assert(_e); + pure_expr*& e = *_e; interpreter& interp = *interpreter::g_interp; // Cast the function pointer to the right type (takes no arguments, returns // a pure_expr*), so we can call it as a native function. Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-06-23 11:10:39 UTC (rev 289) +++ pure/trunk/runtime.h 2008-06-23 13:07:26 UTC (rev 290) @@ -127,12 +127,9 @@ /* Run a Pure function and catch exceptions. If everything goes normal, pure_invoke returns the return value of the executed function. Otherwise it returns 0 and sets e to the exception value, as given by pure_throw(). - XXXFIXME: This only works with C++ and only supports parameterless - functions right now. */ + XXXFIXME: This only supports parameterless functions right now. */ -#ifdef __cplusplus -pure_expr *pure_invoke(void *f, pure_expr*& e); -#endif +pure_expr *pure_invoke(void *f, pure_expr** e); /* Count a new reference to an expression. This should be called whenever you want to store an expression somewhere, in order to prevent it from being This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-23 23:38:42
|
Revision: 291 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=291&view=rev Author: agraef Date: 2008-06-23 16:38:50 -0700 (Mon, 23 Jun 2008) Log Message: ----------- Start refactoring the runtime library in order to provide a sensible public API to external modules which need access to Pure expression data. Modified Paths: -------------- pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-06-23 13:07:26 UTC (rev 290) +++ pure/trunk/runtime.cc 2008-06-23 23:38:50 UTC (rev 291) @@ -298,51 +298,17 @@ return pure_const(interpreter::g_interp->symtab.segfault_sym().f); } -extern "C" -pure_expr *pure_clos(bool local, bool thunked, int32_t tag, uint32_t n, - void *f, void *e, uint32_t m, /* m x pure_expr* */ ...) -{ - // Parameterless closures are always thunked, otherwise they would already - // have been executed. - if (n==0) thunked = true; - pure_expr *x = new_expr(); - x->tag = tag; - x->data.clos = new pure_closure; - x->data.clos->local = local; - x->data.clos->thunked = thunked; - x->data.clos->n = n; - x->data.clos->m = m; - x->data.clos->fp = f; - x->data.clos->ep = e; - if (e) ((Env*)e)->refc++; - if (m == 0) - x->data.clos->env = 0; - else { - x->data.clos->env = new pure_expr*[m]; - va_list ap; - va_start(ap, m); - for (size_t i = 0; i < m; i++) { - x->data.clos->env[i] = va_arg(ap, pure_expr*); - assert(x->data.clos->env[i]->refc > 0); - } - va_end(ap); - } - MEMDEBUG_NEW(x) - return x; -} +/* PUBLIC API. **************************************************************/ -extern "C" -pure_expr *pure_const(int32_t tag) -{ - // XXXFIXME: We should cache these on a per interpreter basis, so that only - // a single expression node exists for each symbol. - pure_expr *x = new_expr(); - x->tag = tag; - x->data.clos = 0; - MEMDEBUG_NEW(x) - return x; -} +// XXXTODO +int32_t pure_sym(const char *s); +int32_t pure_getsym(const char *s); +const char *pure_sym_pname(int32_t sym); +int8_t pure_sym_nprec(int32_t sym); + +pure_expr *pure_symbol(int32_t sym); + extern "C" pure_expr *pure_int(int32_t i) { @@ -369,7 +335,7 @@ } } -static void make_bigint(mpz_t z, int32_t size, limb_t *limbs) +static void make_bigint(mpz_t z, int32_t size, const limb_t *limbs) { // FIXME: For efficiency, we poke directly into the mpz struct here, this // might need to be reviewed for future GMP revisions. @@ -385,7 +351,7 @@ } extern "C" -pure_expr *pure_bigint(int32_t size, limb_t *limbs) +pure_expr *pure_bigint(int32_t size, const limb_t *limbs) { pure_expr *x = new_expr(); x->tag = EXPR::BIGINT; @@ -395,7 +361,7 @@ } extern "C" -pure_expr *pure_mpz(mpz_t z) +pure_expr *pure_mpz(const mpz_t z) { pure_expr *x = new_expr(); x->tag = EXPR::BIGINT; @@ -466,9 +432,113 @@ return x; } +// XXXTODO + +pure_expr *pure_app(pure_expr *fun, pure_expr *arg); + +pure_expr *pure_listl(size_t size, ...); +pure_expr *pure_listv(size_t size, pure_expr **elems); +pure_expr *pure_tuplel(size_t size, ...); +pure_expr *pure_tuplev(size_t size, pure_expr **elems); + +bool pure_is_symbol(const pure_expr *x, int32_t *sym); +bool pure_is_int(const pure_expr *x, int32_t *i); +bool pure_is_long(const pure_expr *x, int64_t *l); +bool pure_is_bigint(const pure_expr *x, int32_t *size, limb_t **limbs); +bool pure_is_mpz(const pure_expr *x, mpz_t *z); +bool pure_is_double(const pure_expr *x, double *d); +bool pure_is_pointer(const pure_expr *x, void **p); + +bool pure_is_string(const pure_expr *x, const char **sym); +bool pure_is_string_dup(const pure_expr *x, char **sym); +bool pure_is_cstring_dup(const pure_expr *x, char **sym); + +bool pure_is_app(const pure_expr *x, pure_expr **fun, pure_expr **arg); + +bool pure_is_listv(const pure_expr *x, size_t *size, pure_expr ***elems); +bool pure_is_tuplev(const pure_expr *x, size_t *size, pure_expr ***elems); + extern "C" -int32_t pure_cmp_bigint(pure_expr *x, int32_t size, limb_t *limbs) +pure_expr *pure_new(pure_expr *x) { + return pure_new_internal(x); +} + +extern "C" +void pure_free(pure_expr *x) +{ + pure_free_internal(x); +} + +extern "C" +void pure_freenew(pure_expr *x) +{ + if (x->refc == 0) + pure_free_internal(pure_new_internal(x)); +} + +extern "C" +void pure_ref(pure_expr *x) +{ + x->refc++; +} + +extern "C" +void pure_unref(pure_expr *x) +{ + pure_unref_internal(x); +} + +/* END OF PUBLIC API. *******************************************************/ + +extern "C" +pure_expr *pure_const(int32_t tag) +{ + // XXXFIXME: We should cache these on a per interpreter basis, so that only + // a single expression node exists for each symbol. + pure_expr *x = new_expr(); + x->tag = tag; + x->data.clos = 0; + MEMDEBUG_NEW(x) + return x; +} + +extern "C" +pure_expr *pure_clos(bool local, bool thunked, int32_t tag, uint32_t n, + void *f, void *e, uint32_t m, /* m x pure_expr* */ ...) +{ + // Parameterless closures are always thunked, otherwise they would already + // have been executed. + if (n==0) thunked = true; + pure_expr *x = new_expr(); + x->tag = tag; + x->data.clos = new pure_closure; + x->data.clos->local = local; + x->data.clos->thunked = thunked; + x->data.clos->n = n; + x->data.clos->m = m; + x->data.clos->fp = f; + x->data.clos->ep = e; + if (e) ((Env*)e)->refc++; + if (m == 0) + x->data.clos->env = 0; + else { + x->data.clos->env = new pure_expr*[m]; + va_list ap; + va_start(ap, m); + for (size_t i = 0; i < m; i++) { + x->data.clos->env[i] = va_arg(ap, pure_expr*); + assert(x->data.clos->env[i]->refc > 0); + } + va_end(ap); + } + MEMDEBUG_NEW(x) + return x; +} + +extern "C" +int32_t pure_cmp_bigint(pure_expr *x, int32_t size, const limb_t *limbs) +{ assert(x && x->tag == EXPR::BIGINT); mpz_t z; make_bigint(z, size, limbs); @@ -812,37 +882,6 @@ } extern "C" -pure_expr *pure_new(pure_expr *x) -{ - return pure_new_internal(x); -} - -extern "C" -void pure_free(pure_expr *x) -{ - pure_free_internal(x); -} - -extern "C" -void pure_freenew(pure_expr *x) -{ - if (x->refc == 0) - pure_free_internal(pure_new_internal(x)); -} - -extern "C" -void pure_ref(pure_expr *x) -{ - x->refc++; -} - -extern "C" -void pure_unref(pure_expr *x) -{ - pure_unref_internal(x); -} - -extern "C" void pure_new_args(uint32_t n, ...) { va_list ap; @@ -1067,6 +1106,8 @@ if (bail_out) exit(0); } +/* LIBRARY API. *************************************************************/ + extern "C" pure_expr *pure_byte_string(const char *s) { Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-06-23 13:07:26 UTC (rev 290) +++ pure/trunk/runtime.h 2008-06-23 23:38:50 UTC (rev 291) @@ -15,6 +15,9 @@ /* Our "limb" type. Used to pass bigint constants to the runtime. */ typedef mp_limb_t limb_t; +/* The following data structures should be considered opaque by + applications. */ + /* Closure data. This is a bit on the heavy side, so expressions which need it (i.e., functions) refer to this extra data via an allocated pointer. */ @@ -57,35 +60,178 @@ pure_expr x[MEMSIZE]; // expression data } pure_mem; -/* Expression constructors. */ +/* PUBLIC API. **************************************************************/ -pure_expr *pure_clos(bool local, bool thunked, int32_t tag, uint32_t n, - void *f, void *e, uint32_t m, /* m x pure_expr* */ ...); -pure_expr *pure_const(int32_t tag); +/* The following routines are meant to be used by external C modules and other + applications which need direct access to Pure expression data. */ + +/* Symbol table access. pure_sym returns the integer code of a (function or + variable) symbol given by its print name; if the symbol doesn't exist yet, + it is created (as an ordinary function or variable symbol). pure_getsym is + like pure_sym, but returns 0 if the symbol doesn't exist. + + Given the (positive) symbol number, pure_sym_pname returns its print name + and pure_sym_nprec its "normalized" precedence. The latter is a small + integer value defined as nprec = 10*prec+fix, where prec is the precedence + level of the symbol and fix its fixity. For operators, the combined value + ranges from 0 (weakest infix operator on level 0) to 94 (strongest postfix + operator on level 9). Applications have nprec=95, ordinary function and + variable symbols nprec=100. */ + +int32_t pure_sym(const char *s); +int32_t pure_getsym(const char *s); +const char *pure_sym_pname(int32_t sym); +int8_t pure_sym_nprec(int32_t sym); + +/* Expression constructors. Atomic objects are constructed with the following + routines: + + - pure_symbol: Takes the integer code of a symbol and returns that symbol + as a Pure value. If the symbol is a global variable or parameterless + function then it is evaluated, giving the value of the variable or the + return value of the function as the result. + + - pure_int: Constructs a Pure machine int from a 32 bit integer value. + + - pure_long: Constructs a Pure bigint from a 64 bit integer value. + + - pure_bigint: Constructs a Pure bigint from a vector of limbs. The size + argument may be negative to denote a negative number, its absolute value + is the number of elements in the limbs vector (the vector is owned by the + caller and won't be be freed). + + - pure_mpz: Constructs a Pure bigint from a (copy of a) GMP mpz_t. + + - pure_double: Constructs a Pure floating point number from a double value. + + - pure_pointer: Constructs a Pure pointer from a C pointer (void*). */ + +pure_expr *pure_symbol(int32_t sym); pure_expr *pure_int(int32_t i); pure_expr *pure_long(int64_t l); -pure_expr *pure_bigint(int32_t size, limb_t *limbs); -pure_expr *pure_mpz(mpz_t z); +pure_expr *pure_bigint(int32_t size, const limb_t *limbs); +pure_expr *pure_mpz(const mpz_t z); pure_expr *pure_double(double d); pure_expr *pure_pointer(void *p); /* String constructors. There are four variations of these, depending on whether the original string is already in utf-8 (_string routines) or in the system encoding (_cstring), and whether the string should be copied - (_dup suffix) or whether Pure takes ownership of the string (no _dup - suffix). All these routines also handle the case that the given string is a - null pointer and will then return the appropriate Pure pointer expression - instead. */ + (_dup suffix) or whether Pure takes ownership of the string. All four + routines handle the case that the given string is a null pointer and will + then return the appropriate Pure pointer expression instead. */ pure_expr *pure_string_dup(const char *s); pure_expr *pure_cstring_dup(const char *s); pure_expr *pure_string(char *s); pure_expr *pure_cstring(char *s); +/* Function applications. pure_app applies the given function to the given + argument. The result is evaluated if possible (i.e., if it is a saturated + function call). Otherwise, the result is a literal application and + references on function and argument are counted automatically. */ + +pure_expr *pure_app(pure_expr *fun, pure_expr *arg); + +/* Convenience functions to construct Pure list and tuple values from a vector + or a varargs list of element expressions. (Internally these are actually + represented as function applications.) The vectors are owned by the caller + and won't be freed. References on the element expressions are counted + automatically. */ + +pure_expr *pure_listl(size_t size, ...); +pure_expr *pure_listv(size_t size, pure_expr **elems); +pure_expr *pure_tuplel(size_t size, ...); +pure_expr *pure_tuplev(size_t size, pure_expr **elems); + +/* Expression deconstructors for all the expression types above. These all + return a bool value indicating whether the given expression is of the + corresponding type and, if so, set the remaining parameter pointers to the + corresponding values. Parameter pointers may be NULL in which case they are + not set and only the result of the type check is returned. + + NOTES: pure_is_symbol will return true not only for constant and unbound + variable symbols, but also for arbitrary closures including local and + anonymous functions. In the case of an anonymous closure, the returned + symbol will be 0. You can check whether an expression actually represents a + named or anonymous closure using the funp and lambdap predicates from the + library API (see below). + + pure_is_long checks whether the result actually fits into a 64 bit integer. + pure_is_bigint mallocs the returned limb vector (if limbs!=NULL); the + caller is responsible for freeing it. */ + +bool pure_is_symbol(const pure_expr *x, int32_t *sym); +bool pure_is_int(const pure_expr *x, int32_t *i); +bool pure_is_long(const pure_expr *x, int64_t *l); +bool pure_is_bigint(const pure_expr *x, int32_t *size, limb_t **limbs); +bool pure_is_mpz(const pure_expr *x, mpz_t *z); +bool pure_is_double(const pure_expr *x, double *d); +bool pure_is_pointer(const pure_expr *x, void **p); + +/* String results are copied with the _dup routines (it is then the caller's + responsibility to free them when appropriate). pure_is_cstring_dup also + converts the string to the system encoding. The string value returned by + pure_is_string points directly to the string data in the Pure expression + and must not be changed by the caller. */ + +bool pure_is_string(const pure_expr *x, const char **sym); +bool pure_is_string_dup(const pure_expr *x, char **sym); +bool pure_is_cstring_dup(const pure_expr *x, char **sym); + +/* Deconstruct literal applications. */ + +bool pure_is_app(const pure_expr *x, pure_expr **fun, pure_expr **arg); + +/* Convenience functions to deconstruct lists and tuples. Returned element + vectors are malloc'd and must be freed by the caller. Note that + pure_is_tuplev will always return true, since a singleton expression, which + is not either a pair or (), is considered a tuple of size 1. */ + +bool pure_is_listv(const pure_expr *x, size_t *size, pure_expr ***elems); +bool pure_is_tuplev(const pure_expr *x, size_t *size, pure_expr ***elems); + +/* Memory management. */ + +/* Count a new reference to an expression. This should be called whenever you + want to store an expression somewhere, in order to prevent it from being + garbage-collected. */ + +pure_expr *pure_new(pure_expr *x); + +/* Drop a reference to an expression. This will cause the expression to be + garbage-collected when it is no longer needed. */ + +void pure_free(pure_expr *x); + +/* Count a reference and then immediately drop it. This is useful to collect + temporaries which are not referenced yet. */ + +void pure_freenew(pure_expr *x); + +/* Increment and decrement the reference counter of an expression. This can be + used to temporarily protect an expression from being garbage-collected. It + doesn't actually change the status of the expression and does not collect + it. */ + +void pure_ref(pure_expr *x); +void pure_unref(pure_expr *x); + +/* END OF PUBLIC API. *******************************************************/ + +/* Stuff below this line is for internal use by the Pure interpreter. Don't + call these directly, unless you know what you are doing. */ + +/* Construct constant symbols and closures. */ + +pure_expr *pure_const(int32_t tag); +pure_expr *pure_clos(bool local, bool thunked, int32_t tag, uint32_t n, + void *f, void *e, uint32_t m, /* m x pure_expr* */ ...); + /* Compare a bigint or string expression against a constant value. This is used by the pattern matching code. */ -int32_t pure_cmp_bigint(pure_expr *x, int32_t size, limb_t *limbs); +int32_t pure_cmp_bigint(pure_expr *x, int32_t size, const limb_t *limbs); int32_t pure_cmp_string(pure_expr *x, const char *s); /* Get the string value of a string expression in the system encoding. Each @@ -127,33 +273,10 @@ /* Run a Pure function and catch exceptions. If everything goes normal, pure_invoke returns the return value of the executed function. Otherwise it returns 0 and sets e to the exception value, as given by pure_throw(). - XXXFIXME: This only supports parameterless functions right now. */ + FIXME: This only supports parameterless functions right now. */ pure_expr *pure_invoke(void *f, pure_expr** e); -/* Count a new reference to an expression. This should be called whenever you - want to store an expression somewhere, in order to prevent it from being - garbage-collected. */ - -pure_expr *pure_new(pure_expr *x); - -/* Drop a reference to an expression. This will cause the expression to be - garbage-collected when it is no longer needed. */ - -void pure_free(pure_expr *x); - -/* Count a reference and then immediately drop it. This is useful to collect - temporaries which are not referenced yet. */ - -void pure_freenew(pure_expr *x); - -/* Increment and decrement the reference counter. This can be used to - temporarily protect an expression from being garbage-collected. It doesn't - actually change the status of the expression and does not collect it. */ - -void pure_ref(pure_expr *x); -void pure_unref(pure_expr *x); - /* Manage arguments of a function call. pure_new_args counts references on a given collection of arguments in preparation for a function call, while pure_free_args collects the arguments of a function call. In both cases the @@ -199,8 +322,12 @@ void pure_debug(int32_t tag, const char *format, ...); -/* Supplementary routines. These are used in the standard library. */ +/* LIBRARY API. *************************************************************/ +/* Add any stuff that is needed in the standard library here. Applications and + external C modules may call these, but be warned that these APIs are + subject to change without further notice. */ + /* Conversions between numeric and pointer types. The input argument must be an expression denoting an int, double, bigint or pointer value. The numeric value of a pointer is its address, cast to a suitably large integer type, @@ -272,7 +399,8 @@ /* Convert a Pure expression to a string and vice versa. Note that eval() will actually parse and execute any Pure source, so it can be used, e.g., to add - new rules to the executing program at runtime. */ + new rules to the executing program at runtime. The result of eval() is the + last computed expression (NULL if none). */ pure_expr *str(const pure_expr *x); pure_expr *eval(const char *s); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-24 00:31:27
|
Revision: 292 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=292&view=rev Author: agraef Date: 2008-06-23 17:31:37 -0700 (Mon, 23 Jun 2008) Log Message: ----------- Overhaul of the str function. Modified Paths: -------------- pure/trunk/lib/strings.pure pure/trunk/runtime.cc pure/trunk/runtime.h pure/trunk/test/prelude.log Modified: pure/trunk/lib/strings.pure =================================================================== --- pure/trunk/lib/strings.pure 2008-06-23 23:38:50 UTC (rev 291) +++ pure/trunk/lib/strings.pure 2008-06-24 00:31:37 UTC (rev 292) @@ -22,12 +22,14 @@ the print representation of an expression in Pure syntax, as a string. The eval function does the opposite, by parsing and returning the value of an expression specified as a string in Pure syntax. (In fact, eval goes well - beyond this, as it can parse and execute arbitrary Pure code. But in that - case you will not always get a result expression.) */ + beyond this, as it can parse and execute arbitrary Pure code. In that case + it will return the last computed expression, if any.) */ -extern expr* str(expr*); +extern void* str(expr*) = pure_str; extern expr* eval(char*); // IMPURE! +str x = cstring (pure_str x); + /* Convert between Unicode character codes and single character strings. */ extern expr* string_chr(int); Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-06-23 23:38:50 UTC (rev 291) +++ pure/trunk/runtime.cc 2008-06-24 00:31:37 UTC (rev 292) @@ -1494,13 +1494,13 @@ } extern "C" -pure_expr *str(const pure_expr *x) +char *str(const pure_expr *x) { assert(x); ostringstream os; try { os << x; - return pure_string_dup(os.str().c_str()); + return strdup(os.str().c_str()); } catch (err &e) { return 0; } Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-06-23 23:38:50 UTC (rev 291) +++ pure/trunk/runtime.h 2008-06-24 00:31:37 UTC (rev 292) @@ -400,9 +400,10 @@ /* Convert a Pure expression to a string and vice versa. Note that eval() will actually parse and execute any Pure source, so it can be used, e.g., to add new rules to the executing program at runtime. The result of eval() is the - last computed expression (NULL if none). */ + last computed expression (NULL if none). The result of str() is a malloc'ed + string in the system encoding which must be freed by the caller. */ -pure_expr *str(const pure_expr *x); +char *str(const pure_expr *x); pure_expr *eval(const char *s); /* Compute a 32 bit hash code of a Pure expression. This makes it possible to Modified: pure/trunk/test/prelude.log =================================================================== --- pure/trunk/test/prelude.log 2008-06-23 23:38:50 UTC (rev 291) +++ pure/trunk/test/prelude.log 2008-06-24 00:31:37 UTC (rev 292) @@ -235,6 +235,7 @@ put_string x/*0:01*/ y/*0:1*/::string = pointer_put_string x/*0:01*/ y/*0:1*/; put_pointer x/*0:01*/ y/*0:1*/::string = pointer_put_pointer x/*0:01*/ y/*0:1*/; put_pointer x/*0:01*/ y/*0:1*/ = pointer_put_pointer x/*0:01*/ y/*0:1*/; +str x/*0:1*/ = cstring (pure_str x/*0:1*/); chr n/*0:1*/::int = string_chr n/*0:1*/ if n/*0:1*/>0; ord s/*0:1*/::string = string_ord s/*0:1*/ if #s/*0:1*/==1; string s/*0:1*/ = pure_string s/*0:1*/; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-24 08:56:22
|
Revision: 293 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=293&view=rev Author: agraef Date: 2008-06-24 01:56:30 -0700 (Tue, 24 Jun 2008) Log Message: ----------- Clean up the public API and implement most operations. Modified Paths: -------------- pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-06-24 00:31:37 UTC (rev 292) +++ pure/trunk/runtime.cc 2008-06-24 08:56:30 UTC (rev 293) @@ -300,62 +300,82 @@ /* PUBLIC API. **************************************************************/ -// XXXTODO +extern "C" +int32_t pure_sym(const char *s) +{ + assert(s); + interpreter& interp = *interpreter::g_interp; + const symbol& sym = interp.symtab.sym(s); + return sym.f; +} -int32_t pure_sym(const char *s); -int32_t pure_getsym(const char *s); -const char *pure_sym_pname(int32_t sym); -int8_t pure_sym_nprec(int32_t sym); +extern "C" +int32_t pure_getsym(const char *s) +{ + assert(s); + interpreter& interp = *interpreter::g_interp; + const symbol* sym = interp.symtab.lookup(s); + if (sym) + return sym->f; + else + return 0; +} -pure_expr *pure_symbol(int32_t sym); - extern "C" -pure_expr *pure_int(int32_t i) +const char *pure_sym_pname(int32_t tag) { - pure_expr *x = new_expr(); - x->tag = EXPR::INT; - x->data.i = i; - MEMDEBUG_NEW(x) - return x; + assert(tag>0); + interpreter& interp = *interpreter::g_interp; + const symbol& sym = interp.symtab.sym(tag); + return sym.s.c_str(); } extern "C" -pure_expr *pure_long(int64_t l) +int8_t pure_sym_nprec(int32_t tag) { - int sgn = (l>0)?1:(l<0)?-1:0; - uint64_t v = (uint64_t)(l>=0?l:-l); - if (sizeof(mp_limb_t) == 8) { - // 8 byte limbs, value fits in a single limb. - limb_t u[1] = { v }; - return pure_bigint(sgn, u); - } else { - // 4 byte limbs, put least significant word in the first limb. - limb_t u[2] = { (uint32_t)v, (uint32_t)(v>>32) }; - return pure_bigint(sgn+sgn, u); - } + assert(tag>0); + interpreter& interp = *interpreter::g_interp; + const symbol& sym = interp.symtab.sym(tag); + return nprec(sym.prec, sym.fix); } -static void make_bigint(mpz_t z, int32_t size, const limb_t *limbs) +extern "C" +pure_expr *pure_symbol(int32_t tag) { - // FIXME: For efficiency, we poke directly into the mpz struct here, this - // might need to be reviewed for future GMP revisions. - int sz = size>=0?size:-size, sgn = size>0?1:size<0?-1:0, sz0 = 0; - // normalize: the most significant limb should be nonzero - for (int i = 0; i < sz; i++) if (limbs[i] != 0) sz0 = i+1; - sz = sz0; size = sgn*sz; - mpz_init(z); - if (sz > 0) _mpz_realloc(z, sz); - assert(sz == 0 || z->_mp_d); - for (int i = 0; i < sz; i++) z->_mp_d[i] = limbs[i]; - z->_mp_size = size; + assert(tag>0); + interpreter& interp = *interpreter::g_interp; + const symbol& sym = interp.symtab.sym(tag); + // Check for an existing global variable for this symbol. + GlobalVar& v = interp.globalvars[tag]; + if (!v.v) { + // The variable doesn't exist yet (we have a new symbol), create it. + string lab; + // Create a name for the variable (cf. interpreter::mkvarlabel). + if (sym.prec < 10 || sym.fix == nullary) + lab = "$("+sym.s+")"; + else + lab = "$"+sym.s; + // Create a global variable bound to the symbol for now. + v.v = new llvm::GlobalVariable + (interp.ExprPtrTy, false, llvm::GlobalVariable::InternalLinkage, 0, + lab.c_str(), interp.module); + interp.JIT->addGlobalMapping(v.v, &v.x); + v.x = pure_new(pure_const(tag)); + // Since we just created this variable, it doesn't have any closure bound + // to it yet, so it's safe to just return the symbol as is. + return v.x; + } else + // The symbol already exists, so there might be a parameterless closure + // bound to it and thus we need to evaluate it. + return pure_call(v.x); } extern "C" -pure_expr *pure_bigint(int32_t size, const limb_t *limbs) +pure_expr *pure_int(int32_t i) { pure_expr *x = new_expr(); - x->tag = EXPR::BIGINT; - make_bigint(x->data.z, size, limbs); + x->tag = EXPR::INT; + x->data.i = i; MEMDEBUG_NEW(x) return x; } @@ -432,29 +452,112 @@ return x; } +extern "C" +pure_expr *pure_app(pure_expr *fun, pure_expr *arg) +{ + return pure_apply2(fun, arg); +} + // XXXTODO -pure_expr *pure_app(pure_expr *fun, pure_expr *arg); - pure_expr *pure_listl(size_t size, ...); pure_expr *pure_listv(size_t size, pure_expr **elems); pure_expr *pure_tuplel(size_t size, ...); pure_expr *pure_tuplev(size_t size, pure_expr **elems); -bool pure_is_symbol(const pure_expr *x, int32_t *sym); -bool pure_is_int(const pure_expr *x, int32_t *i); -bool pure_is_long(const pure_expr *x, int64_t *l); -bool pure_is_bigint(const pure_expr *x, int32_t *size, limb_t **limbs); -bool pure_is_mpz(const pure_expr *x, mpz_t *z); -bool pure_is_double(const pure_expr *x, double *d); -bool pure_is_pointer(const pure_expr *x, void **p); +bool pure_is_symbol(const pure_expr *x, int32_t *sym) +{ + assert(x); + if (x->tag >= 0) { + if (sym) *sym = x->tag; + return true; + } else + return false; +} -bool pure_is_string(const pure_expr *x, const char **sym); -bool pure_is_string_dup(const pure_expr *x, char **sym); -bool pure_is_cstring_dup(const pure_expr *x, char **sym); +bool pure_is_int(const pure_expr *x, int32_t *i) +{ + assert(x); + if (x->tag == EXPR::INT) { + if (i) *i = x->data.i; + return true; + } else + return false; +} -bool pure_is_app(const pure_expr *x, pure_expr **fun, pure_expr **arg); +bool pure_is_mpz(const pure_expr *x, mpz_t *z) +{ + assert(x); + if (x->tag == EXPR::BIGINT) { + if (z) mpz_init_set(*z, x->data.z); + return true; + } else + return false; +} +bool pure_is_double(const pure_expr *x, double *d) +{ + assert(x); + if (x->tag == EXPR::DBL) { + if (d) *d = x->data.d; + return true; + } else + return false; +} + +bool pure_is_pointer(const pure_expr *x, void **p) +{ + assert(x); + if (x->tag == EXPR::PTR) { + if (p) *p = x->data.p; + return true; + } else + return false; +} + +bool pure_is_string(const pure_expr *x, const char **s) +{ + assert(x); + if (x->tag == EXPR::STR) { + if (s) *s = x->data.s; + return true; + } else + return false; +} + +bool pure_is_string_dup(const pure_expr *x, char **s) +{ + assert(x); + if (x->tag == EXPR::STR) { + if (s) *s = strdup(x->data.s); + return true; + } else + return false; +} + +bool pure_is_cstring_dup(const pure_expr *x, char **s) +{ + assert(x); + if (x->tag == EXPR::STR) { + if (s) *s = fromutf8(x->data.s); + return true; + } else + return false; +} + +bool pure_is_app(const pure_expr *x, pure_expr **fun, pure_expr **arg) +{ + assert(x); + if (x->tag == EXPR::APP) { + if (fun) *fun = x->data.x[0]; + if (arg) *arg = x->data.x[1]; + return true; + } else + return false; +} + +// XXXTODO + bool pure_is_listv(const pure_expr *x, size_t *size, pure_expr ***elems); bool pure_is_tuplev(const pure_expr *x, size_t *size, pure_expr ***elems); @@ -537,6 +640,47 @@ } extern "C" +pure_expr *pure_long(int64_t l) +{ + int sgn = (l>0)?1:(l<0)?-1:0; + uint64_t v = (uint64_t)(l>=0?l:-l); + if (sizeof(mp_limb_t) == 8) { + // 8 byte limbs, value fits in a single limb. + limb_t u[1] = { v }; + return pure_bigint(sgn, u); + } else { + // 4 byte limbs, put least significant word in the first limb. + limb_t u[2] = { (uint32_t)v, (uint32_t)(v>>32) }; + return pure_bigint(sgn+sgn, u); + } +} + +static void make_bigint(mpz_t z, int32_t size, const limb_t *limbs) +{ + // FIXME: For efficiency, we poke directly into the mpz struct here, this + // might need to be reviewed for future GMP revisions. + int sz = size>=0?size:-size, sgn = size>0?1:size<0?-1:0, sz0 = 0; + // normalize: the most significant limb should be nonzero + for (int i = 0; i < sz; i++) if (limbs[i] != 0) sz0 = i+1; + sz = sz0; size = sgn*sz; + mpz_init(z); + if (sz > 0) _mpz_realloc(z, sz); + assert(sz == 0 || z->_mp_d); + for (int i = 0; i < sz; i++) z->_mp_d[i] = limbs[i]; + z->_mp_size = size; +} + +extern "C" +pure_expr *pure_bigint(int32_t size, const limb_t *limbs) +{ + pure_expr *x = new_expr(); + x->tag = EXPR::BIGINT; + make_bigint(x->data.z, size, limbs); + MEMDEBUG_NEW(x) + return x; +} + +extern "C" int32_t pure_cmp_bigint(pure_expr *x, int32_t size, const limb_t *limbs) { assert(x && x->tag == EXPR::BIGINT); Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-06-24 00:31:37 UTC (rev 292) +++ pure/trunk/runtime.h 2008-06-24 08:56:30 UTC (rev 293) @@ -83,33 +83,16 @@ const char *pure_sym_pname(int32_t sym); int8_t pure_sym_nprec(int32_t sym); -/* Expression constructors. Atomic objects are constructed with the following - routines: +/* Expression constructors. pure_symbol takes the integer code of a symbol and + returns that symbol as a Pure value. If the symbol is a global variable + bound to a value then that value is returned, if it's a parameterless + function then it is evaluated, giving the return value of the function as + the result. pure_int, pure_mpz, pure_double and pure_pointer construct a + Pure machine int, bigint, floating point value and pointer from a 32 bit + integer, (copy of a) GMP mpz_t, double and C pointer, respectively. */ - - pure_symbol: Takes the integer code of a symbol and returns that symbol - as a Pure value. If the symbol is a global variable or parameterless - function then it is evaluated, giving the value of the variable or the - return value of the function as the result. - - - pure_int: Constructs a Pure machine int from a 32 bit integer value. - - - pure_long: Constructs a Pure bigint from a 64 bit integer value. - - - pure_bigint: Constructs a Pure bigint from a vector of limbs. The size - argument may be negative to denote a negative number, its absolute value - is the number of elements in the limbs vector (the vector is owned by the - caller and won't be be freed). - - - pure_mpz: Constructs a Pure bigint from a (copy of a) GMP mpz_t. - - - pure_double: Constructs a Pure floating point number from a double value. - - - pure_pointer: Constructs a Pure pointer from a C pointer (void*). */ - pure_expr *pure_symbol(int32_t sym); pure_expr *pure_int(int32_t i); -pure_expr *pure_long(int64_t l); -pure_expr *pure_bigint(int32_t size, const limb_t *limbs); pure_expr *pure_mpz(const mpz_t z); pure_expr *pure_double(double d); pure_expr *pure_pointer(void *p); @@ -144,40 +127,40 @@ pure_expr *pure_tuplel(size_t size, ...); pure_expr *pure_tuplev(size_t size, pure_expr **elems); -/* Expression deconstructors for all the expression types above. These all +/* Expression deconstructors for all of the expression types above. These return a bool value indicating whether the given expression is of the - corresponding type and, if so, set the remaining parameter pointers to the + corresponding type and, if so, set the remaining pointers to the corresponding values. Parameter pointers may be NULL in which case they are - not set and only the result of the type check is returned. + not set. - NOTES: pure_is_symbol will return true not only for constant and unbound - variable symbols, but also for arbitrary closures including local and - anonymous functions. In the case of an anonymous closure, the returned - symbol will be 0. You can check whether an expression actually represents a - named or anonymous closure using the funp and lambdap predicates from the - library API (see below). + Notes: - pure_is_long checks whether the result actually fits into a 64 bit integer. - pure_is_bigint mallocs the returned limb vector (if limbs!=NULL); the - caller is responsible for freeing it. */ + - pure_is_mpz takes a pointer to an uninitialized mpz_t and initializes it + with a copy of the Pure bigint. + - pure_is_symbol will return true not only for (constant and unbound + variable) symbols, but also for arbitrary closures including local and + anonymous functions. In the case of an anonymous closure, the returned + symbol will be 0. You can check whether an expression actually represents + a named or anonymous closure using the funp and lambdap predicates from + the library API (see below). */ + bool pure_is_symbol(const pure_expr *x, int32_t *sym); bool pure_is_int(const pure_expr *x, int32_t *i); -bool pure_is_long(const pure_expr *x, int64_t *l); -bool pure_is_bigint(const pure_expr *x, int32_t *size, limb_t **limbs); bool pure_is_mpz(const pure_expr *x, mpz_t *z); bool pure_is_double(const pure_expr *x, double *d); bool pure_is_pointer(const pure_expr *x, void **p); -/* String results are copied with the _dup routines (it is then the caller's - responsibility to free them when appropriate). pure_is_cstring_dup also - converts the string to the system encoding. The string value returned by - pure_is_string points directly to the string data in the Pure expression - and must not be changed by the caller. */ +/* String deconstructors. Here the string results are copied if using the _dup + routines (it is then the caller's responsibility to free them when + appropriate). pure_is_cstring_dup also converts the string to the system + encoding. The string value returned by pure_is_string points directly to + the string data in the Pure expression and must not be changed by the + caller. */ -bool pure_is_string(const pure_expr *x, const char **sym); -bool pure_is_string_dup(const pure_expr *x, char **sym); -bool pure_is_cstring_dup(const pure_expr *x, char **sym); +bool pure_is_string(const pure_expr *x, const char **s); +bool pure_is_string_dup(const pure_expr *x, char **s); +bool pure_is_cstring_dup(const pure_expr *x, char **s); /* Deconstruct literal applications. */ @@ -228,6 +211,11 @@ pure_expr *pure_clos(bool local, bool thunked, int32_t tag, uint32_t n, void *f, void *e, uint32_t m, /* m x pure_expr* */ ...); +/* Additional bigint constructors. */ + +pure_expr *pure_long(int64_t l); +pure_expr *pure_bigint(int32_t size, const limb_t *limbs); + /* Compare a bigint or string expression against a constant value. This is used by the pattern matching code. */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |