Changeset 15037 in project for chicken


Ignore:
Timestamp:
06/19/09 09:18:41 (10 years ago)
Author:
felix winkelmann
Message:
  • warn if transformer returns original form
  • new bootstrap tarball
  • removed pre-cps pass
  • exceptions in module-finalization in compiler doesn't show backtrace
Location:
chicken/trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/batch-driver.scm

    r15016 r15037  
    3535  compiler-arguments process-command-line dump-nodes dump-undefined-globals
    3636  default-standard-bindings default-extended-bindings
    37   foldable-bindings dump-defined-globals apply-pre-cps-rewrite-rules!
     37  foldable-bindings dump-defined-globals
    3838  compiler-cleanup-hook disabled-warnings local-definitions inline-output-file
    3939  file-io-only undefine-shadowed-macros profiled-procedures
     
    497497               (compiler-warning
    498498                'style
    499                 "compiling extensions in unsafe mode is bad practice and should be avoided as it may be surprising to an unsuspecting user") )
     499                "compiling extensions in unsafe mode is bad practice and should be avoided") )
    500500
    501501             (set! ##sys#line-number-database line-number-database-2)
     
    550550                 (print-node "lambda lifted" '|L| node0)
    551551                 (set! first-analysis #t) )
    552 
    553                #;(begin
    554                  (begin-time)
    555                  (set! first-analysis #f)
    556                  (set! db (analyze 'rewrite node0))
    557                  (print-db "analysis" '|0| db 0)
    558                  (end-time "pre-analysis (rewrite)")
    559                  (begin-time)
    560                  (apply-pre-cps-rewrite-rules! node0 db)
    561                  (end-time "applying pre-CPS rewrite rules")
    562                  (print-node "applied pre-CPS rewrite rules" '|R| node0)
    563                  (set! first-analysis #t) )
    564 
     552               
    565553               (let ((req (concatenate (vector->list file-requirements))))
    566554                 (when (debugging 'M "; requirements:")
  • chicken/trunk/chicken.scm

    r15001 r15037  
    152152                (if (string? o) o (conc "-" o)) )
    153153               (loop rest) ] ) ) ) )
    154   (handle-exceptions ex
    155       (begin
    156         (print-error-message ex (current-error-port))
    157         (exit 1))
    158     (apply compile-source-file filename options) )
     154  (apply compile-source-file filename options)
    159155  (exit) )
  • chicken/trunk/compiler.scm

    r14999 r15037  
    9191;   ##compiler#unused -> BOOL
    9292;   ##compiler#foldable -> BOOL
    93 ;   ##compiler#rewrite -> PROCEDURE (see `apply-rewrite-rules!')
    9493
    9594; - Source language:
     
    815814                                              (cond
    816815                                               ((null? body)
    817                                                 (##sys#finalize-module (##sys#current-module))
     816                                                (handle-exceptions ex
     817                                                    (begin
     818                                                      ;; avoid backtrace
     819                                                      (print-error-message ex (current-error-port))
     820                                                      (exit 1))
     821                                                  (##sys#finalize-module (##sys#current-module)))
    818822                                                (cond ((assq name import-libraries) =>
    819823                                                       (lambda (il)
  • chicken/trunk/expand.scm

    r15020 r15037  
    260260             ex) )
    261261      (let ((exp2 (handler exp se dse)))
     262        (when (eq? exp exp2)
     263          (##sys#syntax-error-hook
     264           (string-append
     265            "syntax transformer for `" (symbol->string name)
     266            "' returns original form, which would result in non-termination")
     267           exp))
    262268        (dd `(,name --> ,exp2))
    263269        exp2)))
     
    290296                     (##sys#check-syntax 'let body '#(_ 2) #f dse)
    291297                     (let ([bindings (car body)])
    292                        (cond [(symbol? bindings)
     298                       (cond [(symbol? bindings) ; expand named let
    293299                              (##sys#check-syntax 'let body '(_ #((variable _) 0) . #(_ 1)) #f dse)
    294300                              (let ([bs (cadr body)])
     
    301307                                 #t) ) ]
    302308                             [else (values exp #f)] ) ) ]
    303                     [(and (memq head2 '(set! ##core#set!))
     309                    [(and (memq head2 '(set! ##core#set!)) ; "setter" syntax
    304310                          (pair? body)
    305311                          (pair? (car body)) )
  • chicken/trunk/optimizer.scm

    r14874 r15037  
    6262  parameter-limit eq-inline-operator optimizable-rest-argument-operators
    6363  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    64   make-random-name final-foreign-type inline-max-size simplified-ops apply-pre-cps-rewrite-rules!
     64  make-random-name final-foreign-type inline-max-size simplified-ops
    6565  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    6666  foreign-argument-conversion foreign-result-conversion foreign-type-convert-argument foreign-type-convert-result)
     
    18031803                (debugging 'p "moving liftables to toplevel...")
    18041804                (reconstruct! ls extra) ) ) ) ) ) ) ) )
    1805 
    1806 
    1807 ;;; Apply rewrite-rules to procedure calls
    1808 
    1809 (define (apply-pre-cps-rewrite-rules! node db)
    1810   (define (walk n)
    1811     (let ((class (node-class n))
    1812           (params (node-parameters n))
    1813           (subs (node-subexpressions n)))
    1814       (case class
    1815         ((##core#call)
    1816          (let* ((opnode (walk (first subs)))
    1817                 (proc (and (eq? '##core#variable (node-class opnode))
    1818                            (first (node-parameters opnode))) )
    1819                 (handler (and proc
    1820                               (intrinsic? proc)
    1821                               (##sys#get proc '##compiler#rewrite) ) ) )
    1822            (for-each walk (cdr subs))
    1823            (cond (handler
    1824                   (let ((info (and (pair? (cdr params))
    1825                                    (source-info->line (second params)))))
    1826                     (debugging 'o "applying rule" proc info)
    1827                     (copy-node! (handler proc (cdr subs) db walk) n)))
    1828                  (else n))))
    1829         (else
    1830          (for-each walk subs)))))
    1831   (walk node))
Note: See TracChangeset for help on using the changeset viewer.