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

Fix bug reported by Doug: smart combinators and inline words didn't mix very well in some cases

db4
Slava Pestov 2009-02-06 04:38:54 -06:00
parent 242638fc5c
commit 3166828f75
3 changed files with 38 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/combinators/smart/smart-tests.factor
View File

@ -37,3 +37,11 @@ IN: combinators.smart.tests
[ [
[ { 1 } { 2 } { 3 } ] B{ } append-outputs-as [ { 1 } { 2 } { 3 } ] B{ } append-outputs-as
] unit-test ] unit-test
! Test nesting
: nested-smart-combo-test ( -- array )
[ [ 1 2 ] output>array [ 3 4 ] output>array ] output>array ;
\ nested-smart-combo-test must-infer
[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test

15
basis/stack-checker/transforms/transforms-tests.factor
View File

@ -42,3 +42,18 @@ C: <color> color
[ bad-new-test ] must-infer [ bad-new-test ] must-infer
[ bad-new-test ] must-fail [ bad-new-test ] must-fail
! Corner case if macro expansion calls 'infer', found by Doug
DEFER: smart-combo ( quot -- )
\ smart-combo [ infer [ ] curry ] 1 define-transform
[ [ "a" "b" "c" ] smart-combo ] must-infer
[ [ [ "a" "b" ] smart-combo "c" ] smart-combo ] must-infer
: very-smart-combo ( quot -- ) smart-combo ; inline
[ [ "a" "b" "c" ] very-smart-combo ] must-infer
[ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer

46
basis/stack-checker/transforms/transforms.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors arrays kernel words sequences generic math USING: fry accessors arrays kernel words sequences generic math
namespaces make quotations assocs combinators classes.tuple namespaces make quotations assocs combinators classes.tuple
classes.tuple.private effects summary hashtables classes generic classes.tuple.private effects summary hashtables classes generic
sets definitions generic.standard slots.private continuations sets definitions generic.standard slots.private continuations locals
stack-checker.backend stack-checker.state stack-checker.visitor stack-checker.backend stack-checker.state stack-checker.visitor
stack-checker.errors stack-checker.values stack-checker.errors stack-checker.values
stack-checker.recursive-state ; stack-checker.recursive-state ;
@ -15,48 +15,32 @@ IN: stack-checker.transforms
[ dup infer-word apply-word/effect ] [ dup infer-word apply-word/effect ]
if ; if ;
: ((apply-transform)) ( word quot values stack -- ) :: ((apply-transform)) ( word quot values stack rstate -- )
rot with-datastack first2 rstate recursive-state
dup [ [ stack quot with-datastack first ] with-variable
[ [
[ drop ] word inlined-dependency depends-on
[ [ length meta-d shorten-by ] [ #drop, ] bi ] bi* values [ length meta-d shorten-by ] [ #drop, ] bi
] 2dip rstate infer-quot
swap infer-quot ] [ word give-up-transform ] if* ;
] [
3drop give-up-transform
] if ; inline
: (apply-transform) ( word quot n -- ) : (apply-transform) ( word quot n -- )
ensure-d dup [ known literal? ] all? [ ensure-d dup [ known literal? ] all? [
dup empty? [ dup empty? [ dup recursive-state get ] [
recursive-state get 1array
] [
[ ] [ ]
[ [ literal value>> ] map ] [ [ literal value>> ] map ]
[ first literal recursion>> ] tri [ first literal recursion>> ] tri
prefix
] if ] if
((apply-transform)) ((apply-transform))
] [ 2drop give-up-transform ] if ; ] [ 2drop give-up-transform ] if ;
: apply-transform ( word -- ) : apply-transform ( word -- )
[ inlined-dependency depends-on ] [ [ ] [ "transform-quot" word-prop ] [ "transform-n" word-prop ] tri
[ ] (apply-transform) ;
[ "transform-quot" word-prop ]
[ "transform-n" word-prop ]
tri
(apply-transform)
] bi ;
: apply-macro ( word -- ) : apply-macro ( word -- )
[ inlined-dependency depends-on ] [ [ ] [ "macro" word-prop ] [ "declared-effect" word-prop in>> length ] tri
[ ] (apply-transform) ;
[ "macro" word-prop ]
[ "declared-effect" word-prop in>> length ]
tri
(apply-transform)
] bi ;
: define-transform ( word quot n -- ) : define-transform ( word quot n -- )
[ drop "transform-quot" set-word-prop ] [ drop "transform-quot" set-word-prop ]