Changeset 10209 in project


Ignore:
Timestamp:
03/29/08 14:28:03 (12 years ago)
Author:
felix winkelmann
Message:

a few makefile fixes (allow disabling HACKED_APPLY); internal versions of get/put!; compiler expands fac.scm, now; added synrules from riaxpander/R&K, but not integrated, yet

Location:
chicken/branches/beyond-hope
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/beyond-hope/Makefile.bsd

    r8361 r10209  
    8585        echo "#define C_NO_APPLY_HOOK" >>$@
    8686endif
    87 ifdef HACKED_APPLY
     87ifneq ($(HACKED_APPLY),)
    8888        echo "#define C_HACKED_APPLY" >>$@
    8989endif
  • chicken/branches/beyond-hope/Makefile.linux

    r8361 r10209  
    9090        echo "#define C_NO_APPLY_HOOK" >>$@
    9191endif
    92 ifdef HACKED_APPLY
     92ifneq ($(HACKED_APPLY),)
    9393        echo "#define C_HACKED_APPLY" >>$@
    9494endif
  • chicken/branches/beyond-hope/Makefile.macosx

    r8361 r10209  
    9595        echo "#define C_NO_APPLY_HOOK" >>$@
    9696endif
     97ifneq ($(HACKED_APPLY),)
    9798        echo "#define C_HACKED_APPLY" >>$@
     99endif
    98100        cat chicken-defaults.h >>$@
    99101
     
    109111LINKER_OPTIONS += -arch ppc -arch i386 -isysroot /Developer/SDKs/MacOSX10.4u.sdk
    110112
    111 ifdef HACKED_APPLY
     113ifneq ($(HACKED_APPLY),)
    112114# We undefine HACKED_APPLY in order to override rules.make.
    113115HACKED_APPLY=
  • chicken/branches/beyond-hope/Makefile.solaris

    r8361 r10209  
    8585        echo "#define C_NO_APPLY_HOOK" >>$@
    8686endif
    87 ifdef HACKED_APPLY
     87ifneq ($(HACKED_APPLY),)
    8888        echo "#define C_HACKED_APPLY" >>$@
    8989endif
  • chicken/branches/beyond-hope/TODO

    r10194 r10209  
    44* test local define{-values,-syntax,} expansion
    55* test referential transparency
     6* test interaction of hygienic and non-hygienic macros
     7* test pattern matching macros
     8* test extended lambda-lists
     9* test macro-expansions
     10** quoted literals
     11** keywords
     12** qualified symbols
     13** extended lambda-list markers
     14
     15* test r4rstest
     16* test benchmarks
     17
     18* reimplement default macros hygienically
     19* reimplement chicken-more-macros hygienically
     20
     21* integrate syntax-rules (synrules.scm)
     22
     23* add low-level support for modules
     24* find suitable design for modules
  • chicken/branches/beyond-hope/c-platform.scm

    r10119 r10209  
    100100       ##sys#profile-entry ##sys#profile-exit) ) ) )
    101101
    102 (define units-used-by-default '(library eval expand extras))
     102(define units-used-by-default '(library eval extras))
    103103(define words-per-flonum 4)
    104104(define parameter-limit 1024)
  • chicken/branches/beyond-hope/compiler.scm

    r10194 r10209  
    454454
    455455  (define (lookup id se)
    456     (cond ((get id '##sys#macro-alias))
     456    (cond ((##sys#get id '##sys#macro-alias))
    457457          ((find-id id se))             ;*** currently ignores global macro env - ok?
    458458          (else id)))
     
    460460  (define (macro-alias var se)
    461461    (let ((alias (gensym var)))
    462       (put! alias '##sys#macro-alias (lookup var se))
     462      (##sys#put! alias '##sys#macro-alias (lookup var se))
    463463      alias) )
    464464
     
    511511          ((not-pair? x)
    512512           (if (constant? x)
    513                `(,(macro-alias 'quote se) ,x)
     513               `(quote ,x)
    514514               (syntax-error "illegal atomic form" x)))
    515515          ((symbol? (car x))
     
    521521                   (syntax-error "malformed expression" x)))
    522522             (set! ##sys#syntax-error-culprit x)
    523              (let ((xexpanded (macroexpand x se)))
    524                (cond ((not (eq? x2 xexpanded))
    525                       (walk expanded se dest))
     523             (let ((name (lookup (car x) se))
     524                   (xexpanded (macroexpand x se)))
     525               (cond ((not (eq? x xexpanded))
     526                      (walk xexpanded se dest))
    526527                     
    527528                     [(and inline-table-used (##sys#hash-table-ref inline-table name))
     
    661662                                              ((##sys#compile-to-closure
    662663                                                (cadr b)
    663                                                 '() se)
     664                                                '() (##sys#current-meta-environment))
    664665                                               '()) ) ) )
    665666                                          (cadr x) )
     
    688689                           ms)
    689690                          (walk
    690                            (##sys#canonicalize-body (cddr x))
     691                           (##sys#canonicalize-body (cddr x) se2)
    691692                           se2 dest)))
    692693                               
     
    712713                                [ln (get-line x)]
    713714                                [val (walk (caddr x) se var0)] )
    714                            (cond ((eq? var var0) ; global?
    715                                   (set! var (##sys#alias-global-hook var))
    716                                   (when safe-globals-flag
    717                                     (set! always-bound-to-procedure
    718                                       (lset-adjoin eq? always-bound-to-procedure var))
    719                                     (set! always-bound (lset-adjoin eq? always-bound var)) )
    720                                   (when (macro? var)
    721                                     (compiler-warning
    722                                      'var "assigned global variable `~S' is a macro ~A"
    723                                      var
    724                                      (if ln (sprintf "in line ~S" ln) "") )
    725                                     (when undefine-shadowed-macros (undefine-macro! var) ) ) )
    726                                  ((keyword? var)
    727                                   (compiler-warning 'syntax "assignment to keyword `~S'" var) )
    728                                  ((pair? var) ; macro
    729                                   (syntax-error
    730                                    'set! "assignment to syntactic identifier" var))
    731                                 ((assq var foreign-variables)
    732                                   => (lambda (fv)
    733                                        (let ([type (second fv)]
    734                                              [tmp (gensym)] )
    735                                          `(let ([,tmp ,(foreign-type-convert-argument val type)])
    736                                             (##core#inline_update
    737                                              (,(third fv) ,type)
    738                                              ,(foreign-type-check tmp type) ) ) ) ) )
     715                           (when (eq? var var0) ; global?
     716                             (set! var (##sys#alias-global-hook var))
     717                             (when safe-globals-flag
     718                               (set! always-bound-to-procedure
     719                                 (lset-adjoin eq? always-bound-to-procedure var))
     720                               (set! always-bound (lset-adjoin eq? always-bound var)) )
     721                             (when (macro? var)
     722                               (compiler-warning
     723                                'var "assigned global variable `~S' is a macro ~A"
     724                                var
     725                                (if ln (sprintf "in line ~S" ln) "") )
     726                               (when undefine-shadowed-macros (undefine-macro! var) ) ) )
     727                           (when (keyword? var)
     728                             (compiler-warning 'syntax "assignment to keyword `~S'" var) )
     729                           (when (pair? var) ; macro
     730                             (syntax-error
     731                              'set! "assignment to syntactic identifier" var))
     732                           (cond ((assq var foreign-variables)
     733                                   => (lambda (fv)
     734                                        (let ([type (second fv)]
     735                                              [tmp (gensym)] )
     736                                          `(let ([,tmp ,(foreign-type-convert-argument val type)])
     737                                             (##core#inline_update
     738                                              (,(third fv) ,type)
     739                                              ,(foreign-type-check tmp type) ) ) ) ) )
    739740                                 ((assq var location-pointer-map)
    740741                                  => (lambda (a)
  • chicken/branches/beyond-hope/defaults.make

    r9204 r10209  
    256256# bootstrapping compiler
    257257
    258 CHICKEN = chicken$(EXE)
     258CHICKEN ?= chicken$(EXE)
    259259
    260260# Scheme compiler flags
  • chicken/branches/beyond-hope/eval.scm

    r10194 r10209  
    236236
    237237(define ##sys#compile-to-closure
    238   (let ([macro? macro?]
    239         [write write]
     238  (let ([write write]
    240239        [reverse reverse]
    241240        [open-output-string open-output-string]
     
    563562                                              ((##sys#compile-to-closure
    564563                                                `(##sys#er-transformer ,(cadr b))
    565                                                 '() se)
     564                                                '() (##sys#current-meta-environment))
    566565                                               '() ) ) )
    567566                                           (cadr x) )
     
    579578                                             ((##sys#compile-to-closure
    580579                                               `(##sys#er-transformer ,(cadr b))
    581                                                '() se)
     580                                               '() (##sys#current-meta-environment))
    582581                                              '())))
    583582                                          (cadr x) ) )
     
    598597
    599598                         [(##core#require-for-syntax)
    600                           (let ([ids (map (lambda (x) ((##sys#compile-to-closure x '() se) '())) (cdr x))])
     599                          (let ([ids (map (lambda (x)
     600                                            ((##sys#compile-to-closure
     601                                              x '()
     602                                              (##sys#current-meta-environment) )
     603                                             '()))
     604                                          (cdr x))])
    601605                            (apply ##sys#require ids)
    602606                            (let ([rs (##sys#lookup-runtime-requirements ids)])
     
    617621
    618622                         [(##core#elaborationtimeonly ##core#elaborationtimetoo) ; <- Note this!
    619                           (##core#app (##sys#compile-to-closure (cadr x) '() se #f) '())
     623                          (##core#app
     624                           (##sys#compile-to-closure
     625                            (cadr x) '()
     626                            (##sys#current-meta-environment))
     627                           '())
    620628                          (compile '(##core#undefined) e #f tf cntr se) ]
    621629
     
    723731       ((fluid-let ([##sys#environment-is-mutable mut]
    724732                    [##sys#eval-environment e] )
    725           (##sys#compile-to-closure x '() '()) )
     733          (##sys#compile-to-closure x '() (##sys#current-environment)) )
    726734        '() ) ) ) ) )
    727735
     
    832840               (fluid-let ([##sys#read-error-with-line-number #t]
    833841                           [##sys#current-source-filename fname]
     842                           (##sys#current-environment ##sys#current-environment)
     843                           (##sys#current-meta-environment ##sys#current-meta-environment)
    834844                           [##sys#current-load-path
    835845                            (and fname
  • chicken/branches/beyond-hope/expand.scm

    r10194 r10209  
    3636;;; Syntactic environments
    3737
     38(define ##sys#current-environment (make-parameter '()))
     39(define ##sys#current-meta-environment (make-parameter '()))
     40
    3841(define (lookup id se)
    3942  (cond ((get id '##sys#macro-alias))
     
    7679    (apply ##sys#extend-macro-environment new def) ) )
    7780
    78 (define (macro? sym #!optional (senv '()))
     81(define (macro? sym #!optional (senv (##sys#current-environment)))
    7982  (##sys#check-symbol sym 'macro?)
    80   (##sys#check-pair? senv 'macro?)
     83  (##sys#check-list senv 'macro?)
    8184  (or (lookup sym senv)
    8285      (and (lookup sym ##sys#macro-environment) #t) ) )
     
    185188;;; User-level macroexpansion
    186189
    187 (define (macroexpand exp #!optional (me '()))
     190(define (macroexpand exp #!optional (me (##sys#current-environment)))
    188191  (let loop ([exp exp])
    189192    (let-values ([(exp2 m) (##sys#macroexpand-0 exp me)])
     
    192195          exp2) ) ) )
    193196
    194 (define (macroexpand-1 exp #!optional (me '()))
     197(define (macroexpand-1 exp #!optional (me (##sys#current-environment)))
    195198  (##sys#macroexpand-0 exp me) )
    196199
     
    311314  (let ([reverse reverse]
    312315        [map map] )
    313     (lambda (body #!optional (se '()))
     316    (lambda (body #!optional (se (##sys#current-environment)))
    314317      (define (fini vars vals mvars mvals body)
    315318        (pp `(FINI: ,vars ,vals ,mvars ,mvals ,body)) ;***
     
    466469        [get-line-number get-line-number]
    467470        [symbol->string symbol->string] )
    468     (lambda (id exp pat #!optional culprit (se '()))
     471    (lambda (id exp pat #!optional culprit (se (##sys#current-environment)))
    469472
    470473      (define (test x pred msg)
     
    850853             `(##sys#copy-macro ',val ',name)
    851854             `(##sys#extend-macro-environment
    852                ',name '()
     855               ',name
     856               (##sys#current-environment)
    853857               (##sys#lisp-transformer ,val)))))
    854858    (cond ((symbol? head)
     
    874878   (##sys#check-syntax 'define-syntax form '(define-syntax variable _) #f se)
    875879   `(,(if ##sys#enable-runtime-macros '##core#elaborationtimetoo '##core#elaborationtimeonly)
    876      (##sys#extend-macro-environment ',(cadr form) '() (##sys#er-transformer ,(caddr form))))))
     880     (##sys#extend-macro-environment
     881      ',(cadr form)
     882      (##sys#current-environment)
     883      (##sys#er-transformer ,(caddr form))))))
    877884
    878885
  • chicken/branches/beyond-hope/fac.scm

    r10194 r10209  
    55    (define (sub1 . _)
    66      (error "argh.") )
     7    (set! sub1 99)
    78    (print "fac: " n)
    89    (if (zero? n)
  • chicken/branches/beyond-hope/library.scm

    r9102 r10209  
    46874687;;; Property lists
    46884688
    4689 (define (put! sym prop val)
     4689(define (##sys#put! sym prop val)
    46904690  (##sys#check-symbol sym 'put!)
    46914691  (let loop ((plist (##sys#slot sym 2)))
     
    46954695  val)
    46964696
    4697 (define get
    4698   (getter-with-setter
    4699    (lambda (sym prop . default)
    4700      (##sys#check-symbol sym 'get)
    4701      (let loop ((plist (##sys#slot sym 2)))
    4702        (cond ((null? plist) (optional default #f))
    4703              ((eq? (##sys#slot plist 0) prop) (##sys#slot (##sys#slot plist 1) 0))
    4704              (else (loop (##sys#slot (##sys#slot plist 1) 1))))) )
    4705    put!) )
     4697(define put! ##sys#put!)
     4698
     4699(define (##sys#get sym prop . default)
     4700  (##sys#check-symbol sym 'get)
     4701  (let loop ((plist (##sys#slot sym 2)))
     4702    (cond ((null? plist) (optional default #f))
     4703          ((eq? (##sys#slot plist 0) prop) (##sys#slot (##sys#slot plist 1) 0))
     4704          (else (loop (##sys#slot (##sys#slot plist 1) 1))))) )
     4705
     4706(define get (getter-with-setter ##sys#get put!))
    47064707
    47074708(define (remprop! sym prop)
  • chicken/branches/beyond-hope/rules.make

    r10161 r10209  
    598598# assembler objects
    599599
    600 ifdef HACKED_APPLY
     600ifneq ($(HACKED_APPLY),)
    601601$(APPLY_HACK_OBJECT): apply-hack.$(ARCH).s
    602602        $(ASSEMBLER) $(ASSEMBLER_OPTIONS) $(ASSEMBLER_COMPILE_OPTION) $< $(ASSEMBLER_OUTPUT)
Note: See TracChangeset for help on using the changeset viewer.