LilyPond-Ruby 0.1.1 → 0.1.2

data/share/guile/2.2/srfi/srfi-2.scm

@@ -0,0 +1,31 @@
+;;; srfi-2.scm --- and-let*
+
+;; 	Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+
+;; This module is fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-2)
+  :use-module (ice-9 and-let-star)
+  :re-export-syntax (and-let*))
+
+(cond-expand-provide (current-module) '(srfi-2))
+
+;;; srfi-2.scm ends here

data/share/guile/2.2/srfi/srfi-26.scm

@@ -0,0 +1,66 @@
+;;; srfi-26.scm --- specializing parameters without currying.
+
+;; Copyright (C) 2002, 2006, 2010 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (srfi srfi-26)
+  :export (cut cute))
+
+(cond-expand-provide (current-module) '(srfi-26))
+
+(define-syntax cut
+  (lambda (stx)
+    (syntax-case stx ()
+      ((cut slot0 slot1+ ...)
+       (let loop ((slots	#'(slot0 slot1+ ...))
+                  (params	'())
+                  (args	'()))
+         (if (null? slots)
+             #`(lambda #,(reverse params) #,(reverse args))
+             (let ((s	  (car slots))
+                   (rest (cdr slots)))
+               (with-syntax (((var) (generate-temporaries '(var))))
+                 (syntax-case s (<> <...>)
+                   (<>
+                    (loop rest (cons #'var params) (cons #'var args)))
+                   (<...>
+                    (if (pair? rest)
+                        (error "<...> not on the end of cut expression"))
+                    #`(lambda #,(append (reverse params) #'var)
+                        (apply #,@(reverse (cons #'var args)))))
+                   (else
+                    (loop rest params (cons s args))))))))))))
+
+(define-syntax cute
+  (lambda (stx)
+    (syntax-case stx ()
+      ((cute slots ...)
+       (let loop ((slots #'(slots ...))
+                  (bindings '())
+                  (arguments '()))
+         (define (process-hole)
+           (loop (cdr slots) bindings (cons (car slots) arguments)))
+         (if (null? slots)
+             #`(let #,bindings
+                 (cut #,@(reverse arguments)))
+             (syntax-case (car slots) (<> <...>)
+               (<> (process-hole))
+               (<...> (process-hole))
+               (expr
+                (with-syntax (((t) (generate-temporaries '(t))))
+                  (loop (cdr slots)
+                        (cons #'(t expr) bindings)
+                        (cons #'t arguments)))))))))))

data/share/guile/2.2/srfi/srfi-27.scm

@@ -0,0 +1,96 @@
+;;; srfi-27.scm --- Sources of Random Bits
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library. If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This module is fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-27)
+  #:export (random-integer
+            random-real
+            default-random-source
+            make-random-source
+            random-source?
+            random-source-state-ref
+            random-source-state-set!
+            random-source-randomize!
+            random-source-pseudo-randomize!
+            random-source-make-integers
+            random-source-make-reals)
+  #:use-module (srfi srfi-9))
+
+(cond-expand-provide (current-module) '(srfi-27))
+
+(define-record-type :random-source
+  (%make-random-source state)
+  random-source?
+  (state random-source-state set-random-source-state!))
+
+(define (make-random-source)
+  (%make-random-source (seed->random-state 0)))
+
+(define (random-source-state-ref s)
+  (random-state->datum (random-source-state s)))
+
+(define (random-source-state-set! s state)
+  (set-random-source-state! s (datum->random-state state)))
+
+(define (random-source-randomize! s)
+  (let ((time (gettimeofday)))
+    (set-random-source-state! s (seed->random-state
+                                 (+ (* (car time) 1e6) (cdr time))))))
+
+(define (random-source-pseudo-randomize! s i j)
+  (set-random-source-state! s (seed->random-state (i+j->seed i j))))
+
+(define (i+j->seed i j)
+  (logior (ash (spread i 2) 1)
+          (spread j 2)))
+
+(define (spread n amount)
+  (let loop ((result 0) (n n) (shift 0))
+    (if (zero? n)
+        result
+        (loop (logior result
+                      (ash (logand n 1) shift))
+              (ash n -1)
+              (+ shift amount)))))
+
+(define (random-source-make-integers s)
+  (lambda (n)
+    (random n (random-source-state s))))
+
+(define random-source-make-reals
+  (case-lambda
+    ((s)
+     (lambda ()
+       (let loop ()
+         (let ((x (random:uniform (random-source-state s))))
+           (if (zero? x)
+               (loop)
+               x)))))
+    ((s unit)
+     (or (and (real? unit) (< 0 unit 1))
+         (error "unit must be real between 0 and 1" unit))
+     (random-source-make-reals s))))
+
+(define default-random-source (make-random-source))
+(define random-integer (random-source-make-integers default-random-source))
+(define random-real (random-source-make-reals default-random-source))

data/share/guile/2.2/srfi/srfi-28.scm

@@ -0,0 +1,34 @@
+;;; srfi-28.scm --- Basic Format Strings
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+
+;; This module provides a wrapper for simple-format that always outputs
+;; to a string.
+;;
+;; This module is documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-28)
+  #:replace (format))
+
+(define (format message . args)
+  (apply simple-format #f message args))
+
+(cond-expand-provide (current-module) '(srfi-28))

data/share/guile/2.2/srfi/srfi-31.scm

@@ -0,0 +1,35 @@
+;;; srfi-31.scm --- special form for recursive evaluation
+
+;; 	Copyright (C) 2004, 2006, 2012 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Original author: Rob Browning <rlb@defaultvalue.org>
+
+(define-module (srfi srfi-31)
+  #:export (rec))
+
+(cond-expand-provide (current-module) '(srfi-31))
+
+(define-syntax rec
+  (syntax-rules ()
+    "Return the given object, defined in a lexical environment where
+NAME is bound to itself."
+    ((_ (name . formals) body ...)                ; procedure
+     (letrec ((name (lambda formals body ...)))
+       name))
+    ((_ name expr)                                ; arbitrary object
+     (letrec ((name expr))
+       name))))

data/share/guile/2.2/srfi/srfi-34.scm

@@ -0,0 +1,84 @@
+;;; srfi-34.scm --- Exception handling for programs
+
+;; Copyright (C) 2003, 2006, 2008, 2010 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Neil Jerram <neil@ossau.uklinux.net>
+
+;;; Commentary:
+
+;; This is an implementation of SRFI-34: Exception Handling for
+;; Programs.  For documentation please see the SRFI-34 document; this
+;; module is not yet documented at all in the Guile manual.
+
+;;; Code:
+
+(define-module (srfi srfi-34)
+  #:export (with-exception-handler)
+  #:replace (raise)
+  #:export-syntax (guard))
+
+(cond-expand-provide (current-module) '(srfi-34))
+
+(define throw-key 'srfi-34)
+
+(define (with-exception-handler handler thunk)
+  "Returns the result(s) of invoking THUNK. HANDLER must be a
+procedure that accepts one argument.  It is installed as the current
+exception handler for the dynamic extent (as determined by
+dynamic-wind) of the invocation of THUNK."
+  (with-throw-handler throw-key
+    thunk
+    (lambda (key obj)
+      (handler obj))))
+
+(define (raise obj)
+  "Invokes the current exception handler on OBJ.  The handler is
+called in the dynamic environment of the call to raise, except that
+the current exception handler is that in place for the call to
+with-exception-handler that installed the handler being called.  The
+handler's continuation is otherwise unspecified."
+  (throw throw-key obj))
+
+(define-syntax guard
+  (syntax-rules (else)
+    "Syntax: (guard (<var> <clause1> <clause2> ...) <body>)
+Each <clause> should have the same form as a `cond' clause.
+
+Semantics: Evaluating a guard form evaluates <body> with an exception
+handler that binds the raised object to <var> and within the scope of
+that binding evaluates the clauses as if they were the clauses of a
+cond expression.  That implicit cond expression is evaluated with the
+continuation and dynamic environment of the guard expression.  If
+every <clause>'s <test> evaluates to false and there is no else
+clause, then raise is re-invoked on the raised object within the
+dynamic environment of the original call to raise except that the
+current exception handler is that of the guard expression."
+    ((guard (var clause ... (else e e* ...)) body body* ...)
+     (catch throw-key
+       (lambda () body body* ...)
+       (lambda (key var)
+         (cond clause ...
+               (else e e* ...)))))
+    ((guard (var clause clause* ...) body body* ...)
+     (catch throw-key
+       (lambda () body body* ...)
+       (lambda (key var)
+         (cond clause clause* ...
+               (else (throw key var))))))))
+
+
+;;; (srfi srfi-34) ends here.

data/share/guile/2.2/srfi/srfi-35.scm

@@ -0,0 +1,351 @@
+;;; srfi-35.scm --- Conditions                 -*- coding: utf-8 -*-
+
+;; Copyright (C) 2007-2011, 2017 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+
+;;; Commentary:
+
+;; This is an implementation of SRFI-35, "Conditions".  Conditions are a
+;; means to convey information about exceptional conditions between parts of
+;; a program.
+
+;;; Code:
+
+(define-module (srfi srfi-35)
+  #:use-module (srfi srfi-1)
+  #:export (make-condition-type condition-type?
+            make-condition condition? condition-has-type? condition-ref
+            make-compound-condition extract-condition
+            define-condition-type condition
+            &condition
+            &message message-condition? condition-message
+            &serious serious-condition?
+            &error error?))
+
+(cond-expand-provide (current-module) '(srfi-35))
+
+
+;;;
+;;; Condition types.
+;;;
+
+(define %condition-type-vtable
+  ;; The vtable of all condition types.
+  ;;   vtable fields: vtable, self, printer
+  ;;   user fields:   id, parent, all-field-names
+  (let ((s (make-vtable (string-append standard-vtable-fields "prprpr")
+                        (lambda (ct port)
+                          (format port "#<condition-type ~a ~a>"
+                                  (condition-type-id ct)
+                                  (number->string (object-address ct)
+                                                  16))))))
+    (set-struct-vtable-name! s 'condition-type)
+    s))
+
+(define (%make-condition-type layout id parent all-fields)
+  (let ((struct (make-struct/no-tail %condition-type-vtable
+                                     (make-struct-layout layout) ;; layout
+                                     print-condition             ;; printer
+                                     id parent all-fields)))
+
+    ;; Hack to associate STRUCT with a name, providing a better name for
+    ;; GOOPS classes as returned by `class-of' et al.
+    (set-struct-vtable-name! struct (cond ((symbol? id) id)
+                                          ((string? id) (string->symbol id))
+                                          (else         (string->symbol ""))))
+    struct))
+
+(define (condition-type? obj)
+  "Return true if OBJ is a condition type."
+  (and (struct? obj)
+       (eq? (struct-vtable obj)
+	    %condition-type-vtable)))
+
+(define (condition-type-id ct)
+  (and (condition-type? ct)
+       (struct-ref ct (+ vtable-offset-user 0))))
+
+(define (condition-type-parent ct)
+  (and (condition-type? ct)
+       (struct-ref ct (+ vtable-offset-user 1))))
+
+(define (condition-type-all-fields ct)
+  (and (condition-type? ct)
+       (struct-ref ct (+ vtable-offset-user 2))))
+
+
+(define (struct-layout-for-condition field-names)
+  ;; Return a string denoting the layout required to hold the fields listed
+  ;; in FIELD-NAMES.
+  (let loop ((field-names field-names)
+	     (layout      '("pr")))
+    (if (null? field-names)
+	(string-concatenate/shared layout)
+	(loop (cdr field-names)
+	      (cons "pr" layout)))))
+
+(define (print-condition c port)
+  ;; Print condition C to PORT in a way similar to how records print:
+  ;; #<condition TYPE [FIELD: VALUE ...] ADDRESS>.
+  (define (field-values)
+    (let* ((type    (struct-vtable c))
+           (strings (fold (lambda (field result)
+                            (cons (format #f "~A: ~S" field
+                                          (condition-ref c field))
+                                  result))
+                          '()
+                          (condition-type-all-fields type))))
+      (string-join (reverse strings) " ")))
+
+  (format port "#<condition ~a [~a] ~a>"
+          (condition-type-id (condition-type c))
+          (field-values)
+          (number->string (object-address c) 16)))
+
+(define (make-condition-type id parent field-names)
+  "Return a new condition type named ID, inheriting from PARENT, and with the
+fields whose names are listed in FIELD-NAMES.  FIELD-NAMES must be a list of
+symbols and must not contain names already used by PARENT or one of its
+supertypes."
+  (if (symbol? id)
+      (if (condition-type? parent)
+	  (let ((parent-fields (condition-type-all-fields parent)))
+	    (if (and (every symbol? field-names)
+		     (null? (lset-intersection eq?
+					       field-names parent-fields)))
+		(let* ((all-fields (append parent-fields field-names))
+		       (layout     (struct-layout-for-condition all-fields)))
+		  (%make-condition-type layout
+                                        id parent all-fields))
+		(error "invalid condition type field names"
+		       field-names)))
+	  (error "parent is not a condition type" parent))
+      (error "condition type identifier is not a symbol" id)))
+
+(define (make-compound-condition-type id parents)
+  ;; Return a compound condition type made of the types listed in PARENTS.
+  ;; All fields from PARENTS are kept, even same-named ones, since they are
+  ;; needed by `extract-condition'.
+  (cond ((null? parents)
+         (error "`make-compound-condition-type' passed empty parent list"
+                id))
+        ((null? (cdr parents))
+         (car parents))
+        (else
+         (let* ((all-fields (append-map condition-type-all-fields
+                                        parents))
+                (layout     (struct-layout-for-condition all-fields)))
+           (%make-condition-type layout
+                                 id
+                                 parents         ;; list of parents!
+                                 all-fields)))))
+
+
+;;;
+;;; Conditions.
+;;;
+
+(define (condition? c)
+  "Return true if C is a condition."
+  (and (struct? c)
+       (condition-type? (struct-vtable c))))
+
+(define (condition-type c)
+  (and (struct? c)
+       (let ((vtable (struct-vtable c)))
+	 (if (condition-type? vtable)
+	     vtable
+	     #f))))
+
+(define (condition-has-type? c type)
+  "Return true if condition C has type TYPE."
+  (if (and (condition? c) (condition-type? type))
+      (let loop ((ct (condition-type c)))
+        (or (eq? ct type)
+            (and ct
+                 (let ((parent (condition-type-parent ct)))
+                   (if (list? parent)
+                       (any loop parent) ;; compound condition
+                       (loop (condition-type-parent ct)))))))
+      (throw 'wrong-type-arg "condition-has-type?"
+             "Wrong type argument")))
+
+(define (condition-ref c field-name)
+  "Return the value of the field named FIELD-NAME from condition C."
+  (if (condition? c)
+      (if (symbol? field-name)
+	  (let* ((type   (condition-type c))
+		 (fields (condition-type-all-fields type))
+		 (index  (list-index (lambda (name)
+				       (eq? name field-name))
+				     fields)))
+	    (if index
+		(struct-ref c index)
+		(error "invalid field name" field-name)))
+	  (error "field name is not a symbol" field-name))
+      (throw 'wrong-type-arg "condition-ref"
+             "Wrong type argument: ~S" c)))
+
+(define (make-condition-from-values type values)
+  (apply make-struct/no-tail type values))
+
+(define (make-condition type . field+value)
+  "Return a new condition of type TYPE with fields initialized as specified
+by FIELD+VALUE, a sequence of field names (symbols) and values."
+  (if (condition-type? type)
+      (let* ((all-fields (condition-type-all-fields type))
+	     (inits      (fold-right (lambda (field inits)
+				       (let ((v (memq field field+value)))
+					 (if (pair? v)
+					     (cons (cadr v) inits)
+					     (error "field not specified"
+						    field))))
+				     '()
+				     all-fields)))
+	(make-condition-from-values type inits))
+      (throw 'wrong-type-arg "make-condition"
+             "Wrong type argument: ~S" type)))
+
+(define (make-compound-condition . conditions)
+  "Return a new compound condition composed of CONDITIONS."
+  (let* ((types  (map condition-type conditions))
+	 (ct     (make-compound-condition-type 'compound types))
+	 (inits  (append-map (lambda (c)
+			       (let ((ct (condition-type c)))
+				 (map (lambda (f)
+					(condition-ref c f))
+				      (condition-type-all-fields ct))))
+			     conditions)))
+    (make-condition-from-values ct inits)))
+
+(define (extract-condition c type)
+  "Return a condition of condition type TYPE with the field values specified
+by C."
+
+  (define (first-field-index parents)
+    ;; Return the index of the first field of TYPE within C.
+    (let loop ((parents parents)
+	       (index   0))
+      (let ((parent (car parents)))
+	(cond ((null? parents)
+	       #f)
+	      ((eq? parent type)
+	       index)
+	      ((pair? parent)
+	       (or (loop parent index)
+		   (loop (cdr parents)
+			 (+ index
+			    (apply + (map condition-type-all-fields
+					  parent))))))
+	      (else
+	       (let ((shift (length (condition-type-all-fields parent))))
+		 (loop (cdr parents)
+		       (+ index shift))))))))
+
+  (define (list-fields start-index field-names)
+    ;; Return a list of the form `(FIELD-NAME VALUE...)'.
+    (let loop ((index       start-index)
+	       (field-names field-names)
+	       (result      '()))
+      (if (null? field-names)
+	  (reverse! result)
+	  (loop (+ 1 index)
+		(cdr field-names)
+		(cons* (struct-ref c index)
+		       (car field-names)
+		       result)))))
+
+  (if (and (condition? c) (condition-type? type))
+      (let* ((ct     (condition-type c))
+             (parent (condition-type-parent ct)))
+        (cond ((eq? type ct)
+               c)
+              ((pair? parent)
+               ;; C is a compound condition.
+               (let ((field-index (first-field-index parent)))
+                 ;;(format #t "field-index: ~a ~a~%" field-index
+                 ;;        (list-fields field-index
+                 ;;                     (condition-type-all-fields type)))
+                 (apply make-condition type
+                        (list-fields field-index
+                                     (condition-type-all-fields type)))))
+              (else
+               ;; C does not have type TYPE.
+               #f)))
+      (throw 'wrong-type-arg "extract-condition"
+             "Wrong type argument")))
+
+
+;;;
+;;; Syntax.
+;;;
+
+(define-syntax-rule (define-condition-type name parent pred (field-name field-accessor) ...)
+  (begin
+    (define name
+      (make-condition-type 'name parent '(field-name ...)))
+    (define (pred c)
+      (condition-has-type? c name))
+    (define (field-accessor c)
+      (condition-ref c 'field-name))
+    ...))
+
+(define-syntax-rule (compound-condition (type ...) (field ...))
+  ;; Create a compound condition using `make-compound-condition-type'.
+  (condition ((make-compound-condition-type '%compound `(,type ...))
+              field ...)))
+
+(define-syntax condition-instantiation
+  ;; Build the `(make-condition type ...)' call.
+  (syntax-rules ()
+    ((_ type (out ...))
+     (make-condition type out ...))
+    ((_ type (out ...) (field-name field-value) rest ...)
+     (condition-instantiation type (out ... 'field-name field-value) rest ...))))
+
+(define-syntax condition
+  (syntax-rules ()
+    ((_ (type field ...))
+     (condition-instantiation type () field ...))
+    ((_ (type field ...) ...)
+     (compound-condition (type ...) (field ... ...)))))
+
+
+;;;
+;;; Standard condition types.
+;;;
+
+(define &condition
+  ;; The root condition type.
+  (make-struct/no-tail %condition-type-vtable
+                       (make-struct-layout "")
+                       (lambda (c port)
+                         (display "<&condition>"))
+                       '&condition #f '() '()))
+
+(define-condition-type &message &condition
+  message-condition?
+  (message condition-message))
+
+(define-condition-type &serious &condition
+  serious-condition?)
+
+(define-condition-type &error &serious
+  error?)
+
+;;; srfi-35.scm ends here