1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: assocs kernel accessors quotations slots words
4 sequences namespaces combinators combinators.short-circuit
5 summary smalltalk.classes ;
6 IN: smalltalk.compiler.lexenv
8 ! local-readers: assoc string => word
9 ! local-writers: assoc string => word
10 ! self: word or f for top-level forms
11 ! class: class word or f for top-level forms
12 ! method: generic word or f for top-level forms
13 TUPLE: lexenv local-readers local-writers self return class method ;
15 : <lexenv> ( -- lexenv ) lexenv new ; inline
17 CONSTANT: empty-lexenv T{ lexenv }
19 : lexenv-union ( lexenv1 lexenv2 -- lexenv )
21 [ [ local-readers>> ] bi@ assoc-union >>local-readers ]
22 [ [ local-writers>> ] bi@ assoc-union >>local-writers ]
23 [ [ self>> ] either? >>self ]
24 [ [ return>> ] either? >>return ]
25 [ [ class>> ] either? >>class ]
26 [ [ method>> ] either? >>method ]
29 : local-reader ( name lexenv -- local )
30 local-readers>> at dup [ 1quotation ] when ;
32 : ivar-reader ( name lexenv -- quot/f )
34 [ class>> "slots" word-prop slot-named ] [ self>> ] bi
35 swap dup [ name>> reader-word [ ] 2sequence ] [ 2drop f ] if
38 : class-name ( name -- quot/f )
39 classes get at dup [ [ ] curry ] when ;
41 ERROR: bad-identifier name ;
43 M: bad-identifier summary drop "Unknown identifier" ;
45 : lookup-reader ( name lexenv -- reader-quot )
50 [ drop bad-identifier ]
53 : local-writer ( name lexenv -- local )
54 local-writers>> at dup [ 1quotation ] when ;
56 : ivar-writer ( name lexenv -- quot/f )
58 [ class>> "slots" word-prop slot-named ] [ self>> ] bi
59 swap dup [ name>> writer-word [ ] 2sequence ] [ 2drop f ] if
62 : lookup-writer ( name lexenv -- writer-quot )
66 [ drop bad-identifier ]