Changeset 15037 in project
- Timestamp:
- 06/19/09 09:18:41 (10 years ago)
- Location:
- chicken/trunk
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/trunk/batch-driver.scm
r15016 r15037 35 35 compiler-arguments process-command-line dump-nodes dump-undefined-globals 36 36 default-standard-bindings default-extended-bindings 37 foldable-bindings dump-defined-globals apply-pre-cps-rewrite-rules!37 foldable-bindings dump-defined-globals 38 38 compiler-cleanup-hook disabled-warnings local-definitions inline-output-file 39 39 file-io-only undefine-shadowed-macros profiled-procedures … … 497 497 (compiler-warning 498 498 '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") ) 500 500 501 501 (set! ##sys#line-number-database line-number-database-2) … … 550 550 (print-node "lambda lifted" '|L| node0) 551 551 (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 565 553 (let ((req (concatenate (vector->list file-requirements)))) 566 554 (when (debugging 'M "; requirements:") -
chicken/trunk/chicken.scm
r15001 r15037 152 152 (if (string? o) o (conc "-" o)) ) 153 153 (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) 159 155 (exit) ) -
chicken/trunk/compiler.scm
r14999 r15037 91 91 ; ##compiler#unused -> BOOL 92 92 ; ##compiler#foldable -> BOOL 93 ; ##compiler#rewrite -> PROCEDURE (see `apply-rewrite-rules!')94 93 95 94 ; - Source language: … … 815 814 (cond 816 815 ((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))) 818 822 (cond ((assq name import-libraries) => 819 823 (lambda (il) -
chicken/trunk/expand.scm
r15020 r15037 260 260 ex) ) 261 261 (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)) 262 268 (dd `(,name --> ,exp2)) 263 269 exp2))) … … 290 296 (##sys#check-syntax 'let body '#(_ 2) #f dse) 291 297 (let ([bindings (car body)]) 292 (cond [(symbol? bindings) 298 (cond [(symbol? bindings) ; expand named let 293 299 (##sys#check-syntax 'let body '(_ #((variable _) 0) . #(_ 1)) #f dse) 294 300 (let ([bs (cadr body)]) … … 301 307 #t) ) ] 302 308 [else (values exp #f)] ) ) ] 303 [(and (memq head2 '(set! ##core#set!)) 309 [(and (memq head2 '(set! ##core#set!)) ; "setter" syntax 304 310 (pair? body) 305 311 (pair? (car body)) ) -
chicken/trunk/optimizer.scm
r14874 r15037 62 62 parameter-limit eq-inline-operator optimizable-rest-argument-operators 63 63 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 65 65 generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration 66 66 foreign-argument-conversion foreign-result-conversion foreign-type-convert-argument foreign-type-convert-result) … … 1803 1803 (debugging 'p "moving liftables to toplevel...") 1804 1804 (reconstruct! ls extra) ) ) ) ) ) ) ) ) 1805 1806 1807 ;;; Apply rewrite-rules to procedure calls1808 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 class1815 ((##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 proc1820 (intrinsic? proc)1821 (##sys#get proc '##compiler#rewrite) ) ) )1822 (for-each walk (cdr subs))1823 (cond (handler1824 (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 (else1830 (for-each walk subs)))))1831 (walk node))
Note: See TracChangeset
for help on using the changeset viewer.