Changeset 15060 in project


Ignore:
Timestamp:
06/25/09 13:13:33 (10 years ago)
Author:
felix winkelmann
Message:

uses core syntax forms more often to avoid capture of non-macro special forms; added define-compiler-syntax (untested)

Location:
chicken/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/chicken-syntax.scm

    r15049 r15060  
    10681068
    10691069
    1070 ;;; Just for backwards compatibility
     1070;;; use
    10711071
    10721072(##sys#extend-macro-environment
     
    10781078
    10791079
     1080;;; compiler syntax
     1081
     1082(##sys#extend-macro-environment
     1083 'define-compiler-syntax '()
     1084 (##sys#er-transformer
     1085  (syntax-rules ()
     1086    ((_ (name . llist) body ...)
     1087     (define-compiler-syntax name (lambda llist body ...)))
     1088    ((_ name transformer)
     1089     (##core#define-compiler-syntax name transformer)))))
     1090
     1091
    10801092;;; Just in case someone forgets
    10811093
  • chicken/trunk/compiler.scm

    r15059 r15060  
    143143; (define-compiled-syntax <symbol> <expr>)
    144144; (define-compiled-syntax (<symbol> . <llist>) <expr> ...)
     145; (##core#define-compiler-syntax <symbol> <expr>)
    145146; (##core#module <symbol> #t | (<name> | (<name> ...) ...) <body>)
    146147
     
    745746                        (let* ((var (if (pair? (cadr x)) (caadr x) (cadr x)))
    746747                               (body (if (pair? (cadr x))
    747                                          `(,(macro-alias 'lambda se) ,(cdadr x) ,@(cddr x))
     748                                         `(##core#lambda ,(cdadr x) ,@(cddr x))
    748749                                         (caddr x)))
    749750                               (name (lookup var se)))
     
    771772                        (let* ((var (if (pair? (cadr x)) (caadr x) (cadr x)))
    772773                               (body (if (pair? (cadr x))
    773                                          `(,(macro-alias 'lambda se) ,(cdadr x) ,@(cddr x))
     774                                         `(##core#lambda ,(cdadr x) ,@(cddr x))
    774775                                         (caddr x)))
    775776                               (name (lookup var se)))
     
    786787                              ,body)) ;*** possibly wrong se?
    787788                           e se dest)))
     789
     790                       ((##core#define-compiler-syntax)
     791                        (let* ((var (cadr x))
     792                               (body (caddr x))
     793                               (name (##sys#strip-syntax var se #t)))
     794                          (##sys#put!
     795                           name
     796                           '##compiler#compiler-syntax
     797                           (cons
     798                            (##sys#er-transformer (eval/meta body))
     799                            (##sys#current-environment)))
     800                          (walk '(##core#undefined) e se dest)) )
    788801
    789802                       ((##core#module)
     
    876889
    877890                       ((##core#named-lambda)
    878                         (walk `(,(macro-alias 'lambda se) ,@(cddr x)) e se (cadr x)) )
     891                        (walk `(##core#lambda ,@(cddr x)) e se (cadr x)) )
    879892
    880893                       ((##core#loop-lambda)
     
    10231036                                    (hide-variable ret)
    10241037                                    (walk
    1025                                      `(,(macro-alias 'begin se)
     1038                                     `(##core#begin
    10261039                                        (define ,arg ,(first conv))
    10271040                                        (define
     
    10651078                                         ("C_a_i_bytevector" ,(+ 2 size))
    10661079                                         ',size)) ) )
    1067                                (,(macro-alias 'begin se)
     1080                               (##core#begin
    10681081                                ,@(if init
    10691082                                      `((##core#set! ,alias ,init))
     
    10901103                                           valexp
    10911104                                           (eval
    1092                                             `(,(macro-alias 'let se)
     1105                                            `(##core#let
    10931106                                              ,defconstant-bindings ,valexp)) ) ) ] )
    10941107                           (set! constants-used #t)
     
    11071120                        ((##core#declare)
    11081121                         (walk
    1109                           `(,(macro-alias 'begin se)
     1122                          `(##core#begin
    11101123                             ,@(map (lambda (d)
    11111124                                      (process-declaration d se))
     
    11341147                               ,(walk `(##core#lambda
    11351148                                        ,vars
    1136                                         (,(macro-alias 'let se)
     1149                                        (##core#let
    11371150                                         ,(let loop ([vars vars] [types atypes])
    11381151                                            (if (null? vars)
     
    11481161                                                   (loop (cdr vars) (cdr types)) ) ) ) )
    11491162                                         ,(foreign-type-convert-argument
    1150                                            `(,(macro-alias 'let se)
     1163                                           `(##core#let
    11511164                                             ()
    11521165                                             ,@(cond
     
    11581171                                                    nonnull-c-string))
    11591172                                                 `((##sys#make-c-string
    1160                                                     (,(macro-alias 'let se)
     1173                                                    (##core#let
    11611174                                                     () ,@(cddr lam)))))
    11621175                                                ((member
     
    11781191                                                    unsigned-c-string
    11791192                                                    (const c-string)) )
    1180                                                  `((,(macro-alias 'let se)
    1181                                                     ((r (,(macro-alias 'let se)
    1182                                                          () ,@(cddr lam))))
     1193                                                 `((##core#let
     1194                                                    ((r (##core#let () ,@(cddr lam))))
    11831195                                                    (,(macro-alias 'and se)
    11841196                                                     r
     
    12371249             (let ([llist (cadr lexp)])
    12381250               (if (and (proper-list? llist) (= (llist-length llist) (length args)))
    1239                    (walk `(,(macro-alias 'let se)
     1251                   (walk `(##core#let
    12401252                           ,(map list llist args) ,@(cddr lexp))
    12411253                         e se dest)
    12421254                   (let ((var (gensym 't)))
    12431255                     (walk
    1244                       `(,(macro-alias 'let se)
     1256                      `(##core#let
    12451257                        ((,var ,(car x)))
    12461258                        (,var ,@(cdr x)) )
     
    12581270  ;; Process visited definitions and main expression:
    12591271  (walk
    1260    `(,(macro-alias 'begin '())
     1272   `(##core#begin
    12611273     ,@(let ([p (reverse pending-canonicalizations)])
    12621274         (set! pending-canonicalizations '())
  • chicken/trunk/eval.scm

    r15057 r15060  
    632632                             (##sys#er-transformer (eval/meta body)))
    633633                            (compile '(##core#undefined) e #f tf cntr se) ) )
     634
     635                         ((##core#define-compiler-syntax)
     636                          (compile '(##core#undefined) e #f tf cntr se))
    634637
    635638                         ((##core#module)
  • chicken/trunk/tests/scrutiny.expected

    r15057 r15060  
    88  expected value of type boolean in conditional but were given a value of type `number' which is always true:
    99
    10 (if x7 '1 '2)
     10(if x3 '1 '2)
    1111
    1212Warning: in toplevel procedure `foo':
    1313  branches in conditional expression differ in the number of results:
    1414
    15 (if x10 (values '1 '2) (values '1 '2 (+ ...)))
     15(if x5 (values '1 '2) (values '1 '2 (+ ...)))
    1616
    1717Warning: at toplevel:
    18   expected argument #2 of type `number' in procedure call to `bar12' (line 18), but where given an argument of type `symbol'
     18  expected argument #2 of type `number' in procedure call to `bar6' (line 18), but where given an argument of type `symbol'
    1919
    2020Warning: at toplevel:
     
    2828
    2929Warning: at toplevel:
    30   expected in procedure call to `x17' (line 26) a value of type `(procedure () *)', but were given a value of type `fixnum'
     30  expected in procedure call to `x7' (line 26) a value of type `(procedure () *)', but were given a value of type `fixnum'
    3131
    3232Warning: at toplevel:
Note: See TracChangeset for help on using the changeset viewer.