factor: fixing [[ ]] and some unit tests

Also url[[]] if you define a url[[ word.

basis/alien/complex/complex.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.complex.functor kernel
-sequences ;
+USING: accessors alien alien.c-types alien.complex.functor
+classes.struct kernel math quotations ;
+FROM: alien.c-types => float double ;
 IN: alien.complex
 
-<<
-{ "float" "double" } [ dup "complex-" prepend define-complex-type ] each
->>
+COMPLEX-TYPE: float complex-float
+COMPLEX-TYPE: double complex-double
 
 <<
 ! This overrides the fact that small structures are never returned

basis/alien/complex/functor/functor.factor

@@ -1,32 +1,27 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types classes.struct functors
-kernel math math.functions quotations ;
+USING: functors2 ;
 IN: alien.complex.functor
 
-<FUNCTOR: define-complex-type ( N T -- )
+INLINE-FUNCTOR: complex-type ( n: existing-word t: name -- ) [[
+    USING: alien alien.c-types classes.struct kernel quotations ;
+    QUALIFIED: math
 
-N-type IS ${N}
+    <<
+    STRUCT: ${t} { real ${n} } { imaginary ${n} } ;
 
-T-class DEFINES-CLASS ${T}
+    : <${t}> ( z -- alien )
+        math:>rect ${t} <struct-boa> >c-ptr ;
 
-<T> DEFINES <${T}>
-*T DEFINES *${T}
+    : *${t} ( alien -- z )
+        ${t} memory>struct [ real>> ] [ imaginary>> ] bi math:rect> ; inline
 
-WHERE
+    >>
 
-STRUCT: T-class { real N-type } { imaginary N-type } ;
+    \ ${t} lookup-c-type
+    [ <${t}> ] >>unboxer-quot
+    [ *${t} ] >>boxer-quot
+    complex >>boxed-class
+    drop
 
-: <T> ( z -- alien )
-    >rect T-class <struct-boa> >c-ptr ;
-
-: *T ( alien -- z )
-    T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline
-
-T-class lookup-c-type
-<T> 1quotation >>unboxer-quot
-*T 1quotation >>boxer-quot
-complex >>boxed-class
-drop
-
-;FUNCTOR>
+]]

basis/alien/data/data-docs.factor

@@ -30,7 +30,7 @@ HELP: <c-array>
   }
 } ;
 
-HELP: c-array{
+HELP: \c-array{
 { $description "Literal syntax, consists of a C-type followed by a series of values terminated by " { $snippet "}" } }
 { $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
 { $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
@@ -182,7 +182,7 @@ $nl
 { $subsections "alien.enums" }
 "A utility for defining " { $link "destructors" } " for deallocating memory:"
 { $subsections "alien.destructors" }
-"C struct and union types can be defined with " { $link POSTPONE: STRUCT: } " and " { $link POSTPONE: UNION-STRUCT: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
+"C struct and union types can be defined with " { $link postpone: \STRUCT: } " and " { $link postpone: \UNION-STRUCT: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
 
 HELP: malloc-string
 { $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
@@ -202,7 +202,7 @@ HELP: <c-direct-array>
 { $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
 
 ARTICLE: "c-strings" "C strings"
-"C string types are arrays with shape " { $snippet "{ c-string encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link c-string } " is an alias for " { $snippet "{ c-string utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors. In " { $link POSTPONE: TYPEDEF: } ", " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: STRUCT: } " definitions, the shorthand syntax " { $snippet "c-string[encoding]" } " can be used to specify the string encoding."
+"C string types are arrays with shape " { $snippet "{ c-string encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link c-string } " is an alias for " { $snippet "{ c-string utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors. In " { $link postpone: \TYPEDEF: } ", " { $link postpone: \FUNCTION: } ", " { $link postpone: \CALLBACK: } ", and " { $link postpone: \STRUCT: } " definitions, the shorthand syntax " { $snippet "c-string[encoding]" } " can be used to specify the string encoding."
 $nl
 "Using C string types triggers automatic conversions:"
 { $list
@@ -211,7 +211,7 @@ $nl
     "Passing an already encoded " { $link byte-array } " also works and performs no conversion."
     }
     { "Returning a C string from a C function allocates a Factor string in the Factor heap; the memory pointed to by the returned pointer is then decoded with the requested encoding into the Factor string." }
-    { "Reading " { $link c-string } " slots of " { $link POSTPONE: STRUCT: } " or " { $link POSTPONE: UNION-STRUCT: } " returns Factor strings." }
+    { "Reading " { $link c-string } " slots of " { $link postpone: \STRUCT: } " or " { $link postpone: \UNION-STRUCT: } " returns Factor strings." }
 }
 $nl
 "Care must be taken if the C function expects a pointer to a string with its length represented by another parameter rather than a null terminator. Passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."

basis/alien/data/data-tests.factor

@@ -46,7 +46,7 @@ SPECIALIZED-ARRAY: foo
 { f } [ B{ } binary-zero? ] unit-test
 { t } [ S{ foo f 0 f f } binary-zero? ] unit-test
 { f } [ S{ foo f 1 f f } binary-zero? ] unit-test
-{ f } [ S{ foo f 0 ALIEN: 8 f } binary-zero? ] unit-test
+{ f } [ S{ foo f 0 alien: 8 f } binary-zero? ] unit-test
 { f } [ S{ foo f 0 f t } binary-zero? ] unit-test
 { t t f } [
     foo-array{

basis/alien/data/data.factor

@@ -66,7 +66,7 @@ M: word <c-direct-array>
 M: pointer <c-direct-array>
     drop void* <c-direct-array> ;
 
-SYNTAX: c-array{ \ } [ unclip >c-array ] parse-literal ;
+SYNTAX: \c-array{ \ } [ unclip >c-array ] parse-literal ;
 
 SYNTAX: c-array@
     scan-object [ scan-object scan-object ] dip

basis/alien/destructors/destructors-docs.factor

@@ -1,7 +1,7 @@
 IN: alien.destructors
 USING: help.markup help.syntax alien destructors ;
 
-HELP: DESTRUCTOR:
+HELP: \DESTRUCTOR:
 { $syntax "DESTRUCTOR: word" }
 { $description "Defines four things:"
   { $list
@@ -25,6 +25,6 @@ HELP: DESTRUCTOR:
 
 ARTICLE: "alien.destructors" "Alien destructors"
 "The " { $vocab-link "alien.destructors" } " vocabulary defines a utility parsing word for defining new disposable classes."
-{ $subsections POSTPONE: DESTRUCTOR: } ;
+{ $subsections postpone: \DESTRUCTOR: } ;
 
 ABOUT: "alien.destructors"

basis/alien/destructors/destructors.factor

@@ -1,32 +1,22 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors destructors effects functors generalizations
-kernel parser sequences ;
+USING: functors2 ;
 IN: alien.destructors
 
 TUPLE: alien-destructor alien ;
 
-<FUNCTOR: define-destructor ( F -- )
+INLINE-FUNCTOR: destructor ( f: existing-word -- ) [[
+    USING: accessors alien.destructors effects generalizations
+    destructors kernel literals sequences ;
 
-F-destructor DEFINES-CLASS ${F}-destructor
-<F-destructor> DEFINES <${F}-destructor>
-&F DEFINES &${F}
-|F DEFINES |${F}
-N [ F stack-effect out>> length ]
+    TUPLE: ${f}-destructor < alien-destructor ;
 
-WHERE
+    : <${f}-destructor> ( alien -- destructor )
+        ${f}-destructor boa ; inline
 
-TUPLE: F-destructor < alien-destructor ;
+    : &${f} ( alien -- alien ) dup <${f}-destructor> &dispose drop ; inline
 
-: <F-destructor> ( alien -- destructor )
-    F-destructor boa ; inline
+    : |${f} ( alien -- alien ) dup <${f}-destructor> |dispose drop ; inline
 
-M: F-destructor dispose alien>> F N ndrop ;
-
-: &F ( alien -- alien ) dup <F-destructor> &dispose drop ; inline
-
-: |F ( alien -- alien ) dup <F-destructor> |dispose drop ; inline
-
-;FUNCTOR>
-
-SYNTAX: DESTRUCTOR: scan-word define-destructor ;
+    M: ${f}-destructor dispose alien>> ${f} $[ \ ${f} stack-effect out>> length ] ndrop ;
+]]

basis/alien/endian/endian-docs.factor

@@ -4,7 +4,7 @@ USING: help.markup help.syntax kernel math quotations
 classes.struct ;
 IN: alien.endian
 
-HELP: BE-PACKED-STRUCT:
+HELP: \BE-PACKED-STRUCT:
 { $description "Defines a packed " { $link struct } " where endian-unaware types become big-endian types. Note that endian-aware types will override the big-endianness of this " { $link struct } " declaration; little-endian types will stay little-endian. On big-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
 { $unchecked-example
     "! When run on a big-endian platform, this struct should prettyprint the same as defined"
@@ -17,7 +17,7 @@ IN: scratchpad
 STRUCT: s1 { a char[7] } { b be32 initial: 0 } ;"
 } ;
 
-HELP: BE-STRUCT:
+HELP: \BE-STRUCT:
 { $description "Defines a " { $link struct } " where endian-unaware types become big-endian types. Note that endian-aware types will override the big-endianness of this " { $link struct } " declaration; little-endian types will stay little-endian. On big-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
 { $unchecked-example
     "! When run on a big-endian platform, this struct should prettyprint the same as defined"
@@ -30,7 +30,7 @@ IN: scratchpad
 STRUCT: s1 { a be32 initial: 0 } { b le32 initial: 0 } ;"
 } ;
 
-HELP: LE-PACKED-STRUCT:
+HELP: \LE-PACKED-STRUCT:
 { $description "Defines a packed " { $link struct } " where endian-unaware types become little-endian types. Note that endian-aware types will override the little-endianness of this " { $link struct } " declaration; big-endian types will stay big-endian. On little-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
 { $unchecked-example
     "! When run on a little-endian platform, this struct should prettyprint the same as defined"
@@ -43,7 +43,7 @@ IN: scratchpad
 STRUCT: s1 { a char[7] } { b int initial: 0 } ;"
 } ;
 
-HELP: LE-STRUCT:
+HELP: \LE-STRUCT:
 { $description "Defines a " { $link struct } " where endian-unaware types become little-endian types. Note that endian-aware types will override the little-endianness of this " { $link struct } " declaration; big-endian types will stay big-endian. On little-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
 { $unchecked-example
     "! When run on a little-endian platform, this struct should prettyprint the same as defined"
@@ -141,10 +141,10 @@ ARTICLE: "alien.endian" "Alien endian-aware types"
 }
 "Syntax for making endian-aware structs out of native types:"
 { $subsections
-    POSTPONE: LE-STRUCT:
-    POSTPONE: BE-STRUCT:
-    POSTPONE: LE-PACKED-STRUCT:
-    POSTPONE: BE-PACKED-STRUCT:
+    postpone: \LE-STRUCT:
+    postpone: \BE-STRUCT:
+    postpone: \LE-PACKED-STRUCT:
+    postpone: \BE-PACKED-STRUCT:
 } ;
 
 ABOUT: "alien.endian"

basis/alien/endian/endian.factor

@@ -147,18 +147,18 @@ ERROR: unsupported-endian-type endian slot ;
     [ compute-struct-offsets ] [ drop 1 ]
     (define-struct-class) ;
 
-SYNTAX: LE-STRUCT:
+SYNTAX: \LE-STRUCT:
     parse-struct-definition
     little-endian define-endian-struct-class ;
 
-SYNTAX: BE-STRUCT:
+SYNTAX: \BE-STRUCT:
     parse-struct-definition
     big-endian define-endian-struct-class ;
 
-SYNTAX: LE-PACKED-STRUCT:
+SYNTAX: \LE-PACKED-STRUCT:
     parse-struct-definition
     little-endian define-endian-packed-struct-class ;
 
-SYNTAX: BE-PACKED-STRUCT:
+SYNTAX: \BE-PACKED-STRUCT:
     parse-struct-definition
     big-endian define-endian-packed-struct-class ;

basis/alien/enums/enums-docs.factor

@@ -7,7 +7,7 @@ HELP: define-enum
 { $values
     { "word" word } { "base-type" c-type } { "members" "sequence of word and value pairs" }
 }
-{ $description "Defines an enum. This is the run-time equivalent of " { $link POSTPONE: ENUM: } "." } ;
+{ $description "Defines an enum. This is the run-time equivalent of " { $link postpone: \ENUM: } "." } ;
 
 HELP: enum>number
 { $values
@@ -23,6 +23,6 @@ HELP: number>enum
 }
 { $description "Convert a number to an enum." } ;
 
-{ POSTPONE: ENUM: define-enum enum>number number>enum } related-words
+{ postpone: \ENUM: define-enum enum>number number>enum } related-words
 
 ABOUT: "alien.enums"

basis/alien/parser/parser-tests.factor

@@ -122,6 +122,7 @@ TYPEDEF: int alien-parser-test-int ! reasonably unique name...
 ] unit-test
 
 ! Redefinitions
-{ } [
-    [ C-TYPE: hi TYPEDEF: void* hi ] with-compilation-unit
-] unit-test
+<<
+C-TYPE: hi
+TYPEDEF: void* hi
+>>

basis/alien/parser/parser.factor

@@ -21,7 +21,7 @@ ERROR: bad-array-type ;
 : (parse-c-type) ( string -- type )
     {
         { [ "*" ?tail ] [ (parse-c-type) <pointer> ] }
-        { [ CHAR: ] over member? ] [ parse-array-type ] }
+        { [ char: \] over member? ] [ parse-array-type ] }
         { [ dup search ] [ parse-word ] }
         [ parse-word ]
     } cond ;

basis/alien/prettyprint/prettyprint.factor

@@ -11,7 +11,7 @@ M: alien pprint*
     {
         { [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] }
         { [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
-        [ \ ALIEN: [ alien-address >hex text ] pprint-prefix ]
+        [ \ alien: [ alien-address >hex text ] pprint-prefix ]
     } cond ;
 
 M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;

basis/alien/remote-control/remote-control-tests.factor

@@ -16,7 +16,7 @@ IN: alien.remote-control.tests
     image-path :> image
 
     [
-        [I
+        I[[
 #include <vm/master.h>
 #include <stdio.h>
 #include <stdbool.h>
@@ -32,7 +32,7 @@ int main(int argc, char **argv)
     printf("Done.\n");
     return 0;
 }
-        I]
+        ]]
     ] with-string-writer
     [ compile-file ] with-temp-directory
     [ run-test ] with-temp-directory ;

basis/alien/syntax/syntax-docs.factor

@@ -2,33 +2,33 @@ IN: alien.syntax
 USING: alien alien.c-types alien.enums alien.libraries classes.struct
 help.markup help.syntax see ;
 
-HELP: DLL"
+HELP: \DLL"
 { $syntax "DLL\" path\"" }
 { $values { "path" "a pathname string" } }
 { $description "Constructs a DLL handle at parse time." } ;
 
-HELP: ALIEN:
-{ $syntax "ALIEN: address" }
+HELP: \alien:
+{ $syntax "alien: address" }
 { $values { "address" "a non-negative hexadecimal integer" } }
 { $description "Creates an alien object at parse time." }
 { $notes "Alien objects are invalidated between image saves and loads, and hence source files should not contain alien literals; this word is for interactive use only. See " { $link "alien-expiry" } " for details." } ;
 
 ARTICLE: "syntax-aliens" "Alien object literal syntax"
 { $subsections
-    POSTPONE: ALIEN:
-    POSTPONE: DLL"
+    postpone: \alien:
+    postpone: \DLL"
 } ;
 
-HELP: LIBRARY:
+HELP: \LIBRARY:
 { $syntax "LIBRARY: name" }
 { $values { "name" "a logical library name" } }
-{ $description "Sets the logical library for consequent " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: C-GLOBAL: } " and " { $link POSTPONE: CALLBACK: } " definitions, as well as " { $link POSTPONE: &: } " forms." }
+{ $description "Sets the logical library for consequent " { $link postpone: \FUNCTION: } ", " { $link postpone: \C-GLOBAL: } " and " { $link postpone: \CALLBACK: } " definitions, as well as " { $link postpone: \&: } " forms." }
 { $notes "Logical library names are defined with the " { $link add-library } " word." } ;
 
-HELP: FUNCTION:
+HELP: \FUNCTION:
 { $syntax "FUNCTION: return name ( parameters )" }
 { $values { "return" "a C return type" } { "name" "a C function name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
-{ $description "Defines a new word " { $snippet "name" } " which calls the C library function with the same " { $snippet "name" } " in the logical library given by the most recent " { $link POSTPONE: LIBRARY: } " declaration."
+{ $description "Defines a new word " { $snippet "name" } " which calls the C library function with the same " { $snippet "name" } " in the logical library given by the most recent " { $link postpone: \LIBRARY: } " declaration."
 $nl
 "The new word must be compiled before being executed." }
 { $examples
@@ -45,26 +45,26 @@ $nl
     "The answer to the question is 42."
 } }
 "Using the " { $link c-string } " type instead of " { $snippet "char*" } " causes the FFI to automatically convert Factor strings to C strings. See " { $link "c-strings" } " for more information on using strings with the FFI."
-{ $notes "To make a Factor word with a name different from the C function, use " { $link POSTPONE: FUNCTION-ALIAS: } "." } ;
+{ $notes "To make a Factor word with a name different from the C function, use " { $link postpone: \FUNCTION-ALIAS: } "." } ;
 
-HELP: FUNCTION-ALIAS:
+HELP: \FUNCTION-ALIAS:
 { $syntax "FUNCTION-ALIAS: factor-name
     return c_name ( parameters ) ;" }
 { $values { "factor-name" "a Factor word name" } { "return" "a C return type" } { "name" "a C function name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
-{ $description "Defines a new word " { $snippet "factor-name" } " which calls the C library function named " { $snippet "c_name" } " in the logical library given by the most recent " { $link POSTPONE: LIBRARY: } " declaration."
+{ $description "Defines a new word " { $snippet "factor-name" } " which calls the C library function named " { $snippet "c_name" } " in the logical library given by the most recent " { $link postpone: \LIBRARY: } " declaration."
 $nl
 "The new word must be compiled before being executed." }
 { $notes "Note that the parentheses and commas are only syntax sugar and can be omitted. They serve no purpose other than to make the declaration easier to read." } ;
 
-{ POSTPONE: FUNCTION: POSTPONE: FUNCTION-ALIAS: } related-words
+{ postpone: \FUNCTION: postpone: \FUNCTION-ALIAS: } related-words
 
-HELP: TYPEDEF:
+HELP: \TYPEDEF:
 { $syntax "TYPEDEF: old new" }
 { $values { "old" "a C type" } { "new" "a C type" } }
 { $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
 { $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
 
-HELP: ENUM:
+HELP: \ENUM:
 { $syntax "ENUM: type words... ;" "ENUM: type < base-type words..." }
 { $values { "type" { $maybe "a name to typedef to int" } } { "words" "a sequence of word names" } }
 { $description "Creates a c-type that boxes and unboxes integer values to symbols. A symbol is defined for each member word. The base c-type can optionally be specified and defaults to " { $link int } ". A constructor word " { $snippet "<type>" } " is defined for converting from integers to singletons. The generic word " { $link enum>number } " converts from singletons to integers. Enum-typed values are automatically prettyprinted as their singleton words. Unrecognizing enum numbers are kept as numbers." }
@@ -81,25 +81,25 @@ HELP: ENUM:
     { $code "ENUM: tv_peripherals_4 < uint\n{ appletv 1 } { chromecast 2 } { roku 4 } ;" }
 } ;
 
-HELP: C-TYPE:
+HELP: \C-TYPE:
 { $syntax "C-TYPE: type" }
 { $values { "type" "a new C type" } }
-{ $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link POSTPONE: FUNCTION: } " or as a slot of a " { $link POSTPONE: STRUCT: } ". However, it can be used as the type of a " { $link pointer } "." $nl
+{ $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link postpone: \FUNCTION: } " or as a slot of a " { $link postpone: \STRUCT: } ". However, it can be used as the type of a " { $link pointer } "." $nl
 { $snippet "C-TYPE:" } " can also be used to forward declare C types, allowing circular dependencies to occur between types. For example:"
 { $code "C-TYPE: forward
 STRUCT: backward { x forward* } ;
 STRUCT: forward { x backward* } ;" } }
 { $notes "Primitive C types are displayed using " { $snippet "C-TYPE:" } " syntax when they are " { $link see } "n." } ;
 
-HELP: CALLBACK:
+HELP: \CALLBACK:
 { $syntax "CALLBACK: return type ( parameters )" }
 { $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
-{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters. The ABI of the callback is decided from the ABI of the active " { $link POSTPONE: LIBRARY: } " declaration." }
+{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters. The ABI of the callback is decided from the ABI of the active " { $link postpone: \LIBRARY: } " declaration." }
 { $examples
     { $code
         "CALLBACK: bool FakeCallback ( int message, void* payload )"
         ": MyFakeCallback ( -- alien )"
-        "    [| message payload |"
+        "    |[ message payload |"
         "        \"message #\" write"
         "        message number>string write"
         "        \" received\" write nl"
@@ -108,28 +108,28 @@ HELP: CALLBACK:
     }
 } ;
 
-HELP: &:
+HELP: \&:
 { $syntax "&: symbol" }
 { $values { "symbol" "A C global variable name" } }
-{ $description "Pushes the address of a symbol named " { $snippet "symbol" } " from the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
+{ $description "Pushes the address of a symbol named " { $snippet "symbol" } " from the current library, set with " { $link postpone: \LIBRARY: } "." } ;
 
 HELP: typedef
 { $values { "old" "a C type" } { "new" "a C type" } }
 { $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
-{ $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link POSTPONE: TYPEDEF: } " word instead." } ;
+{ $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link postpone: \TYPEDEF: } " word instead." } ;
 
-{ POSTPONE: TYPEDEF: typedef } related-words
+{ postpone: \TYPEDEF: typedef } related-words
 
-HELP: C-GLOBAL:
+HELP: \C-GLOBAL:
 { $syntax "C-GLOBAL: type name" }
 { $values { "type" "a C type" } { "name" "a C global variable name" } }
-{ $description "Defines a getter " { $snippet "name" } " and setter " { $snippet "set-name" } " for the global value in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
+{ $description "Defines a getter " { $snippet "name" } " and setter " { $snippet "set-name" } " for the global value in the current library, set with " { $link postpone: \LIBRARY: } "." } ;
 
 ARTICLE: "alien.enums" "Enumeration types"
-"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link POSTPONE: ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."
+"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link postpone: \ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."
 $nl
 "Defining enums:"
-{ $subsection POSTPONE: ENUM: }
+{ $subsection postpone: \ENUM: }
 "Defining enums at run-time:"
 { $subsection define-enum }
 "Conversions between enums and integers:"

basis/alien/syntax/syntax.factor

@@ -6,37 +6,37 @@ strings.parser vocabs words ;
 << "alien.arrays" require >> ! needed for bootstrap
 IN: alien.syntax
 
-SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ;
+SYNTAX: \DLL" lexer get skip-blank parse-string dlopen suffix! ;
 
-SYNTAX: ALIEN: 16 scan-base <alien> suffix! ;
+SYNTAX: \alien: 16 scan-base <alien> suffix! ;
 
-SYNTAX: BAD-ALIEN <bad-alien> suffix! ;
+SYNTAX: \BAD-ALIEN <bad-alien> suffix! ;
 
-SYNTAX: LIBRARY: scan-token current-library set ;
+SYNTAX: \LIBRARY: scan-token current-library set ;
 
-SYNTAX: FUNCTION:
+SYNTAX: \FUNCTION:
     (FUNCTION:) make-function define-inline ;
 
-SYNTAX: FUNCTION-ALIAS:
+SYNTAX: \FUNCTION-ALIAS:
     scan-token create-function
     (FUNCTION:) (make-function) define-inline ;
 
-SYNTAX: CALLBACK:
+SYNTAX: \CALLBACK:
     (CALLBACK:) define-inline ;
 
-SYNTAX: TYPEDEF:
+SYNTAX: \TYPEDEF:
     scan-c-type CREATE-C-TYPE dup save-location typedef ;
 
-SYNTAX: ENUM:
+SYNTAX: \ENUM:
     parse-enum (define-enum) ;
 
-SYNTAX: C-TYPE:
+SYNTAX: \C-TYPE:
     void CREATE-C-TYPE typedef ;
 
-SYNTAX: &:
+SYNTAX: \&:
     scan-token current-library get '[ _ _ address-of ] append! ;
 
-SYNTAX: C-GLOBAL: scan-c-type scan-new-word define-global ;
+SYNTAX: \C-GLOBAL: scan-c-type scan-new-word define-global ;
 
-SYNTAX: pointer:
+SYNTAX: \pointer:
     scan-c-type <pointer> suffix! ;

basis/base64/base64.factor

@@ -23,13 +23,13 @@ CONSTANT: alphabet
     alphabet nth ; inline
 
 : base64>ch ( ch -- ch )
-    $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
+    $[ alphabet alphabet-inverse 0 char: = pick set-nth ] nth
     [ malformed-base64 ] unless* ; inline
 
 : (write-lines) ( column byte-array -- column' )
     output-stream get dup '[
         _ stream-write1 1 + dup 76 = [
-            drop B{ CHAR: \r CHAR: \n } _ stream-write 0
+            drop B{ char: \r char: \n } _ stream-write 0
         ] when
     ] each ; inline
 
@@ -43,7 +43,7 @@ CONSTANT: alphabet
 
 : encode-pad ( seq n -- byte-array )
     [ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
-    4 CHAR: = pad-tail ; inline
+    4 char: = pad-tail ; inline
 
 : (encode-base64) ( stream column -- )
     3 pick stream-read dup length {
@@ -77,14 +77,14 @@ PRIVATE>
 
 : decode4 ( seq -- )
     [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
-    [ [ CHAR: = = ] count ] bi
+    [ [ char: = = ] count ] bi
     [ write ] [ head-slice* write ] if-zero ; inline
 
 : (decode-base64) ( stream -- )
     4 "\n\r" pick read-ignoring dup length {
         { 0 [ 2drop ] }
         { 4 [ decode4 (decode-base64) ] }
-        [ drop 4 CHAR: = pad-tail decode4 (decode-base64) ]
+        [ drop 4 char: = pad-tail decode4 (decode-base64) ]
     } case ;
 
 PRIVATE>

basis/bit-arrays/bit-arrays-docs.factor

@@ -29,14 +29,14 @@ $nl
     bit-array>integer
 }
 "Bit array literal syntax:"
-{ $subsections POSTPONE: ?{ } ;
+{ $subsections postpone: \?{ } ;
 
 ABOUT: "bit-arrays"
 
-HELP: ?{
+HELP: \?{
 { $syntax "?{ elements... }" }
 { $values { "elements" "a list of booleans" } }
-{ $description "Marks the beginning of a literal bit array. Literal bit arrays are terminated by " { $link POSTPONE: } } "." }
+{ $description "Marks the beginning of a literal bit array. Literal bit arrays are terminated by " { $link postpone: \} } "." }
 { $examples { $code "?{ t f t }" } } ;
 
 HELP: bit-array

basis/bit-arrays/bit-arrays.factor

@@ -86,7 +86,7 @@ M: bit-array resize
 
 M: bit-array byte-length length bits>bytes ; inline
 
-SYNTAX: ?{ \ } [ >bit-array ] parse-literal ;
+SYNTAX: \?{ \ } [ >bit-array ] parse-literal ;
 
 : integer>bit-array ( n -- bit-array )
     dup 0 =

basis/bit-vectors/bit-vectors-docs.factor

@@ -15,7 +15,7 @@ $nl
     <bit-vector>
 }
 "Literal syntax:"
-{ $subsections POSTPONE: ?V{ }
+{ $subsections postpone: \?V{ }
 "If you don't care about initial capacity, a more elegant way to create a new bit vector is to write:"
 { $code "?V{ } clone" } ;
 
@@ -32,8 +32,8 @@ HELP: >bit-vector
 { $values { "seq" sequence } { "vector" bit-vector } }
 { $description "Outputs a freshly-allocated bit vector with the same elements as a given sequence." } ;
 
-HELP: ?V{
+HELP: \?V{
 { $syntax "?V{ elements... }" }
 { $values { "elements" "a list of booleans" } }
-{ $description "Marks the beginning of a literal bit vector. Literal bit vectors are terminated by " { $link POSTPONE: } } "." }
+{ $description "Marks the beginning of a literal bit vector. Literal bit vectors are terminated by " { $link postpone: \} } "." }
 { $examples { $code "?V{ t f t }" } } ;

basis/bit-vectors/bit-vectors.factor

@@ -1,13 +1,12 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel kernel.private math sequences
-sequences.private growable bit-arrays prettyprint.custom
-parser accessors vectors.functor classes.parser ;
+USING: bit-arrays classes growable kernel math parser
+prettyprint.custom sequences sequences.private vectors.functor ;
 IN: bit-vectors
 
-<< "bit-vector" create-class-in \ bit-array \ <bit-array> define-vector >>
+VECTORIZED: bit bit-array <bit-array>
 
-SYNTAX: ?V{ \ } [ >bit-vector ] parse-literal ;
+SYNTAX: \?V{ \ } [ >bit-vector ] parse-literal ;
 
 M: bit-vector contract 2drop ;
 M: bit-vector >pprint-sequence ;

basis/bootstrap/image/download/download.factor

@@ -4,7 +4,7 @@ USING: assocs bootstrap.image checksums checksums.md5
 http.client io.files kernel math.parser splitting urls ;
 IN: bootstrap.image.download
 
-CONSTANT: url URL" http://downloads.factorcode.org/images/master/"
+CONSTANT: url url"http://downloads.factorcode.org/images/master/"
 
 : download-checksums ( -- alist )
     url "checksums.txt" >url derive-url http-get nip

basis/bootstrap/io/io.factor

@@ -1,5 +1,4 @@
-USING: accessors combinators namespaces sequences system vocabs
-;
+USING: accessors combinators namespaces sequences system vocabs ;
 IN: bootstrap.io
 
 "bootstrap.compiler" require

basis/bootstrap/stage2.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: command-line compiler.units continuations definitions io
+USING: combinators command-line compiler.units continuations definitions io
 io.pathnames kernel math math.parser memory namespaces parser
 parser.notes sequences sets splitting system
 vocabs vocabs.loader ;
@@ -13,8 +13,8 @@ SYMBOL: bootstrap-time
 : strip-encodings ( -- )
     os unix? [
         [
-            P" resource:core/io/encodings/utf16/utf16.factor"
-            P" resource:core/io/encodings/utf16n/utf16n.factor" [ forget ] bi@
+            path"resource:core/io/encodings/utf16/utf16.factor"
+            path"resource:core/io/encodings/utf16n/utf16n.factor" [ forget ] bi@
             "io.encodings.utf16"
             "io.encodings.utf16n" [ loaded-child-vocab-names [ forget-vocab ] each ] bi@
         ] with-compilation-unit
@@ -75,6 +75,30 @@ CONSTANT: default-components
 
     (command-line) parse-command-line
 
+    {
+        { [ os windows? ] [ "alien.libraries.windows" ] }
+        { [ os unix? ] [ "alien.libraries.unix" ] }
+    } cond require
+
+    ! { "hashtables.identity" "prettyprint" } "hashtables.identity.prettyprint" require-when
+    ! { "hashtables.identity" "mirrors" } "hashtables.identity.mirrors" require-when
+    ! { "hashtables.wrapped" "prettyprint" } "hashtables.wrapped.prettyprint" require-when
+
+    ! { "typed" "prettyprint" } "typed.prettyprint" require-when
+    ! { "typed" "compiler.cfg.debugger" } "typed.debugger" require-when
+
+    { "hashtables.identity" "prettyprint" } "hashtables.identity.prettyprint" require-when
+    { "hashtables.identity" "mirrors" } "hashtables.identity.mirrors" require-when
+    { "hashtables.wrapped" "prettyprint" } "hashtables.wrapped.prettyprint" require-when
+    "summary" require
+    "eval" require
+    ! "deques" require
+    ! "command-line.startup" require
+    { "locals" "prettyprint" } "locals.prettyprint" require-when
+    { "typed" "prettyprint" } "typed.prettyprint" require-when
+    { "typed" "compiler.cfg.debugger" } "typed.debugger" require-when
+    "stack-checker.row-polymorphism" reload
+
     ! Set dll paths
     os windows? [ "windows" require ] when
 

basis/calendar/format/format.factor

@@ -15,14 +15,14 @@ MACRO: formatted ( spec -- quot )
         } cond
     ] map [ cleave ] curry ;
 
+: pad-00 ( n -- str ) number>string 2 char: 0 pad-head ;
+
 : formatted>string ( spec -- string )
     '[ _ formatted ] with-string-writer ; inline
 
-: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
+: pad-0000 ( n -- str ) number>string 4 char: 0 pad-head ;
 
-: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ;
-
-: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-head ;
+: pad-00000 ( n -- str ) number>string 5 char: 0 pad-head ;
 
 : write-00 ( n -- ) pad-00 write ;
 

basis/calendar/parser/parser.factor

@@ -28,16 +28,16 @@ ERROR: invalid-timestamp-format ;
 : read-sp ( -- token ) " " read-token ;
 
 : signed-gmt-offset ( dt ch -- dt' )
-    { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
+    { { char: + [ 1 ] } { char: - [ -1 ] } } case time* ;
 
 : read-rfc3339-gmt-offset ( ch -- dt )
     {
         { f [ instant ] }
-        { CHAR: Z [ instant ] }
+        { char: Z [ instant ] }
         [
             [
                 read-00 hours
-                read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
+                read1 { { char: \: [ read-00 ] } { f [ 0 ] } } case minutes
                 time+
             ] dip signed-gmt-offset
         ]
@@ -58,7 +58,7 @@ ERROR: invalid-timestamp-format ;
     read-ymd
     "Tt \t" expect
     read-hms
-    read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
+    read1 { { char: . [ read-rfc3339-seconds ] } [ ] } case
     read-rfc3339-gmt-offset
     <timestamp> ;
 
@@ -66,7 +66,7 @@ ERROR: invalid-timestamp-format ;
     [ (rfc3339>timestamp) ] with-string-reader ;
 
 : parse-rfc822-military-offset ( string -- dt )
-    first CHAR: A - {
+    first char: A - {
         -1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
         1 2 3 4 5 6 7 8 9 10 11 12 0
     } nth hours ;
@@ -101,7 +101,7 @@ CONSTANT: rfc822-named-zones H{
 
 : (rfc822>timestamp) ( -- timestamp )
     "," read-token day-abbreviations3 member? check-timestamp drop
-    read1 CHAR: \s assert=
+    read1 char: \s assert=
     read-sp checked-number
     read-sp month-abbreviations index 1 + check-timestamp
     read-sp checked-number spin
@@ -117,7 +117,7 @@ CONSTANT: rfc822-named-zones H{
 
 : (cookie-string>timestamp-1) ( -- timestamp )
     "," read-token check-day-name
-    read1 CHAR: \s assert=
+    read1 char: \s assert=
     "-" read-token checked-number
     "-" read-token month-abbreviations index 1 + check-timestamp
     read-sp checked-number spin

basis/calendar/windows/windows.factor

@@ -18,7 +18,7 @@ IN: calendar.windows
         ]
     } cleave \ SYSTEMTIME <struct-boa> ;
 
-: SYSTEMTIME>timestamp ( SYSTEMTIME -- timestamp )
+: \SYSTEMTIME>timestamp ( SYSTEMTIME -- timestamp )
     {
         [ wYear>> ]
         [ wMonth>> ]
@@ -38,4 +38,4 @@ M: windows gmt-offset ( -- hours minutes seconds )
     } case neg 60 /mod 0 ;
 
 M: windows gmt
-    SYSTEMTIME <struct> [ GetSystemTime ] keep SYSTEMTIME>timestamp ;
+    SYSTEMTIME <struct> [ GetSystemTime ] keep \SYSTEMTIME>timestamp ;

basis/channels/remote/remote-docs.factor

@@ -58,7 +58,6 @@ $nl
 $nl
 "Given the id from the snippet above, a remote node can put items in the channel (where 123456 is the id):"
 $nl
-{ $snippet "\"myhost.com\" 9001 <node> 123456 <remote-channel>\n\"hello\" over to" }
-;
+{ $snippet "\"myhost.com\" 9001 <node> 123456 <remote-channel>\n\"hello\" over to" } ;
 
 ABOUT: "channels.remote"

basis/checksums/adler-32/adler-32-tests.factor

@@ -1,4 +1,4 @@
 USING: checksums checksums.adler-32 strings tools.test ;
 
 { 300286872 } [ "Wikipedia" adler-32 checksum-bytes ] unit-test
-{ 2679885283 } [ 10000 CHAR: a <string> adler-32 checksum-bytes ] unit-test
+{ 2679885283 } [ 10000 char: a <string> adler-32 checksum-bytes ] unit-test

basis/checksums/bsd/bsd-tests.factor

@@ -1,4 +1,4 @@
 USING: checksums checksums.bsd strings tools.test ;
 
 { 15816 } [ "Wikipedia" bsd checksum-bytes ] unit-test
-{ 47937 } [ 10000 CHAR: a <string> bsd checksum-bytes ] unit-test
+{ 47937 } [ 10000 char: a <string> bsd checksum-bytes ] unit-test

basis/checksums/crc16/crc16.factor

@@ -36,5 +36,5 @@ M: crc16 checksum-bytes
 
 M: crc16 checksum-lines
     init-crc16
-    [ [ (crc16) ] each CHAR: \n (crc16) ] each
+    [ [ (crc16) ] each char: \n (crc16) ] each
     finish-crc16 ; inline

basis/checksums/fletcher/fletcher.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2013 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: checksums grouping io.binary kernel locals math sequences
-;
+USING: checksums grouping io.binary kernel locals math sequences ;
 
 IN: checksums.fletcher
 

basis/checksums/ripemd/ripemd-tests.factor

@@ -64,7 +64,4 @@ USING: checksums checksums.ripemd strings tools.test ;
 0x69 0x7b 0xdb 0xe1 0x6d
 0x37 0xf9 0x7f 0x68 0xf0
 0x83 0x25 0xdc 0x15 0x28
-} } [ 1000000 CHAR: a <string> ripemd-160 checksum-bytes ] unit-test
-
-
-
+} } [ 1000000 char: a <string> ripemd-160 checksum-bytes ] unit-test

basis/checksums/sha/sha-tests.factor

@@ -5,7 +5,7 @@ IN: checksums.sha.tests
 
 { "a9993e364706816aba3e25717850c26c9cd0d89d" } [ "abc" sha1 checksum-bytes bytes>hex-string ] unit-test
 { "84983e441c3bd26ebaae4aa1f95129e5e54670f1" } [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes bytes>hex-string ] unit-test
-! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
+! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 char: a fill string>sha1str ] unit-test ! takes a long time...
 { "dea356a2cddd90c7a7ecedc5ebb563934f460452" } [ "0123456701234567012345670123456701234567012345670123456701234567"
 10 swap <array> concat sha1 checksum-bytes bytes>hex-string ] unit-test
 

basis/circular/circular-tests.factor

@@ -7,10 +7,10 @@ IN: circular.tests
 { 0 } [ { 0 1 2 3 4 } <circular> 0 swap virtual@ drop ] unit-test
 { 2 } [ { 0 1 2 3 4 } <circular> 2 swap virtual@ drop ] unit-test
 
-{ CHAR: t } [ "test" <circular> 0 swap nth ] unit-test
+{ char: t } [ "test" <circular> 0 swap nth ] unit-test
 { "test"  } [ "test" <circular> >string ] unit-test
 
-{ CHAR: e } [ "test" <circular> 5 swap nth-unsafe ] unit-test
+{ char: e } [ "test" <circular> 5 swap nth-unsafe ] unit-test
 
 { [ 1 2 3 ] } [ { 1 2 3 } <circular> [ ] like ] unit-test
 { [ 2 3 1 ] } [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
@@ -19,9 +19,9 @@ IN: circular.tests
 { [ 3 1 2 ] } [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test
 { [ 3 1 2 ] } [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test
 
-{ "fob" } [ "foo" <circular> CHAR: b 2 pick set-nth >string ] unit-test
-{ "boo" } [ "foo" <circular> CHAR: b 3 pick set-nth-unsafe >string ] unit-test
-{ "ornact" } [ "factor" <circular> 4 over change-circular-start CHAR: n 2 pick set-nth >string ] unit-test
+{ "fob" } [ "foo" <circular> char: b 2 pick set-nth >string ] unit-test
+{ "boo" } [ "foo" <circular> char: b 3 pick set-nth-unsafe >string ] unit-test
+{ "ornact" } [ "factor" <circular> 4 over change-circular-start char: n 2 pick set-nth >string ] unit-test
 
 { "bcd" } [ 3 <circular-string> "abcd" [ over circular-push ] each >string ] unit-test
 
@@ -29,7 +29,7 @@ IN: circular.tests
 
 ! This no longer fails
 ! [ "test" <circular> 5 swap nth ] must-fail
-! [ "foo" <circular> CHAR: b 3 rot set-nth ] must-fail
+! [ "foo" <circular> char: b 3 rot set-nth ] must-fail
 
 { { } } [ 3 <growing-circular> >array ] unit-test
 { { 1 2 } } [

basis/classes/struct/struct-docs.factor

@@ -28,10 +28,10 @@ HELP: <struct>
 
 { <struct> <struct-boa> malloc-struct memory>struct } related-words
 
-HELP: STRUCT:
+HELP: \STRUCT:
 { $syntax "STRUCT: class { slot type } { slot type } ... ;" }
 { $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } }
-{ $description "Defines a new " { $link struct } " type. The syntax is nearly identical to " { $link POSTPONE: TUPLE: } "; however, there are some additional restrictions on struct types:"
+{ $description "Defines a new " { $link struct } " type. The syntax is nearly identical to " { $link postpone: \TUPLE: } "; however, there are some additional restrictions on struct types:"
 { $list
 { "Struct classes cannot have a superclass defined." }
 { "The slots of a struct must all have a type declared. The type must be a C type." }
@@ -39,45 +39,45 @@ HELP: STRUCT:
 }
 "Additionally, structs may use bit fields. A slot specifier may use the syntax " { $snippet "bits: n" } " to specify that the bit width of the slot is " { $snippet "n" } ". Bit width may be specified on signed or unsigned integer slots. The layout of bit fields is not guaranteed to match that of any particular C compiler." } ;
 
-HELP: S{
+HELP: \S{
 { $syntax "S{ class slots... }" }
 { $values { "class" "a " { $link struct } " class word" } { "slots" "slot values" } }
-{ $description "Marks the beginning of a literal struct. The syntax is identical to tuple literal syntax with " { $link POSTPONE: T{ } { $snippet " }" } "; either the assoc syntax (that is, " { $snippet "S{ class { slot value } { slot value } ... }" } ") or the simple syntax (" { $snippet "S{ class f value value ... }" } ") can be used." } ;
+{ $description "Marks the beginning of a literal struct. The syntax is identical to tuple literal syntax with " { $link postpone: \T{ } { $snippet " }" } "; either the assoc syntax (that is, " { $snippet "S{ class { slot value } { slot value } ... }" } ") or the simple syntax (" { $snippet "S{ class f value value ... }" } ") can be used." } ;
 
 HELP: S@
 { $syntax "S@ class alien" }
 { $values { "class" "a " { $link struct } " class word" } { "alien" "a literal alien" } }
 { $description "Marks the beginning of a literal struct at a specific C address. The prettyprinter uses this syntax when the memory backing a struct object is invalid. This syntax should not generally be used in source code." } ;
 
-{ POSTPONE: S{ POSTPONE: S@ } related-words
+{ postpone: \S{ postpone: S@ } related-words
 
-HELP: UNION-STRUCT:
+HELP: \UNION-STRUCT:
 { $syntax "UNION-STRUCT: class { slot type } { slot type } ... ;" }
 { $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } }
-{ $description "Defines a new " { $link struct } " type where all of the slots share the same storage. See " { $link POSTPONE: STRUCT: } " for details on the syntax." } ;
+{ $description "Defines a new " { $link struct } " type where all of the slots share the same storage. See " { $link postpone: \STRUCT: } " for details on the syntax." } ;
 
-HELP: PACKED-STRUCT:
+HELP: \PACKED-STRUCT:
 { $syntax "PACKED-STRUCT: class { slot type } { slot type } ... ;" }
 { $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } }
-{ $description "Defines a new " { $link struct } " type with no alignment padding between slots or at the end. In all other respects, behaves like " { $link POSTPONE: STRUCT: } "." } ;
+{ $description "Defines a new " { $link struct } " type with no alignment padding between slots or at the end. In all other respects, behaves like " { $link postpone: \STRUCT: } "." } ;
 
 HELP: define-struct-class
 { $values
     { "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" }
 }
-{ $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link POSTPONE: STRUCT: } " syntax." } ;
+{ $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link postpone: \STRUCT: } " syntax." } ;
 
 HELP: define-packed-struct-class
 { $values
     { "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" }
 }
-{ $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link POSTPONE: PACKED-STRUCT: } " syntax." } ;
+{ $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link postpone: \PACKED-STRUCT: } " syntax." } ;
 
 HELP: define-union-struct-class
 { $values
     { "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" }
 }
-{ $description "Defines a new " { $link struct } " class where all of the slots share the same storage. This is the runtime equivalent of the " { $link POSTPONE: UNION-STRUCT: } " syntax." } ;
+{ $description "Defines a new " { $link struct } " class where all of the slots share the same storage. This is the runtime equivalent of the " { $link postpone: \UNION-STRUCT: } " syntax." } ;
 
 HELP: malloc-struct
 { $values
@@ -111,7 +111,7 @@ HELP: read-struct
 HELP: struct
 { $class-description "The parent class of all struct types." } ;
 
-{ struct POSTPONE: STRUCT: POSTPONE: UNION-STRUCT: } related-words
+{ struct postpone: \STRUCT: postpone: \UNION-STRUCT: } related-words
 
 HELP: struct-class
 { $class-description "The metaclass of all " { $link struct } " classes." } ;
@@ -145,10 +145,10 @@ ARTICLE: "classes.struct.examples" "Struct class examples"
 } ;
 
 ARTICLE: "classes.struct.define" "Defining struct classes"
-"Struct classes are defined using a syntax similar to the " { $link POSTPONE: TUPLE: } " syntax for defining tuple classes:"
-{ $subsections POSTPONE: STRUCT: POSTPONE: PACKED-STRUCT: }
+"Struct classes are defined using a syntax similar to the " { $link postpone: \TUPLE: } " syntax for defining tuple classes:"
+{ $subsections postpone: \STRUCT: postpone: \PACKED-STRUCT: }
 "Union structs are also supported, which behave like structs but share the same memory for all the slots."
-{ $subsections POSTPONE: UNION-STRUCT: } ;
+{ $subsections postpone: \UNION-STRUCT: } ;
 
 ARTICLE: "classes.struct.create" "Creating instances of structs"
 "Structs can be allocated with " { $link new } "- and " { $link boa } "-like constructor words. Additional words are provided for building structs from C memory and from existing buffers:"
@@ -163,8 +163,8 @@ ARTICLE: "classes.struct.create" "Creating instances of structs"
     (struct)
     (malloc-struct)
 }
-"Structs have literal syntax, similar to " { $link POSTPONE: T{ } " for tuples:"
-{ $subsections POSTPONE: S{ } ;
+"Structs have literal syntax, similar to " { $link postpone: \T{ } " for tuples:"
+{ $subsections postpone: \S{ } ;
 
 ARTICLE: "classes.struct.c" "Passing structs to C functions"
 "Structs can be passed and returned by value, or by reference."

basis/classes/struct/struct-tests.factor

@@ -133,7 +133,7 @@ STRUCT: struct-test-bar
     [ make-mirror clear-assoc ] keep
 ] unit-test
 
-{ POSTPONE: STRUCT: }
+{ postpone: \STRUCT: }
 [ struct-test-foo struct-definer-word ] unit-test
 
 UNION-STRUCT: struct-test-float-and-bits
@@ -145,7 +145,7 @@ UNION-STRUCT: struct-test-float-and-bits
 
 { 123 } [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test
 
-{ POSTPONE: UNION-STRUCT: }
+{ postpone: \UNION-STRUCT: }
 [ struct-test-float-and-bits struct-definer-word ] unit-test
 
 STRUCT: struct-test-string-ptr
@@ -492,7 +492,7 @@ PACKED-STRUCT: packed-struct-test
 { 10 } [ "g" packed-struct-test offset-of ] unit-test
 { 11 } [ "h" packed-struct-test offset-of ] unit-test
 
-{ POSTPONE: PACKED-STRUCT: }
+{ postpone: \PACKED-STRUCT: }
 [ packed-struct-test struct-definer-word ] unit-test
 
 STRUCT: struct-1 { a c:int } ;

basis/classes/struct/struct.factor

@@ -144,7 +144,7 @@ M: struct-class initial-value* <struct> t ; inline
 GENERIC: struct-slot-values ( struct -- sequence )
 
 M: struct-class reader-quot
-    dup type>> array? [ dup type>> first define-array-vocab drop ] when
+    dup type>> array? [ dup type>> first underlying-type define-specialized-array ] when
     nip '[ _ read-struct-slot ] ;
 
 M: struct-class writer-quot
@@ -330,7 +330,7 @@ M: struct-class reset-class
         [ call-next-method ]
     } cleave ;
 
-SYMBOL: bits:
+SYMBOL: \bits:
 
 <PRIVATE
 
@@ -378,16 +378,16 @@ PRIVATE>
     dup [ name>> ] map check-duplicate-slots ;
 PRIVATE>
 
-SYNTAX: STRUCT:
+SYNTAX: \STRUCT:
     parse-struct-definition define-struct-class ;
 
-SYNTAX: PACKED-STRUCT:
+SYNTAX: \PACKED-STRUCT:
     parse-struct-definition define-packed-struct-class ;
 
-SYNTAX: UNION-STRUCT:
+SYNTAX: \UNION-STRUCT:
     parse-struct-definition define-union-struct-class ;
 
-SYNTAX: S{
+SYNTAX: \S{
     scan-word dup struct-slots parse-tuple-literal-slots suffix! ;
 
 SYNTAX: S@
@@ -412,7 +412,7 @@ SYNTAX: S@
 
 PRIVATE>
 
-FUNCTOR-SYNTAX: STRUCT:
+FUNCTOR-SYNTAX: \STRUCT:
     scan-param suffix!
     [ 8 <vector> ] append!
     [ parse-struct-slots* ] [ ] while

basis/cocoa/apple-script/apple-script-docs.factor

@@ -7,7 +7,7 @@ HELP: run-apple-script
 { $description "Runs the provided uncompiled AppleScript code." }
 { $notes "Currently, return values are unsupported." } ;
 
-HELP: APPLESCRIPT:
+HELP: \APPLESCRIPT:
 { $syntax "APPLESCRIPT: word [[ ...applescript string... ]] " }
 { $values { "word" "a new word to define" } { "...applescript string..." "AppleScript source text" } }
 { $description "Defines a word that when called will run the provided uncompiled AppleScript. The word has stack effect " { $snippet "( -- )" } " due to return values being currently unsupported." } ;

basis/cocoa/apple-script/apple-script.factor

@@ -7,10 +7,10 @@ multiline words ;
 IN: cocoa.apple-script
 
 : run-apple-script ( str -- )
-    [ NSAppleScript -> alloc ] dip
-    <NSString> -> initWithSource: -> autorelease
-    f -> executeAndReturnError: drop ;
+    [ NSAppleScript send: alloc ] dip
+    <NSString> send: \initWithSource: send: autorelease
+    f send: \executeAndReturnError: drop ;
 
-SYNTAX: APPLESCRIPT:
+SYNTAX: \APPLESCRIPT:
     scan-new-word scan-object
     [ run-apple-script ] curry ( -- ) define-declared ;

basis/cocoa/application/application-docs.factor

@@ -6,7 +6,7 @@ HELP: <NSString>
 { $values { "str" string } { "alien" alien } }
 { $description "Allocates an autoreleased " { $snippet "CFString" } "." } ;
 
-{ <NSString> <CFString> CF>string } related-words
+{ <NSString> <CFString> CFString>string } related-words
 
 HELP: with-autorelease-pool
 { $values { "quot" quotation } }

basis/cocoa/application/application.factor

@@ -4,16 +4,16 @@ USING: alien.c-types alien.syntax cocoa cocoa.classes
 cocoa.runtime core-foundation.strings kernel sequences ;
 IN: cocoa.application
 
-: <NSString> ( str -- alien ) <CFString> -> autorelease ;
+: <NSString> ( str -- alien ) <CFString> send: autorelease ;
 
 CONSTANT: NSApplicationDelegateReplySuccess 0
 CONSTANT: NSApplicationDelegateReplyCancel  1
 CONSTANT: NSApplicationDelegateReplyFailure 2
 
 : with-autorelease-pool ( quot -- )
-    NSAutoreleasePool -> new [ call ] [ -> release ] bi* ; inline
+    NSAutoreleasePool send: new [ call ] [ send: release ] bi* ; inline
 
-: NSApp ( -- app ) NSApplication -> sharedApplication ;
+: NSApp ( -- app ) NSApplication send: sharedApplication ;
 
 CONSTANT: NSAnyEventMask 0xffffffff
 
@@ -24,24 +24,24 @@ FUNCTION: void NSBeep ( )
 
 : add-observer ( observer selector name object -- )
     [
-        [ NSNotificationCenter -> defaultCenter ] 2dip
+        [ NSNotificationCenter send: defaultCenter ] 2dip
         sel_registerName
-    ] 2dip -> addObserver:selector:name:object: ;
+    ] 2dip send: \addObserver:selector:name:object: ;
 
 : remove-observer ( observer -- )
-    [ NSNotificationCenter -> defaultCenter ] dip
-    -> removeObserver: ;
+    [ NSNotificationCenter send: defaultCenter ] dip
+    send: \removeObserver: ;
 
 : cocoa-app ( quot -- )
-    [ call NSApp -> run ] with-cocoa ; inline
+    [ call NSApp send: run ] with-cocoa ; inline
 
 : install-delegate ( receiver delegate -- )
-    -> alloc -> init -> setDelegate: ;
+    send: alloc send: init send: \setDelegate: ;
 
 : running.app? ( -- ? )
     ! Test if we're running a .app.
     ".app"
-    NSBundle -> mainBundle -> bundlePath CF>string
+    NSBundle send: mainBundle send: bundlePath CFString>string
     subseq? ;
 
 : assert.app ( message -- )

basis/cocoa/cocoa-docs.factor

@@ -2,36 +2,36 @@ USING: cocoa.messages help.markup help.syntax strings
 alien core-foundation ;
 IN: cocoa
 
-HELP: ->
-{ $syntax "-> selector" }
+HELP: \send:
+{ $syntax "send: selector" }
 { $values { "selector" "an Objective C method name" } }
 { $description "A sugared form of the following:" }
 { $code "\"selector\" send" } ;
 
-HELP: SUPER->
-{ $syntax "-> selector" }
+HELP: \super:
+{ $syntax "super: selector" }
 { $values { "selector" "an Objective C method name" } }
 { $description "A sugared form of the following:" }
 { $code "\"selector\" send-super" } ;
 
-{ send super-send POSTPONE: -> POSTPONE: SUPER-> } related-words
+{ send super-send postpone: \send: postpone: \super: } related-words
 
-HELP: IMPORT:
+HELP: \IMPORT:
 { $syntax "IMPORT: name" }
 { $description "Makes an Objective C class available for use." }
 { $examples
-    { $code "IMPORT: QTMovie" "QTMovie \"My Movie.mov\" <NSString> f -> movieWithFile:error:" }
+    { $code "IMPORT: QTMovie" "QTMovie \"My Movie.mov\" <NSString> f send: \\movieWithFile:error:" }
 } ;
 
 ARTICLE: "objc-calling" "Calling Objective C code"
 "Before an Objective C class can be used, it must be imported; by default, a small set of common classes are imported automatically, but additional classes can be imported as needed."
-{ $subsections POSTPONE: IMPORT: }
+{ $subsections postpone: \IMPORT: }
 "Every imported Objective C class has as corresponding class word in the " { $vocab-link "cocoa.classes" } " vocabulary. Class words push the class object in the stack, allowing class methods to be invoked."
 $nl
 "Messages can be sent to classes and instances using a pair of parsing words:"
 { $subsections
-    POSTPONE: ->
-    POSTPONE: SUPER->
+    postpone: \send:
+    postpone: \super:
 }
 "These parsing words are actually syntax sugar for a pair of ordinary words; they can be used instead of the parsing words if the selector name is dynamically computed:"
 { $subsections

basis/cocoa/cocoa-tests.factor

@@ -4,15 +4,15 @@ namespaces tools.test ;
 IN: cocoa.tests
 
 <CLASS: Foo < NSObject
-    METHOD: void foo: NSRect rect [
+    COCOA-METHOD: void foo: NSRect rect [
         gc rect "x" set
     ] ;
 ;CLASS>
 
 : test-foo ( -- )
-    Foo -> alloc -> init
-    dup 1.0 2.0 101.0 102.0 <CGRect> -> foo:
-    -> release ;
+    Foo send: alloc send: init
+    dup 1.0 2.0 101.0 102.0 <CGRect> send: \foo:
+    send: release ;
 
 { } [ test-foo ] unit-test
 
@@ -22,14 +22,14 @@ IN: cocoa.tests
 { 102.0 } [ "x" get CGRect-h ] unit-test
 
 <CLASS: Bar < NSObject
-    METHOD: NSRect bar [ test-foo "x" get ] ;
+    COCOA-METHOD: NSRect bar [ test-foo "x" get ] ;
 ;CLASS>
 
 { } [
     Bar [
-        -> alloc -> init
-        dup -> bar "x" set
-        -> release
+        send: alloc send: init
+        dup send: bar "x" set
+        send: release
     ] compile-call
 ] unit-test
 
@@ -40,15 +40,15 @@ IN: cocoa.tests
 
 ! Make sure that we can add methods
 <CLASS: Bar < NSObject
-    METHOD: NSRect bar [ test-foo "x" get ] ;
+    COCOA-METHOD: NSRect bar [ test-foo "x" get ] ;
 
-    METHOD: int babb: int x [ x sq ] ;
+    COCOA-METHOD: int babb: int x [ x sq ] ;
 ;CLASS>
 
 { 144 } [
     Bar [
-        -> alloc -> init
-        dup 12 -> babb:
-        swap -> release
+        send: alloc send: init
+        dup 12 send: \babb:
+        swap send: release
     ] compile-call
 ] unit-test

basis/cocoa/cocoa.factor

@@ -11,18 +11,19 @@ sent-messages [ H{ } clone ] initialize
 : remember-send ( selector -- )
     dup sent-messages get set-at ;
 
-SYNTAX: ->
-    scan-token dup remember-send
+SYNTAX: \send:
+    scan-token unescape-token dup remember-send
     [ lookup-method suffix! ] [ suffix! ] bi \ send suffix! ;
 
-SYNTAX: ?->
+SYNTAX: \?send:
     dup last cache-stubs
-    scan-token dup remember-send
+    scan-token unescape-token dup remember-send
     suffix! \ send suffix! ;
 
-SYNTAX: SEL:
-    scan-token dup remember-send
-    <selector> suffix! \ cocoa.messages:selector suffix! ;
+SYNTAX: \selector:
+    scan-token unescape-token
+    [ remember-send ]
+    [ <selector> suffix! \ cocoa.messages:selector suffix! ] bi ;
 
 SYMBOL: super-sent-messages
 
@@ -31,19 +32,18 @@ super-sent-messages [ H{ } clone ] initialize
 : remember-super-send ( selector -- )
     dup super-sent-messages get set-at ;
 
-SYNTAX: SUPER->
-    scan-token dup remember-super-send
+SYNTAX: \super:
+    scan-token unescape-token dup remember-super-send
     [ lookup-method suffix! ] [ suffix! ] bi \ super-send suffix! ;
-
 SYMBOL: frameworks
 
 frameworks [ V{ } clone ] initialize
 
 [ frameworks get [ load-framework ] each ] "cocoa" add-startup-hook
 
-SYNTAX: FRAMEWORK: scan-token [ load-framework ] [ frameworks get push ] bi ;
+SYNTAX: \FRAMEWORK: scan-token [ load-framework ] [ frameworks get push ] bi ;
 
-SYNTAX: IMPORT: scan-token [ ] import-objc-class ;
+SYNTAX: \IMPORT: scan-token [ ] import-objc-class ;
 
 "Importing Cocoa classes..." print
 

basis/cocoa/dialogs/dialogs.factor

@@ -5,27 +5,27 @@ core-foundation.strings kernel splitting ;
 IN: cocoa.dialogs
 
 : <NSOpenPanel> ( -- panel )
-    NSOpenPanel -> openPanel
-    dup 1 -> setCanChooseFiles:
-    dup 0 -> setCanChooseDirectories:
-    dup 1 -> setResolvesAliases:
-    dup 1 -> setAllowsMultipleSelection: ;
+    NSOpenPanel send: openPanel
+    dup 1 send: \setCanChooseFiles:
+    dup 0 send: \setCanChooseDirectories:
+    dup 1 send: \setResolvesAliases:
+    dup 1 send: \setAllowsMultipleSelection: ;
 
 : <NSDirPanel> ( -- panel ) <NSOpenPanel>
-   dup 1 -> setCanChooseDirectories: ;
+   dup 1 send: \setCanChooseDirectories: ;
 
 : <NSSavePanel> ( -- panel )
-    NSSavePanel -> savePanel
-    dup 1 -> setCanChooseFiles:
-    dup 0 -> setCanChooseDirectories:
-    dup 0 -> setAllowsMultipleSelection: ;
+    NSSavePanel send: savePanel
+    dup 1 send: \setCanChooseFiles:
+    dup 0 send: \setCanChooseDirectories:
+    dup 0 send: \setAllowsMultipleSelection: ;
 
 CONSTANT: NSOKButton 1
 CONSTANT: NSCancelButton 0
 
 : (open-panel) ( panel -- paths )
-    dup -> runModal NSOKButton =
-    [ -> filenames CF>string-array ] [ drop f ] if ;
+    dup send: runModal NSOKButton =
+    [ send: filenames CFString>string-array ] [ drop f ] if ;
 
 : open-panel ( -- paths ) <NSOpenPanel> (open-panel) ;
 
@@ -36,5 +36,5 @@ CONSTANT: NSCancelButton 0
 
 : save-panel ( path -- path/f )
     [ <NSSavePanel> dup ] dip
-    split-path -> runModalForDirectory:file: NSOKButton =
-    [ -> filename CF>string ] [ drop f ] if ;
+    split-path send: \runModalForDirectory:file: NSOKButton =
+    [ send: filename CFString>string ] [ drop f ] if ;

basis/cocoa/enumeration/enumeration.factor

@@ -17,7 +17,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
     ] with-destructors ; inline
 
 :: (NSFastEnumeration-each) ( ... object quot: ( ... elt -- ) state stackbuf count -- ... )
-    object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
+    object state stackbuf count send: \countByEnumeratingWithState:objects:count: :> items-count
     items-count 0 = [
         state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
         items-count <iota> [ items nth quot call ] each

basis/cocoa/messages/messages-docs.factor

@@ -14,7 +14,7 @@ HELP: super-send
 HELP: objc-class
 { $values { "string" string } { "class" alien } }
 { $description "Outputs the Objective C class named by " { $snippet "string" } ". This class can then be used as the receiver in message sends calling class methods, for example:"
-{ $code "NSMutableArray -> alloc" } }
+{ $code "NSMutableArray send: alloc" } }
 { $errors "Throws an error if there is no class named by " { $snippet "string" } "." } ;
 
 HELP: objc-meta-class

basis/cocoa/messages/messages.factor

@@ -45,7 +45,7 @@ super-message-senders [ H{ } clone ] initialize
 TUPLE: selector-tuple name object ;
 
 : selector-name ( name -- name' )
-    CHAR: . over index [ 0 > [ "." split1 nip ] when ] when* ;
+    char: . over index [ 0 > [ "." split1 nip ] when ] when* ;
 
 MEMO: <selector> ( name -- sel )
     selector-name f selector-tuple boa ;
@@ -187,7 +187,7 @@ cell {
 assoc-union alien>objc-types set-global
 
 : objc-struct-type ( i string -- ctype )
-    [ CHAR: = ] 2keep index-from swap subseq
+    [ char: = ] 2keep index-from swap subseq
     objc>struct-types get at* [ drop void* ] unless ;
 
 ERROR: no-objc-type name ;
@@ -199,9 +199,9 @@ ERROR: no-objc-type name ;
 : (parse-objc-type) ( i string -- ctype )
     [ [ 1 + ] dip ] [ nth ] 2bi {
         { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
-        { [ dup CHAR: ^ = ] [ 3drop void* ] }
-        { [ dup CHAR: { = ] [ drop objc-struct-type ] }
-        { [ dup CHAR: [ = ] [ 3drop void* ] }
+        { [ dup char: ^ = ] [ 3drop void* ] }
+        { [ dup char: \{ = ] [ drop objc-struct-type ] }
+        { [ dup char: \[ = ] [ 3drop void* ] }
         [ 2nip decode-type ]
     } cond ;
 
@@ -237,7 +237,7 @@ ERROR: no-objc-type name ;
 
 : method-collisions ( -- collisions )
     objc-methods get >alist
-    [ first CHAR: . swap member? ] filter
+    [ first char: . swap member? ] filter
     [ first "." split1 nip ] collect-by
     [ nip values members length 1 > ] assoc-filter ;
 

basis/cocoa/nibs/nibs.factor

@@ -6,15 +6,15 @@ IN: cocoa.nibs
 
 : load-nib ( name -- )
     NSBundle
-    swap <NSString> NSApp -> loadNibNamed:owner:
+    swap <NSString> NSApp send: \loadNibNamed:owner:
     drop ;
 
 : nib-named ( nib-name -- anNSNib )
-    <NSString> NSNib -> alloc swap f -> initWithNibNamed:bundle:
-    dup [ -> autorelease ] when ;
+    <NSString> NSNib send: alloc swap f send: \initWithNibNamed:bundle:
+    dup [ send: autorelease ] when ;
 
 : nib-objects ( anNSNib -- objects/f )
     f
-    { void* } [ -> instantiateNibWithOwner:topLevelObjects: ]
+    { void* } [ send: \instantiateNibWithOwner:topLevelObjects: ]
     with-out-parameters
-    swap [ CF>array ] [ drop f ] if ;
+    swap [ CFArray>array ] [ drop f ] if ;

basis/cocoa/pasteboard/pasteboard.factor

@@ -1,26 +1,25 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.accessors arrays cocoa cocoa.application
-core-foundation.arrays core-foundation.strings kernel sequences
-;
+core-foundation.arrays core-foundation.strings kernel sequences ;
 IN: cocoa.pasteboard
 
 CONSTANT: NSStringPboardType "NSStringPboardType"
 
 : pasteboard-string? ( pasteboard -- ? )
-    NSStringPboardType swap -> types CF>string-array member? ;
+    NSStringPboardType swap send: types CFString>string-array member? ;
 
 : pasteboard-string ( pasteboard -- str )
-    NSStringPboardType <NSString> -> stringForType:
-    dup [ CF>string ] when ;
+    NSStringPboardType <NSString> send: \stringForType:
+    dup [ CFString>string ] when ;
 
 : set-pasteboard-types ( seq pasteboard -- )
-    swap <CFArray> -> autorelease f -> declareTypes:owner: drop ;
+    swap <CFArray> send: autorelease f send: \declareTypes:owner: drop ;
 
 : set-pasteboard-string ( str pasteboard -- )
     NSStringPboardType <NSString>
     dup 1array pick set-pasteboard-types
-    [ swap <NSString> ] dip -> setString:forType: drop ;
+    [ swap <NSString> ] dip send: \setString:forType: drop ;
 
 : pasteboard-error ( error -- f )
     "Pasteboard does not hold a string" <NSString>

basis/cocoa/plists/plists.factor

@@ -8,10 +8,10 @@ core-foundation.utilities fry io.backend kernel macros math
 quotations sequences ;
 IN: cocoa.plists
 
-: >plist ( value -- plist ) >cf -> autorelease ;
+: >plist ( value -- plist ) >cf send: autorelease ;
 
 : write-plist ( assoc path -- )
-    [ >plist ] [ normalize-path <NSString> ] bi* 0 -> writeToFile:atomically:
+    [ >plist ] [ normalize-path <NSString> ] bi* 0 send: \writeToFile:atomically:
     [ "write-plist failed" throw ] unless ;
 
 DEFER: plist>
@@ -19,30 +19,30 @@ DEFER: plist>
 <PRIVATE
 
 : (plist-NSNumber>) ( NSNumber -- number )
-    dup -> doubleValue dup >integer =
-    [ -> longLongValue ] [ -> doubleValue ] if ;
+    dup send: doubleValue dup >integer =
+    [ send: longLongValue ] [ send: doubleValue ] if ;
 
 : (plist-NSData>) ( NSData -- byte-array )
-    dup -> length <byte-array> [ -> getBytes: ] keep ;
+    dup send: length <byte-array> [ send: \getBytes: ] keep ;
 
 : (plist-NSArray>) ( NSArray -- vector )
     [ plist> ] NSFastEnumeration-map ;
 
 : (plist-NSDictionary>) ( NSDictionary -- hashtable )
-    dup [ [ nip ] [ -> valueForKey: ] 2bi [ plist> ] bi@ ] with
+    dup [ [ nip ] [ send: \valueForKey: ] 2bi [ plist> ] bi@ ] with
     NSFastEnumeration>hashtable ;
 
 : (read-plist) ( NSData -- id )
     NSPropertyListSerialization swap kCFPropertyListImmutable f
     { void* }
-    [ -> propertyListFromData:mutabilityOption:format:errorDescription: ]
+    [ send: \propertyListFromData:mutabilityOption:format:errorDescription: ]
     with-out-parameters
-    [ -> release "read-plist failed" throw ] when* ;
+    [ send: release "read-plist failed" throw ] when* ;
 
 MACRO: objc-class-case ( alist -- quot )
     [
         dup callable?
-        [ first2 [ '[ dup _ execute -> isKindOfClass: c-bool> ] ] dip 2array ]
+        [ first2 [ '[ dup _ execute send: \isKindOfClass: c-bool> ] ] dip 2array ]
         unless
     ] map '[ _ cond ] ;
 
@@ -52,7 +52,7 @@ ERROR: invalid-plist-object object ;
 
 : plist> ( plist -- value )
     {
-        { NSString [ CF>string ] }
+        { NSString [ CFString>string ] }
         { NSNumber [ (plist-NSNumber>) ] }
         { NSData [ (plist-NSData>) ] }
         { NSArray [ (plist-NSArray>) ] }
@@ -63,5 +63,5 @@ ERROR: invalid-plist-object object ;
 
 : read-plist ( path -- assoc )
     normalize-path <NSString>
-    NSData swap -> dataWithContentsOfFile:
+    NSData swap send: \dataWithContentsOfFile:
     [ (read-plist) plist> ] [ "read-plist failed" throw ] if* ;

basis/cocoa/subclassing/subclassing-docs.factor

@@ -1,23 +1,23 @@
 USING: help.markup help.syntax strings alien hashtables ;
 IN: cocoa.subclassing
 
-HELP: <CLASS:
+HELP: \<CLASS:
 { $syntax "<CLASS: name < superclass protocols... imeth... ;CLASS>" }
-{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } }
-{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word."
+{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "imeth" "instance method definitions using " { $link postpone: \COCOA-METHOD: } } }
+{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link postpone: \COCOA-METHOD: } " parsing word."
 $nl
 "This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ;
 
-{ define-objc-class POSTPONE: <CLASS: POSTPONE: METHOD: } related-words
+{ define-objc-class postpone: \<CLASS: postpone: \COCOA-METHOD: } related-words
 
-HELP: METHOD:
-{ $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ] ;" }
+HELP: \COCOA-METHOD:
+{ $syntax "COCOA-METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ] ;" }
 { $values { "return" "a C type name" } { "type1" "a C type name" } { "arg1" "a local variable name" } { "body" "arbitrary code" } }
-{ $description "Defines a method inside of a " { $link POSTPONE: <CLASS: } " form." } ;
+{ $description "Defines a method inside of a " { $link postpone: \<CLASS: } " form." } ;
 
 ARTICLE: "objc-subclassing" "Subclassing Objective C classes"
 "Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:"
-{ $subsections POSTPONE: <CLASS: POSTPONE: METHOD: }
+{ $subsections postpone: \<CLASS: postpone: \COCOA-METHOD: }
 "Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ;
 
 ABOUT: "objc-subclassing"

basis/cocoa/subclassing/subclassing.factor

@@ -71,12 +71,12 @@ IN: cocoa.subclassing
 TUPLE: cocoa-protocol name ;
 C: <cocoa-protocol> cocoa-protocol
 
-SYNTAX: COCOA-PROTOCOL:
+SYNTAX: \COCOA-PROTOCOL:
     scan-token <cocoa-protocol> suffix! ;
 
-SYMBOL: ;CLASS>
+SYMBOL: \;CLASS>
 
-SYNTAX: <CLASS:
+SYNTAX: \<CLASS:
     scan-token
     "<" expect
     scan-token
@@ -101,7 +101,7 @@ SYNTAX: <CLASS:
     [ [ make-local ] map ] H{ } make
     (parse-lambda) <lambda> ?rewrite-closures first ;
 
-SYNTAX: METHOD:
+SYNTAX: \COCOA-METHOD:
     scan-c-type
     parse-selector
     parse-method-body [ swap ] 2dip 4array ";" expect

basis/cocoa/touchbar/touchbar.factor

@@ -1,23 +1,22 @@
 ! Copyright (C) 2017 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types cocoa cocoa.classes cocoa.messages
-cocoa.runtime combinators core-foundation.strings kernel locals
-;
+cocoa.runtime combinators core-foundation.strings kernel locals ;
 IN: cocoa.touchbar
 
 : make-touchbar ( seq self -- touchbar )
-    [ NSTouchBar -> alloc -> init dup ] dip -> setDelegate: {
-        [ swap <CFStringArray> { void { id SEL id } } ?-> setDefaultItemIdentifiers: ]
-        [ swap <CFStringArray> { void { id SEL id } } ?-> setCustomizationAllowedItemIdentifiers: ]
+    [ NSTouchBar send: alloc send: init dup ] dip send: setDelegate: {
+        [ swap <CFStringArray> send: \setDefaultItemIdentifiers: ]
+        [ swap <CFStringArray> send: \setCustomizationAllowedItemIdentifiers: ]
         [ nip ]
     } 2cleave ;
 
 :: make-NSTouchBar-button ( self identifier label-string action-string -- button )
-    NSCustomTouchBarItem -> alloc
-        identifier <CFString> { id { id SEL id } } ?-> initWithIdentifier: :> item
+    NSCustomTouchBarItem send: alloc
+        identifier <CFString> send: \initWithIdentifier: :> item
         NSButton
             label-string <CFString>
             self
-            action-string lookup-selector { id { id SEL id id SEL } } ?-> buttonWithTitle:target:action: :> button
-        item button -> setView:
+            action-string lookup-selector send: \buttonWithTitle:target:action: :> button
+        item button send: \setView:
         item ;

basis/cocoa/views/views.factor

@@ -59,21 +59,21 @@ CONSTANT: NSOpenGLProfileVersion3_2Core 0x3200
 CONSTANT: NSOpenGLProfileVersion4_1Core 0x4100
 
 : <GLView> ( class dim pixel-format -- view )
-    [ -> alloc ]
+    [ send: alloc ]
     [ [ 0 0 ] dip first2 <CGRect> ]
     [ handle>> ] tri*
-    -> initWithFrame:pixelFormat:
-    dup 1 -> setPostsBoundsChangedNotifications:
-    dup 1 -> setPostsFrameChangedNotifications: ;
+    send: \initWithFrame:pixelFormat:
+    dup 1 send: \setPostsBoundsChangedNotifications:
+    dup 1 send: \setPostsFrameChangedNotifications: ;
 
 : view-dim ( view -- dim )
-    -> bounds
+    send: bounds
     [ CGRect-w >fixnum ] [ CGRect-h >fixnum ] bi
     2array ;
 
 : mouse-location ( view event -- loc )
     [
-        -> locationInWindow f -> convertPoint:fromView:
+        send: locationInWindow f send: \convertPoint:fromView:
         [ x>> ] [ y>> ] bi
-    ] [ drop -> frame CGRect-h ] 2bi
+    ] [ drop send: frame CGRect-h ] 2bi
     swap - [ >integer ] bi@ 2array ;

basis/cocoa/windows/windows.factor

@@ -22,19 +22,19 @@ CONSTANT: NSBackingStoreNonretained 1
 CONSTANT: NSBackingStoreBuffered    2
 
 : <NSWindow> ( rect style class -- window )
-    [ -> alloc ] curry 2dip NSBackingStoreBuffered 1
-    -> initWithContentRect:styleMask:backing:defer: ;
+    [ send: alloc ] curry 2dip NSBackingStoreBuffered 1
+    send: \initWithContentRect:styleMask:backing:defer: ;
 
 : class-for-style ( style -- NSWindow/NSPanel )
     0x1ef0 bitand zero? NSWindow NSPanel ? ;
 
 : <ViewWindow> ( view rect style -- window )
-    dup class-for-style <NSWindow> [ swap -> setContentView: ] keep
-    dup dup -> contentView -> setInitialFirstResponder:
-    dup 1 -> setAcceptsMouseMovedEvents:
-    dup 0 -> setReleasedWhenClosed: ;
+    dup class-for-style <NSWindow> [ swap send: \setContentView: ] keep
+    dup dup send: contentView send: \setInitialFirstResponder:
+    dup 1 send: \setAcceptsMouseMovedEvents:
+    dup 0 send: \setReleasedWhenClosed: ;
 
 : window-content-rect ( window -- rect )
-    dup -> class swap
-    [ -> frame ] [ -> styleMask ] bi
-    -> contentRectForFrameRect:styleMask: ;
+    dup send: class swap
+    [ send: frame ] [ send: styleMask ] bi
+    send: \contentRectForFrameRect:styleMask: ;

basis/colors/constants/constants-docs.factor

@@ -4,21 +4,21 @@ USING: help.markup help.syntax strings colors ;
 HELP: named-color
 { $values { "name" string } { "color" color } }
 { $description "Outputs a named color from the color database." }
-{ $notes "In most cases, " { $link POSTPONE: COLOR: } " should be used instead." }
+{ $notes "In most cases, " { $link postpone: \color: } " should be used instead." }
 { $errors "Throws an error if the color is not listed in " { $snippet "rgb.txt" } ", " { $snippet "factor-colors.txt" } " or " { $snippet "solarized-colors.txt" } "." } ;
 
 HELP: named-colors
 { $values { "keys" "a sequence of strings" } }
 { $description "Outputs a sequence of all colors in the " { $snippet "rgb.txt" } " database." } ;
 
-HELP: COLOR:
-{ $syntax "COLOR: name" }
+HELP: \color:
+{ $syntax "color: name" }
 { $description "Parses as a " { $link color } " object with the given name." }
 { $errors "Throws an error if the color is not listed in " { $snippet "rgb.txt" } "." }
 { $examples
   { $code
     "USING: colors.constants io.styles ;"
-    "\"Hello!\" { { foreground COLOR: cyan } } format nl"
+    "\"Hello!\" { { foreground color: cyan } } format nl"
   }
 } ;
 
@@ -27,7 +27,7 @@ ARTICLE: "colors.constants" "Standard color database"
 { $subsections
     named-color
     named-colors
-    POSTPONE: COLOR:
+    postpone: \color:
 } ;
 
 ABOUT: "colors.constants"

basis/colors/constants/constants-tests.factor

@@ -2,4 +2,4 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: colors colors.constants tools.test ;
 
-{ t } [ COLOR: light-green rgba? ] unit-test
+{ t } [ color: light-green rgba? ] unit-test

basis/colors/constants/constants.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs math math.parser memoize io.encodings.utf8
-io.files lexer parser colors sequences splitting ascii ;
+USING: ascii assocs colors io.encodings.utf8 io.files kernel
+lexer math math.parser sequences splitting ;
 IN: colors.constants
 
 <PRIVATE
@@ -9,7 +9,7 @@ IN: colors.constants
 : parse-color ( line -- name color )
     first4
     [ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
-    [ blank? ] trim-head H{ { CHAR: \s CHAR: - } } substitute swap ;
+    [ blank? ] trim-head H{ { char: \s char: - } } substitute swap ;
 
 : parse-colors ( lines -- assoc )
     [ "!" head? ] reject
@@ -31,4 +31,4 @@ ERROR: no-such-color name ;
 : named-color ( name -- color )
     dup colors at [ ] [ no-such-color ] ?if ;
 
-SYNTAX: COLOR: scan-token named-color suffix! ;
+SYNTAX: \color: scan-token named-color suffix! ;

basis/colors/hex/hex-docs.factor

@@ -7,21 +7,19 @@ IN: colors.hex
 
 HELP: hex>rgba
 { $values { "hex" string } { "rgba" color } }
-{ $description "Converts a hexadecimal string value into a " { $link color } "." }
-;
+{ $description "Converts a hexadecimal string value into a " { $link color } "." } ;
 
 HELP: rgba>hex
 { $values { "rgba" color } { "hex" string } }
-{ $description "Converts a " { $link color } " into a hexadecimal string value." }
-;
+{ $description "Converts a " { $link color } " into a hexadecimal string value." } ;
 
-HELP: HEXCOLOR:
-{ $syntax "HEXCOLOR: value" }
+HELP: \hexcolor:
+{ $syntax "hexcolor: value" }
 { $description "Parses as a " { $link color } " object with the given hexadecimal value." }
 { $examples
   { $code
     "USING: colors.hex io.styles ;"
-    "\"Hello!\" { { foreground HEXCOLOR: 336699 } } format nl"
+    "\"Hello!\" { { foreground hexcolor: 336699 } } format nl"
   }
 } ;
 
@@ -31,7 +29,7 @@ ARTICLE: "colors.hex" "HEX colors"
 { $subsections
     hex>rgba
     rgba>hex
-    POSTPONE: HEXCOLOR:
+    postpone: \hexcolor:
 }
 { $see-also "colors" } ;
 

basis/colors/hex/hex-tests.factor

@@ -2,18 +2,18 @@
 ! See http://factorcode.org/license.txt for BSD license
 USING: colors colors.hex tools.test ;
 
-{ HEXCOLOR: 000000 } [ 0.0 0.0 0.0 1.0 <rgba> ] unit-test
-{ HEXCOLOR: FFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
-{ HEXCOLOR: abcdef } [ "abcdef" hex>rgba ] unit-test
-{ HEXCOLOR: abcdef } [ "ABCDEF" hex>rgba ] unit-test
-{ "ABCDEF" } [ HEXCOLOR: abcdef rgba>hex ] unit-test
+{ hexcolor: 000000 } [ 0.0 0.0 0.0 1.0 <rgba> ] unit-test
+{ hexcolor: FFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
+{ hexcolor: abcdef } [ "abcdef" hex>rgba ] unit-test
+{ hexcolor: abcdef } [ "ABCDEF" hex>rgba ] unit-test
+{ "ABCDEF" } [ hexcolor: abcdef rgba>hex ] unit-test
 
-{ HEXCOLOR: 00000000 } [ 0.0 0.0 0.0 0.0 <rgba> ] unit-test
-{ HEXCOLOR: FF000000 } [ 1.0 0.0 0.0 0.0 <rgba> ] unit-test
-{ HEXCOLOR: FFFF0000 } [ 1.0 1.0 0.0 0.0 <rgba> ] unit-test
-{ HEXCOLOR: FFFFFF00 } [ 1.0 1.0 1.0 0.0 <rgba> ] unit-test
-{ HEXCOLOR: FFFFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
+{ hexcolor: 00000000 } [ 0.0 0.0 0.0 0.0 <rgba> ] unit-test
+{ hexcolor: FF000000 } [ 1.0 0.0 0.0 0.0 <rgba> ] unit-test
+{ hexcolor: FFFF0000 } [ 1.0 1.0 0.0 0.0 <rgba> ] unit-test
+{ hexcolor: FFFFFF00 } [ 1.0 1.0 1.0 0.0 <rgba> ] unit-test
+{ hexcolor: FFFFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
 
-{ HEXCOLOR: cafebabe } [ "cafebabe" hex>rgba ] unit-test
-{ HEXCOLOR: 112233 } [ "123" hex>rgba ] unit-test
-{ HEXCOLOR: 11223344 } [ "1234" hex>rgba ] unit-test
+{ hexcolor: cafebabe } [ "cafebabe" hex>rgba ] unit-test
+{ hexcolor: 112233 } [ "123" hex>rgba ] unit-test
+{ hexcolor: 11223344 } [ "1234" hex>rgba ] unit-test

basis/colors/hex/hex.factor

@@ -18,4 +18,4 @@ IN: colors.hex
     [ red>> ] [ green>> ] [ blue>> ] tri
     [ 255 * >integer ] tri@ "%02X%02X%02X" sprintf ;
 
-SYNTAX: HEXCOLOR: scan-token hex>rgba suffix! ;
+SYNTAX: \hexcolor: scan-token hex>rgba suffix! ;

basis/colors/mix/mix-tests.factor

@@ -1,13 +1,13 @@
 USING: colors.constants colors.mix kernel tools.test ;
 
-{ COLOR: blue } [ COLOR: blue COLOR: red 0.0 linear-gradient ] unit-test
-{ COLOR: red } [ COLOR: blue COLOR: red 1.0 linear-gradient ] unit-test
+{ color: blue } [ color: blue color: red 0.0 linear-gradient ] unit-test
+{ color: red } [ color: blue color: red 1.0 linear-gradient ] unit-test
 
-{ COLOR: blue } [ { COLOR: blue COLOR: red COLOR: green } 0.0 sample-linear-gradient ] unit-test
-{ COLOR: red } [ { COLOR: blue COLOR: red COLOR: green } 0.5 sample-linear-gradient ] unit-test
-{ COLOR: green } [ { COLOR: blue COLOR: red COLOR: green } 1.0 sample-linear-gradient ] unit-test
+{ color: blue } [ { color: blue color: red color: green } 0.0 sample-linear-gradient ] unit-test
+{ color: red } [ { color: blue color: red color: green } 0.5 sample-linear-gradient ] unit-test
+{ color: green } [ { color: blue color: red color: green } 1.0 sample-linear-gradient ] unit-test
 
 { t } [
-    { COLOR: blue COLOR: red } 0.5 sample-linear-gradient
-    COLOR: blue COLOR: red 0.5 linear-gradient =
+    { color: blue color: red } 0.5 sample-linear-gradient
+    color: blue color: red 0.5 linear-gradient =
 ] unit-test

basis/combinators/smart/smart.factor

@@ -64,6 +64,9 @@ M: object infer-known* drop f ;
 : output>sequence ( quot exemplar -- seq )
     [ [ call ] [ outputs ] bi ] dip nsequence ; inline
 
+: output>assoc ( quot exemplar -- seq )
+    [ [ call ] [ outputs ] bi ] dip nassoc ; inline
+
 : output>array ( quot -- array )
     { } output>sequence ; inline
 

basis/combinators/smart/syntax/syntax.factor

@@ -0,0 +1,31 @@
+! Copyright (C) 2017 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.smart fry kernel parser sequences
+sequences.generalizations ;
+IN: combinators.smart.syntax
+
+SYNTAX: \quotation[ parse-quotation '[ _ [ ] output>sequence ] append! ;
+
+! SYNTAX: \array[ parse-quotation '[ _ { } output>sequence ] append! ;
+SYNTAX: \array[ parse-quotation '[ _ { } output>sequence ] call( -- a ) suffix! ;
+
+SYNTAX: \vector[ parse-quotation '[ _ V{ } output>sequence ] call( -- a ) suffix! ;
+
+SYNTAX: \assoc[ parse-quotation '[ _ { } output>assoc ] call( -- a ) suffix! ;
+
+SYNTAX: \hashtable[ parse-quotation '[ _ H{ } output>assoc ] call( -- a ) suffix! ;
+
+ERROR: wrong-number-of-outputs quot expected got ;
+: check-outputs ( quot n -- quot )
+    2dup [ outputs dup ] dip = [ 2drop ] [ wrong-number-of-outputs ] if ;
+
+: 2suffix! ( seq obj1 obj2 -- seq ) [ suffix! ] dip suffix! ; inline
+: 3suffix! ( seq obj1 obj2 obj3 -- seq ) [ 2suffix! ] dip suffix! ; inline
+: 4suffix! ( seq obj1 obj2 obj3 obj4 -- seq ) [ 3suffix! ] dip suffix! ; inline
+: 5suffix! ( seq obj1 obj2 obj3 obj4 obj5 -- seq ) [ 4suffix! ] dip suffix! ; inline
+
+SYNTAX: \1[ parse-quotation 1 check-outputs '[ _ { } output>sequence 1 firstn ] call( -- a ) suffix! ; foldable
+SYNTAX: \2[ parse-quotation 2 check-outputs '[ _ { } output>sequence 2 firstn ] call( -- a b ) 2suffix! ; foldable
+SYNTAX: \3[ parse-quotation 3 check-outputs '[ _ { } output>sequence 3 firstn ] call( -- a b c ) 3suffix! ; foldable
+SYNTAX: \4[ parse-quotation 4 check-outputs '[ _ { } output>sequence 4 firstn ] call( -- a b c d ) 4suffix! ; foldable
+SYNTAX: \5[ parse-quotation 5 check-outputs '[ _ { } output>sequence 5 firstn ] call( -- a b c d e ) 5suffix! ; foldable

basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor

@@ -12,13 +12,13 @@ IN: compiler.cfg.alias-analysis.tests
 ! Redundant load elimination
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##copy f 2 1 any-rep }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##slot-imm f 2 0 1 0 }
     } test-alias-analysis
@@ -27,15 +27,15 @@ IN: compiler.cfg.alias-analysis.tests
 ! Store-load forwarding
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##copy f 2 1 any-rep }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##slot-imm f 2 0 1 0 }
     } test-alias-analysis
@@ -44,16 +44,16 @@ IN: compiler.cfg.alias-analysis.tests
 ! Dead store elimination
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
         T{ ##set-slot-imm f 2 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 2 0 1 0 }
     } test-alias-analysis
@@ -61,18 +61,18 @@ IN: compiler.cfg.alias-analysis.tests
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##set-slot-imm f 3 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 2 0 1 0 }
         T{ ##set-slot-imm f 3 0 1 0 }
@@ -82,12 +82,12 @@ IN: compiler.cfg.alias-analysis.tests
 ! Redundant store elimination
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 1 0 1 0 }
     } test-alias-analysis
@@ -95,13 +95,13 @@ IN: compiler.cfg.alias-analysis.tests
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##copy f 2 1 any-rep }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##copy f 2 1 any-rep }
         T{ ##set-slot-imm f 2 0 1 0 }
@@ -111,16 +111,16 @@ IN: compiler.cfg.alias-analysis.tests
 ! Not a redundant load
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 0 1 1 0 }
         T{ ##slot-imm f 2 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 0 1 1 0 }
         T{ ##slot-imm f 2 0 1 0 }
@@ -130,20 +130,20 @@ IN: compiler.cfg.alias-analysis.tests
 ! Not a redundant store
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##set-slot-imm f 2 1 1 0 }
         T{ ##slot-imm f 4 0 1 0 }
         T{ ##set-slot-imm f 3 1 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##set-slot-imm f 2 1 1 0 }
         T{ ##slot-imm f 4 0 1 0 }
         T{ ##set-slot-imm f 3 1 1 0 }
@@ -153,10 +153,10 @@ IN: compiler.cfg.alias-analysis.tests
 ! There's a redundant load, but not a redundant store
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##slot-imm f 4 0 1 0 }
         T{ ##set-slot-imm f 2 0 1 0 }
         T{ ##slot f 5 0 3 0 0 }
@@ -165,10 +165,10 @@ IN: compiler.cfg.alias-analysis.tests
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##slot-imm f 4 0 1 0 }
         T{ ##set-slot-imm f 2 0 1 0 }
         T{ ##slot f 5 0 3 0 0 }
@@ -182,9 +182,9 @@ IN: compiler.cfg.alias-analysis.tests
 ! Redundant load elimination
 {
     V{
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##allot f 4 16 array }
         T{ ##set-slot-imm f 3 4 1 0 }
         T{ ##set-slot-imm f 2 1 1 0 }
@@ -192,9 +192,9 @@ IN: compiler.cfg.alias-analysis.tests
     }
 } [
     V{
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##allot f 4 16 array }
         T{ ##set-slot-imm f 3 4 1 0 }
         T{ ##set-slot-imm f 2 1 1 0 }
@@ -205,18 +205,18 @@ IN: compiler.cfg.alias-analysis.tests
 ! Redundant store elimination
 {
     V{
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##allot f 4 16 array }
         T{ ##slot-imm f 5 1 1 0 }
         T{ ##set-slot-imm f 3 4 1 0 }
     }
 } [
     V{
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##allot f 4 16 array }
         T{ ##set-slot-imm f 1 4 1 0 }
         T{ ##slot-imm f 5 1 1 0 }
@@ -228,10 +228,10 @@ IN: compiler.cfg.alias-analysis.tests
 ! can now alias the new ac
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##allot f 4 16 array }
         T{ ##set-slot-imm f 0 4 1 0 }
         T{ ##set-slot-imm f 4 2 1 0 }
@@ -241,10 +241,10 @@ IN: compiler.cfg.alias-analysis.tests
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
-        T{ ##peek f 3 D: 3 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
+        T{ ##peek f 3 d: 3 }
         T{ ##allot f 4 16 array }
         T{ ##set-slot-imm f 0 4 1 0 }
         T{ ##set-slot-imm f 4 2 1 0 }
@@ -257,13 +257,13 @@ IN: compiler.cfg.alias-analysis.tests
 ! Compares between objects which cannot alias are eliminated
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##allot f 1 16 array }
         T{ ##load-reference f 2 f }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##allot f 1 16 array }
         T{ ##compare f 2 0 1 cc= }
     } test-alias-analysis
@@ -292,14 +292,14 @@ IN: compiler.cfg.alias-analysis.tests
 ! instructions which can call back into Factor code
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
@@ -308,16 +308,16 @@ IN: compiler.cfg.alias-analysis.tests
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
@@ -326,18 +326,18 @@ IN: compiler.cfg.alias-analysis.tests
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 2 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 2 0 1 0 }
@@ -346,14 +346,14 @@ IN: compiler.cfg.alias-analysis.tests
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 1 0 1 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 1 0 1 0 }
@@ -381,7 +381,7 @@ IN: compiler.cfg.alias-analysis.tests
 {
     V{
         T{ ##allot f 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 1 d: 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##copy f 2 1 any-rep }
@@ -389,7 +389,7 @@ IN: compiler.cfg.alias-analysis.tests
 } [
     V{
         T{ ##allot f 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 1 d: 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
@@ -399,8 +399,8 @@ IN: compiler.cfg.alias-analysis.tests
 {
     V{
         T{ ##allot f 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 2 0 1 0 }
@@ -408,8 +408,8 @@ IN: compiler.cfg.alias-analysis.tests
 } [
     V{
         T{ ##allot f 0 }
-        T{ ##peek f 1 D: 1 }
-        T{ ##peek f 2 D: 2 }
+        T{ ##peek f 1 d: 1 }
+        T{ ##peek f 2 d: 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 2 0 1 0 }

basis/compiler/cfg/builder/alien/alien-docs.factor

@@ -5,7 +5,7 @@ strings ;
 IN: compiler.cfg.builder.alien
 
 <<
-STRING: ex-caller-return
+CONSTANT: ex-caller-return [[
 USING: compiler.cfg.builder.alien make prettyprint ;
 [
     T{ ##alien-invoke { reg-outputs { { 1 int-rep RAX } } } } ,
@@ -15,7 +15,7 @@ USING: compiler.cfg.builder.alien make prettyprint ;
     T{ ##alien-invoke { reg-outputs { { 1 int-rep RAX } } } }
     T{ ##box-alien { dst 116 } { src 1 } { temp 115 } }
 }
-;
+]]
 >>
 
 HELP: caller-linkage

basis/compiler/cfg/builder/alien/alien-tests.factor

@@ -33,7 +33,7 @@ IN: compiler.cfg.builder.alien.tests
         T{ ##load-integer { dst 2 } { val 3 } }
         T{ ##copy { dst 4 } { src 1 } { rep any-rep } }
         T{ ##copy { dst 3 } { src 2 } { rep any-rep } }
-        T{ ##inc { loc D: 2 } }
+        T{ ##inc { loc d: 2 } }
         T{ ##branch }
     }
 } [

basis/compiler/cfg/builder/alien/boxing/boxing.factor

@@ -39,18 +39,18 @@ M: object flatten-struct-type-return
 :: explode-struct ( src c-type -- vregs reps )
     c-type flatten-struct-type :> reps
     reps keys dup component-offsets
-    [| rep offset | src offset rep f ^^load-memory-imm ] 2map
+    |[ rep offset | src offset rep f ^^load-memory-imm ] 2map
     reps ;
 
 :: explode-struct-return ( src c-type -- vregs reps )
     c-type flatten-struct-type-return :> reps
     reps keys dup component-offsets
-    [| rep offset | src offset rep f ^^load-memory-imm ] 2map
+    |[ rep offset | src offset rep f ^^load-memory-imm ] 2map
     reps ;
 
 :: implode-struct ( src vregs reps -- )
     vregs reps dup component-offsets
-    [| vreg rep offset | vreg src offset rep f ##store-memory-imm, ] 3each ;
+    |[ vreg rep offset | vreg src offset rep f ##store-memory-imm, ] 3each ;
 
 GENERIC: unbox ( src c-type -- vregs reps )
 

basis/compiler/cfg/builder/blocks/blocks-docs.factor

@@ -3,7 +3,7 @@ help.syntax literals make math multiline quotations sequences ;
 IN: compiler.cfg.builder.blocks
 
 <<
-STRING: ex-emit-trivial-block
+CONSTANT: ex-emit-trivial-block [[
 USING: compiler.cfg.builder.blocks make prettyprint ;
 begin-stack-analysis <basic-block> dup set-basic-block [ gensym ##call, drop ] emit-trivial-block predecessors>> first .
 T{ basic-block
@@ -24,7 +24,7 @@ T{ basic-block
         }
     }
 }
-;
+]]
 >>
 
 HELP: begin-basic-block

basis/compiler/cfg/builder/builder-docs.factor

@@ -5,7 +5,7 @@ multiline quotations sequences vectors words ;
 IN: compiler.cfg.builder
 
 <<
-STRING: ex-emit-call
+CONSTANT: ex-emit-call [[
 USING: compiler.cfg.builder compiler.cfg.builder.blocks compiler.cfg.stacks
 kernel make prettyprint ;
 begin-stack-analysis <basic-block> set-basic-block
@@ -32,13 +32,13 @@ T{ basic-block
         }
     }
 }
-;
+]]
 
-STRING: ex-make-input-map
+CONSTANT: ex-make-input-map [[
 USING: compiler.cfg.builder prettyprint ;
 T{ #shuffle { in-d { 37 81 92 } } } make-input-map .
-{ { 37 D: 2 } { 81 D: 1 } { 92 D: 0 } }
-;
+{ { 37 d: 2 } { 81 d: 1 } { 92 d: 0 } }
+]]
 >>
 
 HELP: build-cfg

basis/compiler/cfg/builder/builder-tests.factor

@@ -130,8 +130,8 @@ IN: compiler.cfg.builder.tests
 {
     byte-array
     alien
-    POSTPONE: f
-} [| class |
+    postpone: f
+} |[ class |
     {
         alien-signed-1
         alien-signed-2
@@ -142,7 +142,7 @@ IN: compiler.cfg.builder.tests
         alien-cell
         alien-float
         alien-double
-    } [| word |
+    } |[ word |
         { class } word '[ _ declare 10 _ execute ] unit-test-builder
         { class fixnum } word '[ _ declare _ execute ] unit-test-builder
     ] each
@@ -154,7 +154,7 @@ IN: compiler.cfg.builder.tests
         set-alien-unsigned-1
         set-alien-unsigned-2
         set-alien-unsigned-4
-    } [| word |
+    } |[ word |
         { fixnum class } word '[ _ declare 10 _ execute ] unit-test-builder
         { fixnum class fixnum } word '[ _ declare _ execute ] unit-test-builder
     ] each
@@ -227,7 +227,7 @@ IN: compiler.cfg.builder.tests
 ] when
 
 ! Regression. Make sure everything is inlined correctly
-{ f } [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
+{ f } [ M\\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
 
 ! Regression. Make sure branch splitting works.
 { 2 } [ [ 1 2 ? ] [ ##return? ] count-insns ] unit-test
@@ -368,9 +368,9 @@ SYMBOL: foo
 ! ! #shuffle
 {
     T{ height-state f 0 0 1 0 }
-    H{ { D: -1 4 } { D: 0 4 } }
+    H{ { d: -1 4 } { d: 0 4 } }
 } [
-    4 D: 0 replace-loc
+    4 d: 0 replace-loc
     f T{ #shuffle
        { mapping { { 2 4 } { 3 4 } } }
        { in-d V{ 4 } }
@@ -405,21 +405,21 @@ SYMBOL: foo
 
 ! make-input-map
 {
-    { { 37 D: 2 } { 81 D: 1 } { 92 D: 0 } }
+    { { 37 d: 2 } { 81 d: 1 } { 92 d: 0 } }
 } [
     T{ #shuffle { in-d { 37 81 92 } } } make-input-map
 ] unit-test
 
 ! store-shuffle
 {
-    H{ { D: 2 1 } }
+    H{ { d: 2 1 } }
 } [
     f T{ #shuffle { in-d { 7 3 0 } } { out-d { 55 } } { mapping { { 55 3 } } } }
     emit-node drop replaces get
 ] cfg-unit-test
 
 {
-    H{ { D: -1 1 } { D: 0 1 } }
+    H{ { d: -1 1 } { d: 0 1 } }
 } [
     f T{ #shuffle
        { in-d { 7 } }

basis/compiler/cfg/copy-prop/copy-prop-tests.factor

@@ -13,12 +13,12 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 0 D: 0 }
+    T{ ##peek f 0 d: 0 }
     T{ ##branch }
 } 1 test-bb
 
 V{
-    T{ ##peek f 1 D: 1 }
+    T{ ##peek f 1 d: 1 }
     T{ ##branch }
 } 2 test-bb
 
@@ -36,9 +36,9 @@ V{
 
 V{
     T{ ##copy f 6 4 any-rep }
-    T{ ##replace f 3 D: 0 }
-    T{ ##replace f 5 D: 1 }
-    T{ ##replace f 6 D: 2 }
+    T{ ##replace f 3 d: 0 }
+    T{ ##replace f 5 d: 1 }
+    T{ ##replace f 6 d: 2 }
     T{ ##branch }
 } 5 test-bb
 
@@ -57,9 +57,9 @@ V{
 
 {
     V{
-        T{ ##replace f 0 D: 0 }
-        T{ ##replace f 4 D: 1 }
-        T{ ##replace f 4 D: 2 }
+        T{ ##replace f 0 d: 0 }
+        T{ ##replace f 4 d: 1 }
+        T{ ##replace f 4 d: 2 }
         T{ ##branch }
     }
 } [ 5 get instructions>> ] unit-test
@@ -71,7 +71,7 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 0 D: 0 }
+    T{ ##peek f 0 d: 0 }
     T{ ##branch }
 } 1 test-bb
 
@@ -82,7 +82,7 @@ V{
 } 2 test-bb
 
 V{
-    T{ ##replace f 2 D: 1 }
+    T{ ##replace f 2 d: 1 }
     T{ ##branch }
 } 3 test-bb
 
@@ -100,7 +100,7 @@ V{
 
 {
     V{
-        T{ ##replace f 0 D: 1 }
+        T{ ##replace f 0 d: 1 }
         T{ ##branch }
     }
 } [ 3 get instructions>> ] unit-test

basis/compiler/cfg/dataflow-analysis/dataflow-analysis-docs.factor

@@ -42,12 +42,12 @@ HELP: run-dataflow-analysis
 
 PRIVATE>
 
-HELP: FORWARD-ANALYSIS:
+HELP: \FORWARD-ANALYSIS:
 { $syntax "FORWARD-ANALYSIS: word" }
 { $values { "word" "name of the compiler pass" } }
 { $description "Syntax word for defining a forward analysis compiler pass." } ;
 
-HELP: BACKWARD-ANALYSIS:
+HELP: \BACKWARD-ANALYSIS:
 { $syntax "BACKWARD-ANALYSIS: word" }
 { $values { "word" "name of the compiler pass" } }
 { $description "Syntax word for defining a backward analysis compiler pass." } ;

basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators.short-circuit compiler.cfg.predecessors
-compiler.cfg.rpo compiler.cfg.utilities deques dlists functors kernel lexer
-locals namespaces sequences ;
+USING: accessors assocs combinators.short-circuit
+compiler.cfg.predecessors compiler.cfg.rpo
+compiler.cfg.utilities deques dlists functors2 kernel namespaces
+sequences strings ;
 IN: compiler.cfg.dataflow-analysis
 
 GENERIC: join-sets ( sets bb dfa -- set )
@@ -12,8 +13,6 @@ GENERIC: successors ( bb dfa -- seq )
 GENERIC: predecessors ( bb dfa -- seq )
 GENERIC: ignore-block? ( bb dfa -- ? )
 
-<PRIVATE
-
 MIXIN: dataflow-analysis
 
 : <dfa-worklist> ( cfg dfa -- queue )
@@ -57,27 +56,14 @@ MIXIN: dataflow-analysis
 M: dataflow-analysis join-sets 2drop assoc-refine ;
 M: dataflow-analysis ignore-block? drop kill-block?>> ;
 
-<FUNCTOR: define-analysis ( name -- )
-
-name DEFINES-CLASS ${name}
-name-ins DEFINES ${name}-ins
-name-outs DEFINES ${name}-outs
-name-in DEFINES ${name}-in
-name-out DEFINES ${name}-out
-
-WHERE
-
-SINGLETON: name
-
-SYMBOL: name-ins
-
-: name-in ( bb -- set ) name-ins get at ;
-
-SYMBOL: name-outs
-
-: name-out ( bb -- set ) name-outs get at ;
-
-;FUNCTOR>
+INLINE-FUNCTOR: dataflow-analysis ( name: name -- ) [[
+USING: assocs namespaces ;
+SINGLETON: ${name}
+SYMBOL: ${name}-ins
+: ${name}-in ( bb -- set ) ${name}-ins get at ;
+SYMBOL: ${name}-outs
+: ${name}-out ( bb -- set ) ${name}-outs get at ;
+]]
 
 ! ! ! Forward dataflow analysis
 
@@ -88,22 +74,19 @@ M: forward-analysis block-order  drop reverse-post-order ;
 M: forward-analysis successors   drop successors>> ;
 M: forward-analysis predecessors drop predecessors>> ;
 
-<FUNCTOR: define-forward-analysis ( name -- )
+INLINE-FUNCTOR: forward-analysis ( name: name -- ) [[
+USING: assocs kernel namespaces ;
+QUALIFIED: namespaces
 
-name IS ${name}
-name-ins IS ${name}-ins
-name-outs IS ${name}-outs
-compute-name-sets DEFINES compute-${name}-sets
+DATAFLOW-ANALYSIS: ${name}
 
-WHERE
+INSTANCE: ${name} forward-analysis
 
-INSTANCE: name forward-analysis
+: compute-${name}-sets ( cfg -- )
+    \ ${name} run-dataflow-analysis
+    [ ${name}-ins namespaces:set ] [ ${name}-outs namespaces:set ] bi* ;
 
-: compute-name-sets ( cfg -- )
-    name run-dataflow-analysis
-    [ name-ins set ] [ name-outs set ] bi* ;
-
-;FUNCTOR>
+]]
 
 ! ! ! Backward dataflow analysis
 
@@ -114,27 +97,16 @@ M: backward-analysis block-order  drop post-order ;
 M: backward-analysis successors   drop predecessors>> ;
 M: backward-analysis predecessors drop successors>> ;
 
-<FUNCTOR: define-backward-analysis ( name -- )
+INLINE-FUNCTOR: backward-analysis ( name: name -- ) [[
+USING: assocs kernel namespaces ;
+QUALIFIED: namespaces
 
-name IS ${name}
-name-ins IS ${name}-ins
-name-outs IS ${name}-outs
-compute-name-sets DEFINES compute-${name}-sets
+DATAFLOW-ANALYSIS: ${name}
 
-WHERE
+INSTANCE: ${name} backward-analysis
 
-INSTANCE: name backward-analysis
+: compute-${name}-sets ( cfg -- )
+    \ ${name} run-dataflow-analysis
+    [ ${name}-outs namespaces:set ] [ ${name}-ins namespaces:set ] bi* ;
 
-: compute-name-sets ( cfg -- )
-    \ name run-dataflow-analysis
-    [ name-outs set ] [ name-ins set ] bi* ;
-
-;FUNCTOR>
-
-PRIVATE>
-
-SYNTAX: FORWARD-ANALYSIS:
-    scan-token [ define-analysis ] [ define-forward-analysis ] bi ;
-
-SYNTAX: BACKWARD-ANALYSIS:
-    scan-token [ define-analysis ] [ define-backward-analysis ] bi ;
+]]

basis/compiler/cfg/dce/dce-tests.factor

@@ -11,12 +11,12 @@ IN: compiler.cfg.dce.tests
     T{ ##load-integer { dst 1 } { val 8 } }
     T{ ##load-integer { dst 2 } { val 16 } }
     T{ ##add { dst 3 } { src1 1 } { src2 2 } }
-    T{ ##replace { src 3 } { loc D: 0 } }
+    T{ ##replace { src 3 } { loc d: 0 } }
 } } [ V{
     T{ ##load-integer { dst 1 } { val 8 } }
     T{ ##load-integer { dst 2 } { val 16 } }
     T{ ##add { dst 3 } { src1 1 } { src2 2 } }
-    T{ ##replace { src 3 } { loc D: 0 } }
+    T{ ##replace { src 3 } { loc d: 0 } }
 } test-dce ] unit-test
 
 { V{ } } [ V{
@@ -40,30 +40,30 @@ IN: compiler.cfg.dce.tests
     T{ ##load-integer { dst 3 } { val 8 } }
     T{ ##allot { dst 1 } { temp 2 } }
     T{ ##set-slot-imm { obj 1 } { src 3 } }
-    T{ ##replace { src 1 } { loc D: 0 } }
+    T{ ##replace { src 1 } { loc d: 0 } }
 } } [ V{
     T{ ##load-integer { dst 3 } { val 8 } }
     T{ ##allot { dst 1 } { temp 2 } }
     T{ ##set-slot-imm { obj 1 } { src 3 } }
-    T{ ##replace { src 1 } { loc D: 0 } }
+    T{ ##replace { src 1 } { loc d: 0 } }
 } test-dce ] unit-test
 
 { V{
     T{ ##allot { dst 1 } { temp 2 } }
-    T{ ##replace { src 1 } { loc D: 0 } }
+    T{ ##replace { src 1 } { loc d: 0 } }
 } } [ V{
     T{ ##allot { dst 1 } { temp 2 } }
-    T{ ##replace { src 1 } { loc D: 0 } }
+    T{ ##replace { src 1 } { loc d: 0 } }
 } test-dce ] unit-test
 
 { V{
     T{ ##allot { dst 1 } { temp 2 } }
-    T{ ##replace { src 1 } { loc D: 0 } }
+    T{ ##replace { src 1 } { loc d: 0 } }
     T{ ##load-integer { dst 3 } { val 8 } }
     T{ ##set-slot-imm { obj 1 } { src 3 } }
 } } [ V{
     T{ ##allot { dst 1 } { temp 2 } }
-    T{ ##replace { src 1 } { loc D: 0 } }
+    T{ ##replace { src 1 } { loc d: 0 } }
     T{ ##load-integer { dst 3 } { val 8 } }
     T{ ##set-slot-imm { obj 1 } { src 3 } }
 } test-dce ] unit-test

basis/compiler/cfg/def-use/def-use-docs.factor

@@ -19,7 +19,7 @@ HELP: defs-vregs
 { $examples
   { $example
     "USING: compiler.cfg.def-use compiler.cfg.instructions compiler.cfg.registers prettyprint ;"
-    "T{ ##peek f 37 D: 0 0 } defs-vregs ."
+    "T{ ##peek f 37 d: 0 0 } defs-vregs ."
     "{ 37 }"
   }
 }
@@ -44,7 +44,7 @@ HELP: uses-vregs
 { $examples
   { $example
     "USING: compiler.cfg.def-use compiler.cfg.instructions compiler.cfg.registers prettyprint ;"
-    "T{ ##replace f 37 D: 1 6 } uses-vregs ."
+    "T{ ##replace f 37 d: 1 6 } uses-vregs ."
     "{ 37 }"
   }
 } ;

basis/compiler/cfg/def-use/def-use-tests.factor

@@ -7,23 +7,23 @@ IN: compiler.cfg.def-use.tests
 
 ! compute-insns
 {
-    T{ ##peek f 123 D: 0 f }
+    T{ ##peek f 123 d: 0 f }
 } [
-    { T{ ##peek f 123 D: 0 } } 0 insns>block block>cfg compute-insns
+    { T{ ##peek f 123 d: 0 } } 0 insns>block block>cfg compute-insns
     123 insn-of
 ] unit-test
 
 V{
-    T{ ##peek f 0 D: 0 }
-    T{ ##peek f 1 D: 0 }
-    T{ ##peek f 2 D: 0 }
+    T{ ##peek f 0 d: 0 }
+    T{ ##peek f 1 d: 0 }
+    T{ ##peek f 2 d: 0 }
 } 1 test-bb
 V{
-    T{ ##replace f 2 D: 0 }
+    T{ ##replace f 2 d: 0 }
 } 2 test-bb
 1 2 edge
 V{
-    T{ ##replace f 0 D: 0 }
+    T{ ##replace f 0 d: 0 }
 } 3 test-bb
 2 3 edge
 V{ } 4 test-bb

basis/compiler/cfg/gc-checks/gc-checks-tests.factor

@@ -144,7 +144,7 @@ IN: compiler.cfg.gc-checks.tests
 
 V{
     T{ ##inc f 3 }
-    T{ ##replace f 0 D: 1 }
+    T{ ##replace f 0 d: 1 }
 } 0 test-bb
 
 V{
@@ -181,8 +181,8 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 2 D: 0 }
-    T{ ##inc { loc D: 3 } }
+    T{ ##peek f 2 d: 0 }
+    T{ ##inc { loc d: 3 } }
     T{ ##branch }
 } 1 test-bb
 
@@ -196,7 +196,7 @@ V{
 } 3 test-bb
 
 V{
-    T{ ##replace f 2 D: 1 }
+    T{ ##replace f 2 d: 1 }
     T{ ##branch }
 } 4 test-bb
 

basis/compiler/cfg/gc-checks/gc-checks.factor

@@ -39,7 +39,7 @@ M: insn gc-check-offsets* 2drop ;
     ! Divide a basic block into sections, where every section
     ! other than the first requires a GC check.
     [
-        insns 0 seq [| insns from to |
+        insns 0 seq |[ insns from to |
             from to insns subseq ,
             insns to
         ] each
@@ -79,7 +79,7 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
     ! the previous block, and the previous block's GC call.
     bbs length 1 - :> len
     len [ <gc-call> ] replicate :> gc-calls
-    len [| n |
+    len |[ n |
         n bbs nth :> bb
         n 1 + bbs nth :> next-bb
         n gc-calls nth :> gc-call

basis/compiler/cfg/instructions/syntax/syntax-docs.factor

@@ -2,13 +2,12 @@ USING: help.markup help.syntax literals multiline sequences splitting ;
 IN: compiler.cfg.instructions.syntax
 
 <<
-STRING: parse-insn-slot-specs-code
+CONSTANT: parse-insn-slot-specs-code [[
 USING: compiler.cfg.instructions.syntax prettyprint splitting ;
 "use: src/int-rep temp: temp/int-rep" " " split parse-insn-slot-specs .
-;
+]]
 
-STRING: parse-insn-slot-specs-result
-{
+CONSTANT: parse-insn-slot-specs-result [[ {
     T{ insn-slot-spec
         { type use }
         { name "src" }
@@ -19,8 +18,7 @@ STRING: parse-insn-slot-specs-result
         { name "temp" }
         { rep int-rep }
     }
-}
-;
+}]]
 >>
 
 HELP: parse-insn-slot-specs

basis/compiler/cfg/instructions/syntax/syntax.factor

@@ -88,14 +88,14 @@ TUPLE: insn-slot-spec type name rep ;
         [ nip define-insn-ctor ]
     } 3cleave ;
 
-SYNTAX: INSN:
+SYNTAX: \INSN:
     scan-new-class insn-word ";" parse-tokens define-insn ;
 
-SYNTAX: VREG-INSN:
+SYNTAX: \VREG-INSN:
     scan-new-class vreg-insn-word ";" parse-tokens define-insn ;
 
-SYNTAX: FLUSHABLE-INSN:
+SYNTAX: \FLUSHABLE-INSN:
     scan-new-class flushable-insn-word ";" parse-tokens define-insn ;
 
-SYNTAX: FOLDABLE-INSN:
+SYNTAX: \FOLDABLE-INSN:
     scan-new-class foldable-insn-word ";" parse-tokens define-insn ;

basis/compiler/cfg/intrinsics/fixnum/fixnum-tests.factor

@@ -42,7 +42,7 @@ IN: compiler.cfg.intrinsics.fixnum.tests
            { src 321 }
            { rep any-rep }
         }
-        T{ ##inc { loc D: -1 } }
+        T{ ##inc { loc d: -1 } }
         T{ ##branch }
     }
     77

basis/compiler/cfg/intrinsics/fixnum/fixnum.factor

@@ -41,7 +41,7 @@ IN: compiler.cfg.intrinsics.fixnum
     '[ _ ^^compare-integer ] binary-op ;
 
 : emit-no-overflow-case ( dst block -- final-bb )
-    [ swap D: -2 inc-stack ds-push ] with-branch ;
+    [ swap d: -2 inc-stack ds-push ] with-branch ;
 
 : emit-overflow-case ( word block -- final-bb )
     [ -1 swap [ emit-call-block ] keep ] with-branch ;

basis/compiler/cfg/intrinsics/simd/backend/backend.factor

@@ -132,10 +132,10 @@ CONSTANT: binary/param [ [ -2 <ds-loc> inc-stack 2inputs ] dip ]
 CONSTANT: quaternary
     [
         ds-drop
-        D: 3 peek-loc
-        D: 2 peek-loc
-        D: 1 peek-loc
-        D: 0 peek-loc
+        d: 3 peek-loc
+        d: 2 peek-loc
+        d: 1 peek-loc
+        d: 0 peek-loc
         -4 <ds-loc> inc-stack
     ]
 

basis/compiler/cfg/intrinsics/simd/simd.factor

@@ -127,7 +127,7 @@ CONSTANT: rep>half {
     {
         [ ^(compare-vector) ]
         [ ^minmax-compare-vector ]
-        { unsigned-int-vector-rep [| src1 src2 rep cc |
+        { unsigned-int-vector-rep |[ src1 src2 rep cc |
             rep sign-bit-mask ^^load-literal :> sign-bits
             src1 sign-bits rep ^^xor-vector
             src2 sign-bits rep ^^xor-vector
@@ -139,12 +139,12 @@ CONSTANT: rep>half {
     {
         [ ^^unpack-vector-head ]
         { unsigned-int-vector-rep [ [ ^^zero-vector ] [ ^^merge-vector-head ] bi ] }
-        { signed-int-vector-rep [| src rep |
+        { signed-int-vector-rep |[ src rep |
             src src rep ^^merge-vector-head :> merged
             rep rep-component-type heap-size 8 * :> bits
             merged bits rep widen-vector-rep ^^shr-vector-imm
         ] }
-        { signed-int-vector-rep [| src rep |
+        { signed-int-vector-rep |[ src rep |
             rep ^^zero-vector :> zero
             zero src rep cc> ^compare-vector :> sign
             src sign rep ^^merge-vector-head
@@ -156,12 +156,12 @@ CONSTANT: rep>half {
         [ ^^unpack-vector-tail ]
         [ [ ^^tail>head-vector ] [ ^^unpack-vector-head ] bi ]
         { unsigned-int-vector-rep [ [ ^^zero-vector ] [ ^^merge-vector-tail ] bi ] }
-        { signed-int-vector-rep [| src rep |
+        { signed-int-vector-rep |[ src rep |
             src src rep ^^merge-vector-tail :> merged
             rep rep-component-type heap-size 8 * :> bits
             merged bits rep widen-vector-rep ^^shr-vector-imm
         ] }
-        { signed-int-vector-rep [| src rep |
+        { signed-int-vector-rep |[ src rep |
             rep ^^zero-vector :> zero
             zero src rep cc> ^compare-vector :> sign
             src sign rep ^^merge-vector-tail
@@ -174,7 +174,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
 : ^(sum-vector-2) ( src rep -- dst )
     {
         [ dupd ^^horizontal-add-vector ]
-        [| src rep |
+        |[ src rep |
             src src rep ^^merge-vector-head :> head
             src src rep ^^merge-vector-tail :> tail
             head tail rep ^^add-vector
@@ -187,7 +187,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
             [ dupd ^^horizontal-add-vector ]
             [ dupd ^^horizontal-add-vector ] bi
         ]
-        [| src rep |
+        |[ src rep |
             src src rep ^^merge-vector-head :> head
             src src rep ^^merge-vector-tail :> tail
             head tail rep ^^add-vector :> src'
@@ -206,7 +206,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
             [ dupd ^^horizontal-add-vector ]
             [ dupd ^^horizontal-add-vector ] tri
         ]
-        [| src rep |
+        |[ src rep |
             src src rep ^^merge-vector-head :> head
             src src rep ^^merge-vector-tail :> tail
             head tail rep ^^add-vector :> src'
@@ -233,7 +233,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
                 [ dupd ^^horizontal-add-vector ]
             } cleave
         ]
-        [| src rep |
+        |[ src rep |
             src src rep ^^merge-vector-head :> head
             src src rep ^^merge-vector-tail :> tail
             head tail rep ^^add-vector :> src'
@@ -268,7 +268,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
 : ^sum-vector ( src rep -- dst )
     {
         { float-vector-rep [ ^(sum-vector) ] }
-        { fixnum-vector-rep [| src rep |
+        { fixnum-vector-rep |[ src rep |
             src rep ^unpack-vector-head :> head
             src rep ^unpack-vector-tail :> tail
             rep widen-vector-rep :> wide-rep
@@ -287,7 +287,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
 
 : ^shuffle-2-vectors-imm ( src1 src2 shuffle rep -- dst )
     [ rep-length 0 pad-tail ] keep {
-        { double-2-rep [| src1 src2 shuffle rep |
+        { double-2-rep |[ src1 src2 shuffle rep |
             shuffle first2 [ 4 mod ] bi@ :> ( i j )
             {
                 { [ i j [ 2 < ] both? ] [
@@ -339,12 +339,12 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
 : emit-simd-v+- ( node -- )
     {
         [ ^^add-sub-vector ]
-        { float-vector-rep [| src1 src2 rep |
+        { float-vector-rep |[ src1 src2 rep |
             rep ^load-add-sub-vector :> signs
             src2 signs rep ^^xor-vector :> src2'
             src1 src2' rep ^^add-vector
         ] }
-        { int-vector-rep   [| src1 src2 rep |
+        { int-vector-rep   |[ src1 src2 rep |
             rep ^load-add-sub-vector :> signs
             src2  signs rep ^^xor-vector :> src2'
             src2' signs rep ^^sub-vector :> src2''
@@ -411,7 +411,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
 : emit-simd-vavg ( node -- )
     {
         [ ^^avg-vector ]
-        { float-vector-rep [| src1 src2 rep |
+        { float-vector-rep |[ src1 src2 rep |
             src1 src2 rep ^^add-vector
             rep ^load-half-vector rep ^^mul-vector
         ] }
@@ -446,7 +446,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
         { unsigned-int-vector-rep [ drop ] }
         [ ^^abs-vector ]
         { float-vector-rep [ [ ^load-neg-zero-vector ] [ swapd ^^andn-vector ] bi ] }
-        { int-vector-rep [| src rep |
+        { int-vector-rep |[ src rep |
             rep ^^zero-vector :> zero
             zero src rep ^^sub-vector :> -src
             zero src rep cc> ^compare-vector :> sign
@@ -584,7 +584,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
 
 : emit-simd-vpack-signed ( node -- )
     {
-        { double-2-rep [| src1 src2 rep |
+        { double-2-rep |[ src1 src2 rep |
             src1 double-2-rep ^^float-pack-vector :> dst-head
             src2 double-2-rep ^^float-pack-vector :> dst-tail
             dst-head dst-tail { 0 1 0 1 } float-4-rep ^^shuffle-vector-halves-imm

basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor

@@ -56,27 +56,27 @@ IN: compiler.cfg.linear-scan.assignment.tests
 } [
     H{ { 37 RAX } } pending-interval-assoc set
     { { 37 int-rep 37 f } } setup-vreg-spills
-    T{ ##peek f 37 D: 0 0 } [ assign-insn-defs ] keep
+    T{ ##peek f 37 d: 0 0 } [ assign-insn-defs ] keep
 ] unit-test
 
 ! assign-all-registers
 {
-    T{ ##replace-imm f 20 D: 0 f }
-    T{ ##replace f RAX D: 0 f }
+    T{ ##replace-imm f 20 d: 0 f }
+    T{ ##replace f RAX d: 0 f }
 } [
     ! It doesn't do anything because ##replace-imm isn't a vreg-insn.
-    T{ ##replace-imm { src 20 } { loc D: 0 } } [ assign-all-registers ] keep
+    T{ ##replace-imm { src 20 } { loc d: 0 } } [ assign-all-registers ] keep
 
     ! This one does something.
     H{ { 37 RAX } } pending-interval-assoc set
     H{ { 37 37 } } leader-map set
-    T{ ##replace { src 37 } { loc D: 0 } } clone
+    T{ ##replace { src 37 } { loc d: 0 } } clone
     [ assign-all-registers ] keep
 ] unit-test
 
 ! assign-registers
 { } [
-    V{ T{ ##inc { loc D: 3 } { insn# 7 } } } 0 insns>block block>cfg { }
+    V{ T{ ##inc { loc d: 3 } { insn# 7 } } } 0 insns>block block>cfg { }
     assign-registers
 ] unit-test
 
@@ -85,7 +85,7 @@ IN: compiler.cfg.linear-scan.assignment.tests
     V{ T{ ##inc { loc T{ ds-loc { n 3 } } } { insn# 7 } } }
 } [
     { } init-assignment
-    V{ T{ ##inc { loc D: 3 } { insn# 7 } } } 0 insns>block
+    V{ T{ ##inc { loc d: 3 } { insn# 7 } } } 0 insns>block
     [ assign-registers-in-block ] keep instructions>>
 ] unit-test
 

basis/compiler/cfg/linear-scan/assignment/assignment.factor

@@ -1,14 +1,18 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators compiler.cfg
-compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals compiler.cfg.linearization
-compiler.cfg.liveness compiler.cfg.registers
-compiler.cfg.renaming.functor compiler.cfg.ssa.destruction.leaders
-compiler.cfg.utilities fry heaps kernel make math namespaces sequences
-;
-IN: compiler.cfg.linear-scan.assignment
+compiler.cfg.def-use compiler.cfg.instructions
+compiler.cfg.instructions.syntax
+compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linearization compiler.cfg.liveness
+compiler.cfg.registers compiler.cfg.renaming.functor
+compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities
+generic.parser heaps kernel make math namespaces sequences sets
+words ;
+FROM: namespaces => set ;
 QUALIFIED: sets
+IN: compiler.cfg.linear-scan.assignment
 
 ! This contains both active and inactive intervals; any interval
 ! such that start <= insn# <= end is in this set.
@@ -88,7 +92,7 @@ SYMBOL: machine-live-outs
     [ pending-interval-heap get expire-old-intervals ]
     [ unhandled-intervals get activate-new-intervals ] bi ;
 
-RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
+RENAMING: assign "[ vreg>reg ]" "[ vreg>reg ]" "[ vreg>reg ]"
 
 : assign-all-registers ( insn -- )
     [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;

basis/compiler/cfg/linear-scan/debugger/debugger.factor

@@ -14,8 +14,8 @@ IN: compiler.cfg.linear-scan.debugger
     allocate-registers drop ;
 
 : picture ( uses -- str )
-    dup last 1 + CHAR: space <string>
-    [ '[ CHAR: * swap _ set-nth ] each ] keep ;
+    dup last 1 + char: space <string>
+    [ '[ char: * swap _ set-nth ] each ] keep ;
 
 : interval-picture ( interval -- str )
     [ uses>> picture ]

basis/compiler/cfg/linear-scan/linear-scan-tests.factor

@@ -33,7 +33,7 @@ check-numbering? on
     ! live range
     {
         T{ ##load-integer f 1 0 }
-        T{ ##replace-imm f D: 0 "hi" }
+        T{ ##replace-imm f d: 0 "hi" }
         T{ ##branch }
     } insns>cfg
     [ cfg set ] [ number-instructions ] [ compute-live-intervals ] tri

basis/compiler/cfg/liveness/liveness-tests.factor

@@ -75,17 +75,17 @@ IN: compiler.cfg.liveness.tests
 
 ! gen-uses
 { H{ { 37 37 } } } [
-    H{ } clone [ T{ ##replace f 37 D: 0 0 } gen-uses ] keep
+    H{ } clone [ T{ ##replace f 37 d: 0 0 } gen-uses ] keep
 ] unit-test
 
 ! kill-defs
 { H{ } } [
-    H{ } dup T{ ##peek f 37 D: 0 0 } kill-defs
+    H{ } dup T{ ##peek f 37 d: 0 0 } kill-defs
 ] unit-test
 
 { H{ { 3 3 } } } [
     H{ { 37 99 } { 99 99 } { 2 99 } } leader-map set
-    H{ { 37 37 } { 3 3 } } dup T{ ##peek f 2 D: 0 0 } kill-defs
+    H{ { 37 37 } { 3 3 } } dup T{ ##peek f 2 d: 0 0 } kill-defs
 ] unit-test
 
 ! liveness-step
@@ -108,21 +108,21 @@ IN: compiler.cfg.liveness.tests
 cpu x86.64? [
     { f } [
         H{ } base-pointers set
-        H{ { 123 T{ ##peek { dst RCX } { loc D: 1 } { insn# 6 } } } } insns set
+        H{ { 123 T{ ##peek { dst RCX } { loc d: 1 } { insn# 6 } } } } insns set
         123 lookup-base-pointer
     ] unit-test
 ] when
 
 ! lookup-base-pointer*
 { f } [
-    456 T{ ##peek f 123 D: 0 } lookup-base-pointer*
+    456 T{ ##peek f 123 d: 0 } lookup-base-pointer*
 ] unit-test
 
 ! transfer-liveness
 {
     H{ { 37 37 } }
 } [
-    H{ } clone dup { T{ ##replace f 37 D: 1 6 } T{ ##peek f 37 D: 0 0 } }
+    H{ } clone dup { T{ ##replace f 37 d: 1 6 } T{ ##peek f 37 d: 0 0 } }
     transfer-liveness
 ] unit-test
 
@@ -141,12 +141,12 @@ cpu x86.64? [
 
 ! visit-insn
 { H{ } } [
-    H{ } clone [ T{ ##peek f 0 D: 0 } visit-insn ] keep
+    H{ } clone [ T{ ##peek f 0 d: 0 } visit-insn ] keep
 ] unit-test
 
 { H{ { 48 48 } { 37 37 } } } [
     H{ { 48 tagged-rep } } representations set
-    H{ { 48 48  } } clone [ T{ ##replace f 37 D: 1 6 } visit-insn ] keep
+    H{ { 48 48  } } clone [ T{ ##replace f 37 d: 1 6 } visit-insn ] keep
 ] unit-test
 
 {
@@ -167,20 +167,20 @@ cpu x86.64? [
 ! Sanity check...
 
 V{
-    T{ ##peek f 0 D: 0 }
-    T{ ##replace f 0 D: 0 }
-    T{ ##replace f 1 D: 1 }
-    T{ ##peek f 1 D: 1 }
+    T{ ##peek f 0 d: 0 }
+    T{ ##replace f 0 d: 0 }
+    T{ ##replace f 1 d: 1 }
+    T{ ##peek f 1 d: 1 }
     T{ ##branch }
 } 1 test-bb
 
 V{
-    T{ ##replace f 2 D: 0 }
+    T{ ##replace f 2 d: 0 }
     T{ ##branch }
 } 2 test-bb
 
 V{
-    T{ ##replace f 3 D: 0 }
+    T{ ##replace f 3 d: 0 }
     T{ ##return }
 } 3 test-bb
 
@@ -201,7 +201,7 @@ unit-test
 ! Tricky case; defs must be killed before uses
 
 V{
-    T{ ##peek f 0 D: 0 }
+    T{ ##peek f 0 d: 0 }
     T{ ##branch }
 } 1 test-bb
 
@@ -223,12 +223,12 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##inc { loc R: 2 } }
-    T{ ##inc { loc D: -2 } }
-    T{ ##peek f 21 D: -1 }
-    T{ ##peek f 22 D: -2 }
-    T{ ##replace f 21 R: 0 }
-    T{ ##replace f 22 R: 1 }
+    T{ ##inc { loc r: 2 } }
+    T{ ##inc { loc d: -2 } }
+    T{ ##peek f 21 d: -1 }
+    T{ ##peek f 22 d: -2 }
+    T{ ##replace f 21 r: 0 }
+    T{ ##replace f 22 r: 1 }
     T{ ##branch }
 } 1 test-bb
 
@@ -238,10 +238,10 @@ V{
 } 2 test-bb
 
 V{
-    T{ ##inc { loc R: -1 } }
-    T{ ##inc { loc D: 1 } }
-    T{ ##peek f 25 R: -1 }
-    T{ ##replace f 25 D: 0 }
+    T{ ##inc { loc r: -1 } }
+    T{ ##inc { loc d: 1 } }
+    T{ ##peek f 25 r: -1 }
+    T{ ##replace f 25 d: 0 }
     T{ ##branch }
 } 3 test-bb
 
@@ -251,35 +251,35 @@ V{
 } 4 test-bb
 
 V{
-    T{ ##inc f R: -1 }
-    T{ ##inc f D: 2 }
-    T{ ##peek f 27 R: -1 }
-    T{ ##peek f 28 D: 2 }
-    T{ ##peek f 29 D: 3 }
+    T{ ##inc f r: -1 }
+    T{ ##inc f d: 2 }
+    T{ ##peek f 27 r: -1 }
+    T{ ##peek f 28 d: 2 }
+    T{ ##peek f 29 d: 3 }
     T{ ##load-integer f 30 1 }
     T{ ##load-integer f 31 0 }
     T{ ##compare-imm-branch f 27 f cc/= }
 } 5 test-bb
 
 V{
-    T{ ##inc f D: -1 }
+    T{ ##inc f d: -1 }
     T{ ##branch }
 } 6 test-bb
 
 V{
-    T{ ##inc f D: -1 }
+    T{ ##inc f d: -1 }
     T{ ##branch }
 } 7 test-bb
 
 V{
     T{ ##phi f 36 H{ { 6 30 } { 7 31 } } }
-    T{ ##inc f D: -2 }
+    T{ ##inc f d: -2 }
     T{ ##unbox f 37 29 "alien_offset" int-rep }
     T{ ##unbox f 38 28 "to_double" double-rep }
     T{ ##unbox f 39 36 "to_cell" int-rep }
     T{ ##alien-invoke f f V{ } V{ { 37 int-rep 0 } { 38 double-rep 4 } { 39 int-rep 12 } } { { 40 int-rep EAX } } { } 0 16 "CFRunLoopRunInMode" f T{ gc-map } }
     T{ ##box f 41 40 "from_signed_cell" int-rep T{ gc-map } }
-    T{ ##replace f 41 D: 0 }
+    T{ ##replace f 41 d: 0 }
     T{ ##branch }
 } 8 test-bb
 
@@ -334,7 +334,7 @@ V{
 } 5 test-bb
 
 V{
-    T{ ##replace f 2 D: 0 }
+    T{ ##replace f 2 d: 0 }
     T{ ##branch }
 } 6 test-bb
 
@@ -368,12 +368,12 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 0 D: 0 }
+    T{ ##peek f 0 d: 0 }
     T{ ##tagged>integer f 1 0 }
     T{ ##call-gc f T{ gc-map } }
-    T{ ##replace f 0 D: 0 }
+    T{ ##replace f 0 d: 0 }
     T{ ##call-gc f T{ gc-map } }
-    T{ ##replace f 1 D: 0 }
+    T{ ##replace f 1 d: 0 }
     T{ ##branch }
 } 1 test-bb
 

basis/compiler/cfg/registers/registers-tests.factor

@@ -3,6 +3,6 @@ IN: compiler.cfg.registers.tests
 
 ! Ensure prettyprinting of ds/rs-loc is right
 
-{ "D: 3\nR: -1\n" } [
-    [ D: 3 . R: -1 . ] with-string-writer
+{ "d: 3\nr: -1\n" } [
+    [ d: 3 . r: -1 . ] with-string-writer
 ] unit-test

basis/compiler/cfg/registers/registers.factor

@@ -32,5 +32,5 @@ C: <ds-loc> ds-loc
 TUPLE: rs-loc < loc ;
 C: <rs-loc> rs-loc
 
-SYNTAX: D: scan-number <ds-loc> suffix! ;
-SYNTAX: R: scan-number <rs-loc> suffix! ;
+SYNTAX: \d:  scan-number <ds-loc> suffix! ;
+SYNTAX: \r:  scan-number <rs-loc> suffix! ;

basis/compiler/cfg/renaming/functor/functor.factor

@@ -1,9 +1,6 @@
 ! Copyright (C) 2009, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs compiler.cfg.def-use
-compiler.cfg.instructions compiler.cfg.instructions.syntax fry
-functors generic.parser kernel lexer namespaces parser sequences
-sets slots words ;
+USING: functors2 kernel sequences slots strings ;
 IN: compiler.cfg.renaming.functor
 
 ! Like compiler.cfg.def-use, but for changing operands
@@ -12,77 +9,70 @@ IN: compiler.cfg.renaming.functor
     '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
     [ drop ] append ;
 
-<FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
+INLINE-FUNCTOR: renaming ( name: name def-quot: string use-quot: string temp-quot: string -- ) [[
+    GENERIC: ${name}-insn-defs ( insn -- )
+    GENERIC: ${name}-insn-uses ( insn -- )
+    GENERIC: ${name}-insn-temps ( insn -- )
 
-rename-insn-defs DEFINES ${NAME}-insn-defs
-rename-insn-uses DEFINES ${NAME}-insn-uses
-rename-insn-temps DEFINES ${NAME}-insn-temps
+    M: insn ${name}-insn-defs drop ;
+    M: insn ${name}-insn-uses drop ;
+    M: insn ${name}-insn-temps drop ;
 
-WHERE
+    ! Instructions with unusual operands
 
-GENERIC: rename-insn-defs ( insn -- )
-GENERIC: rename-insn-uses ( insn -- )
-GENERIC: rename-insn-temps ( insn -- )
+    ! Special ${name}-insn-defs methods
+    M: ##parallel-copy ${name}-insn-defs
+        [ [ first2 ${def-quot} dip 2array ] map ] change-values drop ;
 
-M: insn rename-insn-defs drop ;
-M: insn rename-insn-uses drop ;
-M: insn rename-insn-temps drop ;
+    M: ##phi ${name}-insn-defs ${def-quot} change-dst drop ;
 
-! Instructions with unusual operands
-
-! Special rename-insn-defs methods
-M: ##parallel-copy rename-insn-defs
-    [ [ first2 DEF-QUOT dip 2array ] map ] change-values drop ;
-
-M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
-
-M: alien-call-insn rename-insn-defs
-    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
+    M: alien-call-insn ${name}-insn-defs
+        [ [ first3 ${def-quot} 2dip 3array ] map ] change-reg-outputs
         drop ;
 
-M: ##callback-inputs rename-insn-defs
-    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
-    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-stack-outputs
+    M: ##callback-inputs ${name}-insn-defs
+        [ [ first3 ${def-quot} 2dip 3array ] map ] change-reg-outputs
+        [ [ first3 ${def-quot} 2dip 3array ] map ] change-stack-outputs
         drop ;
 
-! Special rename-insn-uses methods
-M: ##parallel-copy rename-insn-uses
-    [ [ first2 USE-QUOT call 2array ] map ] change-values drop ;
+    ! Special ${name}-insn-uses methods
+    M: ##parallel-copy ${name}-insn-uses
+        [ [ first2 ${use-quot} call 2array ] map ] change-values drop ;
 
-M: ##phi rename-insn-uses
-    [ USE-QUOT assoc-map ] change-inputs drop ;
+    M: ##phi ${name}-insn-uses
+        [ ${use-quot} assoc-map ] change-inputs drop ;
 
-M: alien-call-insn rename-insn-uses
-    [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
-    [ [ first3 USE-QUOT 2dip 3array ] map ] change-stack-inputs
+    M: alien-call-insn ${name}-insn-uses
+        [ [ first3 ${use-quot} 2dip 3array ] map ] change-reg-inputs
+        [ [ first3 ${use-quot} 2dip 3array ] map ] change-stack-inputs
         drop ;
 
-M: ##alien-indirect rename-insn-uses
-    USE-QUOT change-src call-next-method ;
+    M: ##alien-indirect ${name}-insn-uses
+        ${use-quot} change-src call-next-method ;
 
-M: ##callback-outputs rename-insn-uses
-    [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
+    M: ##callback-outputs ${name}-insn-uses
+        [ [ first3 ${use-quot} 2dip 3array ] map ] change-reg-inputs
         drop ;
 
-! Generate methods for everything else
-insn-classes get special-vreg-insns diff [ insn-def-slots empty? ] reject [
-    [ \ rename-insn-defs create-method-in ]
-    [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
+    <<
+    ! Generate methods for everything else
+    insn-classes get special-vreg-insns diff [ insn-def-slots empty? ] reject [
+        [ \ ${name}-insn-defs create-method-in ]
+        [ insn-def-slots [ name>> ] map ${def-quot} slot-change-quot ] bi
         define
-] each
+    ] each
 
-insn-classes get special-vreg-insns diff [ insn-use-slots empty? ] reject [
-    [ \ rename-insn-uses create-method-in ]
-    [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
+    insn-classes get special-vreg-insns diff [ insn-use-slots empty? ] reject [
+        [ \ ${name}-insn-uses create-method-in ]
+        [ insn-use-slots [ name>> ] map ${use-quot} slot-change-quot ] bi
         define
-] each
+    ] each
 
-insn-classes get [ insn-temp-slots empty? ] reject [
-    [ \ rename-insn-temps create-method-in ]
-    [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
+    insn-classes get [ insn-temp-slots empty? ] reject [
+        [ \ ${name}-insn-temps create-method-in ]
+        [ insn-temp-slots [ name>> ] map ${temp-quot} slot-change-quot ] bi
         define
-] each
+    ] each
+    >>
 
-;FUNCTOR>
-
-SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ;
+]]

basis/compiler/cfg/renaming/renaming.factor

@@ -1,7 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs compiler.cfg.registers
-compiler.cfg.renaming.functor kernel namespaces ;
+USING: accessors arrays assocs compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.instructions.syntax
+compiler.cfg.registers compiler.cfg.renaming.functor
+generic.parser kernel namespaces sequences sets words ;
 IN: compiler.cfg.renaming
 
 SYMBOL: renamings
@@ -9,4 +11,4 @@ SYMBOL: renamings
 : rename-value ( vreg -- vreg' )
     renamings get ?at drop ;
 
-RENAMING: rename [ rename-value ] [ rename-value ] [ drop next-vreg ]
+RENAMING: rename "[ rename-value ]" "[ rename-value ]" "[ drop next-vreg ]"

basis/compiler/cfg/representations/coalescing/coalescing-tests.factor

@@ -12,7 +12,7 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 2 D: 0 }
+    T{ ##peek f 2 d: 0 }
     T{ ##load-integer f 0 0 }
     T{ ##branch }
 } 1 test-bb

basis/compiler/cfg/representations/representations-tests.factor

@@ -59,12 +59,12 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 1 D: 0 }
-    T{ ##peek f 2 D: 1 }
+    T{ ##peek f 1 d: 0 }
+    T{ ##peek f 2 d: 1 }
     T{ ##add-float f 3 1 2 }
-    T{ ##replace f 3 D: 0 }
-    T{ ##replace f 3 D: 1 }
-    T{ ##replace f 3 D: 2 }
+    T{ ##replace f 3 d: 0 }
+    T{ ##replace f 3 d: 1 }
+    T{ ##replace f 3 d: 2 }
     T{ ##branch }
 } 1 test-bb
 
@@ -87,20 +87,20 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 1 D: 0 }
+    T{ ##peek f 1 d: 0 }
     T{ ##branch }
 } 1 test-bb
 
 V{
     T{ ##add-float f 2 1 1 }
-    T{ ##replace f 2 D: 0 }
+    T{ ##replace f 2 d: 0 }
     T{ ##epilogue }
     T{ ##return }
 } 2 test-bb
 
 V{
     T{ ##add-float f 3 1 1 }
-    T{ ##replace f 3 D: 0 }
+    T{ ##replace f 3 d: 0 }
     T{ ##epilogue }
     T{ ##return }
 } 3 test-bb
@@ -112,7 +112,7 @@ V{
 
 {
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##branch }
     }
 } [ 1 get instructions>> ] unit-test
@@ -125,19 +125,19 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 1 D: 0 }
+    T{ ##peek f 1 d: 0 }
     T{ ##branch }
 } 1 test-bb
 
 V{
-    T{ ##replace f 1 R: 0 }
+    T{ ##replace f 1 r: 0 }
     T{ ##epilogue }
     T{ ##return }
 } 2 test-bb
 
 V{
     T{ ##mul f 2 1 1 }
-    T{ ##replace f 2 D: 0 }
+    T{ ##replace f 2 d: 0 }
     T{ ##branch }
 } 3 test-bb
 
@@ -155,7 +155,7 @@ V{
 
 {
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##branch }
     }
 } [ 1 get instructions>> ] unit-test
@@ -168,7 +168,7 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 1 D: 0 }
+    T{ ##peek f 1 d: 0 }
     T{ ##branch }
 } 1 test-bb
 
@@ -180,8 +180,8 @@ V{
 V{
     T{ ##add f 2 1 1 }
     T{ ##mul f 3 1 1 }
-    T{ ##replace f 2 D: 0 }
-    T{ ##replace f 3 D: 1 }
+    T{ ##replace f 2 d: 0 }
+    T{ ##replace f 3 d: 1 }
     T{ ##branch }
 } 3 test-bb
 
@@ -201,7 +201,7 @@ V{
 
 {
     V{
-        T{ ##peek f 4 D: 0 }
+        T{ ##peek f 4 d: 0 }
         T{ ##sar-imm f 1 4 $[ tag-bits get ] }
         T{ ##branch }
     }
@@ -214,10 +214,10 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 1 D: 0 }
-    T{ ##peek f 2 D: 0 }
+    T{ ##peek f 1 d: 0 }
+    T{ ##peek f 2 d: 0 }
     T{ ##vector>scalar f 3 2 int-4-rep }
-    T{ ##replace f 3 D: 0 }
+    T{ ##replace f 3 d: 0 }
     T{ ##branch }
 } 1 test-bb
 
@@ -251,7 +251,7 @@ V{
 
 V{
     T{ ##phi f 3 H{ { 1 1 } { 2 2 } } }
-    T{ ##replace f 3 D: 0 }
+    T{ ##replace f 3 d: 0 }
     T{ ##branch }
 } 3 test-bb
 
@@ -282,8 +282,8 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##peek f 0 D: 0 }
-    T{ ##peek f 1 D: 1 }
+    T{ ##peek f 0 d: 0 }
+    T{ ##peek f 1 d: 1 }
     T{ ##add f 2 0 1 }
     T{ ##branch }
 } 1 test-bb
@@ -295,7 +295,7 @@ V{
 
 V{
     T{ ##phi f 4 H{ { 1 2 } { 2 3 } } }
-    T{ ##replace f 4 D: 0 }
+    T{ ##replace f 4 d: 0 }
     T{ ##branch }
 } 3 test-bb
 
@@ -323,10 +323,10 @@ cpu x86.32? [
     } 0 test-bb
 
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##load-reference f 2 0.5 }
         T{ ##add-float f 3 1 2 }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
         T{ ##branch }
     } 1 test-bb
 
@@ -349,7 +349,7 @@ cpu x86.32? [
     } 0 test-bb
 
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##compare-imm-branch f 1 2 cc= }
     } 1 test-bb
 
@@ -365,9 +365,9 @@ cpu x86.32? [
 
     V{
         T{ ##phi f 4 H{ { 2 2 } { 3 3 } } }
-        T{ ##peek f 5 D: 0 }
+        T{ ##peek f 5 d: 0 }
         T{ ##add-float f 6 4 5 }
-        T{ ##replace f 6 D: 0 }
+        T{ ##replace f 6 d: 0 }
     } 4 test-bb
 
     V{
@@ -398,14 +398,14 @@ cpu x86.32? [
 
 { f } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##tagged>integer f 2 1 }
         T{ ##add-float f 3 0 0 }
         T{ ##store-memory-imm f 3 2 0 float-rep f }
         T{ ##store-memory-imm f 3 2 4 float-rep f }
         T{ ##mul-float f 4 0 0 }
-        T{ ##replace f 4 D: 0 }
+        T{ ##replace f 4 d: 0 }
     } test-peephole
     [ ##single>double-float? ] any?
 ] unit-test
@@ -414,12 +414,12 @@ cpu x86.32? [
 {
     V{
         T{ ##load-tagged f 1 $[ 100 tag-fixnum ] }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     }
 } [
     V{
         T{ ##load-integer f 1 100 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -428,18 +428,18 @@ cpu x86.32? [
 
 {
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##sar-imm f 2 1 1 }
         T{ ##add f 4 2 2 }
         T{ ##shl-imm f 3 4 $[ tag-bits get ] }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##shl-imm f 2 1 3 }
         T{ ##add f 3 2 2 }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -447,35 +447,35 @@ cpu x86.32? [
 
 {
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##shl-imm f 2 1 $[ 10 tag-bits get - ] }
         T{ ##add f 4 2 2 }
         T{ ##shl-imm f 3 4 $[ tag-bits get ] }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##shl-imm f 2 1 10 }
         T{ ##add f 3 2 2 }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     } test-peephole
 ] unit-test
 
 {
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##copy f 2 1 int-rep }
         T{ ##add f 5 2 2 }
         T{ ##shl-imm f 3 5 $[ tag-bits get ] }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##shl-imm f 2 1 $[ tag-bits get ] }
         T{ ##add f 3 2 2 }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -484,13 +484,13 @@ cpu x86.32? [
     V{
         T{ ##load-integer f 1 100 }
         T{ ##shl-imm f 2 1 $[ 3 tag-bits get + ] }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     }
 } [
     V{
         T{ ##load-integer f 1 100 }
         T{ ##shl-imm f 2 1 3 }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -498,15 +498,15 @@ cpu x86.32? [
 ! need to be tagged
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##shl-imm f 1 0 3 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##shl-imm f 1 0 3 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -534,16 +534,16 @@ cpu x86.32? [
 ! Peephole optimization if input to ##sar-imm is tagged
 {
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##sar-imm f 7 1 $[ 3 tag-bits get + ] }
         T{ ##shl-imm f 2 7 $[ tag-bits get ] }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##sar-imm f 2 1 3 }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -555,13 +555,13 @@ cpu x86.32? [
         T{ ##load-integer f 1 100 }
         T{ ##sar-imm f 7 1 3 }
         T{ ##shl-imm f 2 7 $[ tag-bits get ] }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     }
 } [
     V{
         T{ ##load-integer f 1 100 }
         T{ ##sar-imm f 2 1 3 }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -569,7 +569,7 @@ cpu x86.32? [
 ! need to be tagged
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##sar-imm f 1 0 $[ 3 tag-bits get + ] }
         T{ ##load-integer f 3 100 }
         T{ ##load-integer f 4 100 }
@@ -577,7 +577,7 @@ cpu x86.32? [
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##sar-imm f 1 0 3 }
         T{ ##load-integer f 3 100 }
         T{ ##load-integer f 4 100 }
@@ -638,7 +638,7 @@ cpu x86.32? [
         T{ ##load-integer f 3 100 }
         T{ ##add f 7 2 3 }
         T{ ##shl-imm f 4 7 $[ tag-bits get ] }
-        T{ ##replace f 4 D: 0 }
+        T{ ##replace f 4 d: 0 }
     }
 } [
     V{
@@ -647,38 +647,38 @@ cpu x86.32? [
         T{ ##sar-imm f 2 1 3 }
         T{ ##load-integer f 3 100 }
         T{ ##add f 4 2 3 }
-        T{ ##replace f 4 D: 0 }
+        T{ ##replace f 4 d: 0 }
     } test-peephole
 ] unit-test
 
 ! Tag/untag elimination
 {
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##add-imm f 2 1 $[ 100 tag-fixnum ] }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 1 D: 0 }
+        T{ ##peek f 1 d: 0 }
         T{ ##add-imm f 2 1 100 }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     } test-peephole
 ] unit-test
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##add f 2 0 1 }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##add f 2 0 1 }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -688,17 +688,17 @@ cpu x86.64? [
 
     [
         V{
-            T{ ##peek f 0 D: 0 }
+            T{ ##peek f 0 d: 0 }
             T{ ##sar-imm f 5 0 $[ tag-bits get ] }
             T{ ##add-imm f 6 5 $[ 30 2^ ] }
             T{ ##shl-imm f 2 6 $[ tag-bits get ] }
-            T{ ##replace f 2 D: 0 }
+            T{ ##replace f 2 d: 0 }
         }
     ] [
         V{
-            T{ ##peek f 0 D: 0 }
+            T{ ##peek f 0 d: 0 }
             T{ ##add-imm f 2 0 $[ 30 2^ ] }
-            T{ ##replace f 2 D: 0 }
+            T{ ##replace f 2 d: 0 }
         } test-peephole
     ] unit-test
 
@@ -707,13 +707,13 @@ cpu x86.64? [
             T{ ##load-integer f 0 100 }
             T{ ##mul-imm f 7 0 $[ 30 2^ ] }
             T{ ##shl-imm f 1 7 $[ tag-bits get ] }
-            T{ ##replace f 1 D: 0 }
+            T{ ##replace f 1 d: 0 }
         }
     ] [
         V{
             T{ ##load-integer f 0 100 }
             T{ ##mul-imm f 1 0 $[ 30 2^ ] }
-            T{ ##replace f 1 D: 0 }
+            T{ ##replace f 1 d: 0 }
         } test-peephole
     ] unit-test
 ] when
@@ -721,15 +721,15 @@ cpu x86.64? [
 ! Tag/untag elimination for ##mul-imm
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##mul-imm f 1 0 100 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##mul-imm f 1 0 100 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -737,108 +737,108 @@ cpu x86.64? [
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##sar-imm f 5 1 $[ tag-bits get ] }
         T{ ##add-imm f 2 5 30 }
         T{ ##mul-imm f 3 2 $[ 100 tag-fixnum ] }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##add-imm f 2 1 30 }
         T{ ##mul-imm f 3 2 100 }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     } test-peephole
 ] unit-test
 
 ! Tag/untag elimination for ##compare-integer and ##test
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##test f 2 0 1 cc= }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##test f 2 0 1 cc= }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     } test-peephole
 ] unit-test
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##compare-integer f 2 0 1 cc= }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##compare-integer f 2 0 1 cc= }
-        T{ ##replace f 2 D: 0 }
+        T{ ##replace f 2 d: 0 }
     } test-peephole
 ] unit-test
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##compare-integer-branch f 0 1 cc= }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##compare-integer-branch f 0 1 cc= }
     } test-peephole
 ] unit-test
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##test-branch f 0 1 cc= }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##test-branch f 0 1 cc= }
     } test-peephole
 ] unit-test
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##compare-integer-imm-branch f 0 $[ 10 tag-fixnum ] cc= }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##compare-integer-imm-branch f 0 10 cc= }
     } test-peephole
 ] unit-test
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##test-imm-branch f 0 $[ 10 tag-fixnum ] cc= }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##test-imm-branch f 0 10 cc= }
     } test-peephole
 ] unit-test
@@ -846,15 +846,15 @@ cpu x86.64? [
 ! Tag/untag elimination for ##neg
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##neg f 1 0 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##neg f 1 0 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -862,21 +862,21 @@ cpu x86.64? [
 
 {
     V{
-        T{ ##peek { dst 0 } { loc D: 0 } }
-        T{ ##peek { dst 1 } { loc D: 1 } }
+        T{ ##peek { dst 0 } { loc d: 0 } }
+        T{ ##peek { dst 1 } { loc d: 1 } }
         T{ ##sar-imm { dst 5 } { src1 0 } { src2 4 } }
         T{ ##sar-imm { dst 6 } { src1 1 } { src2 4 } }
         T{ ##mul { dst 2 } { src1 5 } { src2 6 } }
         T{ ##mul-imm { dst 3 } { src1 2 } { src2 -16 } }
-        T{ ##replace { src 3 } { loc D: 0 } }
+        T{ ##replace { src 3 } { loc d: 0 } }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
-        T{ ##peek f 1 D: 1 }
+        T{ ##peek f 0 d: 0 }
+        T{ ##peek f 1 d: 1 }
         T{ ##mul f 2 0 1 }
         T{ ##neg f 3 2 }
-        T{ ##replace f 3 D: 0 }
+        T{ ##replace f 3 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -885,16 +885,16 @@ cpu x86.64? [
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##not f 3 0 }
         T{ ##xor-imm f 1 3 $[ tag-mask get ] }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##not f 1 0 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     } test-peephole
 ] unit-test
 
@@ -903,15 +903,15 @@ cpu x86.64? [
 
 {
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##bit-count f 3 0 }
         T{ ##shl-imm f 1 3 $[ tag-bits get ] }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     }
 } [
     V{
-        T{ ##peek f 0 D: 0 }
+        T{ ##peek f 0 d: 0 }
         T{ ##bit-count f 1 0 }
-        T{ ##replace f 1 D: 0 }
+        T{ ##replace f 1 d: 0 }
     } test-peephole
 ] unit-test

basis/compiler/cfg/representations/rewrite/rewrite.factor

@@ -1,10 +1,12 @@
 ! Copyright (C) 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs compiler.cfg.instructions
+USING: accessors arrays assocs compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.instructions.syntax
 compiler.cfg.registers compiler.cfg.renaming.functor
 compiler.cfg.representations.conversion
-compiler.cfg.representations.preferred compiler.cfg.rpo kernel
-locals make namespaces sequences ;
+compiler.cfg.representations.preferred compiler.cfg.rpo
+generic.parser kernel make namespaces sequences sets words ;
+FROM: namespaces => set ;
 IN: compiler.cfg.representations.rewrite
 
 ! Insert conversions. This introduces new temporaries, so we need
@@ -65,7 +67,7 @@ SYMBOLS: renaming-set needs-renaming? ;
 : converted-value ( vreg -- vreg' )
     renaming-set get pop first2 [ assert= ] dip ;
 
-RENAMING: convert [ converted-value ] [ converted-value ] [ ]
+RENAMING: convert "[ converted-value ]" "[ converted-value ]" "[ ]"
 
 : perform-renaming ( insn -- )
     needs-renaming? get [