Changeset 12088 in project
- Timestamp:
- 10/01/08 16:24:10 (12 years ago)
- Location:
- chicken/trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/trunk/TODO
r12021 r12088 1 TODO for macro/module system -*- Outline -*- 2 3 * trunk merge 4 12020 was last 1 TODO for trunk -*- Outline -*- 5 2 6 3 * macros … … 33 30 compile-/expansion-time), when import is #t and o import lib 34 31 exists. 32 33 * compiler 34 ** self-recursion optimization 35 what MacScheme called "benchmark-mode" (assume self-calls are recursion) 36 *** needs declaration or option, >= -O2 37 ** cross-module inlining 38 *** emit <sourcefile>.inline file with "-inline-global" (?) 39 *** "-inline-global" slurps *.inline files include-path (?) 40 ** compiler syntax 41 *** hygienic macro-expansion with "escape" option (expand orig. form normally) 35 42 36 43 * tests … … 74 81 *** reimport of imported id 75 82 *** unused defs? 76 77 * eggs78 ** sassy: convert to proper module79 ** port javahack, fmt, fps -
chicken/trunk/batch-driver.scm
r12086 r12088 361 361 (printf "debugging info: ~A~%~!" 362 362 (if emit-trace-info 363 " stacktrace"363 "calltrace" 364 364 "none") ) ) 365 365 (when profile -
chicken/trunk/compiler.scm
r12086 r12088 35 35 ; - Declaration specifiers: 36 36 ; 37 ; (unit <unitname>) 38 ; (uses {<unitname>}) 37 ; ([not] extended-bindings {<name>}) 38 ; ([not] inline {<var>}) 39 ; ([not] interrupts-enabled) 40 ; ([not] safe) 39 41 ; ([not] standard-bindings {<name>}) 40 42 ; ([not] usual-integrations {<name>}) 41 ; ([not] extended-bindings (<name>})42 43 ; ([number-type] <type>) 44 ; (always-bound {<name>}) 45 ; (block) 46 ; (block-global {<name>}) 47 ; (bound-to-procedure {<var>}) 48 ; (c-options {<opt>}) 49 ; (compile-syntax) 50 ; (custom-declare (<tag> <name> <filename> <arg> ...) <string> ...) 51 ; (disable-interrupts) 52 ; (disable-warning <class> ...) 53 ; (emit-import-library {<module> | (<module> <filename>)}) 54 ; (export {<name>}) 43 55 ; (fixnum-arithmetic) 44 ; (unsafe) 45 ; ([not] safe) 46 ; ([not] interrupts-enabled) 56 ; (foreign-declare {<string>}) 57 ; (hide {<name>}) 58 ; (import <symbol-or-string> ...) 59 ; (inline-limit <limit>) 60 ; (keep-shadowed-macros) 61 ; (lambda-lift) 62 ; (link-options {<opt>}) 63 ; (no-argc-checks) 47 64 ; (no-bound-checks) 48 ; (no-argc-checks)49 65 ; (no-procedure-checks) 50 66 ; (no-procedure-checks-for-usual-bindings) 51 ; (block-global {<name>}) 52 ; (lambda-lift) 53 ; (hide {<name>}) 54 ; (disable-interrupts) 55 ; (disable-warning <class> ...) 56 ; (always-bound {<name>}) 57 ; (foreign-declare {<string>}) 58 ; (block) 67 ; (post-process <string> ...) 68 ; (profile <symbol> ...) 69 ; (safe-globals) 59 70 ; (separate) 60 ; (compile-syntax) 61 ; (run-time-macros) DEPRECATED 62 ; (export {<name>}) 63 ; (safe-globals) 64 ; (custom-declare (<tag> <name> <filename> <arg> ...) <string> ...) 65 ; (data <tag1> <exp1> ...) 66 ; (post-process <string> ...) 67 ; (keep-shadowed-macros) 68 ; (import <symbol-or-string> ...) 71 ; (unit <unitname>) 72 ; (unsafe) 69 73 ; (unused <symbol> ...) 70 ; ( profile <symbol> ...)74 ; (uses {<unitname>}) 71 75 ; 72 76 ; <type> = fixnum | generic … … 1351 1355 (set! unsafe #t)] 1352 1356 [else (compiler-warning 'syntax "illegal declaration specifier `~s'" id)]))])) 1353 (( run-time-macros compile-syntax) ;*** run-time-macros is DEPRECATED1357 ((compile-syntax) 1354 1358 (set! ##sys#enable-runtime-macros #t)) 1355 1359 ((block-global hide) … … 1742 1746 (walk (car subs) (append localenv env) vars id #f) 1743 1747 (set! toplevel-scope tl) 1748 ;; decorate ##core#call node with size 1744 1749 (set-car! (cdddr (node-parameters n)) (- current-program-size size0)) ) ) ) ) ) 1745 1750 -
chicken/trunk/misc/inl.scm
r12085 r12088 2 2 3 3 4 (define (node->sexpr n #!optional (port (current-output-port)))4 (define (node->sexpr n) 5 5 (let walk ((n n)) 6 6 `(,(node-class n) … … 13 13 (define (exported? var) 14 14 (and (##compiler#get db var 'global) 15 (not (##compiler#get db var 'standard-binding)) 16 (not (##compiler#get db var 'extended-binding)) 15 17 (or (memq var ##compiler#export-list) 16 18 (not (memq var ##compiler#block-globals))))) 17 (define (walk n e le dest)19 (define (walk n e le k dest) 18 20 (let ((params (node-parameters n)) 19 21 (subs (node-subexpressions n))) 22 ;(pp `(WALK: ,(node-class n) ,e ,le)) 20 23 (case (node-class n) 21 24 ((##core#variable) 22 25 (let ((var (car params))) 23 26 (cond ((memq var e) #t) 24 ((memq var le) 1) ; references lexical 27 ((memq var le) 1) ; references lexical variable 25 28 ((exported? var) #t) 26 29 (else #f)))) 27 30 ((let) 28 (and (walk (car subs) e le #f) 29 (walk (cadr subs) (cons (car params) e) le dest))) 31 (let* ((r (walk (car subs) e le k #f)) 32 (r2 (walk (cadr subs) (cons (car params) e) le k dest))) 33 (cond ((eq? r 1) (and r2 1)) 34 (r r2) 35 (else #f)))) 30 36 ((##core#lambda) 31 37 (##compiler#decompose-lambda-list 32 38 (third params) 33 39 (lambda (vars argc rest) 34 (cond ((walk (car subs) vars e #f) => 35 (lambda (r) 36 ;; if lambda doesn't refer to outer lexicals, collect 37 (when (and dest (not (eq? 1 r))) 38 (set! collected (alist-cons dest n collected))) 39 #t)) 40 (else #f))))) 40 (let ((k (and (pair? vars) (car vars)))) 41 (cond ((walk (car subs) vars (append e le) k #f) => 42 (lambda (r) 43 ;; if lambda doesn't refer to outer lexicals, collect 44 (when (and dest 45 (not (eq? 1 r)) 46 (not (memq dest ##compiler#not-inline-list)) 47 (or (memq dest ##compiler#not-inline-list) 48 (<= (fourth params) ##compiler#inline-max-size))) 49 (set! collected (alist-cons dest n collected))) 50 #t)) 51 (else #f)))))) 41 52 ((set!) 42 53 (let ((var (car params))) 43 (walk (car subs) e le (and (exported? var) var))))54 (walk (car subs) e le k (and (exported? var) var)))) 44 55 ((##core#callunit) #f) 56 ((##core#call) 57 ;; only allow continuation-calls (i.e. returns) and self-recursion 58 (and (eq? '##core#variable (node-class (car subs))) 59 (let ((var (car (node-parameters (car subs))))) 60 (or (eq? var k) 61 (eq? var dest))) 62 (every (cut walk <> e le k #f) subs))) 45 63 ((if) 46 (and (walk (first subs) e le #f)47 (walk (second subs) e le dest)48 (walk (third subs) e le dest)))49 (else (every (cut walk <> e le #f) subs)))))50 (walk node '() '() #f )64 (and (walk (first subs) e le k #f) 65 (walk (second subs) e le k dest) 66 (walk (third subs) e le k dest))) 67 (else (every (cut walk <> e le k #f) subs))))) 68 (walk node '() '() #f #f) 51 69 (for-each 52 70 (lambda (p)
Note: See TracChangeset
for help on using the changeset viewer.