steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove duplicated logic

db4
Slava Pestov 2008-11-11 09:10:33 -06:00
parent d50f4275d4
commit f04b32ea02
1 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/compiler/tree/propagation/recursive/recursive.factor
View File

@ -80,16 +80,19 @@ M: #recursive propagate-around ( #recursive -- )
: save-return-infos ( node infos -- ) : save-return-infos ( node infos -- )
swap out-d>> set-value-infos ; swap out-d>> set-value-infos ;
: unless-loop ( node quot -- )
[ dup label>> loop?>> [ drop ] ] dip if ; inline
M: #call-recursive propagate-before ( #call-recursive -- ) M: #call-recursive propagate-before ( #call-recursive -- )
[ [
[ ] [ latest-input-infos ] [ recursive-phi-infos ] tri [ ] [ latest-input-infos ] [ recursive-phi-infos ] tri
check-fixed-point check-fixed-point
] ]
[ [
dup label>> loop?>> [ drop ] [ [
[ ] [ return-infos ] [ node-output-infos ] tri [ ] [ return-infos ] [ node-output-infos ] tri
[ check-fixed-point ] [ drop save-return-infos ] 3bi [ check-fixed-point ] [ drop save-return-infos ] 3bi
] if ] unless-loop
] bi ; ] bi ;
M: #call-recursive annotate-node M: #call-recursive annotate-node
@ -99,10 +102,10 @@ M: #enter-recursive annotate-node
dup out-d>> (annotate-node) ; dup out-d>> (annotate-node) ;
M: #return-recursive propagate-before ( #return-recursive -- ) M: #return-recursive propagate-before ( #return-recursive -- )
dup label>> loop?>> [ drop ] [ [
[ ] [ latest-input-infos ] [ node-input-infos ] tri [ ] [ latest-input-infos ] [ node-input-infos ] tri
check-fixed-point check-fixed-point
] if ; ] unless-loop ;
M: #return-recursive annotate-node M: #return-recursive annotate-node
dup in-d>> (annotate-node) ; dup in-d>> (annotate-node) ;