more minor tweaks to make bootstrap faster

cvs
Slava Pestov 2005-09-17 03:33:20 +00:00
parent 8af5e755c6
commit 59854a2546
6 changed files with 25 additions and 15 deletions

View File

@ -208,3 +208,8 @@ M: hashtable hashcode ( hash -- n )
#! Make a new hashtable with all key/value pairs from
#! hash1 and hash2. Values in hash2 take precedence.
>r clone dup r> hash-update ;
: remove-all ( hash seq -- seq )
#! Remove all elements from the sequence that are keys
#! in the hashtable.
[ swap hash* not ] subset-with ; flushable

View File

@ -36,9 +36,6 @@ M: object >list ( seq -- list ) dup length 0 rot (>list) ;
: memq? ( obj seq -- ? ) [ eq? ] contains-with? ; flushable
: remove ( obj list -- list ) [ = not ] subset-with ; flushable
: remove-all ( seq1 seq2 -- seq2-seq1 )
[ swap member? not ] subset-with ; flushable
: move ( to from seq -- )
pick pick number=
[ 3drop ] [ [ nth swap ] keep set-nth ] ifte ; inline

View File

@ -8,11 +8,11 @@ DEFER: standard-combination
DEFER: math-combination
: delegate ( object -- delegate )
dup tuple? [ 3 slot ] [ drop f ] ifte ; inline
dup tuple? [ 3 slot ] [ drop f ] ifte ;
: set-delegate ( delegate tuple -- )
dup tuple? [
3 set-slot
] [
"Only tuples can have delegates" throw
] ifte ; inline
] ifte ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: optimizer
USING: arrays generic hashtables inference kernel
USING: arrays generic hashtables inference kernel math
namespaces sequences ;
: node-union ( node quot -- hash | quot: node -- )
@ -27,9 +27,9 @@ GENERIC: returns* ( node -- )
M: f returns* drop ;
: kill-set ( node -- seq )
: kill-set ( node -- hash )
#! Push a list of literals that may be killed in the IR.
dup live-values swap literals hash-diff hash-keys ;
dup live-values swap literals hash-diff ;
: remove-values ( values node -- )
2dup [ node-in-d remove-all ] keep set-node-in-d
@ -37,8 +37,12 @@ M: f returns* drop ;
2dup [ node-in-r remove-all ] keep set-node-in-r
[ node-out-r remove-all ] keep set-node-out-r ;
: kill-node ( literals node -- )
[ remove-values ] each-node-with ;
: kill-node ( values node -- )
over hash-size 0 > [
[ remove-values ] each-node-with
] [
2drop
] ifte ;
! Generic nodes
M: node literals* ( node -- ) drop ;
@ -49,8 +53,12 @@ M: node live-values* ( node -- )
M: node returns* ( node -- seq ) node-successor returns* ;
! #shuffle
: shuffle-literals
[ dup literal? [ dup set ] [ drop ] ifte ] each ;
M: #shuffle literals* ( node -- )
node-out-d [ dup literal? [ dup set ] [ drop ] ifte ] each ;
dup node-out-d shuffle-literals
node-out-r shuffle-literals ;
! #return
M: #return returns* , ;

View File

@ -17,9 +17,7 @@ GENERIC: optimize-node* ( node -- node/t )
DEFER: optimize-node
: optimize-children ( node -- ? )
f swap [
node-children [ optimize-node swap >r or r> ] map
] keep set-node-children ;
f swap node-children [ optimize-node swap >r or r> ] inject ;
: optimize-node ( node -- node ? )
#! Outputs t if any changes were made.

View File

@ -12,7 +12,9 @@ USING: kernel lists namespaces sequences strings ;
: directory? ( file -- ? ) stat car ;
: directory ( dir -- list )
(directory) { "." ".." } swap remove-all string-sort ;
(directory)
{{ [[ "." "." ]] [[ ".." ".." ]] }}
swap remove-all string-sort ;
: file-length ( file -- length ) stat third ;