Changeset 12088 in project


Ignore:
Timestamp:
10/01/08 16:24:10 (12 years ago)
Author:
felix winkelmann
Message:

fixes in inl.scm

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
     1TODO for trunk                                          -*- Outline -*-
    52
    63* macros
     
    3330    compile-/expansion-time), when import is #t and o import lib
    3431    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)
    3542
    3643* tests
     
    7481*** reimport of imported id
    7582*** unused defs?
    76 
    77 * eggs
    78 ** sassy: convert to proper module
    79 ** port javahack, fmt, fps
  • chicken/trunk/batch-driver.scm

    r12086 r12088  
    361361      (printf "debugging info: ~A~%~!"
    362362              (if emit-trace-info
    363                   "stacktrace"
     363                  "calltrace"
    364364                  "none") ) )
    365365    (when profile
  • chicken/trunk/compiler.scm

    r12086 r12088  
    3535; - Declaration specifiers:
    3636;
    37 ; (unit <unitname>)
    38 ; (uses {<unitname>})
     37; ([not] extended-bindings {<name>})
     38; ([not] inline {<var>})
     39; ([not] interrupts-enabled)
     40; ([not] safe)
    3941; ([not] standard-bindings {<name>})
    4042; ([not] usual-integrations {<name>})
    41 ; ([not] extended-bindings (<name>})
    4243; ([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>})
    4355; (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)
    4764; (no-bound-checks)
    48 ; (no-argc-checks)
    4965; (no-procedure-checks)
    5066; (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)
    5970; (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)
    6973; (unused <symbol> ...)
    70 ; (profile <symbol> ...)
     74; (uses {<unitname>})
    7175;
    7276;   <type> = fixnum | generic
     
    13511355                (set! unsafe #t)]
    13521356               [else (compiler-warning 'syntax "illegal declaration specifier `~s'" id)]))]))
    1353        ((run-time-macros compile-syntax) ;*** run-time-macros is DEPRECATED
     1357       ((compile-syntax)
    13541358        (set! ##sys#enable-runtime-macros #t))
    13551359       ((block-global hide)
     
    17421746                  (walk (car subs) (append localenv env) vars id #f)
    17431747                  (set! toplevel-scope tl)
     1748                  ;; decorate ##core#call node with size
    17441749                  (set-car! (cdddr (node-parameters n)) (- current-program-size size0)) ) ) ) ) )
    17451750         
  • chicken/trunk/misc/inl.scm

    r12085 r12088  
    22
    33
    4 (define (node->sexpr n #!optional (port (current-output-port)))
     4(define (node->sexpr n)
    55  (let walk ((n n))
    66    `(,(node-class n)
     
    1313    (define (exported? var)
    1414      (and (##compiler#get db var 'global)
     15           (not (##compiler#get db var 'standard-binding))
     16           (not (##compiler#get db var 'extended-binding))
    1517           (or (memq var ##compiler#export-list)
    1618               (not (memq var ##compiler#block-globals)))))
    17     (define (walk n e le dest)
     19    (define (walk n e le k dest)
    1820      (let ((params (node-parameters n))
    1921            (subs (node-subexpressions n)))
     22        ;(pp `(WALK: ,(node-class n) ,e ,le))
    2023        (case (node-class n)
    2124          ((##core#variable)
    2225           (let ((var (car params)))
    2326             (cond ((memq var e) #t)
    24                    ((memq var le) 1)    ; references lexical
     27                   ((memq var le) 1)    ; references lexical variable
    2528                   ((exported? var) #t)
    2629                   (else #f))))
    2730          ((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))))
    3036          ((##core#lambda)
    3137           (##compiler#decompose-lambda-list
    3238            (third params)
    3339            (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))))))
    4152          ((set!)
    4253           (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))))
    4455          ((##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)))
    4563          ((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)
    5169    (for-each
    5270     (lambda (p)
Note: See TracChangeset for help on using the changeset viewer.