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