1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel quotations classes.tuple make combinators generic
4 words interpolate namespaces sequences io.streams.string fry
5 classes.mixin effects lexer parser classes.tuple.parser
6 effects.parser locals.types locals.parser locals.rewrite.closures ;
9 : scan-param ( -- obj )
10 scan-object dup special? [ literalize ] unless ;
12 : define* ( word def effect -- ) pick set-word define-declared ;
14 : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
19 { ";" [ tuple parsed f parsed ] }
20 { "<" [ scan-param parsed [ parse-tuple-slots ] { } make parsed ] }
23 [ parse-slot-name [ parse-tuple-slots ] when ] { }
27 \ define-tuple-class parsed ; parsing
33 \ create-method parsed
34 parse-definition parsed
41 [ [ boa ] curry ] over push-all
47 parse-definition parsed
53 \ add-mixin-instance parsed ; parsing
55 : `inline \ inline parsed ; parsing
57 : `parsing \ parsing parsed ; parsing
60 ")" parse-effect effect set ; parsing
62 : (INTERPOLATE) ( accum quot -- accum )
63 [ scan interpolate-locals ] dip
64 '[ _ with-string-writer @ ] parsed ;
66 : IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing
68 : DEFINES [ create-in ] (INTERPOLATE) ; parsing
70 DEFER: ;FUNCTOR delimiter
72 : functor-words ( -- assoc )
74 { "TUPLE:" POSTPONE: `TUPLE: }
75 { "M:" POSTPONE: `M: }
76 { "C:" POSTPONE: `C: }
78 { "INSTANCE:" POSTPONE: `INSTANCE: }
79 { "inline" POSTPONE: `inline }
80 { "parsing" POSTPONE: `parsing }
84 : push-functor-words ( -- )
85 functor-words use get push ;
87 : pop-functor-words ( -- )
88 functor-words use get delq ;
90 : parse-functor-body ( -- form )
94 "WHERE" parse-bindings* \ ;FUNCTOR (parse-lambda)
100 : (FUNCTOR:) ( -- word def )
102 parse-locals dup push-locals
103 parse-functor-body swap pop-locals <lambda>
104 rewrite-closures first ;
106 : FUNCTOR: (FUNCTOR:) define ; parsing