core/syntax/syntax.factor

   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.intersection
   5 classes.maybe classes.mixin classes.parser classes.predicate
   6 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 vectors vocabs
  12 vocabs.parser words words.alias words.constant words.symbol ;
  13 IN: bootstrap.syntax
  14
  15 ! These words are defined as a top-level form, instead of with
  16 ! defining parsing words, because during stage1 bootstrap, the
  17 ! "syntax" vocabulary is copied from the host. When stage1
  18 ! bootstrap completes, the host's syntax vocabulary is deleted
  19 ! from the target, then this top-level form creates the
  20 ! target's "syntax" vocabulary as one of the first things done
  21 ! in stage2.
  22
  23 : define-delimiter ( name -- )
  24     "syntax" lookup-word t "delimiter" set-word-prop ;
  25
  26 ! Keep track of words defined by SYNTAX: as opposed to words
  27 ! merely generated by define-syntax.
  28 : mark-top-level-syntax ( word -- word )
  29     dup t "syntax" set-word-prop ;
  30
  31 : define-core-syntax ( name quot -- )
  32     [
  33         dup "syntax" lookup-word [ ] [ no-word-error ] ?if
  34         mark-top-level-syntax
  35     ] dip
  36     define-syntax ;
  37
  38 [
  39     { "]" "}" ";" ">>" } [ define-delimiter ] each
  40
  41     "PRIMITIVE:" [
  42         current-vocab name>>
  43         scan-word scan-effect ensure-primitive
  44     ] define-core-syntax
  45
  46     "CS{" [
  47         "Call stack literals are not supported" throw
  48     ] define-core-syntax
  49
  50     "!" [ lexer get next-line ] define-core-syntax
  51
  52     "#!" [ POSTPONE: ! ] define-core-syntax
  53
  54     "IN:" [ scan-token set-current-vocab ] define-core-syntax
  55
  56     "<PRIVATE" [ begin-private ] define-core-syntax
  57
  58     "PRIVATE>" [ end-private ] define-core-syntax
  59
  60     "USE:" [ scan-token use-vocab ] define-core-syntax
  61
  62     "UNUSE:" [ scan-token unuse-vocab ] define-core-syntax
  63
  64     "USING:" [ ";" [ use-vocab ] each-token ] define-core-syntax
  65
  66     "QUALIFIED:" [ scan-token dup add-qualified ] define-core-syntax
  67
  68     "QUALIFIED-WITH:" [ scan-token scan-token add-qualified ] define-core-syntax
  69
  70     "FROM:" [
  71         scan-token "=>" expect ";" parse-tokens add-words-from
  72     ] define-core-syntax
  73
  74     "EXCLUDE:" [
  75         scan-token "=>" expect ";" parse-tokens add-words-excluding
  76     ] define-core-syntax
  77
  78     "RENAME:" [
  79         scan-token scan-token "=>" expect scan-token add-renamed-word
  80     ] define-core-syntax
  81
  82     "NAN:" [ 16 scan-base <fp-nan> suffix! ] define-core-syntax
  83
  84     "f" [ f suffix! ] define-core-syntax
  85
  86     "CHAR:" [
  87         scan-token {
  88             { [ dup length 1 = ] [ first ] }
  89             { [ "\\" ?head ] [ next-escape >string "" assert= ] }
  90             [ name>char-hook get call( name -- char ) ]
  91         } cond suffix!
  92     ] define-core-syntax
  93
  94     "\"" [ parse-multiline-string suffix! ] define-core-syntax
  95
  96     "SBUF\"" [
  97         lexer get skip-blank parse-string >sbuf suffix!
  98     ] define-core-syntax
  99
 100     "P\"" [
 101         lexer get skip-blank parse-string <pathname> suffix!
 102     ] define-core-syntax
 103
 104     "[" [ parse-quotation suffix! ] define-core-syntax
 105     "{" [ \ } [ >array ] parse-literal ] define-core-syntax
 106     "V{" [ \ } [ >vector ] parse-literal ] define-core-syntax
 107     "B{" [ \ } [ >byte-array ] parse-literal ] define-core-syntax
 108     "BV{" [ \ } [ >byte-vector ] parse-literal ] define-core-syntax
 109     "H{" [ \ } [ parse-hashtable ] parse-literal ] define-core-syntax
 110     "T{" [ parse-tuple-literal suffix! ] define-core-syntax
 111     "W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax
 112     "HS{" [ \ } [ >hash-set ] parse-literal ] define-core-syntax
 113
 114     "POSTPONE:" [ scan-word suffix! ] define-core-syntax
 115     "\\" [ scan-word <wrapper> suffix! ] define-core-syntax
 116     "M\\" [ scan-word scan-word lookup-method <wrapper> suffix! ] define-core-syntax
 117     "inline" [ last-word make-inline ] define-core-syntax
 118     "recursive" [ last-word make-recursive ] define-core-syntax
 119     "foldable" [ last-word make-foldable ] define-core-syntax
 120     "flushable" [ last-word make-flushable ] define-core-syntax
 121     "delimiter" [ last-word t "delimiter" set-word-prop ] define-core-syntax
 122     "deprecated" [ last-word make-deprecated ] define-core-syntax
 123
 124     "SYNTAX:" [
 125         scan-new-word
 126         mark-top-level-syntax
 127         parse-definition define-syntax
 128     ] define-core-syntax
 129
 130     "BUILTIN:" [
 131         scan-word-name
 132         current-vocab lookup-word
 133         (parse-tuple-definition) 2drop check-builtin
 134     ] define-core-syntax
 135
 136     "SYMBOL:" [
 137         scan-new-word define-symbol
 138     ] define-core-syntax
 139
 140     "SYMBOLS:" [
 141         ";" [ create-word-in [ reset-generic ] [ define-symbol ] bi ] each-token
 142     ] define-core-syntax
 143
 144     "SINGLETONS:" [
 145         ";" [ create-class-in define-singleton-class ] each-token
 146     ] define-core-syntax
 147
 148     "DEFER:" [
 149         scan-token current-vocab create-word
 150         [ fake-definition ] [ set-last-word ] [ undefined-def define ] tri
 151     ] define-core-syntax
 152
 153     "ALIAS:" [
 154         scan-new-word scan-word define-alias
 155     ] define-core-syntax
 156
 157     "CONSTANT:" [
 158         scan-new-word scan-object define-constant
 159     ] define-core-syntax
 160
 161     ":" [
 162         (:) define-declared
 163     ] define-core-syntax
 164
 165     "GENERIC:" [
 166         [ simple-combination ] (GENERIC:)
 167     ] define-core-syntax
 168
 169     "GENERIC#" [
 170         [ scan-number <standard-combination> ] (GENERIC:)
 171     ] define-core-syntax
 172
 173     "MATH:" [
 174         [ math-combination ] (GENERIC:)
 175     ] define-core-syntax
 176
 177     "HOOK:" [
 178         [ scan-word <hook-combination> ] (GENERIC:)
 179     ] define-core-syntax
 180
 181     "M:" [
 182         (M:) define
 183     ] define-core-syntax
 184
 185     "UNION:" [
 186         scan-new-class parse-definition define-union-class
 187     ] define-core-syntax
 188
 189     "INTERSECTION:" [
 190         scan-new-class parse-definition define-intersection-class
 191     ] define-core-syntax
 192
 193     "MIXIN:" [
 194         scan-new-class define-mixin-class
 195     ] define-core-syntax
 196
 197     "INSTANCE:" [
 198         location [
 199             scan-word scan-word 2dup add-mixin-instance
 200             <mixin-instance>
 201         ] dip remember-definition
 202     ] define-core-syntax
 203
 204     "PREDICATE:" [
 205         scan-new-class
 206         "<" expect
 207         scan-class
 208         parse-definition define-predicate-class
 209     ] define-core-syntax
 210
 211     "SINGLETON:" [
 212         scan-new-class define-singleton-class
 213     ] define-core-syntax
 214
 215     "TUPLE:" [
 216         parse-tuple-definition define-tuple-class
 217     ] define-core-syntax
 218
 219     "final" [
 220         last-word make-final
 221     ] define-core-syntax
 222
 223     "SLOT:" [
 224         scan-token define-protocol-slot
 225     ] define-core-syntax
 226
 227     "C:" [
 228         scan-new-word scan-word define-boa-word
 229     ] define-core-syntax
 230
 231     "ERROR:" [
 232         parse-tuple-definition
 233         pick save-location
 234         define-error-class
 235     ] define-core-syntax
 236
 237     "FORGET:" [
 238         scan-object forget
 239     ] define-core-syntax
 240
 241     "(" [
 242         ")" parse-effect suffix!
 243     ] define-core-syntax
 244
 245     "MAIN:" [
 246         scan-word
 247         dup ( -- ) check-stack-effect
 248         [ current-vocab main<< ]
 249         [ current-source-file get [ main<< ] [ drop ] if* ] bi
 250     ] define-core-syntax
 251
 252     "<<" [
 253         [
 254             \ >> parse-until >quotation
 255         ] with-nested-compilation-unit call( -- )
 256     ] define-core-syntax
 257
 258     "call-next-method" [
 259         current-method get [
 260             literalize suffix!
 261             \ (call-next-method) suffix!
 262         ] [
 263             not-in-a-method-error
 264         ] if*
 265     ] define-core-syntax
 266
 267     "maybe{" [
 268         \ } [ <anonymous-union> <maybe> ] parse-literal
 269     ] define-core-syntax
 270
 271     "not{" [
 272         \ } [ <anonymous-union> <anonymous-complement> ] parse-literal
 273     ] define-core-syntax
 274
 275     "intersection{" [
 276          \ } [ <anonymous-intersection> ] parse-literal
 277     ] define-core-syntax
 278
 279     "union{" [
 280         \ } [ <anonymous-union> ] parse-literal
 281     ] define-core-syntax
 282
 283     "initial:" "syntax" lookup-word define-symbol
 284
 285     "read-only" "syntax" lookup-word define-symbol
 286
 287     "call(" [ \ call-effect parse-call( ] define-core-syntax
 288
 289     "execute(" [ \ execute-effect parse-call( ] define-core-syntax
 290
 291     "<<<<<<<" [ version-control-merge-conflict ] define-core-syntax
 292     "=======" [ version-control-merge-conflict ] define-core-syntax
 293     ">>>>>>>" [ version-control-merge-conflict ] define-core-syntax
 294
 295     "<<<<<<" [ version-control-merge-conflict ] define-core-syntax
 296     "======" [ version-control-merge-conflict ] define-core-syntax
 297     ">>>>>>" [ version-control-merge-conflict ] define-core-syntax
 298 ] with-compilation-unit