277 lines
8.0 KiB
Factor
277 lines
8.0 KiB
Factor
! Copyright (C) 2004, 2010 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors alien arrays byte-arrays byte-vectors definitions generic
|
|
hashtables kernel math namespaces parser lexer sequences strings
|
|
strings.parser sbufs vectors words words.symbol words.constant
|
|
words.alias quotations io assocs splitting classes.tuple
|
|
generic.standard generic.hook generic.math generic.parser classes
|
|
io.pathnames vocabs vocabs.parser classes.parser classes.union
|
|
classes.intersection classes.mixin classes.predicate
|
|
classes.singleton classes.tuple.parser compiler.units classes.maybe
|
|
combinators effects.parser slots hash-sets source-files
|
|
classes.algebra.private ;
|
|
IN: bootstrap.syntax
|
|
|
|
! These words are defined as a top-level form, instead of with
|
|
! defining parsing words, because during stage1 bootstrap, the
|
|
! "syntax" vocabulary is copied from the host. When stage1
|
|
! bootstrap completes, the host's syntax vocabulary is deleted
|
|
! from the target, then this top-level form creates the
|
|
! target's "syntax" vocabulary as one of the first things done
|
|
! in stage2.
|
|
|
|
: define-delimiter ( name -- )
|
|
"syntax" lookup-word t "delimiter" set-word-prop ;
|
|
|
|
: define-core-syntax ( name quot -- )
|
|
[ dup "syntax" lookup-word [ ] [ no-word-error ] ?if ] dip
|
|
define-syntax ;
|
|
|
|
[
|
|
{ "]" "}" ";" ">>" } [ define-delimiter ] each
|
|
|
|
"PRIMITIVE:" [
|
|
"Primitive definition is not supported" throw
|
|
] define-core-syntax
|
|
|
|
"CS{" [
|
|
"Call stack literals are not supported" throw
|
|
] define-core-syntax
|
|
|
|
"!" [ lexer get next-line ] define-core-syntax
|
|
|
|
"#!" [ POSTPONE: ! ] define-core-syntax
|
|
|
|
"IN:" [ scan-token set-current-vocab ] define-core-syntax
|
|
|
|
"<PRIVATE" [ begin-private ] define-core-syntax
|
|
|
|
"PRIVATE>" [ end-private ] define-core-syntax
|
|
|
|
"USE:" [ scan-token use-vocab ] define-core-syntax
|
|
|
|
"UNUSE:" [ scan-token unuse-vocab ] define-core-syntax
|
|
|
|
"USING:" [ ";" [ use-vocab ] each-token ] define-core-syntax
|
|
|
|
"QUALIFIED:" [ scan-token dup add-qualified ] define-core-syntax
|
|
|
|
"QUALIFIED-WITH:" [ scan-token scan-token add-qualified ] define-core-syntax
|
|
|
|
"FROM:" [
|
|
scan-token "=>" expect ";" parse-tokens add-words-from
|
|
] define-core-syntax
|
|
|
|
"EXCLUDE:" [
|
|
scan-token "=>" expect ";" parse-tokens add-words-excluding
|
|
] define-core-syntax
|
|
|
|
"RENAME:" [
|
|
scan-token scan-token "=>" expect scan-token add-renamed-word
|
|
] define-core-syntax
|
|
|
|
"NAN:" [ 16 scan-base <fp-nan> suffix! ] define-core-syntax
|
|
|
|
"f" [ f suffix! ] define-core-syntax
|
|
|
|
"CHAR:" [
|
|
scan-token {
|
|
{ [ dup length 1 = ] [ first ] }
|
|
{ [ "\\" ?head ] [ next-escape >string "" assert= ] }
|
|
[ name>char-hook get call( name -- char ) ]
|
|
} cond suffix!
|
|
] define-core-syntax
|
|
|
|
"\"" [ parse-multiline-string suffix! ] define-core-syntax
|
|
|
|
"SBUF\"" [
|
|
lexer get skip-blank parse-string >sbuf suffix!
|
|
] define-core-syntax
|
|
|
|
"P\"" [
|
|
lexer get skip-blank parse-string <pathname> suffix!
|
|
] define-core-syntax
|
|
|
|
"[" [ parse-quotation suffix! ] define-core-syntax
|
|
"{" [ \ } [ >array ] parse-literal ] define-core-syntax
|
|
"V{" [ \ } [ >vector ] parse-literal ] define-core-syntax
|
|
"B{" [ \ } [ >byte-array ] parse-literal ] define-core-syntax
|
|
"BV{" [ \ } [ >byte-vector ] parse-literal ] define-core-syntax
|
|
"H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax
|
|
"T{" [ parse-tuple-literal suffix! ] define-core-syntax
|
|
"W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax
|
|
"HS{" [ \ } [ >hash-set ] parse-literal ] define-core-syntax
|
|
|
|
"POSTPONE:" [ scan-word suffix! ] define-core-syntax
|
|
"\\" [ scan-word <wrapper> suffix! ] define-core-syntax
|
|
"M\\" [ scan-word scan-word lookup-method <wrapper> suffix! ] define-core-syntax
|
|
"inline" [ word make-inline ] define-core-syntax
|
|
"recursive" [ word make-recursive ] define-core-syntax
|
|
"foldable" [ word make-foldable ] define-core-syntax
|
|
"flushable" [ word make-flushable ] define-core-syntax
|
|
"delimiter" [ word t "delimiter" set-word-prop ] define-core-syntax
|
|
"deprecated" [ word make-deprecated ] define-core-syntax
|
|
|
|
"SYNTAX:" [
|
|
scan-new-word parse-definition define-syntax
|
|
] define-core-syntax
|
|
|
|
"SYMBOL:" [
|
|
scan-new-word define-symbol
|
|
] define-core-syntax
|
|
|
|
"SYMBOLS:" [
|
|
";" [ create-in [ reset-generic ] [ define-symbol ] bi ] each-token
|
|
] define-core-syntax
|
|
|
|
"SINGLETONS:" [
|
|
";" [ create-class-in define-singleton-class ] each-token
|
|
] define-core-syntax
|
|
|
|
"DEFER:" [
|
|
scan-token current-vocab create
|
|
[ fake-definition ] [ set-word ] [ undefined-def define ] tri
|
|
] define-core-syntax
|
|
|
|
"ALIAS:" [
|
|
scan-new-word scan-word define-alias
|
|
] define-core-syntax
|
|
|
|
"CONSTANT:" [
|
|
scan-new-word scan-object define-constant
|
|
] define-core-syntax
|
|
|
|
":" [
|
|
(:) define-declared
|
|
] define-core-syntax
|
|
|
|
"GENERIC:" [
|
|
[ simple-combination ] (GENERIC:)
|
|
] define-core-syntax
|
|
|
|
"GENERIC#" [
|
|
[ scan-number <standard-combination> ] (GENERIC:)
|
|
] define-core-syntax
|
|
|
|
"MATH:" [
|
|
[ math-combination ] (GENERIC:)
|
|
] define-core-syntax
|
|
|
|
"HOOK:" [
|
|
[ scan-word <hook-combination> ] (GENERIC:)
|
|
] define-core-syntax
|
|
|
|
"M:" [
|
|
(M:) define
|
|
] define-core-syntax
|
|
|
|
"UNION:" [
|
|
scan-new-class parse-definition define-union-class
|
|
] define-core-syntax
|
|
|
|
"INTERSECTION:" [
|
|
scan-new-class parse-definition define-intersection-class
|
|
] define-core-syntax
|
|
|
|
"MIXIN:" [
|
|
scan-new-class define-mixin-class
|
|
] define-core-syntax
|
|
|
|
"INSTANCE:" [
|
|
location [
|
|
scan-word scan-word 2dup add-mixin-instance
|
|
<mixin-instance>
|
|
] dip remember-definition
|
|
] define-core-syntax
|
|
|
|
"PREDICATE:" [
|
|
scan-new-class
|
|
"<" expect
|
|
scan-class
|
|
parse-definition define-predicate-class
|
|
] define-core-syntax
|
|
|
|
"SINGLETON:" [
|
|
scan-new-class define-singleton-class
|
|
] define-core-syntax
|
|
|
|
"TUPLE:" [
|
|
parse-tuple-definition define-tuple-class
|
|
] define-core-syntax
|
|
|
|
"final" [
|
|
word make-final
|
|
] define-core-syntax
|
|
|
|
"SLOT:" [
|
|
scan-token define-protocol-slot
|
|
] define-core-syntax
|
|
|
|
"C:" [
|
|
scan-new-word scan-word define-boa-word
|
|
] define-core-syntax
|
|
|
|
"ERROR:" [
|
|
parse-tuple-definition
|
|
pick save-location
|
|
define-error-class
|
|
] define-core-syntax
|
|
|
|
"FORGET:" [
|
|
scan-object forget
|
|
] define-core-syntax
|
|
|
|
"(" [
|
|
")" parse-effect suffix!
|
|
] define-core-syntax
|
|
|
|
"MAIN:" [
|
|
scan-word
|
|
[ current-vocab main<< ]
|
|
[ file get [ main<< ] [ drop ] if* ] bi
|
|
] define-core-syntax
|
|
|
|
"<<" [
|
|
[
|
|
\ >> parse-until >quotation
|
|
] with-nested-compilation-unit call( -- )
|
|
] define-core-syntax
|
|
|
|
"call-next-method" [
|
|
current-method get [
|
|
literalize suffix!
|
|
\ (call-next-method) suffix!
|
|
] [
|
|
not-in-a-method-error
|
|
] if*
|
|
] define-core-syntax
|
|
|
|
"maybe:" [
|
|
scan-class <maybe> suffix!
|
|
] define-core-syntax
|
|
|
|
"intersection{" [
|
|
\ } [ <anonymous-intersection> ] parse-literal
|
|
] define-core-syntax
|
|
|
|
"union{" [
|
|
\ } [ <anonymous-union> ] parse-literal
|
|
] define-core-syntax
|
|
|
|
"initial:" "syntax" lookup-word define-symbol
|
|
|
|
"read-only" "syntax" lookup-word define-symbol
|
|
|
|
"call(" [ \ call-effect parse-call( ] define-core-syntax
|
|
|
|
"execute(" [ \ execute-effect parse-call( ] define-core-syntax
|
|
|
|
"<<<<<<<" [ version-control-merge-conflict ] define-core-syntax
|
|
"=======" [ version-control-merge-conflict ] define-core-syntax
|
|
">>>>>>>" [ version-control-merge-conflict ] define-core-syntax
|
|
|
|
"<<<<<<" [ version-control-merge-conflict ] define-core-syntax
|
|
"======" [ version-control-merge-conflict ] define-core-syntax
|
|
">>>>>>" [ version-control-merge-conflict ] define-core-syntax
|
|
] with-compilation-unit
|