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
7 locals.rewrite.closures vocabs.parser ;
10 : scan-param ( -- obj )
11 scan-object dup special? [ literalize ] unless ;
13 : define* ( word def effect -- ) pick set-word define-declared ;
15 : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
20 { ";" [ tuple parsed f parsed ] }
21 { "<" [ scan-param parsed [ parse-tuple-slots ] { } make parsed ] }
24 [ parse-slot-name [ parse-tuple-slots ] when ] { }
28 \ define-tuple-class parsed ; parsing
34 \ create-method parsed
35 parse-definition parsed
42 [ [ boa ] curry ] over push-all
48 parse-definition parsed
54 \ add-mixin-instance parsed ; parsing
56 : `inline \ inline parsed ; parsing
58 : `parsing \ parsing parsed ; parsing
61 ")" parse-effect effect set ; parsing
63 : (INTERPOLATE) ( accum quot -- accum )
64 [ scan interpolate-locals ] dip
65 '[ _ with-string-writer @ ] parsed ;
67 : IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing
69 : DEFINES [ create-in ] (INTERPOLATE) ; parsing
71 DEFER: ;FUNCTOR delimiter
73 : functor-words ( -- assoc )
75 { "TUPLE:" POSTPONE: `TUPLE: }
76 { "M:" POSTPONE: `M: }
77 { "C:" POSTPONE: `C: }
79 { "INSTANCE:" POSTPONE: `INSTANCE: }
80 { "inline" POSTPONE: `inline }
81 { "parsing" POSTPONE: `parsing }
85 : push-functor-words ( -- )
86 functor-words use get push ;
88 : pop-functor-words ( -- )
89 functor-words use get delq ;
91 : parse-functor-body ( -- form )
95 "WHERE" parse-bindings* \ ;FUNCTOR (parse-lambda)
101 : (FUNCTOR:) ( -- word def )
103 parse-locals dup push-locals
104 parse-functor-body swap pop-locals <lambda>
105 rewrite-closures first ;
107 : FUNCTOR: (FUNCTOR:) define ; parsing