: define-declared* ( word def effect -- ) pick set-word define-declared ;
+TUPLE: fake-call-next-method ;
+
TUPLE: fake-quotation seq ;
GENERIC: >fake-quotations ( quot -- fake )
M: object >fake-quotations ;
-GENERIC: fake-quotations> ( fake -- quot )
+GENERIC: (fake-quotations>) ( fake -- )
+
+: fake-quotations> ( fake -- quot )
+ [ (fake-quotations>) ] [ ] make ;
-M: fake-quotation fake-quotations>
- seq>> [ fake-quotations> ] [ ] map-as ;
+M: fake-quotation (fake-quotations>)
+ [ seq>> [ (fake-quotations>) ] each ] [ ] make , ;
-M: array fake-quotations> [ fake-quotations> ] map ;
+M: array (fake-quotations>)
+ [ [ (fake-quotations>) ] each ] { } make , ;
-M: object fake-quotations> ;
+M: fake-call-next-method (fake-quotations>)
+ drop method-body get literalize , \ (call-next-method) , ;
+
+M: object (fake-quotations>) , ;
: parse-definition* ( accum -- accum )
- parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
+ parse-definition >fake-quotations parsed
+ [ fake-quotations> first ] over push-all ;
: parse-declared* ( accum -- accum )
complete-effect
SYNTAX: `M:
scan-param parsed
scan-param parsed
- \ create-method-in parsed
+ [ create-method-in dup method-body set ] over push-all
parse-definition*
\ define* parsed ;
SYNTAX: `inline [ word make-inline ] over push-all ;
+SYNTAX: `call-next-method T{ fake-call-next-method } parsed ;
+
: (INTERPOLATE) ( accum quot -- accum )
[ scan interpolate-locals ] dip
'[ _ with-string-writer @ ] parsed ;
{ "INSTANCE:" POSTPONE: `INSTANCE: }
{ "SYNTAX:" POSTPONE: `SYNTAX: }
{ "inline" POSTPONE: `inline }
+ { "call-next-method" POSTPONE: `call-next-method }
} ;
: push-functor-words ( -- )