1 ! Copyright (C) 2007, 2010 Slava Pestov, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel hashtables sequences sequences.private arrays
4 words namespaces make parser effects.parser math assocs effects
5 definitions quotations summary accessors fry ;
10 ! We can't use n*quot, narray and firstn from generalizations because
11 ! they're macros, and macros use memoize!
12 : (n*quot) ( n quot -- quotquot )
13 <repetition> concat >quotation ;
15 : [nsequence] ( length exemplar -- quot )
16 [ [ [ 1 - ] keep ] dip '[ _ _ _ new-sequence ] ]
17 [ drop [ [ set-nth-unsafe ] 2keep [ 1 - ] dip ] (n*quot) ] 2bi
20 : [firstn] ( length -- quot )
22 [ [ nth-unsafe ] 2keep [ 1 + ] dip ] (n*quot)
25 : packer ( seq -- quot )
27 [ { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ]
28 [ { } [nsequence] ] if ;
30 : unpacker ( seq -- quot )
32 [ { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ]
35 : pack/unpack ( quot effect -- newquot )
36 [ in>> packer ] [ out>> unpacker ] bi surround ;
38 : unpack/pack ( quot effect -- newquot )
39 [ in>> unpacker ] [ out>> packer ] bi surround ;
41 : make-memoizer ( table quot effect -- quot )
42 [ unpack/pack '[ _ _ cache ] ] keep
47 : define-memoized ( word quot effect -- )
48 [ drop "memo-quot" set-word-prop ]
49 [ 2drop H{ } clone "memoize" set-word-prop ]
50 [ [ [ dup "memoize" word-prop ] 2dip make-memoizer ] keep define-declared ]
53 SYNTAX: MEMO: (:) define-memoized ;
55 PREDICATE: memoized < word "memoize" word-prop ;
57 M: memoized definer drop \ MEMO: \ ; ;
59 M: memoized definition "memo-quot" word-prop ;
61 M: memoized reset-word
63 [ { "memoize" "memo-quot" } reset-props ]
66 : memoize-quot ( quot effect -- memo-quot )
67 [ H{ } clone ] 2dip make-memoizer ;
69 : reset-memoized ( word -- )
70 "memoize" word-prop clear-assoc ;
72 : invalidate-memoized ( inputs... word -- )
73 [ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
75 \ invalidate-memoized t "no-compile" set-word-prop