1 ! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel hashtables sequences arrays words namespaces
4 parser math assocs effects definitions quotations ;
8 { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
10 : unpacker ( n -- quot )
11 { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
14 stack-effect effect-in length ;
17 stack-effect effect-out length ;
19 : pack/unpack ( quot word -- newquot )
20 [ dup #in unpacker % swap % #out packer % ] [ ] make ;
22 : make-memoizer ( quot word -- quot )
25 [ "memoize" word-prop , ] keep
26 [ pack/unpack , ] keep
31 : check-memoized ( word -- )
32 dup #in 4 > swap #out 4 > or [
33 "There must be no more than 4 input and 4 output arguments" throw
36 : define-memoized ( word quot -- )
38 2dup "memo-quot" set-word-prop
39 over H{ } clone "memoize" set-word-prop
40 over make-memoizer define ;
42 : MEMO: (:) define-memoized ; parsing
44 PREDICATE: memoized < word "memoize" word-prop ;
46 M: memoized definer drop \ MEMO: \ ; ;
48 M: memoized definition "memo-quot" word-prop ;
50 M: memoized reset-word
52 [ { "memoize" "memo-quot" } reset-props ]
55 : memoize-quot ( quot effect -- memo-quot )
56 gensym swap dupd "declared-effect" set-word-prop
57 dup rot define-memoized 1quotation ;
59 : reset-memoized ( word -- )
60 "memoize" word-prop clear-assoc ;
62 : invalidate-memoized ( inputs... word -- )
63 [ #in packer call ] [ "memoize" word-prop delete-at ] bi ;