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