diff options
author | LaMont Jones <lamont@debian.org> | 2003-05-07 08:36:40 -0600 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 |
commit | e21d47d7813159bb71e0671df9b52ec0470c358d (patch) | |
tree | 3c7770ea846123c291f599044e9f234ac17616bb /syntest2.scm | |
parent | 8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (diff) | |
parent | deda2c0fd8689349fea2a900199a76ff7ecb319e (diff) | |
download | scm-e21d47d7813159bb71e0671df9b52ec0470c358d.tar.gz scm-e21d47d7813159bb71e0671df9b52ec0470c358d.zip |
Import Debian changes 5d6-3.2debian/5d6-3.2
scm (5d6-3.2) unstable; urgency=low
* Fix hppa compile. Closes: #144062
scm (5d6-3.1) unstable; urgency=low
* NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171
scm (5d6-3) unstable; urgency=low
* Add build depend on xlibs-dev (Closes: #148020)
scm (5d6-2) unstable; urgency=low
* Remove libregexx-dev from build-depends.
* Change build to use ./scmlit rather than scmlit (should fix some build
problems) (looks like alpha is mostly building)
* New release (Closes: #140175)
* Built with turtlegraphics last time (Closes: #58515)
scm (5d6-1) unstable; urgency=low
* New upstream.
* Add xlib and turtlegr to requested list of features. (closes
some bug)
* Make clean actually clean most everything up.
* Remove hacks renaming build to something else and just set build as a
.PHONY target in debian/rules.
* Add the turtlegr code.
scm (5d5-1) unstable; urgency=low
* New upstream
* Has fixes for 64 bit archs. May fix alpha compile problem. Does fix
(Closes: #140175)
* Take out -O2 arg.
scm (5d4-3) unstable; urgency=low
* Don't link with regexx, but just use libc6's regular expression
functions.
* Define (terms) to output /usr/share/common-licenses/GPL (Closes:
#119321)
scm (5d4-2) unstable; urgency=low
* Add texinfo to build depends (Closes: #107011)
scm (5d4-1) unstable; urgency=low
* New upstream release.
* Move install-info --remove to prerm.
scm (5d3-5) unstable; urgency=low
* Move scm info files to section "The Algorithmic Language Scheme" to
match up with guile.
scm (5d3-4) unstable; urgency=low
* Fix build depends (Closes: #76691)
scm (5d3-3) unstable; urgency=low
* Fix path in scm dhelp file.
scm (5d3-2) unstable; urgency=low
* Actually put the header files in the package. Oops.
scm (5d3-1) unstable; urgency=low
* New upstream. (Closes: #74761)
* Make (terms) use new license location.
* Make use libregexx rather than librx.
* Fix build depends for above.
* Using new regex lib seems to fix crash (Closes: #66787)
* Consider adding scm-dev package with headers, but instead just add the
headers to the scm package. (Closes: #70787)
* Add doc-base support.
Diffstat (limited to 'syntest2.scm')
-rw-r--r-- | syntest2.scm | 186 |
1 files changed, 186 insertions, 0 deletions
diff --git a/syntest2.scm b/syntest2.scm new file mode 100644 index 0000000..68633cf --- /dev/null +++ b/syntest2.scm @@ -0,0 +1,186 @@ +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this software; see the file COPYING. If not, write to +;; the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. +;; +;; As a special exception, the Free Software Foundation gives permission +;; for additional uses of the text contained in its release of GUILE. +;; +;; The exception is that, if you link the GUILE library with other files +;; to produce an executable, this does not by itself cause the +;; resulting executable to be covered by the GNU General Public License. +;; Your use of that executable is in no way restricted on account of +;; linking the GUILE library code into it. +;; +;; This exception does not however invalidate any other reasons why +;; the executable file might be covered by the GNU General Public License. +;; +;; This exception applies only to the code released by the +;; Free Software Foundation under the name GUILE. If you copy +;; code from other Free Software Foundation releases into a copy of +;; GUILE, as the General Public License permits, the exception does +;; not apply to the code that you add in this way. To avoid misleading +;; anyone as to the status of such modified files, you must delete +;; this exception notice from them. +;; +;; If you write modifications of your own for GUILE, it is your choice +;; whether to permit this exception to apply to your modifications. +;; If you do not wish that, delete this exception notice. + +(require 'macro) + +;; Redefine some derived special forms. + +(define-syntax let + (syntax-rules () + ((let ((?name ?val) ...) . ?body) + ((lambda (?name ...) . ?body) ?val ...)) + ((let ?proc ((?name ?val) ...) . ?body) + (let ((?proc #f) + (?name ?val) ...) + (set! ?proc (lambda (?name ...) . ?body)) + (?proc ?name ...))))) + +(define-syntax let* + (syntax-rules () + ((let* () . ?body) + ((lambda () . ?body))) + ((let* ((?name ?val)) . ?body) + ((lambda (?name) . ?body) ?val)) + ((let* ((?name ?val) ?binding ...) . ?body) + (let* ((?name ?val)) + (let* (?binding ...) . ?body))))) + +(define-syntax letrec + (syntax-rules () + ((letrec ((?name ?val) ...) . ?body) + (let ((?name #f) ...) + (set! ?name ?val) ... + (let () . ?body))))) + +(define-syntax and + (syntax-rules () + ((and) #t) + ((and ?exp) + (let ((x ?exp)) + (if x x #f))) + ((and ?exp . ?rest) + (let ((x ?exp)) + (if x (and . ?rest) #f))))) + +(define-syntax or + (syntax-rules () + ((or) #f) + ((or ?exp) + (let ((x ?exp)) + (if x x #f))) + ((or ?exp . ?rest) + (let ((x ?exp)) + (if x x (or . ?rest)))))) + +(define (force promise) + (promise)) + +(define (make-promise proc) + (let ((result #f)) + (lambda () + (if result (car result) + (let ((x (proc))) + (if result (car result) + (begin (set! result (list x)) + x))))))) + +(define-syntax delay + (syntax-rules () + ((delay ?expr) + (make-promise (lambda () ?expr))))) + +(define-syntax do + (syntax-rules () + ((do ((?name ?init . ?step) ...) + (?test . ?result) + ?body ...) + (let-syntax ((do-step (syntax-rules () + ((do-step ?n) ?n) + ((do-step ?n ?s) ?s))) + (do-result (syntax-rules () + ((do-result) (if #f #f)) + ((do-result . ?r) (begin . ?r))))) + (let loop ((?name ?init) ...) + (if ?test + (do-result . ?result) + (begin ?body ... + (loop (do-step ?name . ?step) ...)))))))) + +(define-syntax case + (syntax-rules (else) + ((case ?x (else . ?conseq)) + (begin . ?conseq)) + ((case ?x (?lst . ?conseq)) + (if (memv ?x '?lst) (begin . ?conseq))) + ((case ?x (?lst . ?conseq) . ?rest) + (if (memv ?x '?lst) + (begin . ?conseq) + (case ?x . ?rest))))) + +(define-syntax cond + (syntax-rules (else =>) + ((cond ?clause0 . ?clauses) + (letrec-syntax + ((cond-aux + (syntax-rules (else =>) + ((cond-aux) (if #f #f)) + ((cond-aux (else . ?conseq)) + (begin . ?conseq)) + ((cond-aux (?test => ?proc) . ?rest) + (let ((val ?test)) + (if val (?proc val) (cond-aux . ?rest)))) + ((cond-aux (?test) . ?rest) + (or ?test (cond-aux . ?rest))) + ((cond-aux (?test . ?conseq) . ?rest) + (if ?test (begin . ?conseq) (cond-aux . ?rest)))))) + (cond-aux ?clause0 . ?clauses))))) + +;; This may fail if you redefine CONS, LIST, APPEND, or LIST->VECTOR +;; It uses the (... ...) escape. +;; All forms are evaluated inside a LETREC-SYNTAX body (is this a problem?). + +(define-syntax quasiquote + (syntax-rules () + ((_ ?template) + (letrec-syntax + ((qq + (syntax-rules (unquote unquote-splicing quasiquote) + ((_ (unquote ?form) ()) + ?form) + ((_ (unquote ?form) (?depth)) + (list 'unquote (qq ?form ?depth))) + ((_ (quasiquote ?form) ?depth) + (list 'quasiquote (qq ?form (?depth)))) + ((_ ((unquote-splicing ?form) . ?rest) ()) + (append ?form (qq ?rest ()))) + ((_ ((unquote-splicing ?form) . ?rest) (?depth)) + (append (list 'unquote-splicing (qq ?form ?depth)) + (qq ?rest (?depth)))) + ((_ (?car . ?cdr) ?depth) + (cons (qq ?car ?depth) (qq ?cdr ?depth))) + ((_ #(?elt (... ...)) ?depth) + (list->vector (qq (?elt (... ...)) ?depth))) + ((_ ?atom ?depth) + '?atom)))) + (qq ?template ()))))) + +;;(load "r4rstest.scm") + + |