1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators effects.parser generic
4 kernel namespaces parser quotations sequences words ;
7 ERROR: not-in-a-method-error ;
9 : scan-new-generic ( -- word ) scan-new dup reset-word ;
11 : (GENERIC:) ( quot -- )
12 [ scan-new-generic ] dip call scan-effect define-generic ; inline
14 : create-method-in ( class generic -- method )
15 create-method dup set-last-word dup save-location ;
17 : define-inline-method ( class generic quot -- )
18 [ create-method-in ] dip [ define ] [ drop make-inline ] 2bi ;
20 : scan-new-method ( -- method )
21 scan-class bootstrap-word scan-word create-method-in ;
23 SYMBOL: current-method
25 : with-method-definition ( method quot -- )
26 over current-method set call current-method off ; inline
28 : generic-effect ( word -- effect )
29 "method-generic" word-prop "declared-effect" word-prop ;
31 : method-effect= ( method-effect generic-effect -- ? )
32 [ [ in>> length ] same? ]
35 [ 2drop t ] [ [ out>> length ] same? ] if
38 ERROR: bad-method-effect ;
40 : check-method-effect ( effect -- )
41 last-word generic-effect method-effect= [ throw-bad-method-effect ] unless ;
43 : ?execute-parsing ( word/number -- seq )
45 [ V{ } clone swap execute-parsing ] [ 1array ] if ;
47 : parse-method-definition ( -- quot )
49 { \ ( [ ")" parse-effect check-method-effect parse-definition ] }
51 [ ?execute-parsing \ ; parse-until append >quotation ]
54 : (M:) ( -- method def )
56 scan-new-method [ parse-method-definition ] with-method-definition