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