core/syntax/syntax.factor

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