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 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 ;
  14 IN: bootstrap.syntax
  15
  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
  22 ! in stage2.
  23
  24 : define-delimiter ( name -- )
  25     "syntax" lookup-word t "delimiter" set-word-prop ;
  26
  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 ;
  31
  32 : define-core-syntax ( name quot -- )
  33     [
  34         dup "syntax" lookup-word [ ] [ no-word-error ] ?if
  35         mark-top-level-syntax
  36     ] dip
  37     define-syntax ;
  38
  39 [
  40     { "]" "}" ";" ">>" } [ define-delimiter ] each
  41
  42     "PRIMITIVE:" [
  43         current-vocab name>>
  44         scan-word scan-effect ensure-primitive
  45     ] define-core-syntax
  46
  47     "CS{" [
  48         "Call stack literals are not supported" throw
  49     ] define-core-syntax
  50
  51     "IN:" [ scan-token set-current-vocab ] define-core-syntax
  52
  53     "<PRIVATE" [ begin-private ] define-core-syntax
  54
  55     "PRIVATE>" [ end-private ] define-core-syntax
  56
  57     "USE:" [ scan-token use-vocab ] define-core-syntax
  58
  59     "UNUSE:" [ scan-token unuse-vocab ] define-core-syntax
  60
  61     "USING:" [ ";" [ use-vocab ] each-token ] define-core-syntax
  62
  63     "QUALIFIED:" [ scan-token dup add-qualified ] define-core-syntax
  64
  65     "QUALIFIED-WITH:" [ scan-token scan-token add-qualified ] define-core-syntax
  66
  67     "FROM:" [
  68         scan-token "=>" expect ";" parse-tokens add-words-from
  69     ] define-core-syntax
  70
  71     "EXCLUDE:" [
  72         scan-token "=>" expect ";" parse-tokens add-words-excluding
  73     ] define-core-syntax
  74
  75     "RENAME:" [
  76         scan-token scan-token "=>" expect scan-token add-renamed-word
  77     ] define-core-syntax
  78
  79     "NAN:" [ 16 scan-base <fp-nan> suffix! ] define-core-syntax
  80
  81     "f" [ f suffix! ] define-core-syntax
  82
  83     "CHAR:" [
  84         lexer get parse-raw [ "token" throw-unexpected-eof ] unless* {
  85             { [ dup length 1 = ] [ first ] }
  86             { [ "\\" ?head ] [ next-escape >string "" assert= ] }
  87             [ name>char-hook get call( name -- char ) ]
  88         } cond suffix!
  89     ] define-core-syntax
  90
  91     "\"" [ parse-string suffix! ] define-core-syntax
  92
  93     "SBUF\"" [
  94         lexer get skip-blank parse-string >sbuf suffix!
  95     ] define-core-syntax
  96
  97     "P\"" [
  98         lexer get skip-blank parse-string <pathname> suffix!
  99     ] define-core-syntax
 100
 101     "[" [ parse-quotation suffix! ] define-core-syntax
 102     "{" [ \ } [ >array ] parse-literal ] define-core-syntax
 103     "V{" [ \ } [ >vector ] parse-literal ] define-core-syntax
 104     "B{" [ \ } [ >byte-array ] parse-literal ] define-core-syntax
 105     "BV{" [ \ } [ >byte-vector ] parse-literal ] define-core-syntax
 106     "H{" [ \ } [ parse-hashtable ] parse-literal ] define-core-syntax
 107     "T{" [ parse-tuple-literal suffix! ] define-core-syntax
 108     "TH{" [ parse-tuple-hash-literal suffix! ] define-core-syntax
 109     "W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax
 110     "HS{" [ \ } [ >hash-set ] parse-literal ] define-core-syntax
 111
 112     "POSTPONE:" [ scan-word suffix! ] define-core-syntax
 113     "\\" [ scan-word <wrapper> suffix! ] define-core-syntax
 114     "M\\" [ scan-word scan-word lookup-method <wrapper> suffix! ] define-core-syntax
 115     "inline" [ last-word make-inline ] define-core-syntax
 116     "recursive" [ last-word make-recursive ] define-core-syntax
 117     "foldable" [ last-word make-foldable ] define-core-syntax
 118     "flushable" [ last-word make-flushable ] define-core-syntax
 119     "delimiter" [ last-word t "delimiter" set-word-prop ] define-core-syntax
 120     "deprecated" [ last-word make-deprecated ] define-core-syntax
 121
 122     "SYNTAX:" [
 123         scan-new-word
 124         mark-top-level-syntax
 125         parse-definition define-syntax
 126     ] define-core-syntax
 127
 128     "BUILTIN:" [
 129         scan-word-name
 130         current-vocab lookup-word
 131         (parse-tuple-definition)
 132         2drop builtin-class check-instance drop
 133     ] define-core-syntax
 134
 135     "SYMBOL:" [
 136         scan-new-word define-symbol
 137     ] define-core-syntax
 138
 139     "SYMBOLS:" [
 140         ";" [ create-word-in [ reset-generic ] [ define-symbol ] bi ] each-token
 141     ] define-core-syntax
 142
 143     "SINGLETONS:" [
 144         ";" [ create-class-in define-singleton-class ] each-token
 145     ] define-core-syntax
 146
 147     "DEFER:" [
 148         scan-token current-vocab create-word
 149         [ fake-definition ] [ set-last-word ] [ undefined-def define ] tri
 150     ] define-core-syntax
 151
 152     "ALIAS:" [
 153         scan-new-word scan-word define-alias
 154     ] define-core-syntax
 155
 156     "CONSTANT:" [
 157         scan-new-word scan-object define-constant
 158     ] define-core-syntax
 159
 160     ":" [
 161         (:) define-declared
 162     ] define-core-syntax
 163
 164     "GENERIC:" [
 165         [ simple-combination ] (GENERIC:)
 166     ] define-core-syntax
 167
 168     "GENERIC#:" [
 169         [ scan-number <standard-combination> ] (GENERIC:)
 170     ] define-core-syntax
 171
 172     "MATH:" [
 173         [ math-combination ] (GENERIC:)
 174     ] define-core-syntax
 175
 176     "HOOK:" [
 177         [ scan-word <hook-combination> ] (GENERIC:)
 178     ] define-core-syntax
 179
 180     "M:" [
 181         (M:) define
 182     ] define-core-syntax
 183
 184     "UNION:" [
 185         scan-new-class parse-array-def define-union-class
 186     ] define-core-syntax
 187
 188     "INTERSECTION:" [
 189         scan-new-class parse-array-def define-intersection-class
 190     ] define-core-syntax
 191
 192     "MIXIN:" [
 193         scan-new-class define-mixin-class
 194     ] define-core-syntax
 195
 196     "INSTANCE:" [
 197         location [
 198             scan-word scan-word 2dup add-mixin-instance
 199             <mixin-instance>
 200         ] dip remember-definition
 201     ] define-core-syntax
 202
 203     "PREDICATE:" [
 204         scan-new-class
 205         "<" expect
 206         scan-class
 207         parse-definition define-predicate-class
 208     ] define-core-syntax
 209
 210     "SINGLETON:" [
 211         scan-new-class define-singleton-class
 212     ] define-core-syntax
 213
 214     "TUPLE:" [
 215         parse-tuple-definition define-tuple-class
 216     ] define-core-syntax
 217
 218     "final" [
 219         last-word make-final
 220     ] define-core-syntax
 221
 222     "SLOT:" [
 223         scan-token define-protocol-slot
 224     ] define-core-syntax
 225
 226     "C:" [
 227         scan-new-word scan-word define-boa-word
 228     ] define-core-syntax
 229
 230     "ERROR:" [
 231         parse-tuple-definition
 232         pick save-location
 233         define-error-class
 234     ] define-core-syntax
 235
 236     "FORGET:" [
 237         scan-object forget
 238     ] define-core-syntax
 239
 240     "(" [
 241         ")" parse-effect suffix!
 242     ] define-core-syntax
 243
 244     "MAIN:" [
 245         scan-word
 246         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 ] with-compilation-unit