1 ! Copyright (C) 2004, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien arrays byte-arrays byte-vectors definitions generic
4 hashtables kernel math namespaces parser lexer sequences strings
5 strings.parser sbufs vectors words words.symbol words.constant
6 words.alias quotations io assocs splitting classes.tuple
7 generic.standard generic.hook generic.math generic.parser classes
8 io.pathnames vocabs vocabs.parser classes.parser classes.union
9 classes.intersection classes.mixin classes.predicate
10 classes.singleton classes.tuple.parser compiler.units
11 combinators effects.parser slots hash-sets ;
14 ! These words are defined as a top-level form, instead of with
15 ! defining parsing words, because during stage1 bootstrap, the
16 ! "syntax" vocabulary is copied from the host. When stage1
17 ! bootstrap completes, the host's syntax vocabulary is deleted
18 ! from the target, then this top-level form creates the
19 ! target's "syntax" vocabulary as one of the first things done
22 : define-delimiter ( name -- )
23 "syntax" lookup t "delimiter" set-word-prop ;
25 : define-core-syntax ( name quot -- )
26 [ dup "syntax" lookup [ ] [ no-word-error ] ?if ] dip
30 { "]" "}" ";" ">>" } [ define-delimiter ] each
33 "Primitive definition is not supported" throw
37 "Call stack literals are not supported" throw
40 "!" [ lexer get next-line ] define-core-syntax
42 "#!" [ POSTPONE: ! ] define-core-syntax
44 "IN:" [ scan set-current-vocab ] define-core-syntax
46 "<PRIVATE" [ begin-private ] define-core-syntax
48 "PRIVATE>" [ end-private ] define-core-syntax
50 "USE:" [ scan use-vocab ] define-core-syntax
52 "UNUSE:" [ scan unuse-vocab ] define-core-syntax
54 "USING:" [ ";" [ use-vocab ] each-token ] define-core-syntax
56 "QUALIFIED:" [ scan dup add-qualified ] define-core-syntax
58 "QUALIFIED-WITH:" [ scan scan add-qualified ] define-core-syntax
61 scan "=>" expect ";" parse-tokens add-words-from
65 scan "=>" expect ";" parse-tokens add-words-excluding
69 scan scan "=>" expect scan add-renamed-word
72 "HEX:" [ 16 parse-base ] define-core-syntax
73 "OCT:" [ 8 parse-base ] define-core-syntax
74 "BIN:" [ 2 parse-base ] define-core-syntax
76 "NAN:" [ 16 scan-base <fp-nan> suffix! ] define-core-syntax
78 "f" [ f suffix! ] define-core-syntax
79 "t" "syntax" lookup define-singleton-class
83 { [ dup length 1 = ] [ first ] }
84 { [ "\\" ?head ] [ next-escape >string "" assert= ] }
85 [ name>char-hook get call( name -- char ) ]
89 "\"" [ parse-multiline-string suffix! ] define-core-syntax
92 lexer get skip-blank parse-string >sbuf suffix!
96 lexer get skip-blank parse-string <pathname> suffix!
99 "[" [ parse-quotation suffix! ] define-core-syntax
100 "{" [ \ } [ >array ] parse-literal ] define-core-syntax
101 "V{" [ \ } [ >vector ] parse-literal ] define-core-syntax
102 "B{" [ \ } [ >byte-array ] parse-literal ] define-core-syntax
103 "BV{" [ \ } [ >byte-vector ] parse-literal ] define-core-syntax
104 "H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax
105 "T{" [ parse-tuple-literal suffix! ] define-core-syntax
106 "W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax
107 "HS{" [ \ } [ <hash-set> ] parse-literal ] define-core-syntax
109 "POSTPONE:" [ scan-word suffix! ] define-core-syntax
110 "\\" [ scan-word <wrapper> suffix! ] define-core-syntax
111 "M\\" [ scan-word scan-word method <wrapper> suffix! ] define-core-syntax
112 "inline" [ word make-inline ] define-core-syntax
113 "recursive" [ word make-recursive ] define-core-syntax
114 "foldable" [ word make-foldable ] define-core-syntax
115 "flushable" [ word make-flushable ] define-core-syntax
116 "delimiter" [ word t "delimiter" set-word-prop ] define-core-syntax
117 "deprecated" [ word make-deprecated ] define-core-syntax
120 CREATE-WORD parse-definition define-syntax
124 CREATE-WORD define-symbol
128 ";" [ create-in dup reset-generic define-symbol ] each-token
132 ";" [ create-class-in define-singleton-class ] each-token
136 scan current-vocab create
137 [ fake-definition ] [ set-word ] [ undefined-def define ] tri
141 CREATE-WORD scan-word define-alias
145 CREATE-WORD scan-object define-constant
153 [ simple-combination ] (GENERIC:)
157 [ scan-word <standard-combination> ] (GENERIC:)
161 [ math-combination ] (GENERIC:)
165 [ scan-word <hook-combination> ] (GENERIC:)
173 CREATE-CLASS parse-definition define-union-class
177 CREATE-CLASS parse-definition define-intersection-class
181 CREATE-CLASS define-mixin-class
186 scan-word scan-word 2dup add-mixin-instance
188 ] dip remember-definition
195 parse-definition define-predicate-class
199 CREATE-CLASS define-singleton-class
203 parse-tuple-definition define-tuple-class
211 scan define-protocol-slot
215 CREATE-WORD scan-word define-boa-word
219 parse-tuple-definition
229 ")" parse-effect drop
233 "))" parse-effect suffix!
236 "MAIN:" [ scan-word current-vocab (>>main) ] define-core-syntax
240 \ >> parse-until >quotation
241 ] with-nested-compilation-unit call( -- )
247 \ (call-next-method) suffix!
249 not-in-a-method-error
253 "initial:" "syntax" lookup define-symbol
255 "read-only" "syntax" lookup define-symbol
257 "call(" [ \ call-effect parse-call( ] define-core-syntax
259 "execute(" [ \ execute-effect parse-call( ] define-core-syntax
260 ] with-compilation-unit