1 ! Copyright (C) 2007, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays kernel words sequences generic math
4 namespaces quotations assocs combinators
5 inference.backend inference.dataflow inference.state
6 classes.tuple classes.tuple.private effects summary hashtables
7 classes generic sets definitions generic.standard slots.private ;
8 IN: inference.transforms
10 : pop-literals ( n -- rstate seq )
12 drop recursive-state get { }
15 f swap [ 2drop pop-literal ] map reverse
18 : transform-quot ( quot n -- newquot )
19 [ pop-literals [ ] each ] curry
21 [ swap infer-quot ] 3compose ;
23 : define-transform ( word quot n -- )
24 transform-quot "infer" set-word-prop ;
36 dup peek swap but-last
43 \ cleave [ cleave>quot ] 1 define-transform
45 \ 2cleave [ 2cleave>quot ] 1 define-transform
47 \ 3cleave [ 3cleave>quot ] 1 define-transform
49 \ spread [ spread>quot ] 1 define-transform
52 : [get-slots] ( slots -- quot )
53 [ [ 1quotation , \ keep , ] each \ drop , ] [ ] make ;
55 \ get-slots [ [get-slots] ] 1 define-transform
57 ERROR: duplicated-slots-error names ;
59 M: duplicated-slots-error summary
60 drop "Calling set-slots with duplicate slot setters" ;
64 [ <reversed> [get-slots] ] [ duplicated-slots-error ] if
69 dup +inlined+ depends-on
70 [ "boa-check" word-prop ]
71 [ tuple-layout [ <tuple-boa> ] curry ]
74 \ boa \ no-method boa time-bomb
78 \ (call-next-method) [
79 [ [ +inlined+ depends-on ] bi@ ] [ next-method-quot ] 2bi