more minor tweaks to make bootstrap faster
parent
8af5e755c6
commit
59854a2546
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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* , ;
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue