dataflow optimizer improvement
parent
43cd7b171e
commit
dcac6687a0
|
@ -65,8 +65,6 @@
|
||||||
- intrinsic char-slot set-char-slot integer-slot set-integer-slot
|
- intrinsic char-slot set-char-slot integer-slot set-integer-slot
|
||||||
- [ [ dup call ] dup call ] infer hangs
|
- [ [ dup call ] dup call ] infer hangs
|
||||||
- declarations
|
- declarations
|
||||||
displaced, register and other predicates need to inherit from list
|
|
||||||
not cons, and need stronger branch partial eval
|
|
||||||
- optimize away arithmetic dispatch
|
- optimize away arithmetic dispatch
|
||||||
- the invalid recursion form case needs to be fixed, for inlines too
|
- the invalid recursion form case needs to be fixed, for inlines too
|
||||||
- #jump-f #jump-f-label
|
- #jump-f #jump-f-label
|
||||||
|
@ -83,6 +81,7 @@
|
||||||
|
|
||||||
+ kernel:
|
+ kernel:
|
||||||
|
|
||||||
|
- clear "predicating" word prop when redefining words
|
||||||
- there is a problem with hashcodes of words and bootstrapping
|
- there is a problem with hashcodes of words and bootstrapping
|
||||||
- delegating generic words with a non-standard picker
|
- delegating generic words with a non-standard picker
|
||||||
- powerpc has weird callstack residue
|
- powerpc has weird callstack residue
|
||||||
|
|
|
@ -96,7 +96,7 @@ M: object find ( seq quot -- i elt )
|
||||||
: subset-with ( obj seq quot -- seq | quot: obj elt -- ? )
|
: subset-with ( obj seq quot -- seq | quot: obj elt -- ? )
|
||||||
swap [ with rot ] subset 2nip ; inline
|
swap [ with rot ] subset 2nip ; inline
|
||||||
|
|
||||||
: fiber? ( seq quot -- ? | quot: elt elt -- ? )
|
: every? ( seq quot -- ? | quot: elt elt -- ? )
|
||||||
#! Tests if all elements are equivalent under the relation.
|
#! Tests if all elements are equivalent under the relation.
|
||||||
over empty?
|
over empty?
|
||||||
[ 2drop t ] [ >r [ first ] keep r> all-with? ] ifte ; inline
|
[ 2drop t ] [ >r [ first ] keep r> all-with? ] ifte ; inline
|
||||||
|
|
|
@ -13,9 +13,6 @@ presentation sequences strings styles unparser words ;
|
||||||
[[ CHAR: " """ ]]
|
[[ CHAR: " """ ]]
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
: char>entity ( ch -- str )
|
|
||||||
dup >r html-entities assoc dup r> ? ;
|
|
||||||
|
|
||||||
: chars>entities ( str -- str )
|
: chars>entities ( str -- str )
|
||||||
#! Convert <, >, &, ' and " to HTML entities.
|
#! Convert <, >, &, ' and " to HTML entities.
|
||||||
[
|
[
|
||||||
|
|
|
@ -13,7 +13,7 @@ namespaces prettyprint sequences strings vectors words ;
|
||||||
: unify-results ( seq -- value )
|
: unify-results ( seq -- value )
|
||||||
#! If all values in list are equal, return the value.
|
#! If all values in list are equal, return the value.
|
||||||
#! Otherwise, unify.
|
#! Otherwise, unify.
|
||||||
dup [ eq? ] fiber? [ first ] [ <meet> ] ifte ;
|
dup [ eq? ] every? [ first ] [ <meet> ] ifte ;
|
||||||
|
|
||||||
: unify-stacks ( seq -- stack )
|
: unify-stacks ( seq -- stack )
|
||||||
#! Replace differing literals in stacks with unknown
|
#! Replace differing literals in stacks with unknown
|
||||||
|
@ -21,7 +21,7 @@ namespaces prettyprint sequences strings vectors words ;
|
||||||
unify-lengths seq-transpose [ unify-results ] map ;
|
unify-lengths seq-transpose [ unify-results ] map ;
|
||||||
|
|
||||||
: balanced? ( in out -- ? )
|
: balanced? ( in out -- ? )
|
||||||
[ swap length swap length - ] 2map [ = ] fiber? ;
|
[ swap length swap length - ] 2map [ = ] every? ;
|
||||||
|
|
||||||
: unify-effect ( in out -- in out )
|
: unify-effect ( in out -- in out )
|
||||||
2dup balanced?
|
2dup balanced?
|
||||||
|
|
|
@ -88,7 +88,7 @@ M: node child-ties ( node -- seq )
|
||||||
M: #call infer-classes* ( node -- )
|
M: #call infer-classes* ( node -- )
|
||||||
dup create-ties
|
dup create-ties
|
||||||
dup node-param "infer-effect" word-prop 2unseq
|
dup node-param "infer-effect" word-prop 2unseq
|
||||||
pick node-out-d assume-classes
|
pick node-out-d intersect-classes
|
||||||
swap node-in-d intersect-classes ;
|
swap node-in-d intersect-classes ;
|
||||||
|
|
||||||
M: #push infer-classes* ( node -- )
|
M: #push infer-classes* ( node -- )
|
||||||
|
|
|
@ -232,7 +232,7 @@ M: #values can-kill* ( literal node -- ? )
|
||||||
dupd uses-value? [
|
dupd uses-value? [
|
||||||
branch-returns get
|
branch-returns get
|
||||||
[ memq? ] subset-with
|
[ memq? ] subset-with
|
||||||
[ [ eq? ] fiber? ] all?
|
[ [ eq? ] every? ] all?
|
||||||
] [
|
] [
|
||||||
drop t
|
drop t
|
||||||
] ifte ;
|
] ifte ;
|
||||||
|
|
|
@ -56,4 +56,4 @@ C: wrapper-stream ( stream -- stream )
|
||||||
] keep ;
|
] keep ;
|
||||||
|
|
||||||
: with-wrapper ( stream quot -- )
|
: with-wrapper ( stream quot -- )
|
||||||
>r wrapper-stream-scope r> bind ;
|
>r wrapper-stream-scope r> bind ; inline
|
||||||
|
|
|
@ -77,7 +77,7 @@ M: word prettyprint* ( indent word -- indent )
|
||||||
over recursion-check [ cons ] change
|
over recursion-check [ cons ] change
|
||||||
call
|
call
|
||||||
recursion-check [ cdr ] change
|
recursion-check [ cdr ] change
|
||||||
] ifte ;
|
] ifte ; inline
|
||||||
|
|
||||||
: prettyprint-sequence ( indent start list end -- indent )
|
: prettyprint-sequence ( indent start list end -- indent )
|
||||||
#! Prettyprint a list, with start/end delimiters; eg, [ ],
|
#! Prettyprint a list, with start/end delimiters; eg, [ ],
|
||||||
|
|
|
@ -16,10 +16,10 @@ USE: sequences
|
||||||
[ [ "2 + 2" ] ] [ [ "2 + 2" ] [ lexi> ] sort ] unit-test
|
[ [ "2 + 2" ] ] [ [ "2 + 2" ] [ lexi> ] sort ] unit-test
|
||||||
[ [ 1 2 3 4 5 6 7 ] ] [ [ 6 4 5 7 2 1 3 ] [ > ] sort ] unit-test
|
[ [ 1 2 3 4 5 6 7 ] ] [ [ 6 4 5 7 2 1 3 ] [ > ] sort ] unit-test
|
||||||
|
|
||||||
[ f ] [ [ { } { } "Hello" ] [ = ] fiber? ] unit-test
|
[ f ] [ [ { } { } "Hello" ] [ = ] every? ] unit-test
|
||||||
[ f ] [ [ { 2 } { } { } ] [ = ] fiber? ] unit-test
|
[ f ] [ [ { 2 } { } { } ] [ = ] every? ] unit-test
|
||||||
[ t ] [ [ ] [ = ] fiber? ] unit-test
|
[ t ] [ [ ] [ = ] every? ] unit-test
|
||||||
[ t ] [ [ 1/2 ] [ = ] fiber? ] unit-test
|
[ t ] [ [ 1/2 ] [ = ] every? ] unit-test
|
||||||
[ t ] [ [ 1.0 10/10 1 ] [ = ] fiber? ] unit-test
|
[ t ] [ [ 1.0 10/10 1 ] [ = ] every? ] unit-test
|
||||||
|
|
||||||
[ [ 2 3 4 ] ] [ 1 [ 1 2 3 ] [ + ] map-with ] unit-test
|
[ [ 2 3 4 ] ] [ 1 [ 1 2 3 ] [ + ] map-with ] unit-test
|
||||||
|
|
Loading…
Reference in New Issue