factor-shell: Initial commit.

.gitattributes

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

.gitignore

@@ -1,34 +1,34 @@
-*#*#
-*.*.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
+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

@@ -5,20 +5,15 @@ compiler:
 os:
   - linux
   - osx
+branches:
+  only:
+    - master
 sudo: required
 dist: trusty
 group: deprecated-2017Q4
 services:
   - postgresql
   - redis-server
-branches:
-  except:
-  - clean-windows-x86-64
-  - clean-windows-x86-32
-  - clean-linux-x86-64
-  - clean-linux-x86-32
-  - clean-macosx-x86-64
-  - clean-macosx-x86-32
 addons:
   apt:
     packages:
@@ -31,19 +26,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,26 +39,9 @@ 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
+  - >
-      wget https://github.com/vmt/udis86/archive/v1.7.2.tar.gz && tar xzvf v1.7.2.tar.gz &&
+    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 ) &&
+    ( cd udis86-1.7.2/ && ./autogen.sh && ./configure --enable-shared=yes && make && sudo make install ) &&
-      ( [[ "$TRAVIS_OS_NAME" != "osx" ]] && sudo ldconfig || true );
+    ( [[ "$TRAVIS_OS_NAME" != "osx" ]] && sudo ldconfig || true )
-    fi
-  - 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
-  - git remote set-branches --add origin clean-linux-x86-64
-  - git remote set-branches --add origin clean-linux-x86-32
-  - git remote set-branches --add origin clean-macosx-x86-64
-  - git remote set-branches --add origin clean-macosx-x86-32
-  - git fetch # so we can see which vocabs changed versus origin/master...
 script:
-  - echo "TRAVIS_BRANCH=$TRAVIS_BRANCH, TRAVIS_PULL_REQUEST_BRANCH=$TRAVIS_PULL_REQUEST_BRANCH"
-  - 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 -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 -e='USING: modern.paths tools.test sequences system kernel math random ; core-vocabs os macosx? [ dup length 3 /i sample ] when [ test ] each'"

Factor.app/Contents/Info.plist

@@ -32,9 +32,9 @@
 	<key>CFBundlePackageType</key>
 	<string>APPL</string>
 	<key>CFBundleVersion</key>
-	<string>0.99</string>
+	<string>0.98</string>
 	<key>NSHumanReadableCopyright</key>
-	<string>Copyright © 2003-2018 Factor developers</string>
+	<string>Copyright © 2003-2017 Factor developers</string>
 	<key>NSServices</key>
 	<array>
 		<dict>

GNUmakefile

@@ -1,25 +1,12 @@
 ifdef CONFIG
-	VERSION = 0.99
+	VERSION = 0.98
 	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

@@ -1,32 +1,10 @@
-VERSION = 0.99
+!IF !DEFINED(VERSION)
-
+VERSION = version-missing
-# Crazy hack to do shell commands
-# We do it in Nmakefile because that way we don't have to invoke build through build.cmd
-# and we can just do ``nmake /f Nmakefile x86-64-vista`` or similar
-# and we still get the git branch, id, etc
-
-!IF [git describe --all > git-describe.tmp] == 0
-GIT_DESCRIBE = \
-!INCLUDE <git-describe.tmp>
-!IF [del git-describe.tmp] == 0
-!ENDIF
 !ENDIF
 
-!IF [git rev-parse HEAD > git-id.tmp] == 0
+!IF !DEFINED(GIT_LABEL)
-GIT_ID = \
+GIT_LABEL = git-label-missing
-!INCLUDE <git-id.tmp>
-!IF [del 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
-!ENDIF
-!ENDIF
-
-GIT_LABEL = $(GIT_DESCRIBE)-$(GIT_ID)
 
 !IF DEFINED(PLATFORM)
 
@@ -58,13 +36,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 +43,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
@@ -125,12 +92,11 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm\vm.obj \
 	vm\words.obj
 
-# batch mode has ::
+.cpp.obj:
-.cpp.obj::
+	cl /EHsc $(CL_FLAGS) /Fo$@ /c $<
-	cl /EHsc $(CL_FLAGS) /MP /Fovm/ /c $<
 
-.c.obj::
+.c.obj:
-	cl /EHsc $(CL_FLAGS) /MP /Fovm/ /c $<
+	cl $(CL_FLAGS) /Fo$@ /c $<
 
 .asm.obj:
 	ml $(ML_FLAGS) /Fo$@ /c $<
@@ -150,16 +116,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 +147,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/c-types/c-types-docs.factor

@@ -105,7 +105,7 @@ $nl
 ARTICLE: "c-types.primitives" "Primitive C types"
 "The following numerical types are defined in the " { $vocab-link "alien.c-types" } " vocabulary; a " { $snippet "u" } " prefix denotes an unsigned type:"
 { $table
-    { { $strong "C type" } { $strong "Notes" } }
+    { "C type" "Notes" }
     { { $link char } "always 1 byte" }
     { { $link uchar } { } }
     { { $link short } "always 2 bytes" }

basis/alien/data/data-docs.factor

@@ -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
@@ -154,7 +154,7 @@ ARTICLE: "c-pointers" "Passing pointers to C functions"
 ARTICLE: "c-boxes" "C value boxes"
 "Sometimes it is useful to create a byte array storing a single C value, like a struct with a single field. A pair of utility words exist to make this more convenient:"
 { $subsections <ref> deref }
-"These words can be used to in conjunction with, or instead of, " { $link with-out-parameters } " to handle \"out-parameters\". For example, if a function is declared in the following way:"
+"These words can be used to in conjuction with, or instead of, " { $link with-out-parameters } " to handle \"out-parameters\". For example, if a function is declared in the following way:"
 { $code
   "FUNCTION: int do_foo ( int* a )"
 }
@@ -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/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/linux/linux-tests.factor

@@ -1,4 +1,5 @@
 USING: alien.libraries.finder sequences tools.test ;
+IN: alien.libraries.finder.linux.tests
 
 { t } [ "libm.so" "m" find-library subseq? ] unit-test
 { t } [ "libc.so" "c" find-library subseq? ] unit-test

basis/alien/libraries/finder/linux/linux.factor

@@ -44,4 +44,4 @@ PRIVATE>
 
 M: linux find-library*
     "lib" prepend load-ldconfig-cache
-    [ ldconfig-matches? ] with find nip ?last ;
+    [ ldconfig-matches? ] with find nip ?first ;

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

@@ -1,6 +1,9 @@
-USING: alien.libraries.finder alien.libraries.finder.macosx
+
+USING: alien.libraries.finder
 alien.libraries.finder.macosx.private sequences tools.test ;
 
+IN: alien.libraries.finder.macosx
+
 {
     {
         f

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

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax assocs help.markup help.syntax kernel
+USING: alien alien.syntax assocs help.markup help.syntax strings words
-strings ;
+;
 IN: alien.libraries
 
 HELP: add-library
@@ -38,7 +38,7 @@ HELP: dlopen
 { $values { "path" "a pathname string" } { "dll" "a DLL handle" } }
 { $description "Opens a native library and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } "." }
 { $errors "Throws an error if the library could not be found, or if loading fails for some other reason." }
-{ $notes "This is the low-level facility used to implement " { $link add-library } ". Use the latter instead." } ;
+{ $notes "This is the low-level facility used to implement " { $link load-library } ". Use the latter instead." } ;
 
 HELP: dlsym
 { $values { "name" "a C symbol name" } { "dll" "a DLL handle" } { "alien" { $maybe alien } } }
@@ -72,9 +72,9 @@ HELP: library
     }
 } ;
 
-HELP: library-dll
+HELP: load-library
-{ $values { "obj" object } { "dll" "a DLL handle" } }
+{ $values { "name" string } { "dll" "a DLL handle" } }
-{ $description "Looks up a library by logical name and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } "." } ;
+{ $description "Loads a library by logical name and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } ". If the library is already loaded, returns the existing handle." } ;
 
 HELP: remove-library
 { $values { "name" string } }
@@ -86,8 +86,8 @@ ARTICLE: "loading-libs" "Loading native libraries"
     add-library
     remove-library
 }
-"Once a library has been defined, you can see if the library has correctly loaded:"
+"Once a library has been defined, you can try loading it to see if the path name is correct:"
-{ $subsections library-dll }
+{ $subsections load-library }
 "If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again."
 $nl
 "Libraries that do not come standard with the operating system need to be included with deployed applications that use them. A word is provided to instruct " { $link "tools.deploy" } " that a library must be so deployed:"

basis/alien/libraries/libraries.factor

@@ -36,18 +36,14 @@ C: <library> library
 : make-library ( path abi -- library )
     [ dup open-dll ] dip <library> ;
 
-GENERIC: library-dll ( obj -- dll )
+: library-dll ( library -- dll )
-
-M: f library-dll ;
-
-M: library library-dll
     dup [ dll>> ] when ;
 
-M: string library-dll ( library -- dll )
+: load-library ( name -- dll )
     lookup-library library-dll ;
 
 : dlsym? ( function library -- alien/f )
-    library-dll dlsym ;
+    load-library dlsym ;
 
 M: dll dispose dlclose ;
 
@@ -65,7 +61,7 @@ M: library dispose dll>> [ dispose ] when* ;
 : add-library ( name path abi -- )
     3dup add-library? [
         [ 2drop remove-library ]
-        [ nipd make-library ]
+        [ [ nip ] dip make-library ]
         [ 2drop libraries get set-at ] 3tri
     ] [ 3drop ] if ;
 
@@ -88,7 +84,7 @@ M: library dispose dll>> [ dispose ] when* ;
     lookup-library [ abi>> ] [ cdecl ] if* ;
 
 : address-of ( name library -- value )
-    2dup library-dll dlsym-raw
+    2dup load-library dlsym-raw
     [ 2nip ] [ no-such-symbol ] if* ;
 
 SYMBOL: deploy-libraries

basis/alien/libraries/windows/windows.factor

@@ -1,9 +1,8 @@
-USING: alien.libraries io.pathnames system windows.errors
+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 ;
+    win32-error-string ;

basis/ascii/ascii.factor

@@ -24,7 +24,7 @@ IN: ascii
         [ [ 1 ] when-zero cut-slice swap ]
         [ f 0 rot [ length ] keep <slice> ] if*
     ] produce nip ;
-: capitalize ( str -- str' ) >lower 0 over [ ch>upper ] change-nth ;
+: capitalize ( str -- str' ) unclip [ >lower ] [ ch>upper ] bi* prefix ;
 : >title ( str -- title ) >words [ capitalize ] map concat ;
 
 HINTS: >lower string ;

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> [
@@ -27,133 +24,79 @@ CONSTANT: alphabet $[
 
 : base64>ch ( ch -- ch )
     $[ 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.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
@@ -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.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: bit-arrays classes.parser growable kernel parser
+USING: arrays kernel kernel.private math sequences
-vectors.functor vocabs.loader ;
+sequences.private growable bit-arrays prettyprint.custom
+parser accessors vectors.functor classes.parser ;
 IN: bit-vectors
 
 << "bit-vector" create-class-in \ bit-array \ <bit-array> define-vector >>
@@ -9,5 +10,6 @@ IN: bit-vectors
 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/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-docs.factor

@@ -19,7 +19,7 @@ HELP: primitive-quot
 { $description "Creates the defining quotation for the primitive. If 'vm-func' is a string, then it is prefixed with 'primitive_' and a quotation calling that C++ function is generated." } ;
 
 ARTICLE: "bootstrap.image.primitives" "Bootstrap primitives"
-"This vocab contains utilities for declaring primitives to be added to the bootstrap image. It is used by the file " { $snippet "resource:core/bootstrap/primitives.factor" }
+"This vocab contains utilities for declaring primitives to be added to the bootstrap image. It is used by " { $vocab-link "bootstrap.primitives" }
 $nl
 { $link all-primitives } " is an assoc where all primitives are declared. See that constant for a description of the format." ;
 

basis/bootstrap/image/primitives/primitives.factor

@@ -313,10 +313,6 @@ CONSTANT: all-primitives {
                 { object } { fixnum } f
             }
             { "become" ( old new -- ) "become" { array array } { } f }
-            {
-                "callstack-bounds" ( -- start end ) "callstack_bounds"
-                { } { alien alien } make-flushable
-            }
             {
                 "check-datastack" ( array in# out# -- ? ) "check_datastack"
                 { array integer integer } { object } make-flushable
@@ -778,8 +774,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/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-tests.factor

@@ -1,23 +1,14 @@
-USING: accessors calendar calendar.format sequences tools.test ;
+USING: accessors calendar calendar.format io io.streams.string
+kernel math.order sequences tools.test ;
 IN: calendar.format.tests
 
-CONSTANT: testtime T{ timestamp
+{ } [ now timestamp>rfc3339 drop ] unit-test
-    { year 2018 }
+{ } [ now timestamp>rfc822 drop ] unit-test
-    { month 2 }
-    { day 15 }
-    { hour 8 }
-    { minute 51 }
-    { second 44+423303/500000 }
-    { gmt-offset T{ duration { hour -8 } } }
-}
-
-{ "2018-02-15T08:51:44.846606-08:00" } [ testtime timestamp>rfc3339 ] unit-test
-
-{ "Thu, 15 Feb 2018 08:51:44 -0800" } [ testtime timestamp>rfc822 ] unit-test
 
 { }
 [ { 2008 2009 } [ year. ] each ] unit-test
 
+
 { "03:01:59" } [
     3 hours 1 >>minute 59 >>second duration>hms
 ] unit-test

basis/calendar/format/format.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar calendar.english combinators
+USING: accessors arrays calendar calendar.english combinators io
-fry io io.streams.string kernel macros math math.order
+io.streams.string kernel macros math math.order math.parser
-math.parser math.parser.private present quotations sequences
+math.parser.private present quotations sequences typed words ;
-typed words ;
 IN: calendar.format
 
 MACRO: formatted ( spec -- quot )
@@ -15,9 +14,6 @@ MACRO: formatted ( spec -- quot )
         } cond
     ] map [ cleave ] curry ;
 
-: 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 ;
@@ -52,15 +48,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 +67,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

@@ -104,7 +104,7 @@ CONSTANT: rfc822-named-zones H{
     read1 CHAR: \s assert=
     read-sp checked-number
     read-sp month-abbreviations index 1 + check-timestamp
-    read-sp checked-number spin
+    read-sp checked-number -rot swap
     read-hh:mm:ss
     " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
 
@@ -120,7 +120,7 @@ CONSTANT: rfc822-named-zones H{
     read1 CHAR: \s assert=
     "-" read-token checked-number
     "-" read-token month-abbreviations index 1 + check-timestamp
-    read-sp checked-number spin
+    read-sp checked-number -rot swap
     read-hh:mm:ss
     " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
 

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

@@ -28,10 +28,10 @@ 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 + ] }

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.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.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.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-tests.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2016 Alexander Ilin.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test checksums checksums.crc16 ;
+IN: checksums.crc16.tests
 
 { B{ 0xb8 0x80 } } [
     B{ 0x01 0x04 0x02 0xFF 0xFF } crc16 checksum-bytes

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/internet/internet-tests.factor

@@ -1,17 +1,19 @@
 ! Copyright (C) 2010 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 USING: checksums checksums.internet tools.test ;
+IN: checksums.internet.tests
 
 { B{ 255 255 } } [ { } internet checksum-bytes ] unit-test
 { B{ 254 255 } } [ { 1 } internet checksum-bytes ] unit-test
 { B{ 254 253 } } [ { 1 2 } internet checksum-bytes ] unit-test
 { B{ 251 253 } } [ { 1 2 3 } internet checksum-bytes ] unit-test
 
-{ B{ 34 13 } } [
+: test-data ( -- bytes )
     B{
         0x00 0x01
         0xf2 0x03
         0xf4 0xf5
         0xf6 0xf7
-    } internet checksum-bytes
+    } ;
-] unit-test
+
+{ B{ 34 13 } } [ test-data internet checksum-bytes ] unit-test

basis/checksums/metrohash/metrohash-docs.factor

@@ -1,16 +0,0 @@
-USING: help.markup help.syntax ;
-IN: checksums.metrohash
-
-HELP: metrohash-64
-{ $class-description "MetroHash 64-bit checksum algorithm." } ;
-
-HELP: metrohash-128
-{ $class-description "MetroHash 128-bit checksum algorithm." } ;
-
-ARTICLE: "checksums.metrohash" "MetroHash checksum"
-"MetroHash is a set of non-cryptographic hash functions."
-{ $subsections
-    metrohash-64
-    metrohash-128 } ;
-
-ABOUT: "checksums.metrohash"

basis/checksums/metrohash/metrohash-tests.factor

@@ -1,86 +0,0 @@
-
-USING: byte-arrays checksums checksums.metrohash tools.test ;
-
-{ 17099979927131455419 } [
-    "abc" T{ metrohash-64 { seed 0 } } checksum-bytes
-] unit-test
-
-{ 5688461416820429545 } [
-    "abc" T{ metrohash-64 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 1767508563557181619 } [
-    "abcdefghijklmnopqrstuvwxyz"
-    T{ metrohash-64 { seed 0 } } checksum-bytes
-] unit-test
-
-{ 2460573209396975646 } [
-    "abcdefghijklmnopqrstuvwxyz"
-    T{ metrohash-64 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 878430475465696418 } [
-    "this is a really long sentence that needs to be hashed"
-    T{ metrohash-64 { seed 0 } } checksum-bytes
-] unit-test
-
-{ 14883773106412686490 } [
-    "this is a really long sentence that needs to be hashed"
-    T{ metrohash-64 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 14883773106412686490 } [
-    "this is a really long sentence that needs to be hashed"
-    >byte-array T{ metrohash-64 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 14883773106412686490 } [
-    T{ metrohash-64 { seed 1234 } } [
-        "this is a really " add-checksum-bytes
-        "long sentence that " add-checksum-bytes
-        "needs to be hashed" add-checksum-bytes
-        get-checksum
-    ] with-checksum-state
-] unit-test
-
-{ 182995299641628952910564950850867298725 } [
-    "abc" T{ metrohash-128 { seed 0 } } checksum-bytes
-] unit-test
-
-{ 61180998041120637609836805276498424729 } [
-    "abc" T{ metrohash-128 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 34499071879213198976518413085708640177 } [
-    "abcdefghijklmnopqrstuvwxyz"
-    T{ metrohash-128 { seed 0 } } checksum-bytes
-] unit-test
-
-{ 179174851912813597938406577526685531497 } [
-    "abcdefghijklmnopqrstuvwxyz"
-    T{ metrohash-128 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 212255213697664751676685499681764114896 } [
-    "this is a really long sentence that needs to be hashed"
-    T{ metrohash-128 { seed 0 } } checksum-bytes
-] unit-test
-
-{ 182531630340317658385091745884975528732 } [
-    "this is a really long sentence that needs to be hashed"
-    T{ metrohash-128 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 182531630340317658385091745884975528732 } [
-    "this is a really long sentence that needs to be hashed"
-    >byte-array T{ metrohash-128 { seed 1234 } } checksum-bytes
-] unit-test
-
-{ 182531630340317658385091745884975528732 } [
-    T{ metrohash-128 { seed 1234 } } [
-        "this is a really " add-checksum-bytes
-        "long sentence that " add-checksum-bytes
-        "needs to be hashed" add-checksum-bytes
-        get-checksum
-    ] with-checksum-state
-] unit-test

basis/checksums/metrohash/metrohash.factor

@@ -1,174 +0,0 @@
-! Copyright (C) 2018 John Benediktsson.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data byte-arrays checksums
-combinators grouping io.binary kernel locals math math.bitwise
-sequences specialized-arrays ;
-SPECIALIZED-ARRAY: uint64_t
-SPECIALIZED-ARRAY: uint32_t
-SPECIALIZED-ARRAY: uint16_t
-
-IN: checksums.metrohash
-
-TUPLE: metrohash-64 seed ;
-
-C: <metrohash-64> metrohash-64
-
-<PRIVATE
-
-:: native-mapper ( from to bytes c-type -- seq )
-    from to bytes <slice>
-    bytes byte-array? little-endian? and
-    [ c-type cast-array ]
-    [ c-type heap-size <groups> [ le> ] map ] if ; inline
-
-PRIVATE>
-
-M:: metrohash-64 checksum-bytes ( bytes checksum -- value )
-    0xD6D018F5 :> k0
-    0xA2AA033B :> k1
-    0x62992FC1 :> k2
-    0x30BC5B29 :> k3
-
-    checksum seed>> :> seed
-    bytes length :> len
-
-    len dup 32 mod - :> len/32
-    len dup 16 mod - :> len/16
-    len dup 8 mod - :> len/8
-    len dup 4 mod - :> len/4
-    len dup 2 mod - :> len/2
-
-    seed k2 W+ k0 W* :> h
-
-    h h h h :> ( v0! v1! v2! v3! )
-
-    len 32 >= [
-        0 len/32 bytes uint64_t native-mapper 4 <groups> [
-            first4 {
-                [ k0 W* v0 W+ -29 bitroll-64 v2 W+ v0! ]
-                [ k1 W* v1 W+ -29 bitroll-64 v3 W+ v1! ]
-                [ k2 W* v2 W+ -29 bitroll-64 v0 W+ v2! ]
-                [ k3 W* v3 W+ -29 bitroll-64 v1 W+ v3! ]
-            } spread
-        ] each
-
-        v0 v3 W+ k0 W* v1 W+ -37 bitroll-64 k1 W* v2 bitxor v2!
-        v1 v2 W+ k1 W* v0 W+ -37 bitroll-64 k0 W* v3 bitxor v3!
-        v0 v2 W+ k0 W* v3 W+ -37 bitroll-64 k1 W* v0 bitxor v0!
-        v1 v3 W+ k1 W* v2 W+ -37 bitroll-64 k0 W* v1 bitxor v1!
-
-        v0 v1 bitxor h W+ v0!
-    ] when
-
-    len/32 len/16 bytes uint64_t native-mapper [
-        first2
-        [ k2 W* v0 W+ -29 bitroll-64 k3 W* v1! ]
-        [ k2 W* v0 W+ -29 bitroll-64 k3 W* v2! ] bi*
-        v1 k0 W* -21 bitroll-64 v2 W+ v1 bitxor v1!
-        v2 k3 W* -21 bitroll-64 v1 W+ v2 bitxor v2!
-        v2 v0 W+ v0!
-    ] unless-empty
-
-    len/16 len/8 bytes uint64_t native-mapper [
-        first k3 W* v0 W+ v0!
-        v0 -55 bitroll-64 k1 W* v0 bitxor v0!
-    ] unless-empty
-
-    len/8 len/4 bytes uint32_t native-mapper [
-        first k3 W* v0 W+ v0!
-        v0 -26 bitroll-64 k1 W* v0 bitxor v0!
-    ] unless-empty
-
-    len/4 len/2 bytes uint16_t native-mapper [
-        first k3 W* v0 W+ v0!
-        v0 -48 bitroll-64 k1 W* v0 bitxor v0!
-    ] unless-empty
-
-    bytes len/2 tail-slice [
-        first k3 W* v0 W+ v0!
-        v0 -37 bitroll-64 k1 W* v0 bitxor v0!
-    ] unless-empty
-
-    v0 -28 bitroll-64 v0 bitxor v0!
-    v0 k0 W* v0!
-    v0 -29 bitroll-64 v0 bitxor v0!
-    v0 ;
-
-INSTANCE: metrohash-64 checksum
-
-TUPLE: metrohash-128 seed ;
-
-C: <metrohash-128> metrohash-128
-
-M:: metrohash-128 checksum-bytes ( bytes checksum -- value )
-    0xC83A91E1 :> k0
-    0x8648DBDB :> k1
-    0x7BDEC03B :> k2
-    0x2F5870A5 :> k3
-
-    checksum seed>> :> seed
-    bytes length :> len
-
-    len dup 32 mod - :> len/32
-    len dup 16 mod - :> len/16
-    len dup 8 mod - :> len/8
-    len dup 4 mod - :> len/4
-    len dup 2 mod - :> len/2
-
-    seed k0 W- k3 W* :> v0!
-    seed k1 W+ k2 W* :> v1!
-    seed k0 W+ k2 W* :> v2!
-    seed k1 W- k3 W* :> v3!
-
-    len 32 >= [
-        0 len/32 bytes uint64_t native-mapper 4 <groups> [
-            first4 {
-                [ k0 W* v0 W+ -29 bitroll-64 v2 W+ v0! ]
-                [ k1 W* v1 W+ -29 bitroll-64 v3 W+ v1! ]
-                [ k2 W* v2 W+ -29 bitroll-64 v0 W+ v2! ]
-                [ k3 W* v3 W+ -29 bitroll-64 v1 W+ v3! ]
-            } spread
-        ] each
-
-        v0 v3 W+ k0 W* v1 W+ -21 bitroll-64 k1 W* v2 bitxor v2!
-        v1 v2 W+ k1 W* v0 W+ -21 bitroll-64 k0 W* v3 bitxor v3!
-        v0 v2 W+ k0 W* v3 W+ -21 bitroll-64 k1 W* v0 bitxor v0!
-        v1 v3 W+ k1 W* v2 W+ -21 bitroll-64 k0 W* v1 bitxor v1!
-    ] when
-
-    len/32 len/16 bytes uint64_t native-mapper [
-        first2
-        [ k2 W* v0 W+ -33 bitroll-64 k3 W* v0! ]
-        [ k2 W* v1 W+ -33 bitroll-64 k3 W* v1! ] bi*
-        v0 k2 W* v1 W+ -45 bitroll-64 k1 W* v0 bitxor v0!
-        v1 k3 W* v0 W+ -45 bitroll-64 k0 W* v1 bitxor v1!
-    ] unless-empty
-
-    len/16 len/8 bytes uint64_t native-mapper [
-        first k2 W* v0 W+ -33 bitroll-64 k3 W* v0!
-        v0 k2 W* v1 W+ -27 bitroll-64 k1 W* v0 bitxor v0!
-    ] unless-empty
-
-    len/8 len/4 bytes uint32_t native-mapper [
-        first k2 W* v1 W+ -33 bitroll-64 k3 W* v1!
-        v1 k3 W* v0 W+ -46 bitroll-64 k0 W* v1 bitxor v1!
-    ] unless-empty
-
-    len/4 len/2 bytes uint16_t native-mapper [
-        first k2 W* v0 W+ -33 bitroll-64 k3 W* v0!
-        v0 k2 W* v1 W+ -22 bitroll-64 k1 W* v0 bitxor v0!
-    ] unless-empty
-
-    bytes len/2 tail-slice [
-        first k2 W* v1 W+ -33 bitroll-64 k3 W* v1!
-        v1 k3 W* v0 W+ -58 bitroll-64 k0 W* v1 bitxor v1!
-    ] unless-empty
-
-    v0 k0 W* v1 W+ -13 bitroll-64 v0 W+ v0!
-    v1 k1 W* v0 W+ -37 bitroll-64 v1 W+ v1!
-    v0 k2 W* v1 W+ -13 bitroll-64 v0 W+ v0!
-    v1 k3 W* v0 W+ -37 bitroll-64 v1 W+ v1!
-
-    v0 64 shift v1 + ;
-
-INSTANCE: metrohash-128 checksum

basis/checksums/metrohash/summary.txt

@@ -1 +0,0 @@
-MetroHash checksum algorithm

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

@@ -1,6 +1,7 @@
 ! Copyright (C) 2017 Jon Harper.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: checksums checksums.ripemd strings tools.test ;
+IN: checksums.ripemd.tests
 
 { B{
     0x9c 0x11 0x85 0xa5 0xc5

basis/checksums/ripemd/ripemd.factor

@@ -39,7 +39,7 @@ M: ripemd-160 initialize-checksum-state drop <ripemd-160-state> ;
 : F ( x y z -- out ) bitxor bitxor ;  inline
 : G ( x y z -- out ) pick bitnot swap [ bitand ] 2bi@ bitor ; inline
 : H ( x y z -- out ) [ bitnot bitor ] [ bitxor ] bi* ; inline
-: I ( x y z -- out ) tuck bitnot [ bitand ] 2bi@ bitor ; inline
+: I ( x y z -- out ) swap over bitnot [ bitand ] 2bi@ bitor ; inline
 : J ( x y z -- out ) bitnot bitor bitxor ; inline
 
 CONSTANT: T11 0x00000000

basis/checksums/sha/sha-tests.factor

@@ -3,6 +3,9 @@ checksums.sha.private io.encodings.binary io.streams.byte-array
 kernel math.parser sequences tools.test random ;
 IN: checksums.sha.tests
 
+: test-checksum ( text identifier -- checksum )
+    checksum-bytes bytes>hex-string ;
+
 { "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...
@@ -13,36 +16,36 @@ IN: checksums.sha.tests
 { "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" }
 [
     "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
-    sha-224 checksum-bytes bytes>hex-string
+    sha-224 test-checksum
 ] unit-test
 
 { "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" }
-[ "" sha-256 checksum-bytes bytes>hex-string ] unit-test
+[ "" sha-256 test-checksum ] unit-test
 
 { "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" }
-[ "abc" sha-256 checksum-bytes bytes>hex-string ] unit-test
+[ "abc" sha-256 test-checksum ] unit-test
 
 { "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" }
-[ "message digest" sha-256 checksum-bytes bytes>hex-string ] unit-test
+[ "message digest" sha-256 test-checksum ] unit-test
 
 { "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" }
-[ "abcdefghijklmnopqrstuvwxyz" sha-256 checksum-bytes bytes>hex-string ] unit-test
+[ "abcdefghijklmnopqrstuvwxyz" sha-256 test-checksum ] unit-test
 
 { "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" }
 [
     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
-    sha-256 checksum-bytes bytes>hex-string
+    sha-256 test-checksum
 ] unit-test
 
 { "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" }
 [
     "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
-    sha-256 checksum-bytes bytes>hex-string
+    sha-256 test-checksum
 ] unit-test
 
 
 ! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ]
-! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 checksum-bytes bytes>hex-string ] unit-test
+! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test
 
 {
     t
@@ -84,7 +87,7 @@ CONSTANT: bytes-b B{ 1 2 3 4 5 6 7 8 }
 ERROR: checksums-differ algorithm seq incremental-checksum one-go-checksum ;
 : compare-checksum-calculations ( algorithm seq -- ? )
     2dup [ incremental-checksum ] [ one-go-checksum ] 2bi 2dup = [
-        4drop t
+        2drop 2drop t
     ] [
         checksums-differ
     ] if ;

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

@@ -135,7 +135,7 @@ PRIVATE>
 M: struct-class boa>object
     swap pad-struct-slots
     [ <struct> ] [ struct-slots ] bi
-    [ [ (writer-quot) call( value struct -- ) ] with 2each ] keepd ;
+    [ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
 
 M: struct-class initial-value* <struct> t ; inline
 
@@ -262,7 +262,7 @@ M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inlin
         [
             [ initial>> ]
             [ (writer-quot) ] bi
-            over [ swapd [ call( value struct -- ) ] keepd ] [ 2drop ] if
+            over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
         ] each
     ] [ drop f ] if ;
 

basis/cocoa/cocoa.factor

@@ -1,39 +1,32 @@
 ! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs cocoa.messages compiler.units core-foundation.bundles
+USING: cocoa.messages compiler.units core-foundation.bundles
 hashtables init io kernel lexer namespaces sequences vocabs ;
 IN: cocoa
 
 SYMBOL: sent-messages
 
-sent-messages [ H{ } clone ] initialize
+: (remember-send) ( selector variable -- )
+    [ dupd ?set-at ] change-global ;
 
 : remember-send ( selector -- )
-    dup sent-messages get set-at ;
+    sent-messages (remember-send) ;
 
-SYNTAX: ->
+SYNTAX: -> scan-token dup remember-send suffix! \ send suffix! ;
-    scan-token dup remember-send
-    [ lookup-method suffix! ] [ suffix! ] bi \ send suffix! ;
 
-SYNTAX: ?->
+SYNTAX: ?-> scan-token dup remember-send suffix! \ ?send suffix! ;
-    dup last cache-stubs
-    scan-token dup remember-send
-    suffix! \ send suffix! ;
 
 SYNTAX: SEL:
-    scan-token dup remember-send
+    scan-token
-    <selector> suffix! \ cocoa.messages:selector suffix! ;
+    [ remember-send ]
+    [ <selector> suffix! \ cocoa.messages:selector suffix! ] bi ;
 
 SYMBOL: super-sent-messages
 
-super-sent-messages [ H{ } clone ] initialize
-
 : remember-super-send ( selector -- )
-    dup super-sent-messages get set-at ;
+    super-sent-messages (remember-send) ;
 
-SYNTAX: SUPER->
+SYNTAX: SUPER-> scan-token dup remember-super-send suffix! \ super-send suffix! ;
-    scan-token dup remember-super-send
-    [ lookup-method suffix! ] [ suffix! ] bi \ super-send suffix! ;
 
 SYMBOL: frameworks
 

basis/cocoa/messages/messages-docs.factor

@@ -2,13 +2,13 @@ USING: help.markup help.syntax strings alien ;
 IN: cocoa.messages
 
 HELP: send
-{ $values { "receiver" alien } { "args..." "method arguments" } { "signature" "signature" } { "selector" string } { "return..." "value returned by method, if any" } }
+{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "return..." "value returned by method, if any" } }
 { $description "Sends an Objective C message named by " { $snippet "selector" } " to " { $snippet "receiver" } ". The arguments must be on the stack in left-to-right order." }
 { $errors "Throws an error if the receiver does not recognize the message, or if the arguments have inappropriate types." }
 { $notes "This word uses a special fast code path if " { $snippet "selector" } " is a literal and the word containing the call to " { $link send } " is compiled." } ;
 
 HELP: super-send
-{ $values { "receiver" alien } { "args..." "method arguments" } { "signature" "signature" } { "selector" string } { "return..." "value returned by method, if any" } }
+{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "return..." "value returned by method, if any" } }
 { $description "Sends an Objective C message named by " { $snippet "selector" } " to the super class of " { $snippet "receiver" } ". Otherwise behaves identically to " { $link send } "." } ;
 
 HELP: objc-class

basis/cocoa/messages/messages.factor

@@ -4,8 +4,8 @@ USING: accessors alien alien.c-types alien.data alien.strings
 arrays assocs classes.struct cocoa.runtime cocoa.types
 combinators core-graphics.types fry generalizations
 io.encodings.utf8 kernel layouts libc locals macros make math
-memoize namespaces quotations sequences sets specialized-arrays
+memoize namespaces quotations sequences specialized-arrays
-splitting stack-checker strings words ;
+stack-checker strings words ;
 QUALIFIED-WITH: alien.c-types c
 IN: cocoa.messages
 
@@ -44,11 +44,7 @@ super-message-senders [ H{ } clone ] initialize
 
 TUPLE: selector-tuple name object ;
 
-: selector-name ( name -- name' )
+MEMO: <selector> ( name -- sel ) f \ selector-tuple boa ;
-    CHAR: . over index [ 0 > [ "." split1 nip ] when ] when* ;
-
-MEMO: <selector> ( name -- sel )
-    selector-name f selector-tuple boa ;
 
 : selector ( selector -- alien )
     dup object>> expired? [
@@ -67,24 +63,38 @@ objc-methods [ H{ } clone ] initialize
 
 ERROR: no-objc-method name ;
 
-: ?lookup-method ( selector -- signature/f )
+: ?lookup-method ( selector -- method/f )
     objc-methods get at ;
 
-: lookup-method ( selector -- signature )
+: lookup-method ( selector -- method )
     dup ?lookup-method [ ] [ no-objc-method ] ?if ;
 
-MEMO: make-prepare-send ( selector signature super? -- quot )
+: lookup-sender ( name -- method )
+    lookup-method message-senders get at ;
+
+MEMO: make-prepare-send ( selector method super? -- quot )
     [
         [ \ <super> , ] when swap <selector> , \ selector ,
-    ] [ ] make swap second length 2 - '[ _ _ ndip ] ;
+    ] [ ] make
+    swap second length 2 - '[ _ _ ndip ] ;
 
-MACRO: (send) ( signature selector super? -- quot )
+MACRO: (send) ( selector super? -- quot )
-    swapd [ make-prepare-send ] 2keep
+    [ dup lookup-method ] dip
-    super-message-senders message-senders ? get at suffix ;
+    [ make-prepare-send ] 2keep
+    super-message-senders message-senders ? get at
+    1quotation append ;
 
-: send ( receiver args... signature selector -- return... ) f (send) ; inline
+: send ( receiver args... selector -- return... ) f (send) ; inline
 
-: super-send ( receiver args... signature selector -- return... ) t (send) ; inline
+MACRO:: (?send) ( effect selector super? -- quot )
+    selector dup ?lookup-method effect or super?
+    [ make-prepare-send ] 2keep
+    super-message-senders message-senders ? get at
+    [ 1quotation append ] [ effect selector sender-stub 1quotation append ] if* ;
+
+: ?send ( receiver args... selector effect -- return... ) f (?send) ; inline
+
+: super-send ( receiver args... selector -- return... ) t (send) ; inline
 
 ! Runtime introspection
 SYMBOL: class-init-hooks
@@ -126,7 +136,6 @@ H{
     { "@" id }
     { "#" Class }
     { ":" SEL }
-    { "(" c:void* }
 }
 cell {
     { 4 [ H{
@@ -222,33 +231,19 @@ ERROR: no-objc-type name ;
     [ utf8 alien>string parse-objc-type ] keep
     (free) ;
 
-: method-signature ( method -- signature )
-    [ method-return-type ] [ method-arg-types ] bi 2array ;
-
 : method-name ( method -- name )
     method_getName sel_getName ;
 
-:: register-objc-method ( classname method -- )
+: register-objc-method ( method -- )
-    method method-signature :> signature
+    [ method-name ]
-    method method-name :> name
+    [ [ method-return-type ] [ method-arg-types ] bi 2array ] bi
-    classname "." name 3append :> fullname
+    [ nip cache-stubs ] [ swap objc-methods get set-at ] 2bi ;
-    signature cache-stubs
-    signature name objc-methods get set-at
-    signature fullname objc-methods get set-at ;
 
-: method-collisions ( -- collisions )
+: each-method-in-class ( class quot -- )
-    objc-methods get >alist
+    [ { uint } [ class_copyMethodList ] with-out-parameters ] dip
-    [ first CHAR: . swap member? ] filter
+    over 0 = [ 3drop ] [
-    [ first "." split1 nip ] collect-by
-    [ nip values members length 1 > ] assoc-filter ;
-
-: each-method-in-class ( class quot: ( classname method -- ) -- )
-    [
-        [ class_getName ] keep
-        { uint } [ class_copyMethodList ] with-out-parameters
-    ] dip over 0 = [ 4drop ] [
         [ void* <c-direct-array> ] dip
-        [ with each ] [ drop (free) ] 2bi
+        [ each ] [ drop (free) ] 2bi
     ] if ; inline
 
 : register-objc-methods ( class -- )

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/colors/cmyk/tags.txt

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

basis/colors/constants/tags.txt

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

basis/colors/gray/gray.factor

@@ -7,7 +7,7 @@ TUPLE: gray < color { gray read-only } { alpha read-only } ;
 
 C: <gray> gray
 
-M: gray >rgba
+M: gray >rgba ( gray -- rgba )
     [ gray>> dup dup ] [ alpha>> ] bi <rgba> ; inline
 
 M: gray red>> gray>> ;

basis/colors/gray/tags.txt

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

basis/colors/hex/hex.factor

@@ -6,15 +6,12 @@ lexer math math.parser sequences ;
 
 IN: colors.hex
 
-ERROR: invalid-hex-color hex ;
-
 : hex>rgba ( hex -- rgba )
     dup length {
         { 6 [ 2 group [ hex> 255 /f ] map first3 1.0 ] }
         { 8 [ 2 group [ hex> 255 /f ] map first4 ] }
         { 3 [ [ digit> 15 /f ] { } map-as first3 1.0 ] }
         { 4 [ [ digit> 15 /f ] { } map-as first4 ] }
-        [ drop invalid-hex-color ]
     } case <rgba> ;
 
 : rgba>hex ( rgba -- hex )

basis/colors/hex/tags.txt

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

basis/colors/hsl/tags.txt

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

basis/colors/hsv/hsv.factor

@@ -29,7 +29,7 @@ C: <hsva> hsva
 
 PRIVATE>
 
-M: hsva >rgba
+M: hsva >rgba ( hsva -- rgba )
     [
         dup Hi
         {

basis/colors/hsv/tags.txt

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

basis/colors/lab/tags.txt

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

basis/colors/lch/tags.txt

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

basis/colors/luv/tags.txt

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

basis/colors/mix/tags.txt

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

basis/colors/ryb/tags.txt

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

basis/colors/tags.txt

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

basis/colors/xyy/tags.txt

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

basis/colors/xyz/tags.txt

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

basis/colors/yiq/tags.txt

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

basis/colors/yuv/tags.txt

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

basis/command-line/command-line-docs.factor

@@ -1,11 +1,11 @@
-USING: help.markup help.syntax io.pathnames strings system vocabs vocabs.loader ;
+USING: help.markup help.syntax strings system vocabs vocabs.loader ;
 IN: command-line
 
 HELP: run-bootstrap-init
-{ $description "Runs the bootstrap initialization file in the user's " { $link home } " directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } "." } ;
+{ $description "Runs the bootstrap initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } "." } ;
 
 HELP: run-user-init
-{ $description "Runs the startup initialization file in the user's " { $link home } " directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } "." } ;
+{ $description "Runs the startup initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } "." } ;
 
 HELP: load-vocab-roots
 { $description "Loads the newline-separated list of additional vocabulary roots from the file named " { $snippet ".factor-roots" } "." } ;
@@ -91,7 +91,6 @@ $nl
 ARTICLE: "standard-cli-args" "Command line switches for general usage"
 "The following command line switches can be passed to a bootstrapped Factor image:"
 { $table
-    { { $snippet "-help" } { "Show help for the command line switches." } }
     { { $snippet "-e=" { $emphasis "code" } } { "This specifies a code snippet to evaluate and then exit Factor." } }
     { { $snippet "-run=" { $emphasis "vocab" } } { { $snippet { $emphasis "vocab" } } " is the name of a vocabulary with a " { $link POSTPONE: MAIN: } " hook to run on startup, for example " { $vocab-link "listener" } " or " { $vocab-link "ui.tools" } "." } }
     { { $snippet "-no-user-init" } { "Inhibits the running of user initialization files on startup. See " { $link "rc-files" } "." } }
@@ -117,7 +116,7 @@ $nl
 { $subsections load-vocab-roots } ;
 
 ARTICLE: "rc-files" "Running code on startup"
-"Factor looks for three optional files in the user's " { $link home } " directory."
+"Factor looks for three optional files in your home directory."
 { $subsections
     ".factor-boot-rc"
     ".factor-rc"
@@ -125,6 +124,12 @@ ARTICLE: "rc-files" "Running code on startup"
 }
 "The " { $snippet "-no-user-init" } " command line switch will inhibit loading running of these files."
 $nl
+"If you are unsure where the files should be located, evaluate the following code:"
+{ $code
+    "USE: command-line"
+    "\".factor-rc\" rc-path print"
+    "\".factor-boot-rc\" rc-path print"
+}
 "Here is an example " { $snippet ".factor-boot-rc" } " which sets up your developer name:"
 { $code
     "USING: tools.scaffold namespaces ;"
@@ -133,8 +138,8 @@ $nl
 
 ARTICLE: "command-line" "Command line arguments"
 "Factor command line usage:"
-{ $code "factor [options] [script] [arguments]" }
+{ $code "factor [VM args...] [script] [args...]" }
-"Zero or more options can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup using " { $link run-script } ". Any arguments after the script file are stored in the following variable, with no further processing by Factor itself:"
+"Zero or more VM arguments can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup using " { $link run-script } ". Any arguments after the script file are stored in the following variable, with no further processing by Factor itself:"
 { $subsections command-line }
 "Instead of running a script, it is also possible to run a vocabulary; this invokes the vocabulary's " { $link POSTPONE: MAIN: } " word:"
 { $code "factor [system switches...] -run=<vocab name>" }

basis/command-line/command-line.factor

@@ -24,6 +24,9 @@ SYMBOL: command-line
 : (command-line) ( -- args )
     OBJ-ARGS special-object sift [ alien>native-string ] map ;
 
+: rc-path ( name -- path )
+    home prepend-path ;
+
 : try-user-init ( file -- )
     "user-init" get swap '[
         _ [ ?run-file ] [
@@ -34,14 +37,14 @@ SYMBOL: command-line
     ] when ;
 
 : run-bootstrap-init ( -- )
-    "~/.factor-boot-rc" try-user-init ;
+    ".factor-boot-rc" rc-path try-user-init ;
 
 : run-user-init ( -- )
-    "~/.factor-rc" try-user-init ;
+    ".factor-rc" rc-path try-user-init ;
 
 : load-vocab-roots ( -- )
     "user-init" get [
-        "~/.factor-roots" dup exists? [
+        ".factor-roots" rc-path dup exists? [
             utf8 file-lines harvest [ add-vocab-root ] each
         ] [ drop ] if
         "roots" get [

basis/command-line/startup/startup.factor

@@ -1,62 +1,56 @@
 ! Copyright (C) 2011 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators command-line eval io io.pathnames kernel
+USING: command-line eval io io.pathnames kernel namespaces
-layouts math math.parser namespaces system vocabs.loader ;
+sequences system vocabs.loader ;
 IN: command-line.startup
 
-: help? ( -- ? )
+: cli-usage ( -- )
-    "help" get "h" get or
+"Usage: " write vm-path file-name write " [Factor arguments] [script] [script arguments]
-    os windows? [ script get "/?" = or ] when ;
 
-: help. ( -- )
+Factor arguments:
-"Usage: " write vm-path file-name write " [options] [script] [arguments]
-
-Options:
     -help               print this message and exit
-    -version            print the Factor version and exit
+    -i=<image>          load Factor image file <image> (default " write vm-path file-stem write ".image)
-    -i=<image>          load Factor image file <image> [" write vm-path file-stem write ".image]
     -run=<vocab>        run the MAIN: entry point of <vocab>
         -run=listener   run terminal listener
         -run=ui.tools   run Factor development UI
     -e=<code>           evaluate <code>
     -no-user-init       suppress loading of .factor-rc
-    -datastack=<int>    datastack size in KiB [" write cell 32 * number>string write "]
+    -datastack=<int>    datastack size in KiB
-    -retainstack=<int>  retainstack size in KiB [" write cell 32 * number>string write "]
+    -retainstack=<int>  retainstack size in KiB
-    -callstack=<int>    callstack size in KiB [" write cell cpu ppc? 256 128 ? * number>string write "]
+    -callstack=<int>    callstack size in KiB
-    -callbacks=<int>    callback heap size in KiB [256]
+    -callbacks=<int>    callback heap size in KiB
-    -young=<int>        young gc generation 0 size in MiB [" write cell 4 / number>string write "]
+    -young=<int>        young gc generation 0 size in MiB
-    -aging=<int>        aging gc generation 1 size in MiB [" write cell 2 / number>string write "]
+    -aging=<int>        aging gc generation 1 size in MiB
-    -tenured=<int>      tenured gc generation 2 size in MiB [" write cell 24 * number>string write "]
+    -tenured=<int>      tenured gc generation 2 size in MiB
-    -codeheap=<int>     codeheap size in MiB [64]
+    -codeheap=<int>     codeheap size in MiB
-    -pic=<int>          max pic size [3]
+    -pic=<int>          max pic size
     -fep                enter fep mode immediately
     -no-signals         turn off OS signal handling
-    -roots=<paths>      '" write os windows? ";" ":" ? write "'-separated list of extra vocab root directories
+    -console            open console if possible
+    -roots=<paths>      a list of \"" write os windows? ";" ":" ? write "\"-delimited extra vocab roots
 
 Enter
     \"command-line\" help
 from within Factor for more information.
+
 " write ;
 
-: version? ( -- ? ) "version" get ;
+: help? ( -- ? )
-
+    "help" get "h" get or
-: version. ( -- ) "Factor " write vm-version print ;
+    os windows? [ script get "/?" = or ] when ;
 
 : command-line-startup ( -- )
-    (command-line) parse-command-line {
+    (command-line) parse-command-line
-        { [ help? ] [ help. ] }
+    help? [ cli-usage ] [
-        { [ version? ] [ version. ] }
+        load-vocab-roots
-        [
+        run-user-init
-            load-vocab-roots
+        "e" get script get or [
-            run-user-init
+            "e" get [ eval( -- ) ] when*
-            "e" get script get or [
+            script get [ run-script ] when*
-                "e" get [ eval( -- ) ] when*
+        ] [
-                script get [ run-script ] when*
+            "run" get run
-            ] [
+        ] if
-                "run" get run
+    ] if
-            ] if
-        ]
-    } cond
 
     output-stream get [ stream-flush ] when*
     0 exit ;

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

@@ -15,8 +15,6 @@ IN: compiler.cfg.builder.alien
         0 stack-params set
         V{ } clone reg-values set
         V{ } clone stack-values set
-        0 int-reg-reps set
-        0 float-reg-reps set
         @
         reg-values get
         stack-values get
@@ -95,7 +93,7 @@ IN: compiler.cfg.builder.alien
         [ stack-params get [ caller-stack-cleanup ] keep ]
     } cleave ;
 
-M: #alien-invoke emit-node
+M: #alien-invoke emit-node ( block node -- block' )
     params>>
     [
         [ params>alien-insn-params ]
@@ -104,7 +102,7 @@ M: #alien-invoke emit-node
     ]
     [ caller-return ] bi ;
 
-M: #alien-indirect emit-node
+M: #alien-indirect emit-node ( block node -- block' )
     params>>
     [
         [ ds-pop ^^unbox-any-c-ptr ] dip
@@ -113,7 +111,7 @@ M: #alien-indirect emit-node
     ]
     [ caller-return ] bi ;
 
-M: #alien-assembly emit-node
+M: #alien-assembly emit-node ( block node -- block' )
     params>>
     [
         [ params>alien-insn-params ]
@@ -167,7 +165,7 @@ M: #alien-assembly emit-node
 : emit-callback-outputs ( block params -- )
     [ emit-callback-return ] keep callback-stack-cleanup ;
 
-M: #alien-callback emit-node
+M: #alien-callback emit-node ( block node -- block' )
     dup params>> xt>> dup
     [
         t cfg get frame-pointer?<<

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

@@ -10,30 +10,19 @@ IN: compiler.cfg.builder.alien.boxing
 
 SYMBOL: struct-return-area
 
-SYMBOLS: int-reg-reps float-reg-reps ;
-
-: reg-reps ( reps -- int-reps float-reps )
-    [ second ] reject [ [ first int-rep? ] count ] [ length over - ] bi ;
-
-: record-reg-reps ( reps -- reps )            
-    dup reg-reps [ int-reg-reps +@ ] [ float-reg-reps +@ ] bi* ;
-
-: unrecord-reg-reps ( reps -- reps )
-    dup reg-reps [ neg int-reg-reps +@ ] [ neg float-reg-reps +@ ] bi* ;
-
 GENERIC: flatten-c-type ( c-type -- pairs )
 
 M: c-type flatten-c-type
-    rep>> f f 3array 1array record-reg-reps ;
+    rep>> f f 3array 1array ;
 
 M: long-long-type flatten-c-type
-    drop 2 [ int-rep long-long-on-stack? f 3array ] replicate record-reg-reps ;
+    drop 2 [ int-rep long-long-on-stack? f 3array ] replicate ;
 
 HOOK: flatten-struct-type cpu ( type -- pairs )
 HOOK: flatten-struct-type-return cpu ( type -- pairs )
 
 M: object flatten-struct-type
-    heap-size cell align cell /i { int-rep f f } <array> record-reg-reps ;
+    heap-size cell align cell /i { int-rep f f } <array> ;
 
 M: struct-c-type flatten-c-type
     flatten-struct-type ;
@@ -81,14 +70,14 @@ M: c-type unbox
             [ swap ^^unbox ]
         } case 1array
     ]
-    [ drop f f 3array 1array ] 2bi record-reg-reps ;
+    [ drop f f 3array 1array ] 2bi ;
 
 M: long-long-type unbox
     [ next-vreg next-vreg 2dup ] 2dip unboxer>> ##unbox-long-long, 2array
     int-rep long-long-on-stack? long-long-odd-register? 3array
-    int-rep long-long-on-stack? f 3array 2array record-reg-reps ;
+    int-rep long-long-on-stack? f 3array 2array ;
 
-M: struct-c-type unbox
+M: struct-c-type unbox ( src c-type -- vregs reps )
     [ ^^unbox-any-c-ptr ] dip explode-struct ;
 
 : frob-struct ( c-type -- c-type )

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

@@ -8,11 +8,11 @@ SYMBOL: stack-params
 
 GENERIC: alloc-stack-param ( rep -- n )
 
-M: object alloc-stack-param
+M: object alloc-stack-param ( rep -- n )
     stack-params get
     [ rep-size cell align stack-params +@ ] dip ;
 
-M: float-rep alloc-stack-param
+M: float-rep alloc-stack-param ( rep -- n )
     stack-params get swap rep-size
     [ cell align stack-params +@ ] keep
     float-right-align-on-stack? [ + ] [ drop ] if ;

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

@@ -1,7 +1,7 @@
-USING: arrays assocs compiler.cfg compiler.cfg.builder.blocks
+USING: assocs compiler.cfg compiler.cfg.builder.blocks
-compiler.cfg.instructions compiler.cfg.stacks.local
+compiler.cfg.instructions compiler.cfg.stacks.local compiler.tree
-compiler.tree help.markup help.syntax kernel literals math
+help.markup help.syntax kernel literals math multiline quotations
-multiline quotations sequences vectors words ;
+sequences vectors words ;
 IN: compiler.cfg.builder
 
 <<
@@ -78,7 +78,7 @@ HELP: emit-loop-call
 
 HELP: emit-node
 { $values { "block" basic-block } { "node" node } { "block'" basic-block } }
-{ $description "Emits CFG instructions for the given SSA node. The word can add one or more basic blocks to the " { $link cfg } ". The next block to operate on is pushed onto the stack."
+{ $description "Emits CFG instructions for the given SSA node. The word can add one or more basic blocks to the " { $link cfg } ". The next block to operate on is pushed onto the stack. "
 $nl
 "The following classes emit-node methods does not change the current block:"
   { $list
@@ -104,7 +104,7 @@ HELP: end-word
 { $description "Ends the word by adding a basic block containing a " { $link ##return } " instructions to the " { $link cfg } "." } ;
 
 HELP: height-changes
-{ $values { "#shuffle" #shuffle } { "height-changes" pair } }
+{ $values { "#shuffle" #shuffle } { "height-changes" sequence } }
 { $description "Returns a two-tuple which represents how much the " { $link #shuffle } " node increases or decreases the data and retainstacks." }
 { $examples
   { $example
@@ -115,7 +115,7 @@ HELP: height-changes
 } ;
 
 HELP: out-vregs/stack
-{ $values { "#shuffle" #shuffle } { "pair" sequence } }
+{ $values { "#shuffle" #shuffle } { "seq" sequence } }
 { $description "Returns a sequence of what vregs are on which stack locations after the shuffle instruction." } ;
 
 HELP: trivial-branch?

basis/compiler/cfg/builder/builder.factor

@@ -71,7 +71,7 @@ GENERIC: emit-node ( block node -- block' )
     ##branch, [ begin-basic-block ] dip
     [ label>> id>> loops get set-at ] [ child>> emit-nodes ] 2bi ;
 
-M: #recursive emit-node
+M: #recursive emit-node ( block node -- block' )
     dup label>> loop?>> [ emit-loop ] [ emit-recursive ] if ;
 
 ! #if
@@ -109,28 +109,28 @@ M: #recursive emit-node
     ! loc>vreg sync
     ds-pop any-rep ^^copy f cc/= ##compare-imm-branch, emit-if ;
 
-M: #if emit-node
+M: #if emit-node ( block node -- block' )
     {
         { [ dup trivial-if? ] [ drop emit-trivial-if ] }
         { [ dup trivial-not-if? ] [ drop emit-trivial-not-if ] }
         [ emit-actual-if ]
     } cond ;
 
-M: #dispatch emit-node
+M: #dispatch emit-node ( block node -- block' )
     ! Inputs to the final instruction need to be copied because of
     ! loc>vreg sync. ^^offset>slot always returns a fresh vreg,
     ! though.
     ds-pop ^^offset>slot next-vreg ##dispatch, emit-if ;
 
-M: #call emit-node
+M: #call emit-node ( block node -- block' )
     dup word>> dup "intrinsic" word-prop [
         nip call( block #call -- block' )
     ] [ swap call-height emit-call ] if* ;
 
-M: #call-recursive emit-node
+M: #call-recursive emit-node ( block node -- block' )
     [ label>> id>> ] [ call-height ] bi emit-call ;
 
-M: #push emit-node
+M: #push emit-node ( block node -- block )
     literal>> ^^load-literal ds-push ;
 
 ! #shuffle
@@ -157,7 +157,7 @@ M: #push emit-node
     [ make-input-map ] [ mapping>> ] [ extract-outputs ] tri
     [ [ of of peek-loc ] 2with map ] 2with map ;
 
-M: #shuffle emit-node
+M: #shuffle emit-node ( block node -- block )
     [ out-vregs/stack ] keep store-height-changes
     first2 [ ds-loc store-vregs ] [ rs-loc store-vregs ] bi* ;
 
@@ -167,14 +167,14 @@ M: #shuffle emit-node
     t >>kill-block?
     ##safepoint, ##epilogue, ##return, ;
 
-M: #return emit-node
+M: #return emit-node ( block node -- block' )
     drop end-word ;
 
-M: #return-recursive emit-node
+M: #return-recursive emit-node ( block node -- block' )
     label>> id>> loops get key? [ ] [ end-word ] if ;
 
 ! #terminate
-M: #terminate emit-node
+M: #terminate emit-node ( block node -- block' )
     drop ##no-tco, end-basic-block f ;
 
 ! No-op nodes

basis/compiler/cfg/cfg-docs.factor

@@ -7,46 +7,46 @@ IN: compiler.cfg
 HELP: basic-block
 { $class-description
   "Factors representation of a basic block in the Call Flow Graph (CFG). A basic block is a sequence of instructions that always are executed sequentially and doesn't contain any internal branching. It has the following slots:"
-  { $slots
+  { $table
     {
-        "number"
+        { $slot "number" }
-        { "The blocks sequence number. Generated by calling " { $link number-blocks } "." }
+        { "The blocks sequence number. Generated by calling " { $link number-blocks } ". " }
     }
     {
-        "successors"
+        { $slot "successors" }
         { "A " { $link vector } " of basic blocks that may be executed directly after this block. Most blocks only have one successor but a block that checks where an if-condition should branch to would have two for example." }
     }
     {
-        "predecessors"
+        { $slot "predecessors" }
         { "The opposite of successors -- a " { $link vector } " of basic blocks from which the execution may have arrived into this block." }
     }
     {
-        "instructions"
+        { $slot "instructions" }
         { "A " { $link vector } " of " { $link insn } " tuples which form the instructions of the basic block." }
     }
     {
-        "kill-block?"
+        { $slot "kill-block?" }
         { "The first and the last block in a cfg and all blocks containing " { $link ##call } " instructions are kill blocks. Kill blocks can't be optimized so they are omitted from certain optimization steps." }
     }
     {
-        "height"
+        { $slot "height" }
         "Block's height as a " { $link height-state } ". What the heights of the block was at entry and how much they were increased in the block."
     }
     {
-        "replaces"
+        { $slot "replaces" }
         { "Used by " { $vocab-link "compiler.cfg.stacks.local" } " for local stack analysis." }
     }
     {
-        "peeks"
+        { $slot "peeks" }
         { "Used by " { $vocab-link "compiler.cfg.stacks.local" } " for local stack analysis." }
     }
     {
-        "kills"
+        { $slot "kills" }
         { "Used by " { $vocab-link "compiler.cfg.stacks.local" } " for local stack analysis." }
     }
   }
 }
-{ $notes "A basic-block is an " { $link identity-tuple } " because it is used as a hash table key by the compiler." } ;
+{ $notes "A basic-block is an " { $link identity-tuple } " becase it is used as a hash table key by the compiler." } ;
 
 HELP: <basic-block>
 { $values { "bb" basic-block } }
@@ -60,12 +60,12 @@ HELP: <cfg>
 HELP: cfg
 { $class-description
   "Call flow graph. It has the following slots:"
-  { $slots
+  { $table
-    { "entry" { "Root " { $link basic-block } " of the graph." } }
+    { { $slot "entry" } { "Root " { $link basic-block } " of the graph." } }
-    { "word" { "The " { $link word } " the cfg is produced from." } }
+    { { $slot "word" } { "The " { $link word } " the cfg is produced from." } }
-    { "post-order" { "The blocks of the cfg in a post order traversal " { $link sequence } "." } }
+    { { $slot "post-order" } { "The blocks of the cfg in a post order traversal " { $link sequence } "." } }
-    { "stack-frame" { { $link stack-frame } " of the cfg." } }
+    { { $slot "stack-frame" } { { $link stack-frame } " of the cfg." } }
-    { "frame-pointer?" { "Whether the cfg needs a frame pointer. Only cfgs generated for " { $link #alien-callback } " nodes does need it. If the slot is " { $link t } ", then the frame pointer register (" { $link RBP } " on x86.64 archs) will not be clobbered by register allocation. See " { $vocab-link "compiler.cfg.linear-scan" } " for details." } }
+    { { $slot "frame-pointer?" } { "Whether the cfg needs a frame pointer. Only cfgs generated for " { $link #alien-callback } " nodes does need it. If the slot is " { $link t } ", then the frame pointer register (" { $link RBP } " on x86.64 archs) will not be clobbered by register allocation. See " { $vocab-link "compiler.cfg.linear-scan" } " for details." } }
   }
 }
 { $see-also <cfg> post-order } ;