Changeset 12813 in project for chicken/trunk


Ignore:
Timestamp:
12/12/08 14:14:35 (12 years ago)
Author:
felix winkelmann
Message:

removed if-test-with-non-false-result optimization; added user-level rewrite rules; some compiler cleanup

Location:
chicken/trunk
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed

  • chicken/trunk/TODO

    r12786 r12813  
    1313*** when re-defining intrinsics, the compiler should warn and disable re-writes
    1414    add declaration to keep re-writes enabled for core library files
     15*** check in foreign.import.scm and compiler.import.scm whether the import
     16    took place in the compiler
    1517
    1618** expander
    … …  
    149151** libraries/build
    150152*** check use of paths with windows builds: proper handling of quoting and
    151     slashed on all shell configurations?
     153    slashes on all shell configurations?
    152154
    153155
    … …  
    179181
    180182** compiler
     183*** test define-rewrite-rule
     184**** use declarative interface?
    181185*** generate object-files in /tmp (or TMPDIR)?
    182186
    … …  
    203207*** rules.make should really be generated by a script
    204208*** need script to process import libraries for generating indices for doc.callcc.org
    205     then tell Toby about it
     209    then tell Toby Butzon about it
    206210
    207211
    … …  
    232236** compiler-support for get-keyword ?
    233237
    234 ** lambda-fusion / "fuse-and-dispatch" (suggested by Alex)
     238** lambda-fusion / "fuse-and-dispatch" (suggested by Alex Shinn)
    235239   convert groups of local lambdas referenced to only in operator-position into
    236240   looping lambda + dispatch (static variable can be used), otherwise similar to
    … …  
    238242*** new forms (after optimization, prepared language)
    239243    [##core#dispatch LAMBDABODY1 ... BODY]
    240     [##core#call/dispatch {INDEX} ARGUMENT1 ...}
     244    [##core#goto {INDEX} ARGUMENT1 ...}
     245
     246** lazy gensyms (see "lazy-gensyms" branch)
    241247
    242248** handle optional args primitively

  • chicken/trunk/batch-driver.scm

    r12803 r12813  
    3434 compiler
    3535  compiler-arguments process-command-line dump-nodes dump-undefined-globals
    36   default-standard-bindings default-extended-bindings side-effecting-standard-bindings
    37   non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    38   standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
     36  default-standard-bindings default-extended-bindings
     37  foldable-bindings
    3938  compiler-cleanup-hook disabled-warnings local-definitions inline-output-file
    4039  file-io-only undefine-shadowed-macros profiled-procedures

  • chicken/trunk/c-backend.scm

    r12631 r12813  
    3131(private compiler
    3232  compiler-arguments process-command-line find-early-refs
    33   default-standard-bindings default-extended-bindings side-effecting-standard-bindings
    34   non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings
    35   foldable-extended-bindings
    36   standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
     33  default-standard-bindings default-extended-bindings
     34  foldable-bindings
    3735  installation-home optimization-iterations debugging cleanup
    3836  file-io-only

  • chicken/trunk/c-platform.scm

    r12789 r12813  
    3131(private compiler
    3232  compiler-arguments process-command-line
    33   default-standard-bindings default-extended-bindings side-effecting-standard-bindings
    34   non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    35   standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
     33  default-standard-bindings default-extended-bindings
     34  foldable-bindings non-foldable-bindings
    3635  installation-home debugging intrinsic?
    3736  dump-nodes unlikely-variables
    … …  
    197196    ##sys#intern-symbol ##sys#make-symbol ##sys#null-pointer? ##sys#peek-byte) )
    198197
    199 (define side-effecting-standard-bindings
    200   '(apply call-with-current-continuation set-car! set-cdr! write-char newline write display
     198(define non-foldable-bindings
     199  '(vector
     200    cons list string make-vector make-string string->symbol values current-input-port current-output-port
     201    read-char write-char
     202    apply call-with-current-continuation set-car! set-cdr! write-char newline write display
    201203    peek-char char-ready?
    202204    read read-char for-each map string-set! vector-set! string-fill! vector-fill! open-input-file
    203205    open-output-file close-input-port close-output-port call-with-input-port call-with-output-port
    204     call-with-values eval) )
    205 
    206 (define non-foldable-standard-bindings
    207   '(vector cons list string make-vector make-string string->symbol values current-input-port current-output-port
    208            read-char write-char) )
    209 
    210 (define foldable-standard-bindings
    211   (lset-difference
    212    eq? default-standard-bindings
    213    side-effecting-standard-bindings non-foldable-standard-bindings) )
    214 
    215 (define non-foldable-extended-bindings
    216   '(##sys#slot ##sys#setslot ##sys#call-with-current-continuation ##sys#fudge flush-output print void
     206    call-with-values eval
     207    ##sys#slot ##sys#setslot ##sys#call-with-current-continuation ##sys#fudge flush-output print void
    217208    u8vector->blob/shared s8vector->blob/shared u16vector->blob/shared s16vector->blob/shared u32vector->blob/shared
    218209    f32vector->blob/shared f64vector->blob/shared
    … …  
    226217    ##sys#intern-symbol ##sys#make-symbol make-record-instance error cpu-time ##sys#block-set!) )
    227218
    228 (define foldable-extended-bindings
    229   (lset-difference
    230    eq? default-extended-bindings non-foldable-extended-bindings) )
    231 
    232 (define standard-bindings-that-never-return-false
    233   '(cons list length * - + / current-output-port current-input-port append symbol->string char->integer
    234     integer->char vector-length string-length string-ref gcd lcm reverse string->symbol max min
    235     quotient remainder modulo floor ceiling truncate round exact->inexact inexact->exact exp log sin
    236     cons tan atan expt sqrt asin acos number->string char-upcase char-downcase string-append string
    237     string->list list->string vector->list list->vector read-char substring make-string make-vector
    238     open-input-file open-output-file vector write-char) )
    239 
    240 (define side-effect-free-standard-bindings-that-never-return-false
    241   (lset-difference
    242    eq? standard-bindings-that-never-return-false
    243    side-effecting-standard-bindings) )
     219(define foldable-bindings
     220  (lset-difference
     221   eq?
     222   (lset-union eq? default-standard-bindings default-extended-bindings)
     223   non-foldable-bindings) )
    244224
    245225

  • chicken/trunk/chicken-syntax.scm

    r12632 r12813  
    10721072
    10731073
    1074 ;;; just in case someone forgets
     1074;;; Just in case someone forgets
    10751075
    10761076(##sys#extend-macro-environment

  • chicken/trunk/chicken.scm

    r12559 r12813  
    3434(private compiler
    3535  compiler-arguments
    36   default-standard-bindings default-extended-bindings side-effecting-standard-bindings
    37   non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    38   standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
     36  default-standard-bindings default-extended-bindings
     37  foldable-bindings
    3938  installation-home optimization-iterations process-command-line
    4039  file-io-only nonwinding-call/cc debugging

  • chicken/trunk/compiler.scm

    r12610 r12813  
    8888;   ##compiler#profile -> BOOL
    8989;   ##compiler#unused -> BOOL
     90;   ##compiler#foldable -> BOOL
    9091
    9192; - Source language:
    … …  
    141142; (define-compiled-syntax (<symbol> . <llist>) <expr> ...)
    142143; (##core#module <symbol> #t | (<name> | (<name> ...) ...) <body>)
     144; (##core#define-rewrite-rule <symbol> <expr>)
    143145
    144146; - Core language:
    … …  
    219221;   potential-value -> <node>                Global variable was assigned this value
    220222;   references -> (<node> ...)               Nodes that are accesses of this variable (##core#variable nodes)
    221 ;   side-effecting -> <boolean>              If true: variable names side-effecting standard-binding
    222 ;   foldable -> <boolean>                    If true: variable names foldable standard-binding
    223223;   boxed -> <boolean>                       If true: variable has to be boxed after closure-conversion
    224224;   contractable -> <boolean>                If true: variable names contractable procedure
    … …  
    270270(private compiler
    271271  compiler-arguments process-command-line explicit-use-flag
    272   default-standard-bindings default-extended-bindings side-effecting-standard-bindings
    273   non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    274   standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
     272  default-standard-bindings default-extended-bindings
     273  foldable-bindings
    275274  installation-home decompose-lambda-list external-to-pointer defconstant-bindings constant-declarations
    276275  copy-node! error-is-extended-binding toplevel-scope toplevel-lambda-id
    … …  
    293292  perform-closure-conversion prepare-for-code-generation compiler-source-file create-foreign-stub
    294293  expand-foreign-lambda* data-declarations emit-control-file-item expand-foreign-primitive
    295   process-declaration external-protos-first basic-literal?
     294  process-declaration external-protos-first basic-literal? rewrite
    296295  transform-direct-lambdas! expand-foreign-callback-lambda* debugging emit-unsafe-marker
    297296  debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list
    … …  
    789788                              ,body)) ;*** possibly wrong se?
    790789                           se dest)))
     790
     791                       ((##core#define-rewrite-rule)
     792                        (let ((name (##sys#strip-syntax (cadr x) se #t))
     793                              (re (caddr x)))
     794                          (##sys#put! name '##compiler#intrinsic 'rewrite)
     795                          (rewrite
     796                           name 8
     797                           (eval/meta re))
     798                          '(##core#undefined)))
    791799
    792800                       ((##core#module)

  • chicken/trunk/defaults.make

    r12789 r12813  
    341341CHICKEN_BUG_PROGRAM = $(PROGRAM_PREFIX)chicken-bug$(PROGRAM_SUFFIX)
    342342IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix srfi-13 srfi-69 extras \
    343         regex srfi-14 tcp foreign scheme srfi-18 utils csi
     343        regex srfi-14 tcp foreign compiler scheme srfi-18 utils csi
    344344IMPORT_LIBRARIES += setup-api setup-download
    345345

  • chicken/trunk/distribution/manifest

    r12786 r12813  
    296296foreign.import.scm
    297297foreign.import.c
     298compiler.import.scm
     299compiler.import.c
    298300lolevel.import.scm
    299301srfi-1.import.scm

  • chicken/trunk/foreign.import.scm

    r10754 r12813  
    1 ;;;; foreign.import.scm - import library for "foreign" module
     1;;;; foreign.import.scm - import library for "foreign" pseudo module
    22;
    33; Copyright (c) 2008, The Chicken Team

  • chicken/trunk/optimizer.scm

    r12301 r12813  
    3030(private compiler
    3131  compiler-arguments process-command-line perform-lambda-lifting!
    32   default-standard-bindings default-extended-bindings side-effecting-standard-bindings
    33   non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    34   standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
     32  default-standard-bindings default-extended-bindings
     33  foldable-bindings
    3534  installation-home decompose-lambda-list external-to-pointer
    3635  copy-node! variable-visible? mark-variable intrinsic?
    … …  
    194193                    (let ((var (first (node-parameters (car subs)))))
    195194                      (if (and (intrinsic? var)
    196                                (test var 'foldable)
     195                               (foldable? var)
    197196                               (every constant-node? (cddr subs)) )
    198197                          (let ((form (cons var (map (lambda (arg) `(quote ,(node-value arg)))
    … …  
    491490         (or (test 'not 'call-sites) '()) ) )
    492491   
    493     ;; Handle '(if (<func> <a> ...) ...)', where <func> never returns false:
    494     (for-each
    495      (lambda (varname)
    496        (if (intrinsic? varname)
    497            (for-each
    498             (lambda (site)
    499               (let* ((n (cdr site))
    500                      (subs (node-subexpressions n))
    501                      (kont (first (node-parameters (second subs))))
    502                      (krefs (test kont 'references))
    503                      (lnode (and (not (test kont 'unknown)) (test kont 'value))) )
    504                 ;; Call-site has side-effect-free arguments and a known continuation that has only one use?
    505                 (if (and lnode
    506                          (eq? '##core#lambda (node-class lnode))
    507                          krefs (= 1 (length krefs))
    508                          (not (any (lambda (sn) (expression-has-side-effects? sn db)) (cddr subs))) )
    509                     (let* ((llist (third (node-parameters lnode)))
    510                            (body (first (node-subexpressions lnode))) )
    511                       ;; Continuation has one parameter and contains an 'if' node?
    512                       (if (and (proper-list? llist)
    513                                (null? (cdr llist))
    514                                (eq? 'if (node-class body)) )
    515                           (let* ((var (car llist))
    516                                  (refs (test var 'references))
    517                                  (iftest (first (node-subexpressions body))) )
    518                             ;; Parameter is used only once and is the test-argument?
    519                             (if (and refs (= 1 (length refs))
    520                                      (eq? '##core#variable (node-class iftest))
    521                                      (eq? var (first (node-parameters iftest))) )
    522                                 (let ((bodysubs (node-subexpressions body)))
    523                                   ;; Modify call-site to call continuation directly and swap branches
    524                                   ;;  in the conditional:
    525                                   (debugging 'o "removed call in test-context" varname)
    526                                   (node-parameters-set! n '(#t))
    527                                   (node-subexpressions-set! n (list (second subs) (qnode #t)))
    528                                   (touch) ) ) ) ) ) ) ) )
    529             (or (test varname 'call-sites) '()) ) ) )
    530      side-effect-free-standard-bindings-that-never-return-false)
    531 
    532492    (when (> removed-nots 0) (debugging 'o "Removed `not' forms" removed-nots))
    533493    dirty) )

  • chicken/trunk/rules.make

    r12789 r12813  
    554554          $(HOST_C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(HOST_C_COMPILER_OUTPUT)
    555555foreign.import$(O): foreign.import.c chicken.h $(CHICKEN_CONFIG_H)
     556        $(HOST_C_COMPILER) $(HOST_C_COMPILER_OPTIONS) $(HOST_C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) -DC_SHARED \
     557          $(HOST_C_COMPILER_COMPILE_OPTION) $(HOST_C_COMPILER_OPTIMIZATION_OPTIONS) $(HOST_C_COMPILER_SHARED_OPTIONS) \
     558          $(HOST_C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(HOST_C_COMPILER_OUTPUT)
     559compiler.import$(O): compiler.import.c chicken.h $(CHICKEN_CONFIG_H)
    556560        $(HOST_C_COMPILER) $(HOST_C_COMPILER_OPTIONS) $(HOST_C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) -DC_SHARED \
    557561          $(HOST_C_COMPILER_COMPILE_OPTION) $(HOST_C_COMPILER_OPTIMIZATION_OPTIONS) $(HOST_C_COMPILER_SHARED_OPTIONS) \
    … …  
    11051109        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/tcp.import.so
    11061110        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/foreign.import.so
     1111        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/compiler.import.so
    11071112        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/scheme.import.so
    11081113        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/csi.import.so
    … …  
    13131318foreign.import.c: $(SRCDIR)foreign.import.scm
    13141319        $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
     1320compiler.import.c: $(SRCDIR)compiler.import.scm
     1321        $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
    13151322scheme.import.c: $(SRCDIR)scheme.import.scm
    13161323        $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@

  • chicken/trunk/support.scm

    r12789 r12813  
    3131(private compiler
    3232  compiler-arguments process-command-line dump-nodes dump-undefined-globals
    33   default-standard-bindings default-extended-bindings side-effecting-standard-bindings
    34   non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    35   standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
     33  default-standard-bindings default-extended-bindings
     34  foldable-bindings compiler-macro-environment
    3635  installation-home optimization-iterations compiler-cleanup-hook decompose-lambda-list
    3736  file-io-only banner disabled-warnings internal-bindings
    … …  
    323322; - 'get' and 'put' shadow the routines in the extras-unit, we use low-level
    324323;   symbol-keyed hash-tables here.
     324; - does currently nothing after the first invocation, but we leave it
     325;   this way to have the option to add default entries for each new db.
    325326
    326327(define initialize-analysis-database
    327328  (let ((initial #t))
    328329    (lambda (db)
    329       (for-each
    330        (lambda (s)
    331          (when initial
    332            (mark-variable s '##compiler#intrinsic 'standard))
    333          (when (memq s side-effecting-standard-bindings) (put! db s 'side-effecting #t))
    334          (when (memq s foldable-standard-bindings) (put! db s 'foldable #t)) )
    335        standard-bindings)
    336       (for-each
    337        (lambda (s)
    338          (when initial
     330      (when initial
     331        (for-each
     332         (lambda (s)
     333           (mark-variable s '##compiler#intrinsic 'standard)
     334           (when (memq s foldable-bindings)
     335             (mark-variable s '##compiler#foldable #t)))
     336         standard-bindings)
     337        (for-each
     338         (lambda (s)
    339339           (mark-variable s '##compiler#intrinsic 'extended))
    340          (when (memq s foldable-extended-bindings) (put! db s 'foldable #t)) )
    341        extended-bindings)
    342       (when initial
     340         extended-bindings)
    343341        (for-each
    344342         (lambda (s)
    … …  
    414412(define display-analysis-database
    415413  (let ((names '((captured . cpt) (assigned . set) (boxed . box) (global . glo) (assigned-locally . stl)
    416                  (contractable . con) (standard-binding . stb) (foldable . fld) (simple . sim) (inlinable . inl)
    417                  (side-effecting . sef) (collapsable . col) (removable . rem) (constant . con)
     414                 (contractable . con) (standard-binding . stb) (simple . sim) (inlinable . inl)
     415                 (collapsable . col) (removable . rem) (constant . con)
    418416                 (undefined . und) (replacing . rpg) (unused . uud) (extended-binding . xtb) (inline-export . ilx)
    419417                 (customizable . cst) (has-unused-parameters . hup) (boxed-rest . bxr) ) )
    … …  
    438436                   (begin
    439437                     (case (caar es)
    440                        ((captured assigned boxed global contractable standard-binding foldable assigned-locally
    441                                   side-effecting collapsable removable undefined replacing unused simple inlinable inline-export
     438                       ((captured assigned boxed global contractable standard-binding assigned-locally
     439                                  collapsable removable undefined replacing unused simple inlinable inline-export
    442440                                  has-unused-parameters extended-binding customizable constant boxed-rest hidden-refs)
    443441                        (printf "\t~a" (cdr (assq (caar es) names))) )
    … …  
    14811479
    14821480(define intrinsic? (cut variable-mark <> '##compiler#intrinsic))
     1481(define foldable? (cut variable-mark <> '##compiler#foldable))
     1482
     1483
     1484;;; compiler-specific syntax
     1485
     1486(define compiler-macro-environment
     1487  (let ((me0 (##sys#macro-environment)))
     1488    (##sys#extend-macro-environment
     1489     'define-rewrite-rule
     1490     '()
     1491     (##sys#er-transformer
     1492      (lambda (form r c)
     1493        (##sys#check-syntax 'define-rewrite-rule form '(_ (symbol . _) . #(_ 1)))
     1494        `(##core#define-rewrite-rule
     1495          ,(caadr form) (,(r 'lambda) ,(cdadr form) ,@(cddr form))))))
     1496    (##sys#macro-subset me0)))
Note: See TracChangeset for help on using the changeset viewer.