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

Get foldable and flushable declarations working on typed words

db4
Slava Pestov 2010-02-24 00:16:55 +13:00
parent f0aa694c7e
commit ae25cfe712
7 changed files with 80 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/tree/propagation/simple/simple.factor
View File

@ -72,7 +72,7 @@ M: #declare propagate-before
: foldable-call? ( #call word -- ? )
{
[ nip "foldable" word-prop ]
[ nip foldable? ]
[ drop literal-inputs? ]
[ input-classes-match? ]
} 2&& ;

29
basis/typed/typed-tests.factor
View File

@ -1,5 +1,6 @@
USING: accessors effects eval kernel layouts math namespaces
quotations tools.test typed words ;
quotations tools.test typed words words.symbol
compiler.tree.debugger prettyprint ;
IN: typed.tests
TYPED: f+ ( a: float b: float -- c: float )
@ -122,3 +123,29 @@ TYPED: recompile-fail ( a: subclass -- ? ) buh get eq? ;
[ ] [ "IN: typed.tests TUPLE: subclass < superclass { y read-only } ;" eval( -- ) ] unit-test
[ t ] [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
! Make sure that foldable and flushable work on typed words
TYPED: add ( a: integer b: integer -- c: integer ) + ; foldable
[ [ 3 ] ] [ [ 1 2 add ] cleaned-up-tree nodes>quot ] unit-test
TYPED: flush-test ( s: symbol -- ? ) on t ; flushable
: flush-print-1 ( symbol -- ) flush-test drop ;
: flush-print-2 ( symbol -- ) flush-test . ;
SYMBOL: a-symbol
[ f ] [
f a-symbol [
a-symbol flush-print-1
a-symbol get
] with-variable
] unit-test
[ t ] [
f a-symbol [
a-symbol flush-print-2
a-symbol get
] with-variable
] unit-test

12
basis/typed/typed.factor
View File

@ -11,8 +11,8 @@ ERROR: type-mismatch-error word expected-types ;
ERROR: input-mismatch-error < type-mismatch-error ;
ERROR: output-mismatch-error < type-mismatch-error ;
PREDICATE: typed-gensym < word "typed-gensym" word-prop ;
PREDICATE: typed-word < word "typed-word" word-prop ;
PREDICATE: typed-gensym < word "typed-gensym" word-prop >boolean ;
PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
<PRIVATE
@ -120,10 +120,10 @@ MACRO: (typed) ( word def effect -- quot )
[ effect-in-types unboxed-types [ "in" swap 2array ] map ]
[ effect-out-types unboxed-types [ "out" swap 2array ] map ] bi <effect> ;
M: typed-gensym stack-effect
call-next-method unboxed-effect ;
M: typed-gensym crossref?
"typed-gensym" word-prop crossref? ;
M: typed-gensym stack-effect call-next-method unboxed-effect ;
M: typed-gensym parent-word "typed-gensym" word-prop ;
M: typed-gensym crossref? parent-word crossref? ;
M: typed-gensym where parent-word where ;
: define-typed-gensym ( word def effect -- gensym )
[ 2drop <typed-gensym> dup ]

9
core/effects/effects.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.parser math.order namespaces make sequences strings
words assocs combinators accessors arrays quotations ;
USING: kernel math math.parser math.order namespaces make
sequences strings words assocs combinators accessors arrays
quotations ;
IN: effects
TUPLE: effect
@ -64,7 +65,9 @@ M: pair effect>type second effect>type ;
GENERIC: stack-effect ( word -- effect/f )
M: word stack-effect "declared-effect" word-prop ;
M: word stack-effect
[ "declared-effect" word-prop ]
[ parent-word dup [ stack-effect ] when ] bi or ;
M: deferred stack-effect call-next-method (( -- * )) or ;

13
core/generic/generic-tests.factor
View File

@ -212,3 +212,16 @@ M: integer forget-test 3 + ;
] unit-test
[ 10 forget-test ] [ no-method? ] must-fail-with
! Declarations on methods
GENERIC: flushable-generic ( a -- b ) flushable
M: integer flushable-generic ;
[ t ] [ \ flushable-generic flushable? ] unit-test
[ t ] [ M\ integer flushable-generic flushable? ] unit-test
GENERIC: non-flushable-generic ( a -- b )
M: integer non-flushable-generic ; flushable
[ f ] [ \ non-flushable-generic flushable? ] unit-test
[ t ] [ M\ integer non-flushable-generic flushable? ] unit-test

12
core/generic/generic.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors words kernel sequences namespaces make assocs
hashtables definitions kernel.private classes classes.private
@ -104,11 +104,8 @@ GENERIC: update-generic ( class generic -- )
: method-word-name ( class generic -- string )
[ name>> ] bi@ "=>" glue ;
M: method flushable?
"method-generic" word-prop flushable? ;
M: method stack-effect
"method-generic" word-prop stack-effect ;
M: method parent-word
"method-generic" word-prop ;
M: method crossref?
"forgotten" word-prop not ;
@ -196,8 +193,5 @@ M: generic subwords
tri
] { } make ;
M: generic forget*
[ subwords forget-all ] [ call-next-method ] bi ;
M: class forget-methods
[ implementors ] [ [ swap method ] curry ] bi map forget-all ;

33
core/words/words.factor
View File

@ -73,12 +73,14 @@ GENERIC: crossref? ( word -- ? )
M: word crossref?
dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ;
: inline? ( word -- ? ) "inline" word-prop ; inline
GENERIC: subwords ( word -- seq )
M: word subwords drop f ;
GENERIC: parent-word ( word -- word/f )
M: word parent-word drop f ;
: define ( word def -- )
over changed-definition [ ] like >>def drop ;
@ -100,6 +102,8 @@ M: word subwords drop f ;
: make-deprecated ( word -- )
t "deprecated" set-word-prop ;
: inline? ( word -- ? ) "inline" word-prop ; inline
ERROR: cannot-be-inline word ;
GENERIC: make-inline ( word -- )
@ -111,22 +115,30 @@ M: word make-inline
bi
] if ;
: define-inline ( word def effect -- )
[ define-declared ] [ 2drop make-inline ] 3bi ;
: make-recursive ( word -- )
t "recursive" set-word-prop ;
GENERIC: flushable? ( word -- ? )
M: word flushable?
[ "flushable" word-prop ]
[ parent-word dup [ flushable? ] when ] bi or ;
: make-flushable ( word -- )
t "flushable" set-word-prop ;
GENERIC: foldable? ( word -- ? )
M: word foldable?
[ "foldable" word-prop ]
[ parent-word dup [ foldable? ] when ] bi or ;
: make-foldable ( word -- )
dup make-flushable t "foldable" set-word-prop ;
: define-inline ( word def effect -- )
[ define-declared ] [ 2drop make-inline ] 3bi ;
GENERIC: flushable? ( word -- ? )
M: word flushable? "flushable" word-prop ;
GENERIC: reset-word ( word -- )
M: word reset-word
@ -208,9 +220,10 @@ M: word set-where swap "loc" set-word-prop ;
M: word forget*
dup "forgotten" word-prop [ drop ] [
[ subwords forget-all ]
[ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
[ t "forgotten" set-word-prop ]
bi
tri
] if ;
M: word hashcode*