Changeset 9399 in project


Ignore:
Timestamp:
03/10/08 15:24:21 (12 years ago)
Author:
Alex Shinn
Message:

Adding DSSSL support, updating license info.

Location:
release/3/riaxpander
Files:
12 edited

Legend:

Unmodified
Added
Removed
  • release/3/riaxpander/chicken.scm

    r9373 r9399  
    4040    identifier=?
    4141    identifier->symbol
     42    ##sys#ria-expand-extended-lambda-list
    4243    ;++ more exports
    4344    ))
     
    413414      ,@(map chicken/compile-expression expressions))))
    414415
    415 ;++ Handle DSSSL-extended BVLs.
    416 
    417416(define (chicken/map-lambda-bvl bvl history procedure)
    418417  (if (not (chicken/valid-bvl? bvl))
     
    429428           #t)
    430429          (else
    431            (name? bvl)))))
     430           (and (name? bvl)
     431                (not (memq bvl seen)))))))
    432432
    433433(define (chicken/%map-lambda-bvl bvl procedure)
     
    441441           (procedure bvl)))))
    442442
     443(define ##sys#ria-expand-extended-lambda-list
     444  (let ((reverse reverse)
     445        (gensym gensym))
     446    (lambda (llist0 body errh)
     447      (define (err msg) (errh msg llist0))
     448      (define (->keyword s) (string->keyword (##sys#slot s 1)))
     449      (let ((rvar #f)
     450            (hasrest #f))
     451        (let loop ((mode 0)             ; req, opt, rest, key, end
     452                   (req '())
     453                   (opt '())
     454                   (key '())
     455                   (llist llist0))
     456          (cond
     457           ((null? llist)
     458            (values
     459             (if rvar (##sys#append (reverse req) rvar) (reverse req))
     460             (let ((body
     461                    (if (null? key)
     462                        body
     463                        `((let* ,(map (lambda (k)
     464                                        (let ((s (car k)))
     465                                          `(,s (##sys#get-keyword
     466                                                ',(->keyword s) ,rvar
     467                                                ,@(if (pair? (cdr k))
     468                                                      `((lambda () ,@(cdr k)))
     469                                                      '())))))
     470                                      (reverse key))
     471                            ,@body)))))
     472               (cond
     473                ((null? opt) body)
     474                ((and (not hasrest) (null? key) (null? (cdr opt)))
     475                 `((let ((,(caar opt) (:optional ,rvar ,(cadar opt))))
     476                     ,@body)))
     477                ((and (not hasrest) (null? key))
     478                 `((let-optionals ,rvar ,(reverse opt) ,@body)))
     479                (else
     480                 `((let-optionals* ,rvar
     481                       ,(##sys#append (reverse opt) (list (or hasrest rvar)))
     482                     ,@body)))))))
     483           ((name? llist)
     484            (if (fx> mode 2)
     485                (err "rest argument list specified more than once")
     486                (begin
     487                  (if (not rvar) (set! rvar llist))
     488                  (set! hasrest llist)
     489                  (loop 4 req opt '() '()))))
     490           ((not (pair? llist))
     491            (err "invalid lambda list syntax"))
     492           (else
     493            (let ((x (##sys#slot llist 0))
     494                  (r (##sys#slot llist 1)))
     495              (case x
     496                ((#!optional)
     497                 (if (not rvar) (set! rvar (gensym)))
     498                 (if (eq? mode 0)
     499                     (loop 1 req '() '() r)
     500                     (err "`#!optional' argument marker in wrong context")))
     501                ((#!rest)
     502                 (if (fx<= mode 1)
     503                     (if (and (pair? r) (name? (##sys#slot r 0)))
     504                         (begin
     505                           (if (not rvar) (set! rvar (##sys#slot r 0)))
     506                           (set! hasrest (##sys#slot r 0))
     507                           (loop 2 req opt '() (##sys#slot r 1)))
     508                         (err "invalid syntax of `#!rest' argument"))
     509                     (err "`#!rest' argument marker in wrong context")))
     510                ((#!key)
     511                 (if (not rvar) (set! rvar (gensym)))
     512                 (if (fx<= mode 3)
     513                     (loop 3 req opt '() r)
     514                     (err "`#!key' argument marker in wrong context")))
     515                (else
     516                 (cond
     517                  ((name? x)
     518                   (case mode
     519                     ((0) (loop 0 (cons x req) '() '() r))
     520                     ((1) (loop 1 req (cons (list x #f) opt) '() r))
     521                     ((2) (err "invalid lambda list syntax after `#!rest' marker"))
     522                     (else (loop 3 req opt (cons (list x) key) r))))
     523                  ((and (list? x) (eq? 2 (length x)))
     524                   (case mode
     525                     ((0) (err "invalid required argument syntax"))
     526                     ((1) (loop 1 req (cons x opt) '() r))
     527                     ((2) (err "invalid lambda list syntax after `#!rest' marker"))
     528                     (else (loop 3 req opt (cons x key) r))))
     529                  (else (err "invalid lambda list syntax")))))))))))))
     530
    443531
    444532;;;; Compilation Utilities
  • release/3/riaxpander/classify.scm

    r9346 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
     3;;;; Riaxpander
    44;;;; Classification
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
    8 
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    98
    109(define (classify form environment history)
     
    5756    (if (name? form*)
    5857        (classify-name form environment history)
    59         ((lambda (environment)
    60            (classify form*
    61                      environment
    62                      (history/replace-reduction history form* environment)))
    63          (let ((free-names (syntactic-closure/free-names form))
    64                (closing-environment (syntactic-closure/environment form)))
    65            (if (pair? free-names)
    66                (syntactic-filter closing-environment
    67                                  free-names
    68                                  environment)
    69                closing-environment))))))
     58        (let ((environment*
     59               (syntactic-filter (syntactic-closure/environment form)
     60                                 (syntactic-closure/free-names form)
     61                                 environment)))
     62          (classify form*
     63                    environment
     64                    (history/replace-reduction history form* environment))))))
    7065
    7166
     
    202197  `(,(transformer->operator environment auxiliary-names procedure)))
    203198
    204 (define (call-with-syntactic-environment receiver)
     199(define (capture-syntactic-environment receiver)
    205200  (classifier->form
    206201   (lambda (form environment history)
     
    208203     (classify-reduction (receiver environment) environment history))))
    209204
    210 (define capture-syntactic-environment
    211   call-with-syntactic-environment)
    212 
    213 (define (call-with-syntactic-history receiver)
     205(define (capture-expansion-history receiver)
    214206  (classifier->form
    215207   (lambda (form environment history)
     
    217209     (classify-reduction (receiver history) environment history))))
    218210
     211;;; These names are backwards, but this is compatible with MIT Scheme.
     212
    219213(define (call-with-syntax-error-procedure receiver)
     214  (capture-expansion-history
     215   (lambda (history)
     216     (receiver
     217      (lambda (message . irritants)
     218        (apply syntax-error message history
     219               (and history
     220                    (reduction/form (history/current-reduction history)))
     221               irritants))))))
     222
     223(define (capture-syntax-error-procedure receiver)
    220224  (classifier->form
    221225   (lambda (form environment history)
  • release/3/riaxpander/closure.scm

    r5506 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
     3;;;; Riaxpander
    44;;;; Syntactic Closures
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    88
    99(define-record-type <syntactic-closure>
  • release/3/riaxpander/denotation.scm

    r4547 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
     3;;;; Riaxpander
    44;;;; Denotations
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    88
    99(define-record-type <classifier>
     
    3131      (and (variable? denotation-a)
    3232           (variable? denotation-b)
    33            (eq? (variable/location denotation-a)
    34                 (variable/location denotation-b)))))
     33           (eqv? (variable/location denotation-a)
     34                 (variable/location denotation-b)))))
  • release/3/riaxpander/environment.scm

    r5506 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
     3;;;; Riaxpander
    44;;;; Syntactic Environments
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    88
    99(define-record-type <syntactic-environment>
     
    250250     (lambda (environment procedure)    ;for-each-binding
    251251       (for-each (lambda (binding)
    252                    (procedure (car binding) (cdr binding)))
     252                   (procedure (car binding) (cdr binding) environment))
    253253                 (local-bindings environment))))))
    254254
     
    302302     (lambda (environment procedure)    ;for-each-binding
    303303       (for-each (lambda (binding)
    304                    (procedure (car binding) (cdr binding)))
     304                   (procedure (car binding) (cdr binding) environment))
    305305                 (local-bindings environment))))))
    306306
     
    314314;;; a cache for generated aliases.
    315315
    316 (define (syntactic-transformer-extend environment transformer-reference)
    317   (make-syntactic-environment transformer-syntactic-operations
    318                               (syntactic-environment/parameters environment)
    319                               environment
    320                               (cons '() transformer-reference)))
     316(define (syntactic-transformer-extend environment
     317                                      transformer-reference
     318                                      usage-environment)
     319  (make-syntactic-environment
     320   transformer-syntactic-operations
     321   (syntactic-environment/parameters environment)
     322   environment
     323   (cons '()
     324         (simplify-transformer-reference environment
     325                                         transformer-reference
     326                                         usage-environment))))
     327
     328(define (simplify-transformer-reference parent-environment
     329                                        transformer-reference
     330                                        usage-environment)
     331  (let loop ((transformer-reference transformer-reference))
     332    (if (not (syntactic-closure? transformer-reference))
     333        transformer-reference
     334        (let ((form (syntactic-closure/form transformer-reference)))
     335          (if (name=? usage-environment form
     336                      usage-environment transformer-reference)
     337              (loop form)
     338              transformer-reference)))))
    321339
    322340(define (syntactic-environment/transformer-reference environment)
     
    328346           => loop)
    329347          (else #f))))
     348
     349
     350;;;;; Transformer Environment Syntactic Operations
    330351
    331352(define transformer-syntactic-operations
     
    366387
    367388(define (syntactic-filter closing-environment free-names free-environment)
    368   (make-syntactic-environment
    369    filtered-syntactic-operations
    370    (syntactic-environment/parameters closing-environment)
    371    closing-environment
    372    (cons free-environment free-names)))
     389  (if (or (not (pair? free-names))
     390          (eq? closing-environment free-environment))
     391      closing-environment
     392      (make-syntactic-environment
     393       filtered-syntactic-operations
     394       (syntactic-environment/parameters closing-environment)
     395       closing-environment
     396       (cons free-environment free-names))))
    373397
    374398(define filtered-syntactic-operations
     
    402426                     (cond ((syntactic-lookup environment free-name)
    403427                            => (lambda (denotation)
    404                                  (procedure free-name denotation))))))
     428                                 (procedure free-name
     429                                            denotation
     430                                            environment))))))
    405431                 (free-names environment))))))
  • release/3/riaxpander/history.scm

    r4547 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
     3;;;; Riaxpander
    44;;;; Expansion History
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    88
    99;;; A history is a chain of lists of reductions, interleaved with
  • release/3/riaxpander/riaxpander-chicken-macros.scm

    r9346 r9399  
    595595        (lambda ()
    596596          (swap! t v) ...))))))
     597
     598;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     599;; support DSSSL-style keywords
     600
     601(define-syntax lambda
     602  (let-syntax ((*lambda lambda))
     603    (er-macro-transformer
     604     (lambda (form rename compare)
     605       (receive (standard-bvl body)
     606           (##sys#ria-expand-extended-lambda-list
     607            (cadr form)
     608            (cddr form)
     609            ##sys#syntax-error-hook)
     610         `(,(rename '*lambda) ,standard-bvl ,@body))))))
     611
  • release/3/riaxpander/riaxpander.meta

    r9347 r9399  
    44 (doc-from-wiki)
    55 (files "chicken.scm"                   ;Alphabetical
     6        "chicken-init.scm"
    67        "classify.scm"
    78        "denotation.scm"
     
    1819        "riaxpander-chicken-macros.scm"
    1920        "transform.scm")
    20  (license "Public Domain/BSD")
     21 (license "BSD")
    2122 (category macros))
  • release/3/riaxpander/riaxpander.setup

    r9373 r9399  
    55(install-extension 'riaxpander
    66                   '("riaxpander.so" "riaxpander-chicken-macros.scm")
    7   '((version 0.5)
     7  '((version 0.6)
    88    (documentation "riaxpander.html")
    99    (syntax)
  • release/3/riaxpander/standard.scm

    r5506 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
     3;;;; Riaxpander
    44;;;; Macrologies for Standard Syntax
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    88
    99(define (macrology/standard-derived-syntax)
     
    569569             (case-clause? (pattern-predicate '((* DATUM) + EXPRESSION))))
    570570         (lambda (form rename compare)
    571            (call-with-syntax-error-procedure
     571           (capture-syntax-error-procedure
    572572             (lambda (syntax-error)
    573573               `(,(rename 'LET) ((,(rename 'KEY) ,(cadr form)))
     
    650650                          (qq-nest 'UNQUOTE (cadr template) (- depth 1))))
    651651                     ((unquote-splicing? template rename compare)
    652                       ;++ Pass the correct selector here.
    653                       (syntax-error "Misplaced ,@ template:" #f template))
     652                      ;++ Figure out the selector for a better report.
     653                      (syntax-error "Misplaced ,@ template:" template))
    654654                     (else
    655655                      (qq-list template depth qq))))
  • release/3/riaxpander/taxonomy.scm

    r4547 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
    4 ;;;; Form Classification Taxonomy 
     3;;;; Riaxpander
     4;;;; Form Classification Taxonomy
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    88
    99;;; This file implements the types of possible values returned by CLASSIFY.
  • release/3/riaxpander/transform.scm

    r5506 r9399  
    11;;; -*- Mode: Scheme -*-
    22
    3 ;;;; Explicit Renaming Macros
     3;;;; Riaxpander
    44;;;; Transformer Application
    55
    6 ;;; This code is written by Taylor R. Campbell and placed in the Public
    7 ;;; Domain.  All warranties are disclaimed.
     6;;; Copyright (c) 2008, Taylor R. Campbell
     7;;; See the LICENCE file for licence terms and warranty disclaimer.
    88
    99(define (apply-transformer name transformer form usage-environment)
     
    1111   form
    1212   usage-environment
    13    (syntactic-transformer-extend (transformer/environment transformer) name)))
     13   (syntactic-transformer-extend (transformer/environment transformer)
     14                                 name
     15                                 usage-environment)))
    1416
    1517(define (make-rsc-macro-transformer-procedure procedure)
Note: See TracChangeset for help on using the changeset viewer.