factor: fixing [[ ]] and some unit tests

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

.gitattributes

@@ -1,3 +1,2 @@
 *.factor text eol=lf
 *.html text eol=lf
-misc/vim/*/*/generated.vim linguist-generated

.gitignore

@@ -1,34 +1,33 @@
-*#*#
-*.*.marks
-*.RES
-*.a
-*.bak
-*.dll
-*.dylib
-*.exe
-*.exp
-*.gch*
-*.image
-*.lib
-*.o
-*.obj
-*.res
-*.s
-*.so
 *~
-.#*
+*.gch*
+*.obj
+*.o
+*.s
+*.exe
+Factor/factor
+*.a
+*.dll
+*.lib
+*.exp
+*.res
+*.RES
+*.image
+factor.image.fresh
+*.dylib
+factor.com
+*#*#
+.DS_Store
+.gdb_history
+*.*.marks
 .*.swm
 .*.swn
 .*.swo
 .*.swp
-.DS_Store
+logs
-.gdb_history
+work
-/factor
+*.bak
-/logs
+.#*
-/work
-Factor.app/Contents/MacOS/factor
-Factor.app/Contents/_CodeSignature
-a.out
 checksums.txt
-factor.com
+*.so
-factor.image.fresh
+a.out
+Factor.app/Contents/_CodeSignature

.travis.yml

@@ -31,19 +31,7 @@ addons:
       - cmake
       - libaio-dev
       - libsnappy-dev
-      - libgtk2.0-dev
-      - gtk2-engines-pixbuf
 before_install:
-  - uname -s
-  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then export HOMEBREW_NO_AUTO_UPDATE=1 ; fi # Don't let homebrew upgrade itself
-  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rm -rf ~/.gnupg/; fi  # https://github.com/rvm/rvm/issues/3110
-  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then curl -sSL https://rvm.io/mpapis.asc | gpg --import - ; fi
-  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then curl -sSL https://rvm.io/pkuczynski.asc | gpg --import - ; fi
-  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then curl -sSL https://get.rvm.io | bash -s stable; fi  # https://github.com/travis-ci/travis-ci/issues/6307
-  #- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm reload ; fi # for homebrew to have 2.6.3, which takes too long. instead we just use HOMEBREW_NO_AUTO_UPDATE=1
-  #- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm install ruby-2.6.3 ; fi # for homebrew
-  #- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm use 2.6 ; fi # for homebrew
-
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then ./build.sh deps-macosx ; else ./build.sh deps-apt-get ; fi
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew ls --versions snappy > /dev/null || brew install snappy; fi
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew ls --versions cmake > /dev/null || brew install cmake; fi
@@ -56,11 +44,14 @@ before_install:
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start redis; fi
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start postgresql; fi
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start memcached; fi
-  - if [[ "$TRAVIS_OS_NAME" != "windows" ]]; then
+  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rm -rf ~/.gnupg/; fi  # https://github.com/rvm/rvm/issues/3110
-      wget https://github.com/vmt/udis86/archive/v1.7.2.tar.gz && tar xzvf v1.7.2.tar.gz &&
+  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then curl -#LO https://rvm.io/mpapis.asc; fi
-      ( cd udis86-1.7.2/ && ./autogen.sh && ./configure --enable-shared=yes && make && sudo make install ) &&
+  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then gpg --import mpapis.asc; fi
-      ( [[ "$TRAVIS_OS_NAME" != "osx" ]] && sudo ldconfig || true );
+  - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then curl -sSL https://get.rvm.io | bash -s stable; fi  # https://github.com/travis-ci/travis-ci/issues/6307
-    fi
+  - >
+    wget https://github.com/vmt/udis86/archive/v1.7.2.tar.gz && tar xzvf v1.7.2.tar.gz &&
+    ( cd udis86-1.7.2/ && ./autogen.sh && ./configure --enable-shared=yes && make && sudo make install ) &&
+    ( [[ "$TRAVIS_OS_NAME" != "osx" ]] && sudo ldconfig || true )
   - git remote set-branches --add origin master
   - git remote set-branches --add origin clean-windows-x86-64
   - git remote set-branches --add origin clean-windows-x86-32
@@ -74,8 +65,8 @@ script:
   - export CI_BRANCH="${TRAVIS_PULL_REQUEST_BRANCH:-$TRAVIS_BRANCH}"
   - echo "CI_BRANCH=${CI_BRANCH}"
   - DEBUG=1 ./build.sh net-bootstrap < /dev/null
-  - "./factor -e='USING: memory vocabs.hierarchy tools.test namespaces ; \"zealot\" load f long-unit-tests-enabled? set-global save'"
+  - "./factor -e='USING: memory vocabs.hierarchy ; \"zealot\" load save'"
   - './factor -run=zealot.cli-changed-vocabs'
   - './factor -run=tools.test `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`'
-  - './factor -run=zealot.help-lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`'
+  - './factor -run=help.lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`'
   - "./factor -e='USING: modern.paths tools.test sequences system kernel math random ; core-vocabs os macosx? [ dup length 3 /i sample ] when [ test ] each'"

GNUmakefile

@@ -1,25 +1,12 @@
 ifdef CONFIG
 	VERSION = 0.99
 	GIT_LABEL = $(shell echo `git describe --all`-`git rev-parse HEAD`)
+
 	BUNDLE = Factor.app
-	DEBUG ?= 0
-	REPRODUCIBLE ?= 0
-
-	# gmake's default CXX is g++, we prefer c++
-	SHELL_CXX = $(shell printenv CXX)
-	ifeq ($(SHELL_CXX),)
-		CXX=c++
-	else
-		CXX=$(SHELL_CXX)
-	endif
-
-	XCODE_PATH ?= /Applications/Xcode.app
-	MACOSX_32_SDK ?= MacOSX10.11.sdk
-	MACOSX_SDK ?= MacOSX10.13.sdk
 
 	include $(CONFIG)
 
-	CFLAGS += -Wall \
+	CFLAGS = -Wall \
 		-pedantic \
 		-DFACTOR_VERSION="$(VERSION)" \
 		-DFACTOR_GIT_LABEL="$(GIT_LABEL)" \
@@ -27,16 +14,12 @@ ifdef CONFIG
 
 	CXXFLAGS += -std=c++11
 
-	ifneq ($(DEBUG), 0)
+	ifdef DEBUG
 		CFLAGS += -g -DFACTOR_DEBUG
 	else
 		CFLAGS += -O3
 	endif
 
-	ifneq ($(REPRODUCIBLE), 0)
-		CFLAGS += -DFACTOR_REPRODUCIBLE
-	endif
-
 	ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
 	EXECUTABLE = factor$(EXE_SUFFIX)$(EXE_EXTENSION)
 	CONSOLE_EXECUTABLE = factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION)
@@ -156,8 +139,6 @@ help:
 	@echo "linux-ppc-32"
 	@echo "linux-ppc-64"
 	@echo "linux-arm"
-	@echo "freebsd-x86-32"
-	@echo "freebsd-x86-64"
 	@echo "macosx-x86-32"
 	@echo "macosx-x86-64"
 	@echo "macosx-x86-fat"
@@ -167,18 +148,11 @@ help:
 	@echo "Additional modifiers:"
 	@echo ""
 	@echo "DEBUG=1  compile VM with debugging information"
-	@echo "REPRODUCIBLE=1  compile VM without timestamp"
 	@echo "SITE_CFLAGS=...  additional optimization flags"
 	@echo "X11=1  force link with X11 libraries instead of Cocoa (only on Mac OS X)"
 
 ALL = factor factor-ffi-test factor-lib
 
-freebsd-x86-32:
-	$(MAKE) $(ALL) CONFIG=vm/Config.freebsd.x86.32
-
-freebsd-x86-64:
-	$(MAKE) $(ALL) CONFIG=vm/Config.freebsd.x86.64
-
 macosx-x86-32:
 	$(MAKE) $(ALL) macosx.app CONFIG=vm/Config.macosx.x86.32
 

LICENSE.txt

@@ -1,4 +1,4 @@
-Copyright (c) 2020, Slava Pestov, et al.
+Copyright (c) 2018, Slava Pestov, et al.
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

Nmakefile

@@ -8,21 +8,21 @@ VERSION = 0.99
 !IF [git describe --all > git-describe.tmp] == 0
 GIT_DESCRIBE = \
 !INCLUDE <git-describe.tmp>
-!IF [del git-describe.tmp] == 0
+!IF [rm git-describe.tmp] == 0
 !ENDIF
 !ENDIF
 
 !IF [git rev-parse HEAD > git-id.tmp] == 0
 GIT_ID = \
 !INCLUDE <git-id.tmp>
-!IF [del git-id.tmp] == 0
+!IF [rm git-id.tmp] == 0
 !ENDIF
 !ENDIF
 
 !IF [git rev-parse --abbrev-ref HEAD > git-branch.tmp] == 0
 GIT_BRANCH = \
 !INCLUDE <git-branch.tmp>
-!IF [del git-branch.tmp] == 0
+!IF [rm git-branch.tmp] == 0
 !ENDIF
 !ENDIF
 
@@ -58,13 +58,6 @@ CL_FLAGS = $(CL_FLAGS) $(CL_FLAGS_VISTA)
 PLAF_DLL_OBJS = vm\os-windows-x86.64.obj vm\cpu-x86.obj
 SUBSYSTEM_COM_FLAGS = console
 SUBSYSTEM_EXE_FLAGS = windows
-
-!ELSE
-CL_FLAGS = $(CL_FLAGS) $(CL_FLAGS_VISTA)
-PLAF_DLL_OBJS = vm\os-windows-x86.64.obj vm\cpu-x86.obj
-SUBSYSTEM_COM_FLAGS = console
-SUBSYSTEM_EXE_FLAGS = windows
-
 !ENDIF
 
 !IF DEFINED(DEBUG)
@@ -72,10 +65,6 @@ LINK_FLAGS = $(LINK_FLAGS) /DEBUG
 CL_FLAGS = $(CL_FLAGS) /Zi /DFACTOR_DEBUG
 !ENDIF
 
-!IF DEFINED(REPRODUCIBLE)
-CL_FLAGS = $(CL_FLAGS) /DFACTOR_REPRODUCIBLE
-!ENDIF
-
 ML_FLAGS = /nologo /safeseh
 
 EXE_OBJS = vm\main-windows.obj vm\factor.res
@@ -150,16 +139,6 @@ factor.com: $(EXE_OBJS) $(DLL_OBJS)
 factor.exe: $(EXE_OBJS) $(DLL_OBJS)
 	link $(LINK_FLAGS) /out:factor.exe /SUBSYSTEM:$(SUBSYSTEM_EXE_FLAGS) $(EXE_OBJS) $(DLL_OBJS)
 
-# If we compile factor.exe, run mt.exe, and run factor.exe,
-# then Windows caches the manifest. Even on a recompile without applying
-# the mt.exe tool, if the factor.exe.manifest file is present, the manifest
-# is applied. To avoid this, we delete the .manifest file on clean
-# and copy it from a reference file on compilation and mt.exe.
-#
-factor.exe.manifest: factor.exe
-	copy factor.exe.manifest.in factor.exe.manifest
-	mt -manifest factor.exe.manifest -outputresource:"factor.exe;#1"
-
 all: factor.com factor.exe factor.dll.lib libfactor-ffi-test.dll
 
 !ENDIF
@@ -191,15 +170,12 @@ clean:
 	if exist factor.lib del factor.lib
 	if exist factor.com del factor.com
 	if exist factor.exe del factor.exe
-	if exist factor.exe.manifest del factor.exe.manifest
-	if exist factor.exp del factor.exp
 	if exist factor.dll del factor.dll
 	if exist factor.dll.lib del factor.dll.lib
-	if exist factor.dll.exp del factor.dll.exp
 	if exist libfactor-ffi-test.dll del libfactor-ffi-test.dll
 	if exist libfactor-ffi-test.exp del libfactor-ffi-test.exp
 	if exist libfactor-ffi-test.lib del libfactor-ffi-test.lib
 
-.PHONY: all default x86-32 x86-64 x86-32-vista x86-64-vista clean factor.exe.manifest
+.PHONY: all default x86-32 x86-64 x86-32-vista x86-64-vista clean
 
 .SUFFIXES: .rs

README.md

@@ -28,17 +28,17 @@ a boot image stored on factorcode.org.
 
 To check out Factor:
 
-* `git clone git://github.com/factor/factor.git`
+* `git clone git://factorcode.org/git/factor.git`
 * `cd factor`
 
 To build the latest complete Factor system from git, either use the
 build script:
 
-* Unix: `./build.sh update`
 * Windows: `build.cmd`
+* Unix: `./build.sh update`
 
 or download the correct boot image for your system from
-http://downloads.factorcode.org/images/master/, put it in the `factor`
+http://downloads.factorcode.org/images/master/, put it in the factor
 directory and run:
 
 * Unix: `make` and then `./factor -i=boot.unix-x86.64.image`
@@ -127,25 +127,6 @@ The Factor source tree is organized as follows:
 * `misc/` - editor modes, icons, etc
 * `unmaintained/` - now at [factor-unmaintained](https://github.com/factor/factor-unmaintained)
 
-## Source History
-
-During Factor's lifetime, sourcecode has lived in many repositories. Unfortunately, the first import in Git did not keep history. History has been partially recreated from what could be salvaged. Due to the nature of Git, it's only possible to add history without disturbing upstream work, by using replace objects. These need to be manually fetched, or need to be explicitly added to your git remote configuration.
-
-Use:
-`git fetch origin 'refs/replace/*:refs/replace/*'`
-
-or add the following line to your configuration file
-
-```
-[remote "origin"]
-    url = ...
-    fetch = +refs/heads/*:refs/remotes/origin/*
-    ...
-    fetch = +refs/replace/*:refs/replace/*
-```
-
-Then subsequent fetches will automatically update any replace objects.
-
 ## Community
 
 Factor developers meet in the `#concatenative` channel on
@@ -154,7 +135,5 @@ anything related to Factor or language design in general.
 
 * [Factor homepage](https://factorcode.org)
 * [Concatenative languages wiki](https://concatenative.org)
-* [Mailing list](factor-talk@lists.sourceforge.net)
-* Search for "factorcode" on [Gitter](https://gitter.im/)
 
 Have fun!

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
+USING: accessors alien alien.c-types alien.complex.functor
-sequences ;
+classes.struct kernel math quotations ;
+FROM: alien.c-types => float double ;
 IN: alien.complex
 
-<<
+COMPLEX-TYPE: float complex-float
-{ "float" "double" } [ dup "complex-" prepend define-complex-type ] each
+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
+USING: functors2 ;
-kernel math math.functions quotations ;
 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} ( alien -- z )
-*T DEFINES *${T}
+        ${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." } ;
@@ -41,8 +41,8 @@ HELP: memory>byte-array
 
 HELP: cast-array
 { $values { "byte-array" byte-array } { "c-type" "a C type" } { "array" "a specialized array" } }
-{ $description "Converts a " { $link byte-array } " into a specialized array by interpreting the bytes in it as machine-specific values. Code using this word is unportable." }
+{ $description "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable." }
-{ $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." }
+{ $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." } ;
 
 HELP: malloc-array
@@ -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."
@@ -257,4 +257,4 @@ ARTICLE: "c-out-params" "Output parameters in C"
 { $code
   "1234 { c-string } [ do_frob ] with-out-parameters"
 }
-"which would put the function's return value and error string on the stack." ;
+"which would put the functions return value and error string on the stack." ;

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
+USING: functors2 ;
-kernel parser sequences ;
 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
+    TUPLE: ${f}-destructor < alien-destructor ;
-<F-destructor> DEFINES <${F}-destructor>
-&F DEFINES &${F}
-|F DEFINES |${F}
-N [ F stack-effect out>> length ]
 
-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} ( alien -- alien ) dup <${f}-destructor> |dispose drop ; inline
-    F-destructor boa ; inline
 
-M: F-destructor dispose alien>> F N ndrop ;
+    M: ${f}-destructor dispose alien>> ${f} $[ \ ${f} stack-effect out>> length ] 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 ;

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: \LE-STRUCT:
-    POSTPONE: BE-STRUCT:
+    postpone: \BE-STRUCT:
-    POSTPONE: LE-PACKED-STRUCT:
+    postpone: \LE-PACKED-STRUCT:
-    POSTPONE: BE-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/libraries/finder/freebsd/authors.txt

@@ -1 +0,0 @@
-Jack Lucas

basis/alien/libraries/finder/freebsd/freebsd.factor

@@ -1,26 +0,0 @@
-USING: alien.libraries.finder arrays assocs
-combinators.short-circuit io io.encodings.utf8 io.files
-io.files.info io.launcher kernel sequences sets splitting system
-unicode ;
-IN: alien.libraries.finder.freebsd
-<PRIVATE
-
-: parse-ldconfig-lines ( string -- triple )
-    [ ":-" split1 [ drop ] dip
-    "=>" split1 [ [ blank? ] trim ] bi@
-      2array
-   ] map ;
-
-: load-ldconfig-cache ( -- seq )
-    "/sbin/ldconfig -r" utf8 [ lines ] with-process-reader
-    rest parse-ldconfig-lines ;
-
-: name-matches? ( lib double -- ? )
-    first swap ?head [ ?first CHAR: . = ] [ drop f ] if ;
-
-PRIVATE>
-
-M: freebsd find-library*
-    "l" prepend load-ldconfig-cache
-    [ name-matches? ] with find nip ?first dup [ ".so" append ] when ;
-

basis/alien/libraries/finder/freebsd/platforms.txt

@@ -1 +0,0 @@
-freebsd

basis/alien/libraries/finder/windows/windows-tests.factor

@@ -1,3 +0,0 @@
-USING: alien.libraries.finder sequences tools.test ;
-
-{ t } [ "kernel32.dll" "kernel32" find-library subseq? ] unit-test

basis/alien/libraries/windows/windows.factor

@@ -1,9 +0,0 @@
-USING: alien.libraries io.pathnames system windows.errors
-windows.kernel32 ;
-IN: alien.libraries.windows
-
-M: windows >deployed-library-path
-    file-name ;
-
-M: windows dlerror ( -- message )
-    GetLastError n>win32-error-string ;

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
+C-TYPE: hi
-] unit-test
+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:
+HELP: \alien:
-{ $syntax "ALIEN: address" }
+{ $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: \alien:
-    POSTPONE: DLL"
+    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-tests.factor

@@ -1,7 +1,5 @@
-USING: base64 byte-arrays io.encodings.ascii io.encodings.string
+USING: base64 io.encodings.ascii io.encodings.string kernel
-kernel sequences splitting strings tools.test ;
+sequences splitting strings tools.test ;
-
-{ t } [ 256 <iota> >byte-array dup >base64 base64> = ] unit-test
 
 { "abcdefghijklmnopqrstuvwxyz" } [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
 ] unit-test
@@ -41,9 +39,3 @@ kernel sequences splitting strings tools.test ;
     "eyJhbGciOiJIUzI1NiJ9.eyJzdWIiOiJKb2UifQ.ipevRNuRP6HflG8cFKnmUPtypruRC4fb1DWtoLL62SY"
     "." split [ base64> ] map
 ] unit-test
-
-{ "01a+b/cd" } [ "\xd3V\xbeo\xf7\x1d" >base64 "" like ] unit-test
-{ "\xd3V\xbeo\xf7\x1d" } [ "01a+b/cd" base64> "" like ] unit-test
-
-{ "01a-b_cd" } [ "\xd3V\xbeo\xf7\x1d" >urlsafe-base64 "" like ] unit-test
-{ "\xd3V\xbeo\xf7\x1d" } [ "01a-b_cd" urlsafe-base64> "" like ] unit-test

basis/base64/base64.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs byte-arrays combinators fry growable io
+USING: arrays combinators fry io io.binary io.encodings.binary
-io.encodings.binary io.streams.byte-array kernel kernel.private
+io.streams.byte-array kernel literals math namespaces sbufs
-literals locals math math.bitwise namespaces sbufs sequences
+sequences ;
-sequences.private ;
 IN: base64
 
 ERROR: malformed-base64 ;
@@ -11,10 +10,8 @@ ERROR: malformed-base64 ;
 <PRIVATE
 
 <<
-CONSTANT: alphabet $[
+CONSTANT: alphabet
     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
-    >byte-array
-]
 
 : alphabet-inverse ( alphabet -- seq )
     dup supremum 1 + f <array> [
@@ -26,134 +23,80 @@ 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* { fixnum } declare ; inline
+    [ malformed-base64 ] unless* ; inline
 
-: encode3 ( x y z -- a b c d )
+: (write-lines) ( column byte-array -- column' )
-    { fixnum fixnum fixnum } declare {
+    output-stream get dup '[
-        [ [ -2 shift ch>base64 ] [ 2 bits 4 shift ] bi ]
+        _ stream-write1 1 + dup 76 = [
-        [ [ -4 shift bitor ch>base64 ] [ 4 bits 2 shift ] bi ]
+            drop B{ char: \r char: \n } _ stream-write 0
-        [ [ -6 shift bitor ch>base64 ] [ 6 bits ch>base64 ] bi ]
+        ] when
-    } spread ; inline
+    ] each ; inline
 
-:: (stream-write-lines) ( column data stream -- column' )
+: write-lines ( column byte-array -- column' )
-    column data over 71 > [
+    over [ (write-lines) ] [ write ] if ; inline
-        [
-            stream stream-write1 1 + dup 76 = [
-                drop 0
-                B{ CHAR: \r CHAR: \n } stream stream-write
-            ] when
-        ] each
-    ] [
-        stream stream-write 4 +
-    ] if ; inline
 
-: stream-write-lines ( column data stream -- column' )
+: encode3 ( seq -- byte-array )
-    pick [ (stream-write-lines) ] [ stream-write ] if ; inline
+    be> { -18 -12 -6 0 } '[
+        shift 0x3f bitand ch>base64
+    ] with B{ } map-as ; inline
 
-: write-lines ( column data -- column' )
+: encode-pad ( seq n -- byte-array )
-    output-stream get stream-write-lines ; inline
+    [ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
+    4 char: = pad-tail ; inline
 
-:: (encode-base64) ( input output column -- )
+: (encode-base64) ( stream column -- )
-    4 <byte-array> :> data
+    3 pick stream-read dup length {
-    column [ input stream-read1 dup ] [
+        { 0 [ 3drop ] }
-        input stream-read1
+        { 3 [ encode3 write-lines (encode-base64) ] }
-        input stream-read1
+        [ encode-pad write-lines (encode-base64) ]
-        [ [ 0 or ] bi@ encode3 ] 2keep [ 0 1 ? ] bi@ + {
+    } case ;
-            { 0 [ ] }
-            { 1 [ drop CHAR: = ] }
-            { 2 [ 2drop CHAR: = CHAR: = ] }
-        } case data (4sequence) output stream-write-lines
-    ] while 2drop ; inline
 
 PRIVATE>
 
 : encode-base64 ( -- )
-    input-stream get output-stream get f (encode-base64) ;
+    input-stream get f (encode-base64) ;
 
 : encode-base64-lines ( -- )
-    input-stream get output-stream get 0 (encode-base64) ;
+    input-stream get 0 (encode-base64) ;
 
 <PRIVATE
 
 : read1-ignoring ( ignoring stream -- ch )
-    dup stream-read1 pick dupd member-eq?
+    dup stream-read1 pick dupd member?
     [ drop read1-ignoring ] [ 2nip ] if ; inline recursive
 
+: push-ignoring ( accum ch -- accum )
+    dup { f 0 } member-eq? [ drop ] [ suffix! ] if ; inline
+
+: read-into-ignoring ( accum n ignoring stream -- accum )
+    '[ _ _ read1-ignoring push-ignoring ] times ; inline
+
 : read-ignoring ( n ignoring stream -- accum )
-    pick <sbuf> [
+    [ [ <sbuf> ] keep ] 2dip read-into-ignoring ; inline
-        '[ _ _ read1-ignoring [ ] _ push-if ] times
-    ] keep ;
 
-: decode4 ( a b c d -- x y z )
+: decode4 ( seq -- )
-    { fixnum fixnum fixnum fixnum } declare {
+    [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
-        [ base64>ch 2 shift ]
+    [ [ char: = = ] count ] bi
-        [ base64>ch [ -4 shift bitor ] [ 4 bits 4 shift ] bi ]
+    [ write ] [ head-slice* write ] if-zero ; inline
-        [ base64>ch [ -2 shift bitor ] [ 2 bits 6 shift ] bi ]
-        [ base64>ch bitor ]
-    } spread ; inline
 
-:: (decode-base64) ( input output -- )
+: (decode-base64) ( stream -- )
-    3 <byte-array> :> data
+    4 "\n\r" pick read-ignoring dup length {
-    [ B{ CHAR: \n CHAR: \r } input read1-ignoring dup ] [
+        { 0 [ 2drop ] }
-        B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
+        { 4 [ decode4 (decode-base64) ] }
-        B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
+        [ drop 4 char: = pad-tail decode4 (decode-base64) ]
-        B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
+    } case ;
-        [ decode4 data (3sequence) ] 3keep
-        [ CHAR: = eq? 1 0 ? ] tri@ + +
-        [ head-slice* ] unless-zero
-        output stream-write
-    ] while drop ;
 
 PRIVATE>
 
 : decode-base64 ( -- )
-    input-stream get output-stream get (decode-base64) ;
+    input-stream get (decode-base64) ;
-
-<PRIVATE
-
-: ensure-encode-length ( base64 -- base64 )
-    dup length 3 /mod zero? [ 1 + ] unless 4 *
-    output-stream get expand ;
-
-: ensure-decode-length ( seq -- seq )
-    dup length 4 /mod zero? [ 1 + ] unless 3 *
-    output-stream get expand ;
-
-PRIVATE>
 
 : >base64 ( seq -- base64 )
-    binary [
+    binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ;
-        ensure-encode-length
-        binary [ encode-base64 ] with-byte-reader
-    ] with-byte-writer ;
 
 : base64> ( base64 -- seq )
-    binary [
+    binary [ binary [ decode-base64 ] with-byte-reader ] with-byte-writer ;
-        ensure-decode-length
-        binary [ decode-base64 ] with-byte-reader
-    ] with-byte-writer ;
 
 : >base64-lines ( seq -- base64 )
-    binary [
+    binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ;
-        ensure-encode-length
-        binary [ encode-base64-lines ] with-byte-reader
-    ] with-byte-writer ;
-
-: >urlsafe-base64 ( seq -- base64 )
-    >base64 H{
-        { CHAR: + CHAR: - }
-        { CHAR: / CHAR: _ }
-    } substitute ;
-
-: urlsafe-base64> ( base64 -- seq )
-    H{
-        { CHAR: - CHAR: + }
-        { CHAR: _ CHAR: / }
-    } substitute base64> ;
-
-: >urlsafe-base64-lines ( seq -- base64 )
-    >base64-lines H{
-        { CHAR: + CHAR: - }
-        { CHAR: / CHAR: _ }
-    } substitute ;

basis/base64/summary.txt

@@ -1 +1 @@
-Base64 encoding/decoding (RFC 3548)
+Base64 encoding/decoding

basis/binary-search/tags.txt

@@ -1,2 +1 @@
 algorithms
-collections

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

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.accessors byte-arrays fry io.binary
-kernel kernel.private locals math math.bitwise parser sequences
+kernel kernel.private locals math math.bitwise parser
-sequences.private vocabs.loader ;
+prettyprint.custom sequences sequences.private ;
 IN: bit-arrays
 
 TUPLE: bit-array
@@ -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 =
@@ -98,4 +98,6 @@ SYNTAX: ?{ \ } [ >bit-array ] parse-literal ;
 
 INSTANCE: bit-array sequence
 
-{ "bit-arrays" "prettyprint" } "bit-arrays.prettyprint" require-when
+M: bit-array pprint-delims drop \ ?{ \ } ;
+M: bit-array >pprint-sequence ;
+M: bit-array pprint* pprint-object ;

basis/bit-arrays/prettyprint/prettyprint.factor

@@ -1,6 +0,0 @@
-USING: bit-arrays kernel prettyprint.custom ;
-IN: bit-arrays.prettyprint
-
-M: bit-array pprint-delims drop \ ?{ \ } ;
-M: bit-array >pprint-sequence ;
-M: bit-array pprint* pprint-object ;

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,14 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: bit-arrays classes.parser growable kernel parser
+USING: bit-arrays classes growable kernel math parser
-vectors.functor vocabs.loader ;
+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 ;
-{ "bit-vectors" "prettyprint" } "bit-vectors.prettyprint" require-when
+M: bit-vector pprint-delims drop \ ?V{ \ } ;
+M: bit-vector pprint* pprint-object ;

basis/bit-vectors/prettyprint/prettyprint.factor

@@ -1,7 +0,0 @@
-USING: bit-vectors kernel prettyprint.custom ;
-IN: bit-vectors.prettyprint
-
-M: bit-vector >pprint-sequence ;
-M: bit-vector pprint-delims drop \ ?V{ \ } ;
-M: bit-vector pprint* pprint-object ;
-

basis/bitstreams/bitstreams-docs.factor

@@ -25,7 +25,7 @@ HELP: seek
 
 HELP: align
 { $values { "n" integer } { "bitstream" bit-reader } }
-{ $description "Moves the read cursor of the bit-reader forward until its position in bits from the start of the stream is an even multiple of n. If it is already such a multiple, the cursor is not moved at all." } ;
+{ $description "Moves the read cursor of the bit-reader forward until its position in bits from the start of the stream is an even multiple of n. If it is already such a multiple, the cursor is not moved at all. " } ;
 
 HELP: enough-bits?
 { $values { "n" integer } { "bs" bit-reader } { "?" boolean } }

basis/bitstreams/bitstreams.factor

@@ -166,10 +166,10 @@ ERROR: not-enough-bits n bit-reader ;
     bs bytes>> subseq endian> execute( seq -- x )
     n bs subseq-endian execute( bignum n bs -- bits ) ;
 
-M: lsb0-bit-reader peek
+M: lsb0-bit-reader peek ( n bs -- bits )
     \ le> \ subseq>bits-le (peek) ;
 
-M: msb0-bit-reader peek
+M: msb0-bit-reader peek ( n bs -- bits )
     \ be> \ subseq>bits-be (peek) ;
 
 :: bit-writer-bytes ( writer -- bytes )

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/image/image-docs.factor

@@ -46,7 +46,7 @@ HELP: sub-primitives
 
 ARTICLE: "bootstrap.image" "Bootstrapping new images"
 "A new image can be built from source; this is known as " { $emphasis "bootstrap" } ". Bootstrap is a two-step process. The first stage is the creation of a bootstrap image from a running Factor instance:"
-{ $subsections make-image make-my-image }
+{ $subsections make-image }
 "The second bootstrapping stage is initiated by running the resulting bootstrap image:"
 { $code "./factor -i=boot.x86.32.image" }
 "This stage loads additional code, compiles all words, and creates a final " { $snippet "factor.image" } "."

basis/bootstrap/image/image.factor

@@ -1,15 +1,15 @@
 ! Copyright (C) 2004, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-arrays classes
+USING: accessors arrays assocs byte-arrays classes classes.builtin
-classes.builtin classes.private classes.tuple
+classes.private classes.tuple classes.tuple.private combinators
-classes.tuple.private combinators combinators.short-circuit
+combinators.short-circuit combinators.smart
-combinators.smart command-line compiler.codegen.relocation
+compiler.codegen.relocation compiler.units fry generic
-compiler.units fry generic generic.single.private grouping
+generic.single.private grouping hashtables hashtables.private io
-hashtables hashtables.private io io.binary io.encodings.binary
+io.binary io.encodings.binary io.files io.pathnames kernel
-io.files io.pathnames kernel kernel.private layouts locals make
+kernel.private layouts locals make math math.order namespaces
-math math.order namespaces namespaces.private parser
+namespaces.private parser parser.notes prettyprint quotations
-parser.notes prettyprint quotations sequences sequences.private
+sequences sequences.private source-files strings system vectors
-source-files strings system vectors vocabs words ;
+vocabs words ;
 IN: bootstrap.image
 
 : arch-name ( os cpu -- arch )
@@ -540,8 +540,3 @@ PRIVATE>
 
 : make-my-image ( -- )
     my-arch-name make-image ;
-
-: make-image-main ( -- )
-    command-line get [ make-my-image ] [ [ make-image ] each ] if-empty ;
-
-MAIN: make-image-main

basis/bootstrap/image/primitives/primitives.factor

@@ -778,8 +778,8 @@ CONSTANT: all-primitives {
     {
         "tools.profiler.sampling.private"
         {
-            { "set-profiling" ( n -- ) "set_profiling" { object } { } f }
+            { "profiling" ( n -- ) "sampling_profiler" { object } { } f }
-            { "get-samples" ( -- samples/f ) "get_samples" { } { object } f }
+            { "(get-samples)" ( -- samples/f ) "get_samples" { } { object } f }
         }
     }
     {

basis/bootstrap/image/upload/upload.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! Copyright (C) 2015 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image checksums checksums.openssl fry io
+USING: bootstrap.image checksums checksums.openssl cli.git fry
-io.directories io.encodings.ascii io.encodings.utf8 io.files
+io io.directories io.encodings.ascii io.encodings.utf8 io.files
 io.files.temp io.files.unique io.launcher io.pathnames kernel
-make math.parser namespaces sequences splitting system unicode ;
+make math.parser namespaces sequences splitting system ;
 IN: bootstrap.image.upload
 
 SYMBOL: upload-images-destination
@@ -21,11 +21,7 @@ SYMBOL: build-images-destination
     or ;
 
 : factor-git-branch ( -- name )
-    image-path parent-directory [
+    image-path parent-directory git-current-branch ;
-        { "git" "rev-parse" "--abbrev-ref" "HEAD" }
-        utf8 <process-reader> stream-contents
-        [ blank? ] trim-tail
-    ] with-directory ;
 
 : git-branch-destination ( -- dest )
     build-images-destination get
@@ -47,7 +43,14 @@ SYMBOL: build-images-destination
         ] each
     ] with-file-writer ;
 
-: scp-name ( -- path ) "scp" ;
+! Windows scp doesn't like pathnames with colons, it treats them as hostnames.
+! Workaround for uploading checksums.txt created with temp-file.
+! e.g. C:\Users\\Doug\\AppData\\Local\\Temp/factorcode.org\\Factor/checksums.txt
+! ssh: Could not resolve hostname c: no address associated with name
+
+HOOK: scp-name os ( -- path )
+M: object scp-name "scp" ;
+M: windows scp-name "pscp" ;
 
 : upload-images ( -- )
     [

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"
+            path"resource:core/io/encodings/utf16/utf16.factor"
-            P" resource:core/io/encodings/utf16n/utf16n.factor" [ forget ] bi@
+            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/cache/cache.factor

@@ -38,9 +38,9 @@ M: cache-assoc dispose* clear-assoc ;
 PRIVATE>
 
 : purge-cache ( cache -- )
-    dup [ assoc>> ] [ max-age>> ] bi V{ } clone [
+    [ assoc>> ] [ max-age>> ] bi V{ } clone [
         '[
             nip dup age>> 1 + [ >>age ] keep
             _ < [ drop t ] [ _ dispose-to f ] if
-        ] assoc-filter >>assoc drop 
+        ] assoc-filter! drop
     ] keep [ last rethrow ] unless-empty ;

basis/calendar/calendar-docs.factor

@@ -401,22 +401,6 @@ HELP: day-of-year
     }
 } ;
 
-HELP: week-number
-{ $values { "timestamp" timestamp } { "[1,53]" integer } }
-{ $description "Calculates the ISO 8601 week number from 1 to 53 (leap years). See " { $snippet "https://en.wikipedia.org/wiki/ISO_week_date" } }
-{ $examples
-    "Last day of 2018 is already in the first week of 2019."
-    { $example "USING: calendar prettyprint ;"
-               "2018 12 31 <date> week-number ."
-               "1"
-    }
-    "2020 is a leap year with 53 weeks, and January 1st, 2021 is still in week 53 of 2020."
-    { $example "USING: calendar prettyprint ;"
-               "2021 1 1 <date> week-number ."
-               "53"
-    }
-} ;
-
 HELP: sunday
 { $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
 { $description "Returns the Sunday from the current week, which starts on a Sunday." } ;
@@ -589,7 +573,6 @@ ARTICLE: "calendar-facts" "Calendar facts"
     days-in-month
     day-of-year
     day-of-week
-    week-number
 }
 "Calculating a Julian day number:"
 { $subsections julian-day-number }

basis/calendar/calendar-tests.factor

@@ -194,9 +194,3 @@ IN: calendar
 
 ! pm
 [ now 30 pm ] [ not-in-interval? ] must-fail-with
-
-{ 1 } [ 2018 12 31 <date> week-number ] unit-test
-
-{ 16 } [ 2019 4 17 <date> week-number ] unit-test
-
-{ 53 } [ 2021 1 1 <date> week-number ] unit-test

basis/calendar/calendar.factor

@@ -40,10 +40,10 @@ CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 }
 
 GENERIC: leap-year? ( obj -- ? )
 
-M: integer leap-year?
+M: integer leap-year? ( year -- ? )
     dup 100 divisor? 400 4 ? divisor? ;
 
-M: timestamp leap-year?
+M: timestamp leap-year? ( timestamp -- ? )
     year>> leap-year? ;
 
 : (days-in-month) ( year month -- n )
@@ -121,10 +121,10 @@ GENERIC: easter ( obj -- obj' )
 
     h l + 7 m * - 114 + 31 /mod 1 + ;
 
-M: integer easter
+M: integer easter ( year -- timestamp )
     dup easter-month-day <date> ;
 
-M: timestamp easter
+M: timestamp easter ( timestamp -- timestamp )
     clone
     dup year>> easter-month-day
     swapd >>day swap >>month ;
@@ -167,52 +167,52 @@ GENERIC: +second ( timestamp x -- timestamp )
     { [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&&
     [ 3 >>month 1 >>day ] when ;
 
-M: integer +year
+M: integer +year ( timestamp n -- timestamp )
     [ + ] curry change-year adjust-leap-year ;
 
-M: real +year
+M: real +year ( timestamp n -- timestamp )
     [ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ;
 
 : months/years ( n -- months years )
     12 /rem [ 1 - 12 ] when-zero swap ; inline
 
-M: integer +month
+M: integer +month ( timestamp n -- timestamp )
     [ over month>> + months/years [ >>month ] dip +year ] unless-zero ;
 
-M: real +month
+M: real +month ( timestamp n -- timestamp )
     [ float>whole-part swapd average-month * +day swap +month ] unless-zero ;
 
-M: integer +day
+M: integer +day ( timestamp n -- timestamp )
     [
         over >date< julian-day-number + julian-day-number>date
         [ >>year ] [ >>month ] [ >>day ] tri*
     ] unless-zero ;
 
-M: real +day
+M: real +day ( timestamp n -- timestamp )
     [ float>whole-part swapd 24 * +hour swap +day ] unless-zero ;
 
 : hours/days ( n -- hours days )
     24 /rem swap ;
 
-M: integer +hour
+M: integer +hour ( timestamp n -- timestamp )
     [ over hour>> + hours/days [ >>hour ] dip +day ] unless-zero ;
 
-M: real +hour
+M: real +hour ( timestamp n -- timestamp )
     float>whole-part swapd 60 * +minute swap +hour ;
 
 : minutes/hours ( n -- minutes hours )
     60 /rem swap ;
 
-M: integer +minute
+M: integer +minute ( timestamp n -- timestamp )
     [ over minute>> + minutes/hours [ >>minute ] dip +hour ] unless-zero ;
 
-M: real +minute
+M: real +minute ( timestamp n -- timestamp )
     [ float>whole-part swapd 60 * +second swap +minute ] unless-zero ;
 
 : seconds/minutes ( n -- seconds minutes )
     60 /rem swap >integer ;
 
-M: number +second
+M: number +second ( timestamp n -- timestamp )
     [ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ;
 
 : (time+) ( timestamp duration -- timestamp' duration )
@@ -291,7 +291,8 @@ GENERIC: time- ( time1 time2 -- time3 )
         [ neg +year   0 ] change-year drop
     ] if ;
 
-M: timestamp <=> [ >gmt tuple-slots ] compare ;
+M: timestamp <=> ( ts1 ts2 -- n )
+    [ >gmt tuple-slots ] compare ;
 
 : same-day? ( ts1 ts2 -- ? )
     [ >gmt >date< <date> ] same? ;
@@ -375,9 +376,8 @@ M: duration time-
 
 GENERIC: days-in-year ( obj -- n )
 
-M: integer days-in-year leap-year? 366 365 ? ;
+M: integer days-in-year ( year -- n ) leap-year? 366 365 ? ;
-
+M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
-M: timestamp days-in-year year>> days-in-year ;
 
 : days-in-month ( timestamp -- n )
     >date< drop (days-in-month) ;
@@ -538,16 +538,6 @@ M: integer end-of-year 12 31 <date> ;
 : unix-time>timestamp ( seconds -- timestamp )
     [ unix-1970 ] dip +second ; inline
 
-: (week-number) ( timestamp -- [0,53] )
-    [ day-of-year ] [ day-of-week [ 7 ] when-zero ] bi - 10 + 7 /i ;
-
-: week-number ( timestamp -- [1,53] )
-    dup (week-number) {
-        {  0 [ year>> 1 - end-of-year (week-number) ] }
-        { 53 [ year>> 1 + <year> (week-number) 1 = 1 53 ? ] }
-        [ nip ]
-    } case ;
-
 {
     { [ os unix? ] [ "calendar.unix" ] }
     { [ os windows? ] [ "calendar.windows" ] }

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 ;
 
@@ -52,15 +52,15 @@ MACRO: formatted ( spec -- quot )
 
 GENERIC: day. ( obj -- )
 
-M: integer day.
+M: integer day. ( n -- )
     number>string dup length 2 < [ bl ] when write ;
 
-M: timestamp day.
+M: timestamp day. ( timestamp -- )
     day>> day. ;
 
 GENERIC: month. ( obj -- )
 
-M: array month.
+M: array month. ( pair -- )
     first2
     [ month-name write bl number>string print ]
     [ 1 zeller-congruence ]
@@ -71,15 +71,15 @@ M: array month.
         1 + + 7 mod zero? [ nl ] [ bl ] if
     ] with each-integer nl ;
 
-M: timestamp month.
+M: timestamp month. ( timestamp -- )
     [ year>> ] [ month>> ] bi 2array month. ;
 
 GENERIC: year. ( obj -- )
 
-M: integer year.
+M: integer year. ( n -- )
     12 [ 1 + 2array month. nl ] with each-integer ;
 
-M: timestamp year.
+M: timestamp year. ( timestamp -- )
     year>> year. ;
 
 : timestamp>mdtm ( timestamp -- str )

basis/calendar/format/tags.txt

@@ -1 +0,0 @@
-time

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/unix/unix.factor

@@ -31,7 +31,7 @@ IN: calendar.unix
 : timezone-name ( -- string )
     get-time zone>> ;
 
-M: unix gmt-offset
+M: unix gmt-offset ( -- hours minutes seconds )
     get-time gmtoff>> 3600 /mod 60 /mod ;
 
 : current-timeval ( -- timeval )

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>> ]
@@ -28,14 +28,14 @@ IN: calendar.windows
         [ [ wSecond>> ] [ wMilliseconds>> 1000 / ] bi + ]
     } cleave instant <timestamp> ;
 
-M: windows gmt-offset
+M: windows gmt-offset ( -- hours minutes seconds )
     TIME_ZONE_INFORMATION <struct>
     dup GetTimeZoneInformation {
-        { TIME_ZONE_ID_INVALID [ win32-error ] }
+        { TIME_ZONE_ID_INVALID [ win32-error-string throw ] }
         { TIME_ZONE_ID_UNKNOWN [ Bias>> ] }
         { TIME_ZONE_ID_STANDARD [ Bias>> ] }
         { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
     } case neg 60 /mod 0 ;
 
 M: windows gmt
-    SYSTEMTIME <struct> [ GetSystemTime ] keep SYSTEMTIME>timestamp ;
+    SYSTEMTIME <struct> [ GetSystemTime ] keep \SYSTEMTIME>timestamp ;

basis/channels/channels.factor

@@ -31,11 +31,11 @@ GENERIC: from ( channel -- value )
 
 PRIVATE>
 
-M: channel to
+M: channel to ( value channel -- )
     dup receivers>>
     [ dup wait to ] [ nip (to) ] if-empty ;
 
-M: channel from
+M: channel from ( channel -- value )
     [ self ] dip
     notify senders>>
     [ (from) ] unless-empty

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/channels/remote/remote.factor

@@ -60,10 +60,10 @@ C: <remote-channel> remote-channel
 
 PRIVATE>
 
-M: remote-channel to
+M: remote-channel to ( value remote-channel -- )
     [ id>> swap to-message boa ] keep send-message drop ;
 
-M: remote-channel from
+M: remote-channel from ( remote-channel -- value )
     [ id>> from-message boa ] keep send-message ;
 
 [

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/adler-32/adler-32.factor

@@ -8,10 +8,10 @@ SINGLETON: adler-32
 
 CONSTANT: adler-32-modulus 65521
 
-M: adler-32 checksum-bytes
+M: adler-32 checksum-bytes ( bytes checksum -- value )
     drop
     [ sum 1 + ]
-    [ [ dup length [1,b] <reversed> vdot ] [ length ] bi + ] bi
+    [ [ dup length [1,b] <reversed> v. ] [ length ] bi + ] bi
     [ adler-32-modulus mod ] bi@ 16 shift bitor ;
 
 INSTANCE: adler-32 checksum

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/bsd/bsd.factor

@@ -5,7 +5,7 @@ IN: checksums.bsd
 
 SINGLETON: bsd
 
-M: bsd checksum-bytes
+M: bsd checksum-bytes ( bytes checksum -- value )
     drop 0 [
         [ [ -1 shift ] [ 1 bitand 15 shift ] bi + ] dip
         + 0xffff bitand

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/fnv1/fnv1.factor

@@ -38,67 +38,67 @@ CONSTANT: fnv1-256-basis 0xdd268dbcaac550362d98c384c4e576ccc8b1536847b6bbb31023b
 CONSTANT: fnv1-512-basis 0xb86db0b1171f4416dca1e50f309990acac87d059c90000000000000000000d21e948f68a34c192f62ea79bc942dbe7ce182036415f56e34bac982aac4afe9fd9
 CONSTANT: fnv1-1024-basis 0x5f7a76758ecc4d32e56d5a591028b74b29fc4223fdada16c3bf34eda3674da9a21d9000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004c6d7eb6e73802734510a555f256cc005ae556bde8cc9c6a93b21aff4b16c71ee90b3
 
-M: fnv1-32 checksum-bytes
+M: fnv1-32 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-32-basis swap
     [ swap fnv1-32-prime * bitxor fnv1-32-mod bitand ] each ;
 
-M: fnv1a-32 checksum-bytes
+M: fnv1a-32 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-32-basis swap
     [ bitxor fnv1-32-prime * fnv1-32-mod bitand ] each ;
 
 
-M: fnv1-64 checksum-bytes
+M: fnv1-64 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-64-basis swap
     [ swap fnv1-64-prime * bitxor fnv1-64-mod bitand ] each ;
 
-M: fnv1a-64 checksum-bytes
+M: fnv1a-64 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-64-basis swap
     [ bitxor fnv1-64-prime * fnv1-64-mod bitand ] each ;
 
 
-M: fnv1-128 checksum-bytes
+M: fnv1-128 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-128-basis swap
     [ swap fnv1-128-prime * bitxor fnv1-128-mod bitand ] each ;
 
-M: fnv1a-128 checksum-bytes
+M: fnv1a-128 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-128-basis swap
     [ bitxor fnv1-128-prime * fnv1-128-mod bitand ] each ;
 
 
-M: fnv1-256 checksum-bytes
+M: fnv1-256 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-256-basis swap
     [ swap fnv1-256-prime * bitxor fnv1-256-mod bitand ] each ;
 
-M: fnv1a-256 checksum-bytes
+M: fnv1a-256 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-256-basis swap
     [ bitxor fnv1-256-prime * fnv1-256-mod bitand ] each ;
 
 
-M: fnv1-512 checksum-bytes
+M: fnv1-512 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-512-basis swap
     [ swap fnv1-512-prime * bitxor fnv1-512-mod bitand ] each ;
 
-M: fnv1a-512 checksum-bytes
+M: fnv1a-512 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-512-basis swap
     [ bitxor fnv1-512-prime * fnv1-512-mod bitand ] each ;
 
 
-M: fnv1-1024 checksum-bytes
+M: fnv1-1024 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-1024-basis swap
     [ swap fnv1-1024-prime * bitxor fnv1-1024-mod bitand ] each ;
 
-M: fnv1a-1024 checksum-bytes
+M: fnv1a-1024 checksum-bytes ( bytes checksum -- value )
     drop
     fnv1-1024-basis swap
     [ bitxor fnv1-1024-prime * fnv1-1024-mod bitand ] each ;

basis/checksums/murmur/murmur.factor

@@ -47,7 +47,7 @@ CONSTANT: n 0xe6546b64
 
 PRIVATE>
 
-M: murmur3-32 checksum-bytes
+M: murmur3-32 checksum-bytes ( bytes checksum -- value )
     seed>> 32 bits main-loop end-case avalanche ;
 
 INSTANCE: murmur3-32 checksum

basis/checksums/openssl/openssl.factor

@@ -38,13 +38,13 @@ M: evp-md-context dispose*
 : set-digest ( name ctx -- )
     handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
 
-M: openssl-checksum initialize-checksum-state
+M: openssl-checksum initialize-checksum-state ( checksum -- evp-md-context )
     maybe-init-ssl name>> <evp-md-context> [ set-digest ] keep ;
 
-M: evp-md-context add-checksum-bytes
+M: evp-md-context add-checksum-bytes ( ctx bytes -- ctx' )
     [ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
 
-M: evp-md-context get-checksum
+M: evp-md-context get-checksum ( ctx -- value )
     handle>>
     { { int EVP_MAX_MD_SIZE } int }
     [ EVP_DigestFinal_ex ssl-error ] with-out-parameters

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
+{ "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
+{ "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
+{ "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/prettyprint/prettyprint.factor

@@ -116,7 +116,7 @@ M: struct-mirror delete-at
 M: struct-mirror clear-assoc
     object>> reset-struct-slots ;
 
-M: struct-mirror >alist
+M: struct-mirror >alist ( mirror -- alist )
     object>> [
         [ drop "underlying" ] [ >c-ptr ] bi 2array 1array
     ] [

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:"
+"Struct classes are defined using a syntax similar to the " { $link postpone: \TUPLE: } " syntax for defining tuple classes:"
-{ $subsections POSTPONE: STRUCT: POSTPONE: PACKED-STRUCT: }
+{ $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:"
+"Structs have literal syntax, similar to " { $link postpone: \T{ } " for tuples:"
-{ $subsections POSTPONE: S{ } ;
+{ $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
+    [ NSAppleScript send: alloc ] dip
-    <NSString> -> initWithSource: -> autorelease
+    <NSString> send: \initWithSource: send: autorelease
-    f -> executeAndReturnError: drop ;
+    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
+    [ NSNotificationCenter send: defaultCenter ] dip
-    -> removeObserver: ;
+    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: ->
+HELP: \send:
-{ $syntax "-> selector" }
+{ $syntax "send: selector" }
 { $values { "selector" "an Objective C method name" } }
 { $description "A sugared form of the following:" }
 { $code "\"selector\" send" } ;
 
-HELP: SUPER->
+HELP: \super:
-{ $syntax "-> selector" }
+{ $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: \send:
-    POSTPONE: SUPER->
+    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
+    Foo send: alloc send: init
-    dup 1.0 2.0 101.0 102.0 <CGRect> -> foo:
+    dup 1.0 2.0 101.0 102.0 <CGRect> send: \foo:
-    -> release ;
+    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
+        send: alloc send: init
-        dup -> bar "x" set
+        dup send: bar "x" set
-        -> release
+        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
+        send: alloc send: init
-        dup 12 -> babb:
+        dup 12 send: \babb:
-        swap -> release
+        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: ->
+SYNTAX: \send:
-    scan-token dup remember-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:
+SYNTAX: \selector:
-    scan-token dup remember-send
+    scan-token unescape-token
-    <selector> suffix! \ cocoa.messages:selector suffix! ;
+    [ 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->
+SYNTAX: \super:
-    scan-token dup remember-super-send
+    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
+    NSOpenPanel send: openPanel
-    dup 1 -> setCanChooseFiles:
+    dup 1 send: \setCanChooseFiles:
-    dup 0 -> setCanChooseDirectories:
+    dup 0 send: \setCanChooseDirectories:
-    dup 1 -> setResolvesAliases:
+    dup 1 send: \setResolvesAliases:
-    dup 1 -> setAllowsMultipleSelection: ;
+    dup 1 send: \setAllowsMultipleSelection: ;
 
 : <NSDirPanel> ( -- panel ) <NSOpenPanel>
-   dup 1 -> setCanChooseDirectories: ;
+   dup 1 send: \setCanChooseDirectories: ;
 
 : <NSSavePanel> ( -- panel )
-    NSSavePanel -> savePanel
+    NSSavePanel send: savePanel
-    dup 1 -> setCanChooseFiles:
+    dup 1 send: \setCanChooseFiles:
-    dup 0 -> setCanChooseDirectories:
+    dup 0 send: \setCanChooseDirectories:
-    dup 0 -> setAllowsMultipleSelection: ;
+    dup 0 send: \setAllowsMultipleSelection: ;
 
 CONSTANT: NSOKButton 1
 CONSTANT: NSCancelButton 0
 
 : (open-panel) ( panel -- paths )
-    dup -> runModal NSOKButton =
+    dup send: runModal NSOKButton =
-    [ -> filenames CF>string-array ] [ drop f ] if ;
+    [ 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 =
+    split-path send: \runModalForDirectory:file: NSOKButton =
-    [ -> filename CF>string ] [ drop f ] if ;
+    [ 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 ;
@@ -126,7 +126,6 @@ H{
     { "@" id }
     { "#" Class }
     { ":" SEL }
-    { "(" c:void* }
 }
 cell {
     { 4 [ H{
@@ -188,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 ;
@@ -200,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: ^ = ] [ 3drop void* ] }
-        { [ dup CHAR: { = ] [ drop objc-struct-type ] }
+        { [ dup char: \{ = ] [ drop objc-struct-type ] }
-        { [ dup CHAR: [ = ] [ 3drop void* ] }
+        { [ dup char: \[ = ] [ 3drop void* ] }
         [ 2nip decode-type ]
     } cond ;
 
@@ -238,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:
+    <NSString> NSNib send: alloc swap f send: \initWithNibNamed:bundle:
-    dup [ -> autorelease ] when ;
+    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:
+    NSStringPboardType <NSString> send: \stringForType:
-    dup [ CF>string ] when ;
+    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 =
+    dup send: doubleValue dup >integer =
-    [ -> longLongValue ] [ -> doubleValue ] if ;
+    [ 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: } } }
+{ $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: METHOD: } " parsing word."
+{ $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:
+HELP: \COCOA-METHOD:
-{ $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ] ;" }
+{ $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: {
+    [ NSTouchBar send: alloc send: init dup ] dip send: setDelegate: {
-        [ swap <CFStringArray> { void { id SEL id } } ?-> setDefaultItemIdentifiers: ]
+        [ swap <CFStringArray> send: \setDefaultItemIdentifiers: ]
-        [ swap <CFStringArray> { void { id SEL id } } ?-> setCustomizationAllowedItemIdentifiers: ]
+        [ swap <CFStringArray> send: \setCustomizationAllowedItemIdentifiers: ]
         [ nip ]
     } 2cleave ;
 
 :: make-NSTouchBar-button ( self identifier label-string action-string -- button )
-    NSCustomTouchBarItem -> alloc
+    NSCustomTouchBarItem send: alloc
-        identifier <CFString> { id { id SEL id } } ?-> initWithIdentifier: :> item
+        identifier <CFString> send: \initWithIdentifier: :> item
         NSButton
             label-string <CFString>
             self
-            action-string lookup-selector { id { id SEL id id SEL } } ?-> buttonWithTitle:target:action: :> button
+            action-string lookup-selector send: \buttonWithTitle:target:action: :> button
-        item button -> setView:
+        item button send: \setView:
         item ;

basis/cocoa/types/types.factor

@@ -1,11 +1,9 @@
 ! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax classes.struct cocoa.runtime
-core-graphics.types kernel literals layouts ;
+core-graphics.types ;
 IN: cocoa.types
 
-CONSTANT: NSNotFound $[ 32bit? 0x7fffffff 0x7fffffffffffffff ? ]
-
 TYPEDEF: long NSInteger
 TYPEDEF: ulong NSUInteger
 

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:
+    send: \initWithFrame:pixelFormat:
-    dup 1 -> setPostsBoundsChangedNotifications:
+    dup 1 send: \setPostsBoundsChangedNotifications:
-    dup 1 -> setPostsFrameChangedNotifications: ;
+    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
+    [ send: alloc ] curry 2dip NSBackingStoreBuffered 1
-    -> initWithContentRect:styleMask:backing:defer: ;
+    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 class-for-style <NSWindow> [ swap send: \setContentView: ] keep
-    dup dup -> contentView -> setInitialFirstResponder:
+    dup dup send: contentView send: \setInitialFirstResponder:
-    dup 1 -> setAcceptsMouseMovedEvents:
+    dup 1 send: \setAcceptsMouseMovedEvents:
-    dup 0 -> setReleasedWhenClosed: ;
+    dup 0 send: \setReleasedWhenClosed: ;
 
 : window-content-rect ( window -- rect )
-    dup -> class swap
+    dup send: class swap
-    [ -> frame ] [ -> styleMask ] bi
+    [ send: frame ] [ send: styleMask ] bi
-    -> contentRectForFrameRect:styleMask: ;
+    send: \contentRectForFrameRect:styleMask: ;

basis/colors/cmyk/tags.txt

@@ -1 +0,0 @@
-colors

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:
+HELP: \color:
-{ $syntax "COLOR: name" }
+{ $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
+USING: ascii assocs colors io.encodings.utf8 io.files kernel
-io.files lexer parser colors sequences splitting ascii ;
+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/constants/tags.txt

@@ -1 +0,0 @@
-colors