~ chicken-core (chicken-5) 89a110080526e0160f3240281d3bd98eb0aff0ba
commit 89a110080526e0160f3240281d3bd98eb0aff0ba
Author: unknown <felix@.(none)>
AuthorDate: Tue Oct 20 12:18:53 2009 +0200
Commit: unknown <felix@.(none)>
CommitDate: Tue Oct 20 12:18:53 2009 +0200
removed some obsolete scripts and files
diff --git a/misc/Chicken Runtime Data Type Proposal b/misc/Chicken Runtime Data Type Proposal
deleted file mode 100644
index 63dcc68f..00000000
--- a/misc/Chicken Runtime Data Type Proposal
+++ /dev/null
@@ -1,445 +0,0 @@
-* Chicken Runtime Data Type Proposal *
-
-Based on SRFI-99. I really like the SRFI-9 compatibility combined with the R6RS
-features.
-
-
-- Procedural Layer -
-
-- Suggested canonical name form of a condition identifier is '&<condition
-name>' where <condition name> is descriptive.
-
-- Suggested canonical name form of an rtd identifier is ':<rtd name>'. I know
-this conflicts with keyword-style; ':optional' redux.
-
-- Procedural Layer per SRFI-99 with some extensions.
-
-- Procedure rtd-constructor
-
-(rtd-constructor RTD [FIELDSPECS [INIT ...]]) => CTOR
-
-{{FIELDSPECS}} per SRFI-99.
-
-{{INIT}} is an '<initial value>'
-
-{{CTOR}} per SRFI-99, except when {{INIT}} specified, in which case the initial
-value of the constructed rtd-object is supplied. Otherwise the field must named
-in {{FIELDSPECS}}.
-
-<initial value> -> initializer <field> <procedure/(-> object)>
- -> initial <field> <object>
-
-- Procedure rtd-mutator
-
-(rtd-mutator RTD FIELD [CHECKER]) => MUTATOR
-
-{{CHECKER}} is a 'procedure' with signature '(object -> boolean)'.
-
-{{MUTATOR}} per SRFI-99, except when a {{CHECKER}} specified. In which case the
-mutating object is validated with the {{CHECKER}} before mutation and an
-'&invalid-field-value' condition is raised if necessary.
-
-- Procedure rtd-operator
-
-(rtd-operator RTD OPERATION ...)
-
-{{OPERATION}} is an '<operation>'.
-
-<operation> -> printer <procedure/(rtd-object output-port)>
- -> displayer <procedure/(rtd-object output-port)>
- -> writer <procedure/(rtd-object output-port)>
- -> comparator <procedure/(rtd-object rtd-object -> (union -1 0 1))>
- -> hasher <procedure/(rtd-object (optional fixnum) -> fixnum)>
-
-- Procedure rtd-operation
-
-(rtd-operation RTD OPER) => PROCEDURE
-
-{{OPER}} is an '<operation>'.
-
-<operation> -> printer
- -> displayer
- -> writer
- -> comparator
- -> hasher
-
-Default rtd operators can be generated when a user-supplied procedure is
-unspecified.
-
-- Can have routines like '(rtd-comparator RTD) => PROCEDURE'.
-
-- make-rtd-parameter
-
-(make-rtd-parameter RTD SETTER VALUE [GUARD]) => PARAMETER-PROCEDURE
-
-{{SETTER}} is a 'procedure/(rtd-object object)'.
-
-Returns a {{PARAMETER-PROCEDURE}} closed over the {{RTD}}.
-
-'(make-parameter VALUE (lambda (x) (SETTER RTD (GUARD x))))'
-
-- Procedure rtd-print-syntax
-
-(rtd-print-syntax RTD [SYNTAX])
-(rtd-print-syntax RTD) => '<print-syntax>'
-
-{{SYNTAX}} is a '<print-syntax>'.
-
-<print-syntax> -> srfi-10
- -> character
- -> sharp
- -> parameterized
- -> none
-
-'<print-syntax>' should probably be a keyword.
-
-See - Discussion - below.
-
-- Parameter current-print-syntax
-
-(current-print-syntax [SYNTAX])
-(current-print-syntax) => '<print-syntax>'
-
-{{SYNTAX}} is a '<print-syntax>'.
-
-Very unsure about this one.
-
-- While SRFI-99 uses symbols to represent keyed arguments Chicken can use
-keywords. The flag symbols of SRFI-99 would need to be represented as boolean
-keyword arguments. Ex: 'opaque?' -> opaque?: #f/#t.
-
-Both styles can be supported. However, an existing example of a keyword only
-interpretation of a SRFI is "srfi-69.scm".
-
-The symbol style is Scheme-y while the keyword style is CommonLisp-y. But I
-like DSSSL lambda-lists so my preference is the keyword style, if only one must
-be chosen.
-
-Really think both should be supported when features are advertised as a SRFI
-implementation. (Unit srfi-69 needs work.)
-
-
-- Syntactic Layer -
-
-- Macro define-record-type
-
-(define-record-type TYPESPEC CTORSPEC PREDSPEC FLDSPEC ...)
-
-{{TYPESPEC}} is a '<type spec>'.
-
-{{CTORSPEC}} is a '<constructor spec>'.
-
-{{PREDSPEC}} is a '<predicate spec>'.
-
-{{FLDSPEC}} is a '<field spec>'.
-
-<type spec> -> <type name>
- -> (<type name> <parent>)
- -> (<type name> <parent> <option> ...)
-
-<constructor spec> -> #f {no constructor procedure}
- -> #t {default constructor procedure}
- -> <constructor name>
- -> (<constructor name> <field name> ...)
- -> (<constructor name> (<field name> <initial value>) ...)
-
-<predicate spec> -> #f {no predicate procedure}
- -> #t {default predicate procedure}
- -> <predicate name>
-
-<field spec> -> <field name>
- -> (<field name>)
- -> (<field name> <accessor spec>)
- -> (<field name> <accessor spec> <mutator spec>)
- -> (<field name> <accessor spec> <mutator spec> <check spec>)
- -> (<field name> <accessor spec> <mutator spec> <check spec>)
-
-<accessor spec> -> #f {no accessor procedure}
- -> #t {default accessor procedure}
- -> <accessor name>
-
-<mutator spec> -> #f {no mutator procedure}
- -> #t {default mutator procedure}
- -> <mutator name>
-
-<check spec> -> #f {no check procedure}
- -> #t {default check procedure}
- -> <expression> {=> procedure/(object -> boolean)}
-
-<parent> -> #f {no parent}
- -> #t {default parent}
- -> <expression> {=> rtd-object}
-
-<option> -> sealed?
- -> opaque?
- -> uid <expression> {=> symbol}
- -> printer <expression> {=> procedure/(rtd-object output-port)}
- -> displayer <expression> {=> procedure/(rtd-object output-port)}
- -> writer <expression> {=> procedure/(rtd-object output-port)}
- -> comparator <expression> {=> procedure/(rtd-object rtd-object -> (union -1 0 1))}
- -> hasher <expression> {=> procedure/(rtd-object (optional fixnum) -> fixnum)}
-
-<initial value> -> initializer <expression> {=> <procedure/(-> object)}
- -> initial <expression> {=> object}
-
-<type name> -> <identifier>
-<constructor name> -> <identifier>
-<predicate name> -> <identifier>
-<accessor name> -> <identifier>
-<mutator name> -> <identifier>
-<field name> -> <identifier>
-<type predicate name> -> <identifier>
-
-- Procedure define-reader-ctor
-
-(define-reader-ctor RTD () PROC)
-
-Is this necessary, useful?
-
-- Macro define-record-printer
-
-(define-record-printer RTD (RTDVAR PORTVAR) EXPRESSION ...)
-
-Does "(rtd-operator RTD 'printer (lambda (RTDVAR PORTVAR) EXPRESSION ...))"
-
-(define-record-printer RTD () PROC)
-
-Does "(rtd-operator RTD 'printer PROC)"
-
-- Macro define-record-displayer
-
-(define-record-displayer RTD (RTDVAR OUTPUT-PORT) EXPRESSION ...)
-
-Does "(rtd-operator RTD 'displayer (lambda (RTDVAR PORTVAR) EXPRESSION ...))"
-
-(define-record-displayer RTD () PROC)
-
-Does "(rtd-operator RTD 'displayer PROC)"
-
-- Macro define-record-writer
-
-(define-record-writer RTD (RTDVAR OUTPUT-PORT) EXPRESSION ...)
-
-Does "(rtd-operator RTD 'writer (lambda (RTDVAR PORTVAR) EXPRESSION ...))"
-
-(define-record-writer RTD () PROC)
-
-Does "(rtd-operator RTD 'writer PROC)"
-
-- Macro define-record-comparator
-
-(define-record-comparator RTD (RTDVAR1 RTDVAR2) EXPRESSION ...)
-
-Does "(rtd-operator RTD 'comparator (lambda (RTDVAR1 RTDVAR2) EXPRESSION ...))"
-
-(define-record-comparator RTD () FUNC)
-
-Does "(rtd-operator RTD 'comparator FUNC)"
-
-- Macro define-record-hasher
-
-(define-record-hasher RTD (RTDVAR) EXPRESSION ...)
-
-Does "(rtd-operator RTD 'hasher (lambda (RTDVAR) EXPRESSION ...))"
-
-(define-record-hasher RTD () FUNC)
-
-Does "(rtd-operator RTD 'hasher FUNC)"
-
-- Macro define-record-operator
-
-(define-record-operator RTD OPERATION ...)
-
-Something like this possible but I don't see the point.
-
-
-- Data Representation -
-
-The core structure-type is a vector-like object with a reference to a
-runtime-type-descriptor or rtd structure-type object in slot 0. So a
-structure-type object always has at least 1 element.
-
-For backwards compatibility a structure-type with a symbol in slot
-0 can be given the current semantics. A synthetic rtd can be generated
-on-the-fly for such cases.
-
-- The rtd structure-type layout:
-
-0 Definition rtd
-1 Parent rtd or #f
-2 Name symbol
-3 Fields vector-of (union symbol (symbol mutable) (symbol immutable))
-4 Sealed? boolean
-5 Opaque? boolean
-6 Uid symbol
-
-- The "rtd" rtd structure-type object:
-
-0 self-reference
-1 #f
-2 'rtd
-3 #(parent name uid names kinds sealed opaque types inits)
-4 #t
-5 #t
-6 #f
-
-The Definition is not considered a "field" since it is always present.
-
-The Uid violates the contract deliberately since user rtd's Uid must be a
-symbol.
-
-R6RS suggests an automatically generated Uid to be in the UUID namespace
-prefixed with the rtd's Name. For example: 'rtd:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6'.
-
-- Operations
-
--- The 'rtd-object' operations data-structure is a 'mapset' since it is
-associative, unique-valued and extensible. Called the 'rtd-operation-mapset'.
-
--- Represention options:
-
-1) Use an associative data-structure keyed by 'rtd-object' returning
-'rtd-operation-mapset' for that 'rtd-object'.
-
-2) Store the 'rtd-operation-mapset' in the 'rtd-object'.
-
-Both have their merits but the 1st option can coexist more easily with the
-symbol-tag style. The '##sys#record-printers' would become
-'##sys#record-operations'. Need routines to abstract the lookup of
-'rtd-operation-mapset' so it can be generated automatically when not found.
-Should also have finer-grained routines that return specific opration
-procedures.
-
-'##sys#record-operations' should probably be a hash-table since the current
-a-list will be inefficient after some 'magic-limit' of about 12.
-
-(The 'magic-limit' value is based on tests w/ Chicken 3 on my platfrom, YMMV.
-This is the value used by "lookup-table" to switch between a-list & hash-table
-representations.)
-
---- Extending utility of '##sys#hash-table'
-
-The '##sys#hash-table' API currently only supports symbols. However, changing
-the signature of the various '##sys#hash-table' routines to allow an optional
-hash function is straight-forward. Affected are '##sys#hash-table-ref',
-'##sys#hash-table-set!' and '##sys#hash-table-update!'. (The
-'##sys#hash-table-location' routine doesn't need this change since only used
-for environments.)
-
-
-- Discussion -
-
--- The rtd-operations used by system routines:
-
-'display' '(rtd-displayer RTD)'
-
-'write' '(rtd-writer RTD)'
-
-'equal?' '(zero? ((rtd-comparator RTD) X Y))'
-
-'equal?-hash' '(rtd-hasher RTD)'
-
-The 'rtd-printer' is used as a default for 'displayer' & 'writer', but will
-not override.
-
--- Kinda think an 'rtd-object' should differentiate SRFI-10 syntax from other
-forms:
-
-The 'rtd-printer' could always produce SRFI-10 'read-syntax' while
-'rtd-displayer' produces human-readable output & 'rtd-writer' uses the
-'read-table'.
-
--- Identifiers
-
-The identifiers are subject to the same rules as any other identifier in a
-module. So the syntactic layer will "(define <type name> (make-rtd '<type name>
-...))". So there is an identifier in the module namespace of '<type name>'.
-
-But the Name rtd field is not in a module namespace! Any two rtd's w/ the same
-Name but different Uid's are unique, no matter what the correspondence, if any,
-between the fields. Any two rtd's w/ the same Uid must be eqv?/equal? in all
-fields, except the Name can be different.
-
--- Slot access performance
-
-Direct access to field slots by accessor & mutator procedures is tricky
-w/�inheritance. If the parent 'rtd-object' is available at expand time then the
-syntactic layer can open code the slot index. Otherwise runtime fieldname ->
-slot-index is needed. Kinda implies that an imported 'rtd-object' used as a
-parent needs to be instantiated at compile time - how to determine an automatic
-'-extend' is beyond me.
-
--- Unresolved:
-
---- Generative vs. Nongenerative
-
-(Shiro Kawai comp.lang.scheme Sun, 8 Mar 2009 01:14:37 -0800 (PST) Generative/nongenerative record types)
-This is just a rough idea from top of my head. Feedbacks are welcome.
-
-I've been feeling very uncomfortable about "nongenerative" record type
-creation feature in R6RS but couldn't point my finger to what made me
-feel so. I see why the feature like that is needed, but it doesn't
-look
-like Scheme-way as I perceive (what Scheme-way is may vary widely
-among people, though). I dug the discussion about it and so far got
-an impression that (1) first, make-record-type is understood to be
-generative, in order to guarantee to create distinct types, and then
-(2) uid for nongenerative record type creation is introduced, mainly
-to accomodate efficient local record definitions.
-
-Record type descriptor is an immutable object, and I tend to think
-equality of immutable objects should, ideally, defined by equality of
-its components (as Henry Baker suggests in [1]). Implementation may
-take advantage of immutability to share the same storage for
-equivalent object. Anyway, it seems weird that two immutalbe objects
-are not equivalent even though I cannot distinguish one from the other
-any way except the system-provided equivalence predicate (e.g. eqv?).
-
-The only reason I can think of that immutable record types with
-exactly the same definitions need to be distinguished is the necessity
-of distinct types.
-
-Then, how about separate type identity from structure definitions?
-
-The record type in R6RS are burdened by two roles; creating distinct
-types, and creating aggregate types. These two are not the same;
-sometimes I merely need an aggregate type for code readability and do
-not care if it is distinct from other types. I've been happily using
-a macro that expands aggregate type definition into bunch of
-procedures that operate on vectors.
-
-Specifically,
-
-* make-record-type-descriptor (or equivalent) is *allowed* to return
-the
- identical rtd if all the given arguments are equivalent.
-
-* Record type equivalence is based on equivalence of rtd's components.
-(If the implementation returns identical rtd for equivalent arguments,
-the comparison is effectively eq?).
-
-* If you need distinct types, give make-record-type-descriptor
-something
-different. An easiest way may be to add "type-id" component to rtd,
-and
-use eqv? to compare that component to determine equivalence of rtds.
-It is easy to create distinct rtd by giving (cons #f #f) as type-id.
-
-* For the syntactic layer, I'm not sure whether the define-record-type
-macro should create a distinct type or not. But I feel it better to
-have different macros for distinct type creation and mere aggregate
-type creation. Local aggregate structure for readability requires
-latter, while the record type which is part of external API of some
-module may require former.
-
-On the surface, this idea just reverses the default perception of
-generative/nongenerative behavior of make-record-type-descriptor;
-R6RS's is generative unless unique uid is given. This one is
-nongenerative unless unique type-id is given. But this one eliminates
-explicit bookkeeping of uids, which is effectively creating another
-namespace in R6RS.
-
-[1] http://home.pipeline.com/~hbaker1/ObjectIdentity.html
-
---- Conflicts between structure-type 'symbol' tags & 'rtd-object' names is an
-open issue.
diff --git a/misc/inline.scm b/misc/inline.scm
deleted file mode 100644
index 6be85cf9..00000000
--- a/misc/inline.scm
+++ /dev/null
@@ -1,418 +0,0 @@
-;;; this assumes that :
-;;; a) nothing has been evaluated yet
-;;; b) basic syntactical correctness has been assured (so a list l starting
-;;; with 'define-inline will have the procedure-name as (caadr l) and
-;;; arity for all procedure calls is correct)
-;;; c) alpha substitution has occurred so all named symbols are guaranteed
-;;; unique across all procedures
-;;; d) optional, keyword, and rest arguments are not allowed for inline
-;;; procedures (although it should be possible to add them)
-
-;; beginning of the pass
-;; takes the ordered quoted list of all top-level statements
-;; ends by calling either
-;; inline-pass:final with the input list (if no inline procedures exist) and
-;; null, or
-;; inline-pass:graph-inline with two lists, the inline procedures (with some
-;; metadata) and all non-inline-procedure statements.
-(define (inline-pass:start qlst)
- (let find-inline ((q qlst) ; quoted top-level statements
- (i 0) ; index of inline procedure for later steps
- (l '()) ; inline procedures
- (r '())) ; non-inline statements
- (cond ((null? q)
- (if (= 0 i)
- (inline-pass:final (reverse r) '())
- (inline-pass:graph-inline i (reverse l) (reverse r))))
- ((and (list? (car q)) (eq? 'define-inline (caar q)))
- (find-inline
- (cdr q)
- (+ 1 i)
- (cons (cons (caadar q)
- (vector i 0 (cddar q) (cdadar q)))
- l)
- r))
- (else
- (find-inline (cdr q) i l (cons (car q) r))))))
-
-
-;; walks through a list
-;; takes a list, an index vector, and the metadata inline list from above
-;; ends by returning the (possibly modified) vector
-(define (inline-pass:walk l v ilst)
- (let walk ((l l)
- (t 0))
- (cond ((null? l)
- v)
- ((list? (car l))
- (cond ((null? (car l))
- (walk (cdr l) t))
- ((eq? 'quote (caar l))
- (or (= 0 t)
- (walk (cdar l) 3))
- (walk (cdr l) t))
- ((eq? 'quasiquote (caar l))
- (walk (cdar l) 2)
- (walk (cdr l) t))
- ((or (eq? 'unquote (caar l))
- (eq? 'unquote-splicing (caar l)))
- (walk (cdar l) 1)
- (walk (cdr l) t))
- (else
- (walk (car l) t)
- (walk (cdr l) t))))
- ((pair? (car l))
- (walk (unfold not-pair? car cdr (car l) list) t)
- (walk (cdr l) t))
- ((vector? (car l))
- (walk (vector->list (car l)) t)
- (walk (cdr l) t))
- ((not (symbol? (car l)))
- (walk (cdr l) t))
- ((> t 1)
- (walk (cdr l) t))
- ((alist-ref (car l) ilst) =>
- (lambda (d)
- (vector-set! v (vector-ref d 0) #t)
- (walk (cdr l) t)))
- (else
- (walk (cdr l) t)))))
-
-
-;; builds a graph of calls to inline procedures from inline procedures
-;; takes the inline-list-length, inline metadata list, and other statements
-;; ends by calling inline-pass:simplify1 with the graph and input args
-(define (inline-pass:graph-inline i ilst rlst)
- (inline-pass:simplify1
- (map
- (lambda (iv)
- (cons (car iv)
- (inline-pass:walk
- (vector-ref (cdr iv) 3)
- (make-vector i #f)
- ilst)))
- ilst)
- i ilst rlst))
-
-
-;; simplifies direct self-call, no further inline, and only-self cases
-;; takes the graph, inline list length, inline metadata list, and statements
-;; ends by calling either:
-;; inline-pass:simplify2 with the further inline, no-further-but-self inline,
-;; graph, inline length, all inline, and other statements, or
-;; inline-pass:final with the statements and inlines
-(define (inline-pass:simplify1 g i ilst rlst)
- (for-each
- (lambda (x)
- (and (vector-ref (cdr x) (car x))
- (vector-set! (cdr (list-ref ilst (car x))) 1 1)))
- g)
- (let simple ((h g) ; graph
- (l ilst) ; inline metadata
- (r '()) ; no further inlines (except possibly self)
- (s '())) ; further inlining
- (cond ((null? h)
- (if (null? s)
- (inline-pass:final rlst r)
- (inline-pass:simplify2 s r g i ilst rlst)))
- ((every (lambda (x i) (or (= i (caar h)) (not x)))
- (vector->list (cdar h)) (iota i))
- (simple (cdr h) (cdr l) (cons (car l) r) s))
- (else
- (simple (cdr h) (cdr l) r (cons (car l) s))))))
-
-;; substitutes in inlined procedures
-;; takes the procedure in which to do the substitution (as a list) and the
-;; list of inlined procedures with metadata
-;; ends with the new procedure-as-list
-;; note: there are four distinct cases -
-;; 1) inline procedure in application position, no self call :
-;; becomes a (begin ...) with the arguments set locally
-;; 2) inline procedure in application position, with self call :
-;; becomes a (let <name> (vars ...) ...)
-;; 3) inline procedure not in application position, no self call :
-;; becomes a (lambda (arglist) ...)
-;; 4) inline procedure not in application position, with self call :
-;; becomes a (lambda (arglist) (let <name> (vars ...) ...) with new
-;; symbols generated for arglist
-(define (inline-pass:subst1 l ilst)
- (let walk ((l l)
- (t 0))
- (cond ((null? l)
- l)
- ((vector? l)
- (list->vector (walk (vector->list l) t)))
- ((symbol? l)
- (cond ((> t 1)
- l)
- ((alist-ref l ilst) =>
- (lambda (d)
- (if (= 1 (vector-ref d 1))
- (let* ((a (map
- (lambda (x) (gensym 'ia))
- (vector-ref d 2)))
- (m (map
- (lambda (a x) (list a x))
- (vector-ref d 2) a)))
- `(lambda ,a (let ,l ,m
- ,@(vector-ref d 3))))
- `(lambda ,(vector-ref d 2)
- ,@(vector-ref d 3)))))
- (else
- l)))
- ((not (pair? l))
- l)
- ((list? (car l))
- (cond ((null? (car l))
- (cons (car l) (walk (cdr l) t)))
- ((not (symbol? (caar l)))
- (cons (walk (car l) t) (walk (cdr l) t)))
- ((eq? 'quote (caar l))
- (if (= t 0)
- (cons (car l) (walk (cdr l) t))
- (cons `(quote ,(walk (cadr l) 3))
- (walk (cdr l) t))))
- ((eq? 'quasiquote (caar l))
- (cons `(quasiquote ,(walk (cadr l) 2))
- (walk (cdr l) t)))
- ((or (eq? 'unquote (caar l))
- (eq? 'unquote-splicing (caar l)))
- (cons `(,(caar l) ,(walk (cadr l) 1))
- (walk (cdr l) t)))
- ((> t 1)
- (cons (walk (car l) t) (walk (cdr l) t)))
- ((alist-ref (caar l) ilst) =>
- (lambda (d)
- (cons
- (if (= 1 (vector-ref d 1))
- (let ((m (map
- (lambda (a x) (list a x))
- (vector-ref d 2)
- (walk (cdar l) t))))
- `(let ,(caar l) ,m
- ,@(vector-ref d 3)))
- `(begin
- ,@(map
- (lambda (a x)
- `(set-local! ,a ,x))
- (vector-ref d 2)
- (walk (cdar l) t))
- ,@(vector-ref d 3)))
- (walk (cdr l) t))))
- (else
- (cons (walk (car l) t) (walk (cdr l) t)))))
- ((pair? (car l))
- (cons (cons (walk (caar l) t) (walk (cdar l) t))
- (walk (cdr l) t)))
- ((vector? (car l))
- (cons (list->vector (walk (vector->list (car l)) t))
- (walk (cdr l) t)))
- ((not (symbol? (car l)))
- (cons (car l) (walk (cdr l) t)))
- ((> t 1)
- (cons (car l) (walk (cdr l) t)))
- ((alist-ref (car l) ilst) =>
- (lambda (d)
- (cons
- (if (= 1 (vector-ref d 1))
- (let* ((a (map
- (lambda (x) (gensym 'ia))
- (vector-ref d 2)))
- (m (map
- (lambda (a x) (list a x))
- (vector-ref d 2) a)))
- `(lambda ,a (let ,(car l) ,m
- ,@(vector-ref d 3))))
- `(lambda ,(vector-ref d 2) ,@(vector-ref d 3)))
- (walk (cdr l) t))))
- (else
- (cons (car l) (walk (cdr l) t))))))
-
-
-;; substitutes in inlined procedures with further processing
-;; takes the procedure in which to do the substitution (as a list), the
-;; list of inlined procedures with metadata, and a list of procedures to
-;; not treat as inline
-;; ends with the new procedure-as-list
-;; note: there are four distinct cases -
-;; 1) inline procedure in application position, no self call :
-;; becomes a (begin ...) with the arguments set locally
-;; 2) inline procedure in application position, with self call :
-;; becomes a (let <name> (vars ...) ...)
-;; 3) inline procedure not in application position, no self call :
-;; becomes a (lambda (arglist) ...)
-;; 4) inline procedure not in application position, with self call :
-;; becomes a (lambda (arglist) (let <name> (vars ...) ...) with new
-;; symbols generated for arglist
-(define (inline-pass:subst2 l ilst nof)
- (let walk ((l l)
- (n nof)
- (t 0))
- (cond ((null? l)
- l)
- ((vector? l)
- (list->vector (walk (vector->list l) t n)))
- ((symbol? l)
- (cond ((> t 1)
- l)
- ((memq l n) =>
- (lambda (m)
- (let ((d (alist-ref l ilst)))
- (if (= 1 (vector-ref d 1))
- l
- (begin
- (vector-set! d 1 1)
- (if (= 1 (length m))
- l
- (walk l t (cdr m))))))))
- ((alist-ref l ilst) =>
- (lambda (d)
- (if (= 1 (vector-ref d 1))
- (let* ((a (map
- (lambda (x) (gensym 'ia))
- (vector-ref d 2)))
- (m (map
- (lambda (a x) (list a x))
- (vector-ref d 2) a)))
- `(lambda ,a (let ,l ,m
- ,@(walk (vector-ref d 3) t
- (cons l n)))))
- `(lambda ,(vector-ref d 2)
- ,@(walk (vector-ref d 3) t
- (cons l n))))))
- (else
- l)))
- ((not (pair? l))
- l)
- ((list? (car l))
- (cond ((null? (car l))
- (cons (car l) (walk (cdr l) t n)))
- ((not (symbol? (caar l)))
- (cons (walk (car l) t n) (walk (cdr l) t n)))
- ((eq? 'quote (caar l))
- (if (= t 0)
- (cons (car l) (walk (cdr l) t n))
- (cons `(quote ,(walk (cadr l) 3 n))
- (walk (cdr l) t n))))
- ((eq? 'quasiquote (caar l))
- (cons `(quasiquote ,(walk (cadr l) 2 n))
- (walk (cdr l) t n)))
- ((or (eq? 'unquote (caar l))
- (eq? 'unquote-splicing (caar l)))
- (cons `(,(caar l) ,(walk (cadr l) 1 n))
- (walk (cdr l) t n)))
- ((> t 1)
- (cons (walk (car l) t n) (walk (cdr l) t n)))
- ((memq (caar l) n) =>
- (lambda (m)
- (let ((d (alist-ref (caar l) ilst)))
- (if (= 1 (vector-ref d 1))
- (cons (cons (caar l)
- (walk (cdar l) t n))
- (walk (cdr l) t n))
- (begin
- (vector-set! d 1 1)
- (if (= 1 (length m))
- (cons (cons (caar l)
- (walk (cdar l) t n))
- (walk (cdr l) t n))
- (walk l t
- (cdr m))))))))
- ((alist-ref (caar l) ilst) =>
- (lambda (d)
- (cons
- (if (= 1 (vector-ref d 1))
- (let ((m (map
- (lambda (a x) (list a x))
- (vector-ref d 2)
- (walk (cdar l) t
- (cons (caar l) n)))))
- `(let ,(caar l) ,m
- ,@(walk (vector-ref d 3) t
- (cons (caar l) n))))
- `(begin
- ,@(map
- (lambda (a x)
- `(set-local! ,a ,x))
- (vector-ref d 2)
- (walk (cdar l) t
- (cons (caar l) n)))
- ,@(walk (vector-ref d 3) t
- (cons (caar l) n))))
- (walk (cdr l) t n))))
- (else
- (cons (walk (car l) t n) (walk (cdr l) t n)))))
- ((pair? (car l))
- (cons (cons (walk (caar l) t n) (walk (cdar l) t n))
- (walk (cdr l) t n)))
- ((vector? (car l))
- (cons (list->vector (walk (vector->list (car l)) t n))
- (walk (cdr l) t n)))
- ((not (symbol? (car l)))
- (cons (car l) (walk (cdr l) t n)))
- ((> t 1)
- (cons (car l) (walk (cdr l) t)))
- ((memq (car l) n) =>
- (lambda (m)
- (let ((d (alist-ref (car l) ilst)))
- (if (= 1 (vector-ref d 1))
- (cons (car l) (walk (cdr l) t n))
- (begin
- (vector-set! d 1 1)
- (if (= 1 (length m))
- (cons (car l) (walk (cdr l) t n))
- (walk l t (cdr m))))))))
- ((alist-ref (car l) ilst) =>
- (lambda (d)
- (cons
- (if (= 1 (vector-ref d 1))
- (let* ((a (map
- (lambda (x) (gensym 'ia))
- (vector-ref d 2)))
- (m (map
- (lambda (a x) (list a x))
- (vector-ref d 2) a)))
- `(lambda ,a (let ,l ,m
- ,@(walk (vector-ref d 3) t
- (cons (car l) n)))))
- `(lambda ,(vector-ref d 2)
- ,@(walk (vector-ref d 3) t (cons (car l) n))))
- (walk (cdr l) t n))))
- (else
- (cons (car l) (walk (cdr l) t n))))))
-
-;; finds which inlined procedures are called from non-inlined procedures
-;; performs substitutions for all inline procedures
-;; takes the further inline procedures, no further inline procedures, graph,
-;; inlined procedures list, and statements list
-;; ends by calling inline-pass:final with the statements and inline procedures
-;; ready for substitution
-(define (inline-pass:simplify2 fur nof g ilst rlst)
- (for-each
- (lambda (x)
- (vector-set! (cdr x) 3
- (inline-pass:subst1 (vector-ref (cdr x) 3) nof)))
- fur)
- (let ((v (inline-pass:walk rlst (make-vector i #f) fur)))
- (for-each
- (lambda (x)
- (vector-set! (cdr x) 3
- (inline-pass:subst2 (vector-ref (cdr x) 3) ilst
- (list (car x)))))
- (vector-fold
- (lambda (i r x)
- (if x
- (cons (list-ref ilst i) r)
- r))
- '() v))
- (inline-pass:final rlst ilst)))
-
-
-;; inlines all procedures
-;; takes the list of statements and the list of inline procedures with metadata
-;; returns the list of statements with all procedures inlined
-(define (inline-pass:final rlst ilst)
- (if (null? ilst)
- rlst
- (inline-pass:subst1 rlst ilst)))
-
diff --git a/misc/manual.css b/misc/manual.css
deleted file mode 100644
index 786b36e1..00000000
--- a/misc/manual.css
+++ /dev/null
@@ -1,33 +0,0 @@
-/* manual.css - Stylesheet for HTML manual */
-
-
-CODE {
- color: #666666;
-}
-
-a:link {
- color: #336;
-}
-
-a:visited { color: #666; }
-
-a:active { color: #966; }
-
-a:hover { color: #669; }
-
-body {
- background: #fff;
- color: #000;
- font: 9pt "Lucida Grande", "Verdana", sans-serif;
- margin: 8em;
-}
-
-TABLE {
- font: 9pt "Lucida Grande", "Verdana", sans-serif;
-}
-
-H3 {
- color: #113;
-}
-
-PRE { font-family: "Andale Mono", monospace; }
diff --git a/scripts/README b/scripts/README
index 09c6e87e..62902f41 100644
--- a/scripts/README
+++ b/scripts/README
@@ -1,44 +1,34 @@
-README for scripts/
-===================
-
-
-This directory contains a couple of things that might be useful:
-
- scheme
-
- A wrapper sh(1) script that allows automatic compilation of Scheme
- scripts. If you precede a Scheme file with a header line like this
-
- #!/usr/bin/env scheme
-
- then a compiled version of the code will be stored in $HOME/.cache
- and executed, instead of the original source file.
-
- tools.scm
-
- Helper functions for some of the scripts here.
-
- test-dist.sh
-
- Takes a platform-designator and the path to a tarball and unpacks,
- builds and tests the chicken distribution contained therein.
-
- wiki2html.scm
-
- A simple svnwiki -> HTML translator used for the manual. Needs
- `htmlprag' and `matchable' eggs installed.
-
- make-egg-index.scm
-
- Creates an egg index HTML page from a local working copy of a
- `release/<number>' egg tree.
-
- makedist.scm
-
- Creates a distribution tarball from a chicken svn checkout.
-
- henrietta.scm
- henrietta.cgi
-
- A CGI script and sub-program that serves eggs from a local tree
- or via svn over HTTP.
+README for scripts/
+===================
+
+
+This directory contains a couple of things that might be useful:
+
+ tools.scm
+
+ Helper functions for some of the scripts here.
+
+ test-dist.sh
+
+ Takes a platform-designator and the path to a tarball and unpacks,
+ builds and tests the chicken distribution contained therein.
+
+ wiki2html.scm
+
+ A simple svnwiki -> HTML translator used for the manual. Needs
+ `htmlprag' and `matchable' eggs installed.
+
+ make-egg-index.scm
+
+ Creates an egg index HTML page from a local working copy of a
+ `release/<number>' egg tree.
+
+ makedist.scm
+
+ Creates a distribution tarball from a chicken svn checkout.
+
+ henrietta.scm
+ henrietta.cgi
+
+ A CGI script and sub-program that serves eggs from a local tree
+ or via svn over HTTP.
diff --git a/scripts/chicken-scheme b/scripts/chicken-scheme
deleted file mode 100755
index 892c0093..00000000
--- a/scripts/chicken-scheme
+++ /dev/null
@@ -1,44 +0,0 @@
-#!/bin/bash
-### usage: chicken-scheme FILENAME
-#
-# variables:
-#
-# CHICKEN_AUTOCOMPILE_DEBUG
-
-
-dbgoption=
-cache=$HOME/.chicken-scheme.cache
-uname=`uname`
-wd=`pwd`
-
-if test -n "$CHICKEN_AUTOCOMPILE_DEBUG"; then
- set -x
- dbgoption="-v2"
-fi
-
-if test "$#" == 0; then
- exec csi
-else
- prg="$1"
-fi
-
-if test $uname = "Darwin"; then
- prgh=`md5 -q $prg`
-else
- prgh=`md5sum $prg | sed -n -e 's/\([^[:space:]]*\).*/\1/p'`
-fi
-
-if test \! -d $cache; then
- mkdir -p $cache
-fi
-
-if test "$prg" -nt "$cache/$prgh"; then
- csc $dbgoption "$prg" -o "$cache/$prgh"
-fi
-
-if test -x "$cache/$prgh"; then
- shift
- exec "$cache/$prgh" "$@"
-else
- echo "can not run $1"
-fi
diff --git a/scripts/guess-platform.sh b/scripts/guess-platform.sh
deleted file mode 100644
index a81236d7..00000000
--- a/scripts/guess-platform.sh
+++ /dev/null
@@ -1,21 +0,0 @@
-#!/bin/sh
-### guess-platform.sh - guess correct setting for PLATFORM
-
-
-if test "$MSYSTEM" == MINGW32; then
- echo mingw-msys
- exit
-fi
-
-case `uname` in
- *Linux*)
- echo "linux";;
- *BSD*)
- echo "bsd";;
- Darwin)
- echo "macosx";;
- *)
- echo "cannot figure out correct PLATFORM"
- exit 1;;
- # missing: solaris, cygwin
-esac
diff --git a/scripts/scheme b/scripts/scheme
deleted file mode 100755
index 66740fab..00000000
--- a/scripts/scheme
+++ /dev/null
@@ -1,44 +0,0 @@
-#!/bin/bash
-### usage: scheme FILENAME
-#
-# variables:
-#
-# AUTOCOMPILE_DEBUG
-
-
-dbgoption=
-cache=$HOME/.schemecache
-uname=`uname`
-wd=`pwd`
-
-if test -n "$AUTOCOMPILE_DEBUG"; then
- set -x
- dbgoption="-v2"
-fi
-
-if test "$#" == 0; then
- exec csi
-else
- prg="$1"
-fi
-
-if test $uname = "Darwin"; then
- prgh=`md5 -q $prg`
-else
- prgh=`md5sum $prg | sed -n -e 's/\([^[:space:]]*\).*/\1/p'`
-fi
-
-if test \! -d $cache; then
- mkdir -p $cache
-fi
-
-if test "$prg" -nt "$cache/$prgh"; then
- csc $dbgoption "$prg" -o "$cache/$prgh"
-fi
-
-if test -x "$cache/$prgh"; then
- shift
- exec "$cache/$prgh" "$@"
-else
- echo "can not run $1"
-fi
diff --git a/scripts/xhere b/scripts/xhere
deleted file mode 100755
index 761efe26..00000000
--- a/scripts/xhere
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/bin/sh
-prg=$1
-here="`pwd`"
-shift
-LD_LIBRARY_PATH=$here DYLD_LIBRARY_PATH=$here PATH=.:$PATH exec ./$prg "$@"
Trap