1 ! Copyright (C) 2004, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays byte-arrays byte-vectors
4 classes.algebra.private classes.builtin classes.error
5 classes.intersection classes.maybe classes.mixin classes.parser
6 classes.predicate classes.singleton classes.tuple classes.tuple.parser
7 classes.union combinators compiler.units definitions effects
8 effects.parser generic generic.hook generic.math generic.parser
9 generic.standard hash-sets hashtables io.pathnames kernel lexer
10 math namespaces parser quotations sbufs sequences slots
11 source-files splitting strings strings.parser
12 strings.parser.private vectors vocabs vocabs.parser words
13 words.alias words.constant words.symbol ;
16 ! These words are defined as a top-level form, instead of with
17 ! defining parsing words, because during stage1 bootstrap, the
18 ! "syntax" vocabulary is copied from the host. When stage1
19 ! bootstrap completes, the host's syntax vocabulary is deleted
20 ! from the target, then this top-level form creates the
21 ! target's "syntax" vocabulary as one of the first things done
24 : define-delimiter ( name -- )
25 "syntax" lookup-word t "delimiter" set-word-prop ;
27 ! Keep track of words defined by SYNTAX: as opposed to words
28 ! merely generated by define-syntax.
29 : mark-top-level-syntax ( word -- word )
30 dup t "syntax" set-word-prop ;
32 : define-core-syntax ( name quot -- )
34 dup "syntax" lookup-word [ ] [ throw-no-word-error ] ?if
40 { "]" "}" ";" ">>" } [ define-delimiter ] each
44 scan-word scan-effect ensure-primitive
48 "Call stack literals are not supported" throw
51 "!" [ lexer get next-line ] define-core-syntax
53 "#!" [ POSTPONE: ! ] define-core-syntax
55 "IN:" [ scan-token set-current-vocab ] define-core-syntax
57 "<PRIVATE" [ begin-private ] define-core-syntax
59 "PRIVATE>" [ end-private ] define-core-syntax
61 "USE:" [ scan-token use-vocab ] define-core-syntax
63 "UNUSE:" [ scan-token unuse-vocab ] define-core-syntax
65 "USING:" [ ";" [ use-vocab ] each-token ] define-core-syntax
67 "QUALIFIED:" [ scan-token dup add-qualified ] define-core-syntax
69 "QUALIFIED-WITH:" [ scan-token scan-token add-qualified ] define-core-syntax
72 scan-token "=>" expect ";" parse-tokens add-words-from
76 scan-token "=>" expect ";" parse-tokens add-words-excluding
80 scan-token scan-token "=>" expect scan-token add-renamed-word
83 "NAN:" [ 16 scan-base <fp-nan> suffix! ] define-core-syntax
85 "f" [ f suffix! ] define-core-syntax
89 { [ dup length 1 = ] [ first ] }
90 { [ "\\" ?head ] [ next-escape >string "" assert= ] }
91 [ name>char-hook get call( name -- char ) ]
95 "\"" [ "\"" parse-multiline-string-until suffix! ] define-core-syntax
98 lexer get skip-blank parse-string >sbuf suffix!
102 lexer get skip-blank parse-string <pathname> suffix!
105 "[" [ parse-quotation suffix! ] define-core-syntax
106 "{" [ \ } [ >array ] parse-literal ] define-core-syntax
107 "V{" [ \ } [ >vector ] parse-literal ] define-core-syntax
108 "B{" [ \ } [ >byte-array ] parse-literal ] define-core-syntax
109 "BV{" [ \ } [ >byte-vector ] parse-literal ] define-core-syntax
110 "H{" [ \ } [ parse-hashtable ] parse-literal ] define-core-syntax
111 "T{" [ parse-tuple-literal suffix! ] define-core-syntax
112 "W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax
113 "HS{" [ \ } [ >hash-set ] parse-literal ] define-core-syntax
115 "POSTPONE:" [ scan-word suffix! ] define-core-syntax
116 "\\" [ scan-word <wrapper> suffix! ] define-core-syntax
117 "M\\" [ scan-word scan-word lookup-method <wrapper> suffix! ] define-core-syntax
118 "inline" [ last-word make-inline ] define-core-syntax
119 "recursive" [ last-word make-recursive ] define-core-syntax
120 "foldable" [ last-word make-foldable ] define-core-syntax
121 "flushable" [ last-word make-flushable ] define-core-syntax
122 "delimiter" [ last-word t "delimiter" set-word-prop ] define-core-syntax
123 "deprecated" [ last-word make-deprecated ] define-core-syntax
127 mark-top-level-syntax
128 parse-definition define-syntax
133 current-vocab lookup-word
134 (parse-tuple-definition) 2drop check-builtin
138 scan-new-word define-symbol
142 ";" [ create-word-in [ reset-generic ] [ define-symbol ] bi ] each-token
146 ";" [ create-class-in define-singleton-class ] each-token
150 scan-token current-vocab create-word
151 [ fake-definition ] [ set-last-word ] [ undefined-def define ] tri
155 scan-new-word scan-word define-alias
159 scan-new-word scan-object define-constant
167 [ simple-combination ] (GENERIC:)
171 [ scan-number <standard-combination> ] (GENERIC:)
175 [ math-combination ] (GENERIC:)
179 [ scan-word <hook-combination> ] (GENERIC:)
187 scan-new-class parse-definition define-union-class
191 scan-new-class parse-definition define-intersection-class
195 scan-new-class define-mixin-class
200 scan-word scan-word 2dup add-mixin-instance
202 ] dip remember-definition
209 parse-definition define-predicate-class
213 scan-new-class define-singleton-class
217 parse-tuple-definition define-tuple-class
225 scan-token define-protocol-slot
229 scan-new-word scan-word define-boa-word
233 parse-tuple-definition
243 ")" parse-effect suffix!
248 dup ( -- ) check-stack-effect
249 [ current-vocab main<< ]
250 [ current-source-file get [ main<< ] [ drop ] if* ] bi
255 \ >> parse-until >quotation
256 ] with-nested-compilation-unit call( -- )
262 \ (call-next-method) suffix!
264 throw-not-in-a-method-error
269 \ } [ <anonymous-union> <maybe> ] parse-literal
273 \ } [ <anonymous-union> <anonymous-complement> ] parse-literal
277 \ } [ <anonymous-intersection> ] parse-literal
281 \ } [ <anonymous-union> ] parse-literal
284 "initial:" "syntax" lookup-word define-symbol
286 "read-only" "syntax" lookup-word define-symbol
288 "call(" [ \ call-effect parse-call-paren ] define-core-syntax
290 "execute(" [ \ execute-effect parse-call-paren ] define-core-syntax
292 "<<<<<<<" [ version-control-merge-conflict ] define-core-syntax
293 "=======" [ version-control-merge-conflict ] define-core-syntax
294 ">>>>>>>" [ version-control-merge-conflict ] define-core-syntax
296 "<<<<<<" [ version-control-merge-conflict ] define-core-syntax
297 "======" [ version-control-merge-conflict ] define-core-syntax
298 ">>>>>>" [ version-control-merge-conflict ] define-core-syntax
299 ] with-compilation-unit