From: Alex Chapman Date: Fri, 30 Jan 2009 10:20:28 +0000 (+1100) Subject: Merge branch 'master' into experimental X-Git-Tag: 0.94~2132^2~25 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=da7a6da6a54ded7382979b618a3437a5e55f1974;hp=4e41211399df7523acd9e5fb9d4dd71ac3140727 Merge branch 'master' into experimental Conflicts: basis/http/client/client.factor --- diff --git a/.gitignore b/.gitignore index f4334f3727..a7cbeeeef3 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,4 @@ logs work build-support/wordsize *.bak +.#* diff --git a/Factor.app/Contents/Info.plist b/Factor.app/Contents/Info.plist index a8943d0d32..c87520d0fd 100644 --- a/Factor.app/Contents/Info.plist +++ b/Factor.app/Contents/Info.plist @@ -32,7 +32,7 @@ CFBundlePackageType APPL NSHumanReadableCopyright - Copyright © 2003-2008, Slava Pestov and friends + Copyright © 2003-2009, Slava Pestov and friends NSServices diff --git a/Makefile b/Makefile index ffcbf6364c..b41e756729 100644 --- a/Makefile +++ b/Makefile @@ -3,6 +3,7 @@ AR = ar LD = ld EXECUTABLE = factor +CONSOLE_EXECUTABLE = factor-console VERSION = 0.92 IMAGE = factor.image @@ -25,23 +26,25 @@ ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION) DLL_OBJS = $(PLAF_DLL_OBJS) \ vm/alien.o \ vm/bignum.o \ + vm/callstack.o \ + vm/code_block.o \ + vm/code_gc.o \ vm/code_heap.o \ + vm/data_gc.o \ + vm/data_heap.o \ vm/debug.o \ + vm/errors.o \ vm/factor.o \ vm/ffi_test.o \ vm/image.o \ vm/io.o \ vm/math.o \ - vm/data_gc.o \ - vm/code_gc.o \ vm/primitives.o \ + vm/profiler.o \ + vm/quotations.o \ vm/run.o \ - vm/callstack.o \ vm/types.o \ - vm/quotations.o \ - vm/utilities.o \ - vm/errors.o \ - vm/profiler.o + vm/utilities.o EXE_OBJS = $(PLAF_EXE_OBJS) @@ -136,9 +139,11 @@ zlib1.dll: winnt-x86-32: freetype6.dll zlib1.dll $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 + $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 winnt-x86-64: $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64 + $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64 wince-arm: $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm @@ -159,6 +164,11 @@ factor: $(DLL_OBJS) $(EXE_OBJS) $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ $(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS) +factor-console: $(DLL_OBJS) $(EXE_OBJS) + $(LINKER) $(ENGINE) $(DLL_OBJS) + $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ + $(CFLAGS) $(CFLAGS_CONSOLE) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS) + clean: rm -f vm/*.o rm -f factor*.dll libfactor.{a,so,dylib} diff --git a/basis/alias/alias-docs.factor b/basis/alias/alias-docs.factor deleted file mode 100644 index 3f2eee6460..0000000000 --- a/basis/alias/alias-docs.factor +++ /dev/null @@ -1,26 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel words help.markup help.syntax ; -IN: alias - -HELP: ALIAS: -{ $syntax "ALIAS: new-word existing-word" } -{ $values { "new-word" word } { "existing-word" word } } -{ $description "Creates a " { $snippet "new" } " inlined word that calls the " { $snippet "existing" } " word." } -{ $examples - { $example "USING: alias prettyprint sequences ;" - "IN: alias.test" - "ALIAS: sequence-nth nth" - "0 { 10 20 30 } sequence-nth ." - "10" - } -} ; - -ARTICLE: "alias" "Word aliasing" -"The " { $vocab-link "alias" } " vocabulary implements a way to make many different names for the same word. Although creating new names for words is generally frowned upon, aliases are useful for the Win32 API and other cases where words need to be renamed for symmetry." $nl -"Make a new word that aliases another word:" -{ $subsection define-alias } -"Make an alias at parse-time:" -{ $subsection POSTPONE: ALIAS: } ; - -ABOUT: "alias" diff --git a/basis/alias/alias.factor b/basis/alias/alias.factor deleted file mode 100644 index 4de4d833fa..0000000000 --- a/basis/alias/alias.factor +++ /dev/null @@ -1,18 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors words quotations kernel effects sequences parser ; -IN: alias - -PREDICATE: alias < word "alias" word-prop ; - -M: alias reset-word - [ call-next-method ] [ f "alias" set-word-prop ] bi ; - -M: alias stack-effect - def>> first stack-effect ; - -: define-alias ( new old -- ) - [ 1quotation define-inline ] - [ drop t "alias" set-word-prop ] 2bi ; - -: ALIAS: CREATE-WORD scan-word define-alias ; parsing diff --git a/basis/alias/authors.txt b/basis/alias/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/alias/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/alias/summary.txt b/basis/alias/summary.txt deleted file mode 100644 index 15690a7b9b..0000000000 --- a/basis/alias/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Defining multiple words with the same name diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 31542b2699..40171f56e7 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -8,10 +8,6 @@ sequences system libc alien.strings io.encodings.utf8 ; [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test -: foo ( -- n ) &: fdafd [ 123 ] unless* ; - -[ 123 ] [ foo ] unit-test - [ -1 ] [ -1 *char ] unit-test [ -1 ] [ -1 *short ] unit-test [ -1 ] [ -1 *int ] unit-test diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index ae148e3ac0..d1354cb04e 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -234,17 +234,16 @@ M: long-long-type box-return ( type -- ) f swap box-parameter ; : define-deref ( name -- ) - [ CHAR: * prefix "alien.c-types" create ] - [ c-getter 0 prefix ] bi - define-inline ; + [ CHAR: * prefix "alien.c-types" create ] [ c-getter 0 prefix ] bi + (( c-ptr -- value )) define-inline ; : define-out ( name -- ) [ "alien.c-types" constructor-word ] - [ dup c-setter '[ _ [ 0 @ ] keep ] ] - bi define-inline ; + [ dup c-setter '[ _ [ 0 @ ] keep ] ] bi + (( value -- c-ptr )) define-inline ; : c-bool> ( int -- ? ) - zero? not ; + 0 = not ; inline : define-primitive-type ( type name -- ) [ typedef ] diff --git a/basis/alien/remote-control/remote-control-tests.factor b/basis/alien/remote-control/remote-control-tests.factor new file mode 100644 index 0000000000..8b6c5e9b22 --- /dev/null +++ b/basis/alien/remote-control/remote-control-tests.factor @@ -0,0 +1,44 @@ +USING: interpolate multiline +io io.directories io.encodings.ascii io.files +io.files.temp io.launcher io.streams.string kernel locals system +tools.test sequences ; +IN: alien.remote-control.tests + +: compile-file ( contents -- ) + "test.c" ascii set-file-contents + { "gcc" "-I../" "-L.." "-lfactor" "test.c" } + os macosx? cpu x86.64? and [ "-m64" suffix ] when + try-process ; + +: run-test ( -- line ) + os windows? "temp/a.exe" "temp/a.out" ? + ascii [ readln ] with-process-reader ; + +:: test-embedding ( code -- line ) + image :> image + + [ + I[ +#include +#include +#include + +int main(int argc, char **argv) +{ + F_PARAMETERS p; + default_parameters(&p); + p.image_path = STRING_LITERAL("${image}"); + init_factor(&p); + start_embedded_factor(&p); + ${code} + printf("Done.\n"); + return 0; +} + ]I + ] with-string-writer + "resource:temp" [ compile-file ] with-directory + "resource:" [ run-test ] with-directory ; + +! [ "Done." ] [ "" test-embedding ] unit-test + +! [ "Done." ] [ "factor_yield();" test-embedding ] unit-test \ No newline at end of file diff --git a/basis/alien/remote-control/remote-control.factor b/basis/alien/remote-control/remote-control.factor index 9cd9050ea8..4da06ec4c9 100644 --- a/basis/alien/remote-control/remote-control.factor +++ b/basis/alien/remote-control/remote-control.factor @@ -15,7 +15,7 @@ IN: alien.remote-control "void" { "long" } "cdecl" [ sleep ] alien-callback ; : ?callback ( word -- alien ) - dup compiled>> [ execute ] [ drop f ] if ; inline + dup optimized>> [ execute ] [ drop f ] if ; inline : init-remote-control ( -- ) \ eval-callback ?callback 16 setenv diff --git a/basis/alien/strings/windows/tags.txt b/basis/alien/strings/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/alien/strings/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor index abce91f56f..f5537fa239 100644 --- a/basis/alien/structs/fields/fields.factor +++ b/basis/alien/structs/fields/fields.factor @@ -52,8 +52,8 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ; [ (>>offset) ] [ type>> heap-size + ] 2bi ] reduce ; -: define-struct-slot-word ( word quot spec -- ) - offset>> prefix define-inline ; +: define-struct-slot-word ( word quot spec effect -- ) + [ offset>> prefix ] dip define-inline ; : define-getter ( type spec -- ) [ set-reader-props ] keep @@ -62,11 +62,13 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ; type>> [ c-getter ] [ c-type-boxer-quot ] bi append ] - [ ] tri define-struct-slot-word ; + [ ] tri + (( c-ptr -- value )) define-struct-slot-word ; : define-setter ( type spec -- ) [ set-writer-props ] keep - [ writer>> ] [ type>> c-setter ] [ ] tri define-struct-slot-word ; + [ writer>> ] [ type>> c-setter ] [ ] tri + (( value c-ptr -- )) define-struct-slot-word ; : define-field ( type spec -- ) [ define-getter ] [ define-setter ] 2bi ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index 15d82884f9..bed454e81d 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -4,7 +4,7 @@ USING: accessors arrays alien alien.c-types alien.structs alien.arrays alien.strings kernel math namespaces parser sequences words quotations math.parser splitting grouping effects assocs combinators lexer strings.parser alien.parser -fry ; +fry vocabs.parser words.constant ; IN: alien.syntax : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing @@ -31,10 +31,11 @@ IN: alien.syntax : C-ENUM: ";" parse-tokens - dup length - [ [ create-in ] dip 1quotation define ] 2each ; + [ [ create-in ] dip define-constant ] each-index ; parsing +: address-of ( name library -- value ) + load-library dlsym [ "No such symbol" throw ] unless* ; + : &: - scan "c-library" get - '[ _ _ load-library dlsym ] over push-all ; parsing + scan "c-library" get '[ _ _ address-of ] over push-all ; parsing diff --git a/basis/ascii/ascii-docs.factor b/basis/ascii/ascii-docs.factor index 6af697cf89..b2bbc16836 100644 --- a/basis/ascii/ascii-docs.factor +++ b/basis/ascii/ascii-docs.factor @@ -37,8 +37,30 @@ HELP: quotable? { $values { "ch" "a character" } { "?" "a boolean" } } { $description "Tests for characters which may appear in a Factor string literal without escaping." } ; -ARTICLE: "ascii" "ASCII character classes" -"The " { $vocab-link "ascii" } " vocabulary implements traditional ASCII character classes:" +HELP: ascii? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Tests for whether a number is an ASCII character." } ; + +HELP: ch>lower +{ $values { "ch" "a character" } { "lower" "a character" } } +{ $description "Converts an ASCII character to lower case." } ; + +HELP: ch>upper +{ $values { "ch" "a character" } { "upper" "a character" } } +{ $description "Converts an ASCII character to upper case." } ; + +HELP: >lower +{ $values { "str" "a string" } { "lower" "a string" } } +{ $description "Converts an ASCII string to lower case." } ; + +HELP: >upper +{ $values { "str" "a string" } { "upper" "a string" } } +{ $description "Converts an ASCII string to upper case." } ; + +ARTICLE: "ascii" "ASCII" +"The " { $vocab-link "ascii" } " vocabulary implements support for the legacy ASCII character set. Most applications should use " { $link "unicode" } " instead." +$nl +"ASCII character classes:" { $subsection blank? } { $subsection letter? } { $subsection LETTER? } @@ -46,6 +68,11 @@ ARTICLE: "ascii" "ASCII character classes" { $subsection printable? } { $subsection control? } { $subsection quotable? } -"Modern applications should use Unicode 5.0 instead (" { $vocab-link "unicode.categories" } ")." ; +{ $subsection ascii? } +"ASCII case conversion:" +{ $subsection ch>lower } +{ $subsection ch>upper } +{ $subsection >lower } +{ $subsection >upper } ; ABOUT: "ascii" diff --git a/basis/ascii/ascii-tests.factor b/basis/ascii/ascii-tests.factor index 7dacce734b..6f39b32a01 100644 --- a/basis/ascii/ascii-tests.factor +++ b/basis/ascii/ascii-tests.factor @@ -12,3 +12,8 @@ IN: ascii.tests 0 "There are Four Upper Case characters" [ LETTER? [ 1+ ] when ] each ] unit-test + +[ t f ] [ CHAR: \s ascii? 400 ascii? ] unit-test + +[ "HELLO HOW ARE YOU?" ] [ "hellO hOw arE YOU?" >upper ] unit-test +[ "i'm good thx bai" ] [ "I'm Good THX bai" >lower ] unit-test diff --git a/basis/ascii/ascii.factor b/basis/ascii/ascii.factor index c009c66cde..193e847d27 100644 --- a/basis/ascii/ascii.factor +++ b/basis/ascii/ascii.factor @@ -1,27 +1,23 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.order sequences -combinators.short-circuit ; +USING: kernel math math.order sequences strings +combinators.short-circuit hints ; IN: ascii +: ascii? ( ch -- ? ) 0 127 between? ; inline : blank? ( ch -- ? ) " \t\n\r" member? ; inline - : letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline - : LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline - : digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline - : printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline - -: control? ( ch -- ? ) - "\0\e\r\n\t\u000008\u00007f" member? ; inline - -: quotable? ( ch -- ? ) - dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline - -: Letter? ( ch -- ? ) - [ [ letter? ] [ LETTER? ] ] 1|| ; - -: alpha? ( ch -- ? ) - [ [ Letter? ] [ digit? ] ] 1|| ; +: control? ( ch -- ? ) "\0\e\r\n\t\u000008\u00007f" member? ; inline +: quotable? ( ch -- ? ) { [ printable? ] [ "\"\\" member? not ] } 1&& ; inline +: Letter? ( ch -- ? ) { [ letter? ] [ LETTER? ] } 1|| ; inline +: alpha? ( ch -- ? ) { [ Letter? ] [ digit? ] } 1|| ; inline +: ch>lower ( ch -- lower ) dup LETTER? [ HEX: 20 + ] when ; inline +: >lower ( str -- lower ) [ ch>lower ] map ; +: ch>upper ( ch -- upper ) dup letter? [ HEX: 20 - ] when ; inline +: >upper ( str -- upper ) [ ch>upper ] map ; + +HINTS: >lower string ; +HINTS: >upper string ; \ No newline at end of file diff --git a/basis/assoc-heaps/assoc-heaps-docs.factor b/basis/assoc-heaps/assoc-heaps-docs.factor new file mode 100644 index 0000000000..b148995cb8 --- /dev/null +++ b/basis/assoc-heaps/assoc-heaps-docs.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string assocs +heaps.private ; +IN: assoc-heaps + +HELP: +{ $values { "assoc" assoc } { "heap" heap } { "assoc-heap" assoc-heap } } +{ $description "Constructs a new " { $link assoc-heap } " from two existing data structures." } ; + +HELP: +{ $values { "unique-heap" assoc-heap } } +{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ; + +HELP: +{ $values { "unique-heap" assoc-heap } } +{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ; + +{ } related-words + +HELP: assoc-heap +{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap may update both the assoc and the heap or leave them out of sync if it's advantageous." } ; + +ARTICLE: "assoc-heaps" "Associative heaps" +"The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl +"Associative heap constructor:" +{ $subsection } +"Unique heaps:" +{ $subsection } +{ $subsection } ; + +ABOUT: "assoc-heaps" diff --git a/basis/assoc-heaps/assoc-heaps-tests.factor b/basis/assoc-heaps/assoc-heaps-tests.factor new file mode 100644 index 0000000000..6ea3fe14a4 --- /dev/null +++ b/basis/assoc-heaps/assoc-heaps-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test assoc-heaps ; +IN: assoc-heaps.tests diff --git a/basis/assoc-heaps/assoc-heaps.factor b/basis/assoc-heaps/assoc-heaps.factor new file mode 100644 index 0000000000..a495aed626 --- /dev/null +++ b/basis/assoc-heaps/assoc-heaps.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs hashtables heaps kernel ; +IN: assoc-heaps + +TUPLE: assoc-heap assoc heap ; + +C: assoc-heap + +: ( -- unique-heap ) + H{ } clone ; + +: ( -- unique-heap ) + H{ } clone ; + +M: assoc-heap heap-push* ( value key assoc-heap -- entry ) + pick over assoc>> key? [ + 3drop f + ] [ + [ assoc>> swapd set-at ] [ heap>> heap-push* ] 3bi + ] if ; + +M: assoc-heap heap-pop ( assoc-heap -- value key ) + heap>> heap-pop ; + +M: assoc-heap heap-peek ( assoc-heap -- value key ) + heap>> heap-peek ; + +M: assoc-heap heap-empty? ( assoc-heap -- value key ) + heap>> heap-empty? ; diff --git a/basis/assoc-heaps/authors.txt b/basis/assoc-heaps/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/assoc-heaps/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/base64/base64-docs.factor b/basis/base64/base64-docs.factor index ed92a19577..530caab8bd 100644 --- a/basis/base64/base64-docs.factor +++ b/basis/base64/base64-docs.factor @@ -7,7 +7,13 @@ HELP: >base64 { $examples { $example "USING: prettyprint base64 strings ;" "\"The monorail is a free service.\" >base64 >string ." "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\"" } } -{ $see-also base64> } ; +{ $see-also base64> >base64-lines } ; + +HELP: >base64-lines +{ $values { "seq" sequence } { "base64" "a string of base64 characters" } } +{ $description "Converts a sequence to its base64 representation by taking six bits at a time as an index into a lookup table containing alphanumerics, '+', and '/'. The result is padded with '=' if the input was not a multiple of six bits. A crlf is inserted for every 76 characters of output." } +{ $see-also base64> >base64-lines } ; + HELP: base64> { $values { "base64" "a string of base64 characters" } { "seq" sequence } } @@ -16,13 +22,26 @@ HELP: base64> { $example "USING: prettyprint base64 strings ;" "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\" base64> >string ." "\"The monorail is a free service.\"" } } { $notes "This word will throw if the input string contains characters other than those allowed in base64 encodings." } -{ $see-also >base64 } ; +{ $see-also >base64 >base64-lines } ; + +HELP: encode-base64 +{ $description "Reads the standard input and writes it to standard output encoded in base64." } ; + +HELP: decode-base64 +{ $description "Reads the standard input and decodes it, writing to standard output." } ; + +HELP: encode-base64-lines +{ $description "Reads the standard input and writes it to standard output encoded in base64 with a crlf every 76 characters." } ; ARTICLE: "base64" "Base 64 conversions" "The " { $vocab-link "base64" } " vocabulary implements conversions of sequences to printable characters in base 64. These plain-text representations of binary data may be passed around and converted back to binary data later." $nl -"Converting to base 64:" +"Converting to and from base64 as strings:" { $subsection >base64 } -"Converting back to binary:" -{ $subsection base64> } ; +{ $subsection >base64-lines } +{ $subsection base64> } +"Using base64 from streams:" +{ $subsection encode-base64 } +{ $subsection encode-base64-lines } +{ $subsection decode-base64 } ; ABOUT: "base64" diff --git a/basis/base64/base64-tests.factor b/basis/base64/base64-tests.factor index 9958e7943f..dcc4aa5240 100644 --- a/basis/base64/base64-tests.factor +++ b/basis/base64/base64-tests.factor @@ -1,4 +1,4 @@ -USING: kernel tools.test base64 strings ; +USING: kernel tools.test base64 strings sequences ; IN: base64.tests [ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" >base64 base64> >string @@ -7,6 +7,7 @@ IN: base64.tests [ "a" ] [ "a" >base64 base64> >string ] unit-test [ "ab" ] [ "ab" >base64 base64> >string ] unit-test [ "abc" ] [ "abc" >base64 base64> >string ] unit-test +[ "abcde" ] [ "abcde" >base64 3 cut "\r\n" swap 3append base64> >string ] unit-test ! From http://en.wikipedia.org/wiki/Base64 [ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ] @@ -15,5 +16,11 @@ IN: base64.tests >base64 >string ] unit-test +[ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz\r\nIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg\r\ndGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu\r\ndWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo\r\nZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ] +[ + "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure." + >base64-lines >string +] unit-test + \ >base64 must-infer \ base64> must-infer diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index e3033a2bde..a1668e7ce9 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -1,16 +1,22 @@ -! Copyright (C) 2008 Doug Coleman. +! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math sequences io.binary splitting grouping -accessors ; +USING: combinators io io.binary io.encodings.binary +io.streams.byte-array io.streams.string kernel math namespaces +sequences strings io.crlf ; IN: base64 > length ] [ to>> ] bi - ; inline +: read1-ignoring ( ignoring -- ch ) + read1 2dup swap member? [ drop read1-ignoring ] [ nip ] if ; + +: read-ignoring ( ignoring n -- str ) + [ drop read1-ignoring ] with map harvest + [ f ] [ >string ] if-empty ; : ch>base64 ( ch -- ch ) - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" nth ; + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + nth ; inline : base64>ch ( ch -- ch ) { @@ -19,32 +25,60 @@ IN: base64 f 0 f f f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 f f f f f f 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 - } nth ; + } nth ; inline + +SYMBOL: column + +: write1-lines ( ch -- ) + write1 + column get [ + 1+ [ 76 = [ crlf ] when ] + [ 76 mod column set ] bi + ] when* ; -: encode3 ( seq -- seq ) +: write-lines ( str -- ) + [ write1-lines ] each ; + +: encode3 ( seq -- ) be> 4 [ - -6 * shift HEX: 3f bitand ch>base64 - ] with B{ } map-as ; + -6 * shift HEX: 3f bitand ch>base64 write1-lines + ] with each ; inline + +: encode-pad ( seq n -- ) + [ 3 0 pad-right binary [ encode3 ] with-byte-writer ] + [ 1+ ] bi* head-slice 4 CHAR: = pad-right write-lines ; inline -: decode4 ( str -- str ) - 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ; +ERROR: malformed-base64 ; -: >base64-rem ( str -- str ) - [ 3 0 pad-right encode3 ] [ length 1+ ] bi - head-slice 4 CHAR: = pad-right ; +: decode4 ( seq -- ) + [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ] + [ [ CHAR: = = ] count ] bi head-slice* + [ write1 ] each ; inline PRIVATE> +: encode-base64 ( -- ) + 3 read dup length { + { 0 [ drop ] } + { 3 [ encode3 encode-base64 ] } + [ encode-pad encode-base64 ] + } case ; + +: encode-base64-lines ( -- ) + 0 column [ encode-base64 ] with-variable ; + +: decode-base64 ( -- ) + "\n\r" 4 read-ignoring dup length { + { 0 [ drop ] } + { 4 [ decode4 decode-base64 ] } + [ malformed-base64 ] + } case ; + : >base64 ( seq -- base64 ) - #! cut string into two pieces, convert 3 bytes at a time - #! pad string with = when not enough bits - dup length dup 3 mod - cut - [ 3 [ encode3 ] map concat ] - [ [ "" ] [ >base64-rem ] if-empty ] - bi* append ; + binary [ [ encode-base64 ] with-string-reader ] with-byte-writer ; : base64> ( base64 -- seq ) - #! input length must be a multiple of 4 - [ 4 [ decode4 ] map concat ] - [ [ CHAR: = = ] count-end ] - bi head* ; + [ binary [ decode-base64 ] with-byte-reader ] with-string-writer ; + +: >base64-lines ( seq -- base64 ) + binary [ [ encode-base64-lines ] with-string-reader ] with-byte-writer ; diff --git a/basis/base64/tags.txt b/basis/base64/tags.txt new file mode 100644 index 0000000000..8fd3eccc9a --- /dev/null +++ b/basis/base64/tags.txt @@ -0,0 +1,2 @@ +parsing +web diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor index a5ae23dde6..1de49d353d 100644 --- a/basis/bit-arrays/bit-arrays-tests.factor +++ b/basis/bit-arrays/bit-arrays-tests.factor @@ -76,3 +76,7 @@ IN: bit-arrays.tests t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t } bit-array>integer ] unit-test + +[ 49 ] [ 49 dup set-bits [ ] count ] unit-test + +[ HEX: 100 ] [ ?{ f f f f f f f f t } bit-array>integer ] unit-test diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index d407f0b84d..f1ba71ce1e 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -11,7 +11,7 @@ TUPLE: bit-array byte -3 shift ; inline +: n>byte ( m -- n ) -3 shift ; inline : byte/bit ( n alien -- byte bit ) over n>byte alien-unsigned-1 swap 7 bitand ; inline @@ -19,13 +19,13 @@ TUPLE: bit-array : set-bit ( ? byte bit -- byte ) 2^ rot [ bitor ] [ bitnot bitand ] if ; inline -: bits>cells 31 + -5 shift ; inline +: bits>cells ( m -- n ) 31 + -5 shift ; inline -: bits>bytes 7 + n>byte ; inline +: bits>bytes ( m -- n ) 7 + n>byte ; inline : (set-bits) ( bit-array n -- ) [ [ length bits>cells ] keep ] dip swap underlying>> - '[ [ _ _ ] dip set-alien-unsigned-4 ] each ; inline + '[ 2 shift [ _ _ ] dip set-alien-unsigned-4 ] each ; inline PRIVATE> @@ -83,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ; ] if ; : bit-array>integer ( bit-array -- n ) - 0 swap underlying>> dup length [ + 0 swap underlying>> dup length [ alien-unsigned-1 swap 8 shift bitor ] with each ; diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index f0d9e8e131..617073bbc4 100644 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors compiler cpu.architecture vocabs.loader system sequences namespaces parser kernel kernel.private classes @@ -25,8 +25,8 @@ IN: bootstrap.compiler enable-compiler -: compile-uncompiled ( words -- ) - [ compiled>> not ] filter compile ; +: compile-unoptimized ( words -- ) + [ optimized>> not ] filter compile ; nl "Compiling..." write flush @@ -48,70 +48,70 @@ nl wrap probe namestack* -} compile-uncompiled +} compile-unoptimized "." write flush { bitand bitor bitxor bitnot -} compile-uncompiled +} compile-unoptimized "." write flush { + 1+ 1- 2/ < <= > >= shift -} compile-uncompiled +} compile-unoptimized "." write flush { new-sequence nth push pop peek flip -} compile-uncompiled +} compile-unoptimized "." write flush { hashcode* = get set -} compile-uncompiled +} compile-unoptimized "." write flush { memq? split harvest sift cut cut-slice start index clone set-at reverse push-all class number>string string>number -} compile-uncompiled +} compile-unoptimized "." write flush { lines prefix suffix unclip new-assoc update word-prop set-word-prop 1array 2array 3array ?nth -} compile-uncompiled +} compile-unoptimized "." write flush { malloc calloc free memcpy -} compile-uncompiled +} compile-unoptimized "." write flush -{ build-tree } compile-uncompiled +{ build-tree } compile-unoptimized "." write flush -{ optimize-tree } compile-uncompiled +{ optimize-tree } compile-unoptimized "." write flush -{ optimize-cfg } compile-uncompiled +{ optimize-cfg } compile-unoptimized "." write flush -{ (compile) } compile-uncompiled +{ (compile) } compile-unoptimized "." write flush -vocabs [ words compile-uncompiled "." write flush ] each +vocabs [ words compile-unoptimized "." write flush ] each " done" print flush diff --git a/basis/bootstrap/finish-bootstrap.factor b/basis/bootstrap/finish-bootstrap.factor index 133b64acaa..36f6291bc6 100644 --- a/basis/bootstrap/finish-bootstrap.factor +++ b/basis/bootstrap/finish-bootstrap.factor @@ -12,5 +12,6 @@ namespaces eval kernel vocabs.loader io ; ignore-cli-args? not script get and [ run-script ] [ "run" get run ] if* output-stream get [ stream-flush ] when* + 0 exit ] [ print-error 1 exit ] recover ] set-boot-quot diff --git a/basis/bootstrap/finish-staging.factor b/basis/bootstrap/finish-staging.factor index a60ce04e15..49f504fd41 100644 --- a/basis/bootstrap/finish-staging.factor +++ b/basis/bootstrap/finish-staging.factor @@ -7,4 +7,5 @@ io ; (command-line) parse-command-line "run" get run output-stream get [ stream-flush ] when* + 0 exit ] set-boot-quot diff --git a/basis/bootstrap/help/help.factor b/basis/bootstrap/help/help.factor index 5b49ce2802..145738ff45 100644 --- a/basis/bootstrap/help/help.factor +++ b/basis/bootstrap/help/help.factor @@ -4,6 +4,7 @@ parser vocabs.loader vocabs.loader.private accessors assocs ; IN: bootstrap.help : load-help ( -- ) + "help.lint" require "alien.syntax" require "compiler" require diff --git a/basis/bootstrap/image/image-docs.factor b/basis/bootstrap/image/image-docs.factor index 91aa22b738..3856382ffb 100644 --- a/basis/bootstrap/image/image-docs.factor +++ b/basis/bootstrap/image/image-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax io io.files ; +USING: help.markup help.syntax io io.files io.pathnames ; IN: bootstrap.image ARTICLE: "bootstrap.image" "Bootstrapping new images" diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index c7d87776a1..513b8972a6 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -1,15 +1,16 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien arrays byte-arrays generic assocs hashtables assocs -hashtables.private io kernel kernel.private math namespaces make -parser prettyprint sequences sequences.private strings sbufs +hashtables.private io io.binary io.files io.encodings.binary +io.pathnames kernel kernel.private math namespaces make parser +prettyprint sequences sequences.private strings sbufs vectors words quotations assocs system layouts splitting grouping growable classes classes.builtin classes.tuple -classes.tuple.private words.private io.binary io.files vocabs +classes.tuple.private words.private vocabs vocabs.loader source-files definitions debugger quotations.private sequences.private combinators -io.encodings.binary math.order math.private accessors -slots.private compiler.units ; +math.order math.private accessors +slots.private compiler.units fry ; IN: bootstrap.image : arch ( os cpu -- arch ) @@ -65,14 +66,14 @@ M: id equal? SYMBOL: objects -: (objects) objects get ; inline +: (objects) ( obj -- id assoc ) objects get ; inline : lookup-object ( obj -- n/f ) (objects) at ; : put-object ( n obj -- ) (objects) set-at ; : cache-object ( obj quot -- value ) - [ (objects) ] dip [ obj>> ] prepose cache ; inline + [ (objects) ] dip '[ obj>> @ ] cache ; inline ! Constants @@ -94,7 +95,7 @@ SYMBOL: objects SYMBOL: sub-primitives : make-jit ( quot rc rt offset -- quad ) - { [ { } make ] [ ] [ ] [ ] } spread 4array ; inline + [ { } make ] 3dip 4array ; inline : jit-define ( quot rc rt offset name -- ) [ make-jit ] dip set ; inline @@ -343,25 +344,37 @@ M: wrapper ' [ emit ] emit-object ; ! Strings +: native> ( object -- object ) + big-endian get [ [ be> ] map ] [ [ le> ] map ] if ; + : emit-bytes ( seq -- ) - bootstrap-cell - big-endian get [ [ be> ] map ] [ [ le> ] map ] if - emit-seq ; + bootstrap-cell native> emit-seq ; : pad-bytes ( seq -- newseq ) dup length bootstrap-cell align 0 pad-right ; -: check-string ( string -- ) - [ 127 > ] contains? - [ "Bootstrap cannot emit non-ASCII strings" throw ] when ; +: extended-part ( str -- str' ) + dup [ 128 < ] all? [ drop f ] [ + [ -7 shift 1 bitxor ] { } map-as + big-endian get + [ [ 2 >be ] { } map-as ] + [ [ 2 >le ] { } map-as ] if + B{ } join + ] if ; + +: ascii-part ( str -- str' ) + [ + [ 128 mod ] [ 128 >= ] bi + [ 128 bitor ] when + ] B{ } map-as ; : emit-string ( string -- ptr ) - dup check-string + [ length ] [ extended-part ' ] [ ] tri string type-number object tag-number [ - dup length emit-fixnum - f ' emit - f ' emit - pad-bytes emit-bytes + [ emit-fixnum ] + [ emit ] + [ f ' emit ascii-part pad-bytes emit-bytes ] + tri* ] emit-object ; M: string ' @@ -432,7 +445,7 @@ M: quotation ' array>> ' quotation type-number object tag-number [ emit ! array - f ' emit ! compiled>> + f ' emit ! compiled 0 emit ! xt 0 emit ! code ] emit-object @@ -523,11 +536,9 @@ M: quotation ' ! Image output : (write-image) ( image -- ) - bootstrap-cell big-endian get [ - [ >be write ] curry each - ] [ - [ >le write ] curry each - ] if ; + bootstrap-cell big-endian get + [ '[ _ >be write ] each ] + [ '[ _ >le write ] each ] if ; : write-image ( image -- ) "Writing image to " write diff --git a/basis/bootstrap/image/upload/upload.factor b/basis/bootstrap/image/upload/upload.factor index f0edf85e65..d70a253e5f 100644 --- a/basis/bootstrap/image/upload/upload.factor +++ b/basis/bootstrap/image/upload/upload.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: checksums checksums.openssl splitting assocs kernel io.files bootstrap.image sequences io namespaces make -io.launcher math io.encodings.ascii ; +io.launcher math io.encodings.ascii io.files.temp io.pathnames +io.directories ; IN: bootstrap.image.upload SYMBOL: upload-images-destination diff --git a/basis/bootstrap/io/io.factor b/basis/bootstrap/io/io.factor index a38107fbab..b9a49b48b8 100644 --- a/basis/bootstrap/io/io.factor +++ b/basis/bootstrap/io/io.factor @@ -1,12 +1,11 @@ USING: system vocabs vocabs.loader kernel combinators -namespaces sequences io.backend ; +namespaces sequences io.backend accessors ; IN: bootstrap.io "bootstrap.compiler" vocab [ - "io." { + "io.backend." { { [ "io-backend" get ] [ "io-backend" get ] } - { [ os unix? ] [ "unix" ] } + { [ os unix? ] [ "unix." os name>> append ] } { [ os winnt? ] [ "windows.nt" ] } - { [ os wince? ] [ "windows.ce" ] } } cond append require ] when diff --git a/basis/bootstrap/math/math.factor b/basis/bootstrap/math/math.factor index 347969af0d..27b2f6b181 100644 --- a/basis/bootstrap/math/math.factor +++ b/basis/bootstrap/math/math.factor @@ -2,6 +2,4 @@ USING: vocabs vocabs.loader kernel ; "math.ratios" require "math.floats" require -"math.complex" require - -"prettyprint" vocab [ "math.complex.prettyprint" require ] when +"math.complex" require \ No newline at end of file diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor index fb7292b989..b521244fe0 100644 --- a/basis/bootstrap/stage2.factor +++ b/basis/bootstrap/stage2.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors init namespaces words io +USING: accessors init namespaces words words.symbol io kernel.private math memory continuations kernel io.files -io.backend system parser vocabs sequences +io.pathnames io.backend system parser vocabs sequences vocabs.loader combinators splitting source-files strings -definitions assocs compiler.errors compiler.units -math.parser generic sets command-line ; +definitions assocs compiler.errors compiler.units math.parser +generic sets command-line ; IN: bootstrap.stage2 SYMBOL: core-bootstrap-time @@ -13,7 +13,7 @@ SYMBOL: core-bootstrap-time SYMBOL: bootstrap-time : default-image-name ( -- string ) - vm file-name os windows? [ "." split1 drop ] when + vm file-name os windows? [ "." split1-last drop ] when ".image" append resource-path ; : do-crossref ( -- ) @@ -42,7 +42,7 @@ SYMBOL: bootstrap-time "Core bootstrap completed in " write core-bootstrap-time get print-time "Bootstrap completed in " write bootstrap-time get print-time - [ compiled>> ] count-words " compiled words" print + [ optimized>> ] count-words " compiled words" print [ symbol? ] count-words " symbol words" print [ ] count-words " words total" print @@ -102,6 +102,8 @@ SYMBOL: bootstrap-time ] if ] [ drop - load-help? off - "resource:basis/bootstrap/bootstrap-error.factor" run-file + [ + load-help? off + "resource:basis/bootstrap/bootstrap-error.factor" run-file + ] with-scope ] recover diff --git a/basis/bootstrap/threads/threads.factor b/basis/bootstrap/threads/threads.factor index 8b751f8458..24cbba6af8 100644 --- a/basis/bootstrap/threads/threads.factor +++ b/basis/bootstrap/threads/threads.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: vocabs vocabs.loader kernel ; +USING: vocabs vocabs.loader kernel io.thread threads +compiler.utilities namespaces ; IN: bootstrap.threads -USE: io.thread -USE: threads - "debugger" vocab [ "debugger.threads" require ] when + +[ yield ] yield-hook set-global \ No newline at end of file diff --git a/basis/bootstrap/unicode/unicode.factor b/basis/bootstrap/unicode/unicode.factor index 1046d41bdc..3530c9d99f 100644 --- a/basis/bootstrap/unicode/unicode.factor +++ b/basis/bootstrap/unicode/unicode.factor @@ -1,5 +1 @@ -USING: strings.parser kernel namespaces unicode.data ; -IN: bootstrap.unicode - -[ name>char [ "Invalid character" throw ] unless* ] -name>char-hook set-global +USE: unicode \ No newline at end of file diff --git a/basis/cairo/authors.txt b/basis/cairo/authors.txt new file mode 100644 index 0000000000..68d35d192b --- /dev/null +++ b/basis/cairo/authors.txt @@ -0,0 +1,2 @@ +Sampo Vuori +Doug Coleman diff --git a/basis/cairo/cairo.factor b/basis/cairo/cairo.factor new file mode 100755 index 0000000000..da7f5a2f32 --- /dev/null +++ b/basis/cairo/cairo.factor @@ -0,0 +1,37 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: cairo.ffi kernel accessors sequences +namespaces fry continuations destructors ; +IN: cairo + +TUPLE: cairo-t alien ; +C: cairo-t +M: cairo-t dispose ( alien -- ) alien>> cairo_destroy ; + +TUPLE: cairo-surface-t alien ; +C: cairo-surface-t +M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ; + +: check-cairo ( cairo_status_t -- ) + dup CAIRO_STATUS_SUCCESS = [ drop ] + [ cairo_status_to_string "Cairo error: " prepend throw ] if ; + +SYMBOL: cairo +: cr ( -- cairo ) cairo get ; inline + +: (with-cairo) ( cairo-t quot -- ) + [ alien>> cairo ] dip + '[ @ cr cairo_status check-cairo ] + with-variable ; inline + +: with-cairo ( cairo quot -- ) + [ ] dip '[ _ (with-cairo) ] with-disposal ; inline + +: (with-surface) ( cairo-surface-t quot -- ) + [ alien>> ] dip [ cairo_surface_status check-cairo ] bi ; inline + +: with-surface ( cairo_surface quot -- ) + [ ] dip '[ _ (with-surface) ] with-disposal ; inline + +: with-cairo-from-surface ( cairo_surface quot -- ) + '[ cairo_create _ with-cairo ] with-surface ; inline diff --git a/basis/cairo/ffi/ffi.factor b/basis/cairo/ffi/ffi.factor new file mode 100644 index 0000000000..d29a3fb097 --- /dev/null +++ b/basis/cairo/ffi/ffi.factor @@ -0,0 +1,948 @@ +! Copyright (c) 2007 Sampo Vuori +! Copyright (c) 2008 Matthew Willis +! +! Adapted from cairo.h, version 1.5.14 +! License: http://factorcode.org/license.txt + +USING: system combinators alien alien.syntax kernel +alien.c-types accessors sequences arrays ui.gadgets ; + +IN: cairo.ffi +<< "cairo" { + { [ os winnt? ] [ "libcairo-2.dll" ] } + { [ os macosx? ] [ "/opt/local/lib/libcairo.dylib" ] } + { [ os unix? ] [ "libcairo.so.2" ] } +} cond "cdecl" add-library >> + +LIBRARY: cairo + +FUNCTION: int cairo_version ( ) ; +FUNCTION: char* cairo_version_string ( ) ; + +TYPEDEF: int cairo_bool_t + +! I am leaving these and other void* types as opaque structures +TYPEDEF: void* cairo_t +TYPEDEF: void* cairo_surface_t + +C-STRUCT: cairo_matrix_t + { "double" "xx" } + { "double" "yx" } + { "double" "xy" } + { "double" "yy" } + { "double" "x0" } + { "double" "y0" } ; + +TYPEDEF: void* cairo_pattern_t + +TYPEDEF: void* cairo_destroy_func_t +: cairo-destroy-func ( quot -- callback ) + [ "void" { "void*" } "cdecl" ] dip alien-callback ; inline + +! See cairo.h for details +C-STRUCT: cairo_user_data_key_t + { "int" "unused" } ; + +TYPEDEF: int cairo_status_t +C-ENUM: + CAIRO_STATUS_SUCCESS + CAIRO_STATUS_NO_MEMORY + CAIRO_STATUS_INVALID_RESTORE + CAIRO_STATUS_INVALID_POP_GROUP + CAIRO_STATUS_NO_CURRENT_POINT + CAIRO_STATUS_INVALID_MATRIX + CAIRO_STATUS_INVALID_STATUS + CAIRO_STATUS_NULL_POINTER + CAIRO_STATUS_INVALID_STRING + CAIRO_STATUS_INVALID_PATH_DATA + CAIRO_STATUS_READ_ERROR + CAIRO_STATUS_WRITE_ERROR + CAIRO_STATUS_SURFACE_FINISHED + CAIRO_STATUS_SURFACE_TYPE_MISMATCH + CAIRO_STATUS_PATTERN_TYPE_MISMATCH + CAIRO_STATUS_INVALID_CONTENT + CAIRO_STATUS_INVALID_FORMAT + CAIRO_STATUS_INVALID_VISUAL + CAIRO_STATUS_FILE_NOT_FOUND + CAIRO_STATUS_INVALID_DASH + CAIRO_STATUS_INVALID_DSC_COMMENT + CAIRO_STATUS_INVALID_INDEX + CAIRO_STATUS_CLIP_NOT_REPRESENTABLE + CAIRO_STATUS_TEMP_FILE_ERROR + CAIRO_STATUS_INVALID_STRIDE ; + +TYPEDEF: int cairo_content_t +: CAIRO_CONTENT_COLOR HEX: 1000 ; +: CAIRO_CONTENT_ALPHA HEX: 2000 ; +: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000 ; + +TYPEDEF: void* cairo_write_func_t +: cairo-write-func ( quot -- callback ) + [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline + +TYPEDEF: void* cairo_read_func_t +: cairo-read-func ( quot -- callback ) + [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline + +! Functions for manipulating state objects +FUNCTION: cairo_t* +cairo_create ( cairo_surface_t* target ) ; + +FUNCTION: cairo_t* +cairo_reference ( cairo_t* cr ) ; + +FUNCTION: void +cairo_destroy ( cairo_t* cr ) ; + +FUNCTION: uint +cairo_get_reference_count ( cairo_t* cr ) ; + +FUNCTION: void* +cairo_get_user_data ( cairo_t* cr, cairo_user_data_key_t* key ) ; + +FUNCTION: cairo_status_t +cairo_set_user_data ( cairo_t* cr, cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy ) ; + +FUNCTION: void +cairo_save ( cairo_t* cr ) ; + +FUNCTION: void +cairo_restore ( cairo_t* cr ) ; + +FUNCTION: void +cairo_push_group ( cairo_t* cr ) ; + +FUNCTION: void +cairo_push_group_with_content ( cairo_t* cr, cairo_content_t content ) ; + +FUNCTION: cairo_pattern_t* +cairo_pop_group ( cairo_t* cr ) ; + +FUNCTION: void +cairo_pop_group_to_source ( cairo_t* cr ) ; + +! Modify state +TYPEDEF: int cairo_operator_t +C-ENUM: + CAIRO_OPERATOR_CLEAR + + CAIRO_OPERATOR_SOURCE + CAIRO_OPERATOR_OVER + CAIRO_OPERATOR_IN + CAIRO_OPERATOR_OUT + CAIRO_OPERATOR_ATOP + + CAIRO_OPERATOR_DEST + CAIRO_OPERATOR_DEST_OVER + CAIRO_OPERATOR_DEST_IN + CAIRO_OPERATOR_DEST_OUT + CAIRO_OPERATOR_DEST_ATOP + + CAIRO_OPERATOR_XOR + CAIRO_OPERATOR_ADD + CAIRO_OPERATOR_SATURATE ; + +FUNCTION: void +cairo_set_operator ( cairo_t* cr, cairo_operator_t op ) ; + +FUNCTION: void +cairo_set_source ( cairo_t* cr, cairo_pattern_t* source ) ; + +FUNCTION: void +cairo_set_source_rgb ( cairo_t* cr, double red, double green, double blue ) ; + +FUNCTION: void +cairo_set_source_rgba ( cairo_t* cr, double red, double green, double blue, double alpha ) ; + +FUNCTION: void +cairo_set_source_surface ( cairo_t* cr, cairo_surface_t* surface, double x, double y ) ; + +FUNCTION: void +cairo_set_tolerance ( cairo_t* cr, double tolerance ) ; + +TYPEDEF: int cairo_antialias_t +C-ENUM: + CAIRO_ANTIALIAS_DEFAULT + CAIRO_ANTIALIAS_NONE + CAIRO_ANTIALIAS_GRAY + CAIRO_ANTIALIAS_SUBPIXEL ; + +FUNCTION: void +cairo_set_antialias ( cairo_t* cr, cairo_antialias_t antialias ) ; + +TYPEDEF: int cairo_fill_rule_t +C-ENUM: + CAIRO_FILL_RULE_WINDING + CAIRO_FILL_RULE_EVEN_ODD ; + +FUNCTION: void +cairo_set_fill_rule ( cairo_t* cr, cairo_fill_rule_t fill_rule ) ; + +FUNCTION: void +cairo_set_line_width ( cairo_t* cr, double width ) ; + +TYPEDEF: int cairo_line_cap_t +C-ENUM: + CAIRO_LINE_CAP_BUTT + CAIRO_LINE_CAP_ROUND + CAIRO_LINE_CAP_SQUARE ; + +FUNCTION: void +cairo_set_line_cap ( cairo_t* cr, cairo_line_cap_t line_cap ) ; + +TYPEDEF: int cairo_line_join_t +C-ENUM: + CAIRO_LINE_JOIN_MITER + CAIRO_LINE_JOIN_ROUND + CAIRO_LINE_JOIN_BEVEL ; + +FUNCTION: void +cairo_set_line_join ( cairo_t* cr, cairo_line_join_t line_join ) ; + +FUNCTION: void +cairo_set_dash ( cairo_t* cr, double* dashes, int num_dashes, double offset ) ; + +FUNCTION: void +cairo_set_miter_limit ( cairo_t* cr, double limit ) ; + +FUNCTION: void +cairo_translate ( cairo_t* cr, double tx, double ty ) ; + +FUNCTION: void +cairo_scale ( cairo_t* cr, double sx, double sy ) ; + +FUNCTION: void +cairo_rotate ( cairo_t* cr, double angle ) ; + +FUNCTION: void +cairo_transform ( cairo_t* cr, cairo_matrix_t* matrix ) ; + +FUNCTION: void +cairo_set_matrix ( cairo_t* cr, cairo_matrix_t* matrix ) ; + +FUNCTION: void +cairo_identity_matrix ( cairo_t* cr ) ; + +FUNCTION: void +cairo_user_to_device ( cairo_t* cr, double* x, double* y ) ; + +FUNCTION: void +cairo_user_to_device_distance ( cairo_t* cr, double* dx, double* dy ) ; + +FUNCTION: void +cairo_device_to_user ( cairo_t* cr, double* x, double* y ) ; + +FUNCTION: void +cairo_device_to_user_distance ( cairo_t* cr, double* dx, double* dy ) ; + +! Path creation functions +FUNCTION: void +cairo_new_path ( cairo_t* cr ) ; + +FUNCTION: void +cairo_move_to ( cairo_t* cr, double x, double y ) ; + +FUNCTION: void +cairo_new_sub_path ( cairo_t* cr ) ; + +FUNCTION: void +cairo_line_to ( cairo_t* cr, double x, double y ) ; + +FUNCTION: void +cairo_curve_to ( cairo_t* cr, double x1, double y1, double x2, double y2, double x3, double y3 ) ; + +FUNCTION: void +cairo_arc ( cairo_t* cr, double xc, double yc, double radius, double angle1, double angle2 ) ; + +FUNCTION: void +cairo_arc_negative ( cairo_t* cr, double xc, double yc, double radius, double angle1, double angle2 ) ; + +FUNCTION: void +cairo_rel_move_to ( cairo_t* cr, double dx, double dy ) ; + +FUNCTION: void +cairo_rel_line_to ( cairo_t* cr, double dx, double dy ) ; + +FUNCTION: void +cairo_rel_curve_to ( cairo_t* cr, double dx1, double dy1, double dx2, double dy2, double dx3, double dy3 ) ; + +FUNCTION: void +cairo_rectangle ( cairo_t* cr, double x, double y, double width, double height ) ; + +FUNCTION: void +cairo_close_path ( cairo_t* cr ) ; + +FUNCTION: void +cairo_path_extents ( cairo_t* cr, double* x1, double* y1, double* x2, double* y2 ) ; + +! Painting functions +FUNCTION: void +cairo_paint ( cairo_t* cr ) ; + +FUNCTION: void +cairo_paint_with_alpha ( cairo_t* cr, double alpha ) ; + +FUNCTION: void +cairo_mask ( cairo_t* cr, cairo_pattern_t* pattern ) ; + +FUNCTION: void +cairo_mask_surface ( cairo_t* cr, cairo_surface_t* surface, double surface_x, double surface_y ) ; + +FUNCTION: void +cairo_stroke ( cairo_t* cr ) ; + +FUNCTION: void +cairo_stroke_preserve ( cairo_t* cr ) ; + +FUNCTION: void +cairo_fill ( cairo_t* cr ) ; + +FUNCTION: void +cairo_fill_preserve ( cairo_t* cr ) ; + +FUNCTION: void +cairo_copy_page ( cairo_t* cr ) ; + +FUNCTION: void +cairo_show_page ( cairo_t* cr ) ; + +! Insideness testing +FUNCTION: cairo_bool_t +cairo_in_stroke ( cairo_t* cr, double x, double y ) ; + +FUNCTION: cairo_bool_t +cairo_in_fill ( cairo_t* cr, double x, double y ) ; + +! Rectangular extents +FUNCTION: void +cairo_stroke_extents ( cairo_t* cr, double* x1, double* y1, double* x2, double* y2 ) ; + +FUNCTION: void +cairo_fill_extents ( cairo_t* cr, double* x1, double* y1, double* x2, double* y2 ) ; + +! Clipping +FUNCTION: void +cairo_reset_clip ( cairo_t* cr ) ; + +FUNCTION: void +cairo_clip ( cairo_t* cr ) ; + +FUNCTION: void +cairo_clip_preserve ( cairo_t* cr ) ; + +FUNCTION: void +cairo_clip_extents ( cairo_t* cr, double* x1, double* y1, double* x2, double* y2 ) ; + +C-STRUCT: cairo_rectangle_t + { "double" "x" } + { "double" "y" } + { "double" "width" } + { "double" "height" } ; + +C-STRUCT: cairo_rectangle_list_t + { "cairo_status_t" "status" } + { "cairo_rectangle_t*" "rectangles" } + { "int" "num_rectangles" } ; + +FUNCTION: cairo_rectangle_list_t* +cairo_copy_clip_rectangle_list ( cairo_t* cr ) ; + +FUNCTION: void +cairo_rectangle_list_destroy ( cairo_rectangle_list_t* rectangle_list ) ; + +! Font/Text functions + +TYPEDEF: void* cairo_scaled_font_t + +TYPEDEF: void* cairo_font_face_t + +C-STRUCT: cairo_glyph_t + { "ulong" "index" } + { "double" "x" } + { "double" "y" } ; + +C-STRUCT: cairo_text_extents_t + { "double" "x_bearing" } + { "double" "y_bearing" } + { "double" "width" } + { "double" "height" } + { "double" "x_advance" } + { "double" "y_advance" } ; + +C-STRUCT: cairo_font_extents_t + { "double" "ascent" } + { "double" "descent" } + { "double" "height" } + { "double" "max_x_advance" } + { "double" "max_y_advance" } ; + +TYPEDEF: int cairo_font_slant_t +C-ENUM: + CAIRO_FONT_SLANT_NORMAL + CAIRO_FONT_SLANT_ITALIC + CAIRO_FONT_SLANT_OBLIQUE ; + +TYPEDEF: int cairo_font_weight_t +C-ENUM: + CAIRO_FONT_WEIGHT_NORMAL + CAIRO_FONT_WEIGHT_BOLD ; + +TYPEDEF: int cairo_subpixel_order_t +C-ENUM: + CAIRO_SUBPIXEL_ORDER_DEFAULT + CAIRO_SUBPIXEL_ORDER_RGB + CAIRO_SUBPIXEL_ORDER_BGR + CAIRO_SUBPIXEL_ORDER_VRGB + CAIRO_SUBPIXEL_ORDER_VBGR ; + +TYPEDEF: int cairo_hint_style_t +C-ENUM: + CAIRO_HINT_STYLE_DEFAULT + CAIRO_HINT_STYLE_NONE + CAIRO_HINT_STYLE_SLIGHT + CAIRO_HINT_STYLE_MEDIUM + CAIRO_HINT_STYLE_FULL ; + +TYPEDEF: int cairo_hint_metrics_t +C-ENUM: + CAIRO_HINT_METRICS_DEFAULT + CAIRO_HINT_METRICS_OFF + CAIRO_HINT_METRICS_ON ; + +TYPEDEF: void* cairo_font_options_t + +FUNCTION: cairo_font_options_t* +cairo_font_options_create ( ) ; + +FUNCTION: cairo_font_options_t* +cairo_font_options_copy ( cairo_font_options_t* original ) ; + +FUNCTION: void +cairo_font_options_destroy ( cairo_font_options_t* options ) ; + +FUNCTION: cairo_status_t +cairo_font_options_status ( cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_font_options_merge ( cairo_font_options_t* options, cairo_font_options_t* other ) ; + +FUNCTION: cairo_bool_t +cairo_font_options_equal ( cairo_font_options_t* options, cairo_font_options_t* other ) ; + +FUNCTION: ulong +cairo_font_options_hash ( cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_font_options_set_antialias ( cairo_font_options_t* options, cairo_antialias_t antialias ) ; + +FUNCTION: cairo_antialias_t +cairo_font_options_get_antialias ( cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_font_options_set_subpixel_order ( cairo_font_options_t* options, cairo_subpixel_order_t subpixel_order ) ; + +FUNCTION: cairo_subpixel_order_t +cairo_font_options_get_subpixel_order ( cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_font_options_set_hint_style ( cairo_font_options_t* options, cairo_hint_style_t hint_style ) ; + +FUNCTION: cairo_hint_style_t +cairo_font_options_get_hint_style ( cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_font_options_set_hint_metrics ( cairo_font_options_t* options, cairo_hint_metrics_t hint_metrics ) ; + +FUNCTION: cairo_hint_metrics_t +cairo_font_options_get_hint_metrics ( cairo_font_options_t* options ) ; + +! This interface is for dealing with text as text, not caring about the +! font object inside the the cairo_t. + +FUNCTION: void +cairo_select_font_face ( cairo_t* cr, char* family, cairo_font_slant_t slant, cairo_font_weight_t weight ) ; + +FUNCTION: void +cairo_set_font_size ( cairo_t* cr, double size ) ; + +FUNCTION: void +cairo_set_font_matrix ( cairo_t* cr, cairo_matrix_t* matrix ) ; + +FUNCTION: void +cairo_get_font_matrix ( cairo_t* cr, cairo_matrix_t* matrix ) ; + +FUNCTION: void +cairo_set_font_options ( cairo_t* cr, cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_get_font_options ( cairo_t* cr, cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_set_font_face ( cairo_t* cr, cairo_font_face_t* font_face ) ; + +FUNCTION: cairo_font_face_t* +cairo_get_font_face ( cairo_t* cr ) ; + +FUNCTION: void +cairo_set_scaled_font ( cairo_t* cr, cairo_scaled_font_t* scaled_font ) ; + +FUNCTION: cairo_scaled_font_t* +cairo_get_scaled_font ( cairo_t* cr ) ; + +FUNCTION: void +cairo_show_text ( cairo_t* cr, char* utf8 ) ; + +FUNCTION: void +cairo_show_glyphs ( cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs ) ; + +FUNCTION: void +cairo_text_path ( cairo_t* cr, char* utf8 ) ; + +FUNCTION: void +cairo_glyph_path ( cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs ) ; + +FUNCTION: void +cairo_text_extents ( cairo_t* cr, char* utf8, cairo_text_extents_t* extents ) ; + +FUNCTION: void +cairo_glyph_extents ( cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs, cairo_text_extents_t* extents ) ; + +FUNCTION: void +cairo_font_extents ( cairo_t* cr, cairo_font_extents_t* extents ) ; + +! Generic identifier for a font style + +FUNCTION: cairo_font_face_t* +cairo_font_face_reference ( cairo_font_face_t* font_face ) ; + +FUNCTION: void +cairo_font_face_destroy ( cairo_font_face_t* font_face ) ; + +FUNCTION: uint +cairo_font_face_get_reference_count ( cairo_font_face_t* font_face ) ; + +FUNCTION: cairo_status_t +cairo_font_face_status ( cairo_font_face_t* font_face ) ; + +TYPEDEF: int cairo_font_type_t +C-ENUM: + CAIRO_FONT_TYPE_TOY + CAIRO_FONT_TYPE_FT + CAIRO_FONT_TYPE_WIN32 + CAIRO_FONT_TYPE_QUARTZ ; + +FUNCTION: cairo_font_type_t +cairo_font_face_get_type ( cairo_font_face_t* font_face ) ; + +FUNCTION: void* +cairo_font_face_get_user_data ( cairo_font_face_t* font_face, cairo_user_data_key_t* key ) ; + +FUNCTION: cairo_status_t +cairo_font_face_set_user_data ( cairo_font_face_t* font_face, cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy ) ; + +! Portable interface to general font features. + +FUNCTION: cairo_scaled_font_t* +cairo_scaled_font_create ( cairo_font_face_t* font_face, cairo_matrix_t* font_matrix, cairo_matrix_t* ctm, cairo_font_options_t* options ) ; + +FUNCTION: cairo_scaled_font_t* +cairo_scaled_font_reference ( cairo_scaled_font_t* scaled_font ) ; + +FUNCTION: void +cairo_scaled_font_destroy ( cairo_scaled_font_t* scaled_font ) ; + +FUNCTION: uint +cairo_scaled_font_get_reference_count ( cairo_scaled_font_t* scaled_font ) ; + +FUNCTION: cairo_status_t +cairo_scaled_font_status ( cairo_scaled_font_t* scaled_font ) ; + +FUNCTION: cairo_font_type_t +cairo_scaled_font_get_type ( cairo_scaled_font_t* scaled_font ) ; + +FUNCTION: void* +cairo_scaled_font_get_user_data ( cairo_scaled_font_t* scaled_font, cairo_user_data_key_t* key ) ; + +FUNCTION: cairo_status_t +cairo_scaled_font_set_user_data ( cairo_scaled_font_t* scaled_font, cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy ) ; + +FUNCTION: void +cairo_scaled_font_extents ( cairo_scaled_font_t* scaled_font, cairo_font_extents_t* extents ) ; + +FUNCTION: void +cairo_scaled_font_text_extents ( cairo_scaled_font_t* scaled_font, char* utf8, cairo_text_extents_t* extents ) ; + +FUNCTION: void +cairo_scaled_font_glyph_extents ( cairo_scaled_font_t* scaled_font, cairo_glyph_t* glyphs, int num_glyphs, cairo_text_extents_t* extents ) ; + +FUNCTION: cairo_font_face_t* +cairo_scaled_font_get_font_face ( cairo_scaled_font_t* scaled_font ) ; + +FUNCTION: void +cairo_scaled_font_get_font_matrix ( cairo_scaled_font_t* scaled_font, cairo_matrix_t* font_matrix ) ; + +FUNCTION: void +cairo_scaled_font_get_ctm ( cairo_scaled_font_t* scaled_font, cairo_matrix_t* ctm ) ; + +FUNCTION: void +cairo_scaled_font_get_font_options ( cairo_scaled_font_t* scaled_font, cairo_font_options_t* options ) ; + +! Query functions + +FUNCTION: cairo_operator_t +cairo_get_operator ( cairo_t* cr ) ; + +FUNCTION: cairo_pattern_t* +cairo_get_source ( cairo_t* cr ) ; + +FUNCTION: double +cairo_get_tolerance ( cairo_t* cr ) ; + +FUNCTION: cairo_antialias_t +cairo_get_antialias ( cairo_t* cr ) ; + +FUNCTION: cairo_bool_t +cairo_has_current_point ( cairo_t* cr ) ; + +FUNCTION: void +cairo_get_current_point ( cairo_t* cr, double* x, double* y ) ; + +FUNCTION: cairo_fill_rule_t +cairo_get_fill_rule ( cairo_t* cr ) ; + +FUNCTION: double +cairo_get_line_width ( cairo_t* cr ) ; + +FUNCTION: cairo_line_cap_t +cairo_get_line_cap ( cairo_t* cr ) ; + +FUNCTION: cairo_line_join_t +cairo_get_line_join ( cairo_t* cr ) ; + +FUNCTION: double +cairo_get_miter_limit ( cairo_t* cr ) ; + +FUNCTION: int +cairo_get_dash_count ( cairo_t* cr ) ; + +FUNCTION: void +cairo_get_dash ( cairo_t* cr, double* dashes, double* offset ) ; + +FUNCTION: void +cairo_get_matrix ( cairo_t* cr, cairo_matrix_t* matrix ) ; + +FUNCTION: cairo_surface_t* +cairo_get_target ( cairo_t* cr ) ; + +FUNCTION: cairo_surface_t* +cairo_get_group_target ( cairo_t* cr ) ; + +TYPEDEF: int cairo_path_data_type_t +C-ENUM: + CAIRO_PATH_MOVE_TO + CAIRO_PATH_LINE_TO + CAIRO_PATH_CURVE_TO + CAIRO_PATH_CLOSE_PATH ; + +! NEED TO DO UNION HERE +C-STRUCT: cairo_path_data_t-point + { "double" "x" } + { "double" "y" } ; + +C-STRUCT: cairo_path_data_t-header + { "cairo_path_data_type_t" "type" } + { "int" "length" } ; + +C-UNION: cairo_path_data_t "cairo_path_data_t-point" "cairo_path_data_t-header" ; + +C-STRUCT: cairo_path_t + { "cairo_status_t" "status" } + { "cairo_path_data_t*" "data" } + { "int" "num_data" } ; + +FUNCTION: cairo_path_t* +cairo_copy_path ( cairo_t* cr ) ; + +FUNCTION: cairo_path_t* +cairo_copy_path_flat ( cairo_t* cr ) ; + +FUNCTION: void +cairo_append_path ( cairo_t* cr, cairo_path_t* path ) ; + +FUNCTION: void +cairo_path_destroy ( cairo_path_t* path ) ; + +! Error status queries + +FUNCTION: cairo_status_t +cairo_status ( cairo_t* cr ) ; + +FUNCTION: char* +cairo_status_to_string ( cairo_status_t status ) ; + +! Surface manipulation + +FUNCTION: cairo_surface_t* +cairo_surface_create_similar ( cairo_surface_t* other, cairo_content_t content, int width, int height ) ; + +FUNCTION: cairo_surface_t* +cairo_surface_reference ( cairo_surface_t* surface ) ; + +FUNCTION: void +cairo_surface_finish ( cairo_surface_t* surface ) ; + +FUNCTION: void +cairo_surface_destroy ( cairo_surface_t* surface ) ; + +FUNCTION: uint +cairo_surface_get_reference_count ( cairo_surface_t* surface ) ; + +FUNCTION: cairo_status_t +cairo_surface_status ( cairo_surface_t* surface ) ; + +TYPEDEF: int cairo_surface_type_t +C-ENUM: + CAIRO_SURFACE_TYPE_IMAGE + CAIRO_SURFACE_TYPE_PDF + CAIRO_SURFACE_TYPE_PS + CAIRO_SURFACE_TYPE_XLIB + CAIRO_SURFACE_TYPE_XCB + CAIRO_SURFACE_TYPE_GLITZ + CAIRO_SURFACE_TYPE_QUARTZ + CAIRO_SURFACE_TYPE_WIN32 + CAIRO_SURFACE_TYPE_BEOS + CAIRO_SURFACE_TYPE_DIRECTFB + CAIRO_SURFACE_TYPE_SVG + CAIRO_SURFACE_TYPE_OS2 + CAIRO_SURFACE_TYPE_WIN32_PRINTING + CAIRO_SURFACE_TYPE_QUARTZ_IMAGE ; + +FUNCTION: cairo_surface_type_t +cairo_surface_get_type ( cairo_surface_t* surface ) ; + +FUNCTION: cairo_content_t +cairo_surface_get_content ( cairo_surface_t* surface ) ; + +FUNCTION: cairo_status_t +cairo_surface_write_to_png ( cairo_surface_t* surface, char* filename ) ; + +FUNCTION: cairo_status_t +cairo_surface_write_to_png_stream ( cairo_surface_t* surface, cairo_write_func_t write_func, void* closure ) ; + +FUNCTION: void* +cairo_surface_get_user_data ( cairo_surface_t* surface, cairo_user_data_key_t* key ) ; + +FUNCTION: cairo_status_t +cairo_surface_set_user_data ( cairo_surface_t* surface, cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy ) ; + +FUNCTION: void +cairo_surface_get_font_options ( cairo_surface_t* surface, cairo_font_options_t* options ) ; + +FUNCTION: void +cairo_surface_flush ( cairo_surface_t* surface ) ; + +FUNCTION: void +cairo_surface_mark_dirty ( cairo_surface_t* surface ) ; + +FUNCTION: void +cairo_surface_mark_dirty_rectangle ( cairo_surface_t* surface, int x, int y, int width, int height ) ; + +FUNCTION: void +cairo_surface_set_device_offset ( cairo_surface_t* surface, double x_offset, double y_offset ) ; + +FUNCTION: void +cairo_surface_get_device_offset ( cairo_surface_t* surface, double* x_offset, double* y_offset ) ; + +FUNCTION: void +cairo_surface_set_fallback_resolution ( cairo_surface_t* surface, double x_pixels_per_inch, double y_pixels_per_inch ) ; + +FUNCTION: void +cairo_surface_copy_page ( cairo_surface_t* surface ) ; + +FUNCTION: void +cairo_surface_show_page ( cairo_surface_t* surface ) ; + +! Image-surface functions + +TYPEDEF: int cairo_format_t +C-ENUM: + CAIRO_FORMAT_ARGB32 + CAIRO_FORMAT_RGB24 + CAIRO_FORMAT_A8 + CAIRO_FORMAT_A1 + CAIRO_FORMAT_RGB16_565 ; + +FUNCTION: cairo_surface_t* +cairo_image_surface_create ( cairo_format_t format, int width, int height ) ; + +FUNCTION: int +cairo_format_stride_for_width ( cairo_format_t format, int width ) ; + +FUNCTION: cairo_surface_t* +cairo_image_surface_create_for_data ( uchar* data, cairo_format_t format, int width, int height, int stride ) ; + +FUNCTION: uchar* +cairo_image_surface_get_data ( cairo_surface_t* surface ) ; + +FUNCTION: cairo_format_t +cairo_image_surface_get_format ( cairo_surface_t* surface ) ; + +FUNCTION: int +cairo_image_surface_get_width ( cairo_surface_t* surface ) ; + +FUNCTION: int +cairo_image_surface_get_height ( cairo_surface_t* surface ) ; + +FUNCTION: int +cairo_image_surface_get_stride ( cairo_surface_t* surface ) ; + +FUNCTION: cairo_surface_t* +cairo_image_surface_create_from_png ( char* filename ) ; + +FUNCTION: cairo_surface_t* +cairo_image_surface_create_from_png_stream ( cairo_read_func_t read_func, void* closure ) ; + +! Pattern creation functions + +FUNCTION: cairo_pattern_t* +cairo_pattern_create_rgb ( double red, double green, double blue ) ; + +FUNCTION: cairo_pattern_t* +cairo_pattern_create_rgba ( double red, double green, double blue, double alpha ) ; + +FUNCTION: cairo_pattern_t* +cairo_pattern_create_for_surface ( cairo_surface_t* surface ) ; + +FUNCTION: cairo_pattern_t* +cairo_pattern_create_linear ( double x0, double y0, double x1, double y1 ) ; + +FUNCTION: cairo_pattern_t* +cairo_pattern_create_radial ( double cx0, double cy0, double radius0, double cx1, double cy1, double radius1 ) ; + +FUNCTION: cairo_pattern_t* +cairo_pattern_reference ( cairo_pattern_t* pattern ) ; + +FUNCTION: void +cairo_pattern_destroy ( cairo_pattern_t* pattern ) ; + +FUNCTION: uint +cairo_pattern_get_reference_count ( cairo_pattern_t* pattern ) ; + +FUNCTION: cairo_status_t +cairo_pattern_status ( cairo_pattern_t* pattern ) ; + +FUNCTION: void* +cairo_pattern_get_user_data ( cairo_pattern_t* pattern, cairo_user_data_key_t* key ) ; + +FUNCTION: cairo_status_t +cairo_pattern_set_user_data ( cairo_pattern_t* pattern, cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy ) ; + +TYPEDEF: int cairo_pattern_type_t +C-ENUM: + CAIRO_PATTERN_TYPE_SOLID + CAIRO_PATTERN_TYPE_SURFACE + CAIRO_PATTERN_TYPE_LINEAR + CAIRO_PATTERN_TYPE_RADIA ; + +FUNCTION: cairo_pattern_type_t +cairo_pattern_get_type ( cairo_pattern_t* pattern ) ; + +FUNCTION: void +cairo_pattern_add_color_stop_rgb ( cairo_pattern_t* pattern, double offset, double red, double green, double blue ) ; + +FUNCTION: void +cairo_pattern_add_color_stop_rgba ( cairo_pattern_t* pattern, double offset, double red, double green, double blue, double alpha ) ; + +FUNCTION: void +cairo_pattern_set_matrix ( cairo_pattern_t* pattern, cairo_matrix_t* matrix ) ; + +FUNCTION: void +cairo_pattern_get_matrix ( cairo_pattern_t* pattern, cairo_matrix_t* matrix ) ; + +TYPEDEF: int cairo_extend_t +C-ENUM: + CAIRO_EXTEND_NONE + CAIRO_EXTEND_REPEAT + CAIRO_EXTEND_REFLECT + CAIRO_EXTEND_PAD ; + +FUNCTION: void +cairo_pattern_set_extend ( cairo_pattern_t* pattern, cairo_extend_t extend ) ; + +FUNCTION: cairo_extend_t +cairo_pattern_get_extend ( cairo_pattern_t* pattern ) ; + +TYPEDEF: int cairo_filter_t +C-ENUM: + CAIRO_FILTER_FAST + CAIRO_FILTER_GOOD + CAIRO_FILTER_BEST + CAIRO_FILTER_NEAREST + CAIRO_FILTER_BILINEAR + CAIRO_FILTER_GAUSSIAN ; + +FUNCTION: void +cairo_pattern_set_filter ( cairo_pattern_t* pattern, cairo_filter_t filter ) ; + +FUNCTION: cairo_filter_t +cairo_pattern_get_filter ( cairo_pattern_t* pattern ) ; + +FUNCTION: cairo_status_t +cairo_pattern_get_rgba ( cairo_pattern_t* pattern, double* red, double* green, double* blue, double* alpha ) ; + +FUNCTION: cairo_status_t +cairo_pattern_get_surface ( cairo_pattern_t* pattern, cairo_surface_t* *surface ) ; + +FUNCTION: cairo_status_t +cairo_pattern_get_color_stop_rgba ( cairo_pattern_t* pattern, int index, double* offset, double* red, double* green, double* blue, double* alpha ) ; + +FUNCTION: cairo_status_t +cairo_pattern_get_color_stop_count ( cairo_pattern_t* pattern, int* count ) ; + +FUNCTION: cairo_status_t +cairo_pattern_get_linear_points ( cairo_pattern_t* pattern, double* x0, double* y0, double* x1, double* y1 ) ; + +FUNCTION: cairo_status_t +cairo_pattern_get_radial_circles ( cairo_pattern_t* pattern, double* x0, double* y0, double* r0, double* x1, double* y1, double* r1 ) ; + +! Matrix functions + +FUNCTION: void +cairo_matrix_init ( cairo_matrix_t* matrix, double xx, double yx, double xy, double yy, double x0, double y0 ) ; + +FUNCTION: void +cairo_matrix_init_identity ( cairo_matrix_t* matrix ) ; + +FUNCTION: void +cairo_matrix_init_translate ( cairo_matrix_t* matrix, double tx, double ty ) ; + +FUNCTION: void +cairo_matrix_init_scale ( cairo_matrix_t* matrix, double sx, double sy ) ; + +FUNCTION: void +cairo_matrix_init_rotate ( cairo_matrix_t* matrix, double radians ) ; + +FUNCTION: void +cairo_matrix_translate ( cairo_matrix_t* matrix, double tx, double ty ) ; + +FUNCTION: void +cairo_matrix_scale ( cairo_matrix_t* matrix, double sx, double sy ) ; + +FUNCTION: void +cairo_matrix_rotate ( cairo_matrix_t* matrix, double radians ) ; + +FUNCTION: cairo_status_t +cairo_matrix_invert ( cairo_matrix_t* matrix ) ; + +FUNCTION: void +cairo_matrix_multiply ( cairo_matrix_t* result, cairo_matrix_t* a, cairo_matrix_t* b ) ; + +FUNCTION: void +cairo_matrix_transform_distance ( cairo_matrix_t* matrix, double* dx, double* dy ) ; + +FUNCTION: void +cairo_matrix_transform_point ( cairo_matrix_t* matrix, double* x, double* y ) ; + +! Functions to be used while debugging (not intended for use in production code) +FUNCTION: void +cairo_debug_reset_static_data ( ) ; diff --git a/basis/cairo/gadgets/gadgets.factor b/basis/cairo/gadgets/gadgets.factor new file mode 100644 index 0000000000..87942b4c91 --- /dev/null +++ b/basis/cairo/gadgets/gadgets.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2008 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: sequences math kernel byte-arrays cairo.ffi cairo +io.backend ui.gadgets accessors opengl.gl arrays fry +classes ui.render namespaces destructors libc ; +IN: cairo.gadgets + +stride ( width -- stride ) 4 * ; + +: image-dims ( gadget -- width height stride ) + dim>> first2 over width>stride ; inline +: image-buffer ( width height stride -- alien ) + * nip malloc ; inline +PRIVATE> + +GENERIC: render-cairo* ( gadget -- ) + +: render-cairo ( gadget -- alien ) + [ + image-dims + [ image-buffer dup CAIRO_FORMAT_ARGB32 ] + [ cairo_image_surface_create_for_data ] 3bi + ] [ '[ _ render-cairo* ] with-cairo-from-surface ] bi ; + +TUPLE: cairo-gadget < gadget ; + +: ( dim -- gadget ) + cairo-gadget new-gadget + swap >>dim ; + +M: cairo-gadget draw-gadget* + [ + [ dim>> ] [ render-cairo &free ] bi + origin get first2 glRasterPos2i + 1.0 -1.0 glPixelZoom + [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip + glDrawPixels + ] with-destructors ; + +: copy-surface ( surface -- ) + cr swap 0 0 cairo_set_source_surface + cr cairo_paint ; diff --git a/basis/cairo/summary.txt b/basis/cairo/summary.txt new file mode 100644 index 0000000000..f6cb370ff6 --- /dev/null +++ b/basis/cairo/summary.txt @@ -0,0 +1 @@ +Cairo graphics library binding diff --git a/basis/cairo/tags.txt b/basis/cairo/tags.txt new file mode 100644 index 0000000000..bb863cf9a0 --- /dev/null +++ b/basis/cairo/tags.txt @@ -0,0 +1 @@ +bindings diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 793c771b64..522e0c52f3 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -211,7 +211,7 @@ M: real +minute ( timestamp n -- timestamp ) M: number +second ( timestamp n -- timestamp ) [ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ; -: (time+) +: (time+) ( timestamp duration -- timestamp' duration ) [ second>> +second ] keep [ minute>> +minute ] keep [ hour>> +hour ] keep @@ -219,7 +219,8 @@ M: number +second ( timestamp n -- timestamp ) [ month>> +month ] keep [ year>> +year ] keep ; inline -: +slots [ bi@ + ] curry 2keep ; inline +: +slots ( obj1 obj2 quot -- n obj1 obj2 ) + [ bi@ + ] curry 2keep ; inline PRIVATE> diff --git a/basis/channels/remote/remote-docs.factor b/basis/channels/remote/remote-docs.factor index 862084e1d9..309f764d2d 100644 --- a/basis/channels/remote/remote-docs.factor +++ b/basis/channels/remote/remote-docs.factor @@ -6,6 +6,7 @@ IN: channels.remote HELP: { $values { "node" "a node object" } { "id" "the id of the published channel on the node" } + { "remote-channel" remote-channel } } { $description "Create a remote channel that acts as a proxy for a " "channel on another node. The remote node's channel must have been " diff --git a/basis/checksums/common/common.factor b/basis/checksums/common/common.factor index 7d5f34777d..0ae4328446 100644 --- a/basis/checksums/common/common.factor +++ b/basis/checksums/common/common.factor @@ -1,21 +1,20 @@ ! Copyright (C) 2006, 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.bitwise strings io.binary namespaces -make grouping ; +make grouping byte-arrays ; IN: checksums.common SYMBOL: bytes-read -: calculate-pad-length ( length -- pad-length ) - dup 56 < 55 119 ? swap - ; +: calculate-pad-length ( length -- length' ) + [ 56 < 55 119 ? ] keep - ; : pad-last-block ( str big-endian? length -- str ) [ - rot % - HEX: 80 , - dup HEX: 3f bitand calculate-pad-length 0 % - 3 shift 8 rot [ >be ] [ >le ] if % - ] "" make 64 group ; + [ % ] 2dip HEX: 80 , + [ HEX: 3f bitand calculate-pad-length % ] + [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi + ] B{ } make 64 group ; : update-old-new ( old new -- ) [ [ get ] bi@ w+ dup ] 2keep [ set ] bi@ ; inline diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index d919b0e313..04c6c2497e 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel io io.binary io.files io.streams.byte-array math math.functions math.parser namespaces splitting grouping strings -sequences byte-arrays locals sequences.private -io.encodings.binary symbols math.bitwise checksums -checksums.common checksums.stream ; +sequences byte-arrays locals sequences.private macros fry +io.encodings.binary math.bitwise checksums +checksums.common checksums.stream combinators ; IN: checksums.md5 ! See http://www.faqs.org/rfcs/rfc1321.html @@ -29,7 +29,7 @@ SYMBOLS: a b c d old-a old-b old-c old-d ; old-c c update-old-new old-d d update-old-new ; -:: (ABCD) ( x s i k func a b c d -- ) +:: (ABCD) ( x a b c d k s i func -- ) #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s) a [ b get c get d get func call w+ @@ -39,11 +39,6 @@ SYMBOLS: a b c d old-a old-b old-c old-d ; b get w+ ] change ; inline -: ABCD a b c d (ABCD) ; inline -: BCDA b c d a (ABCD) ; inline -: CDAB c d a b (ABCD) ; inline -: DABC d a b c (ABCD) ; inline - : F ( X Y Z -- FXYZ ) #! F(X,Y,Z) = XY v not(X) Z pick bitnot bitand [ bitand ] [ bitor ] bi* ; @@ -60,104 +55,113 @@ SYMBOLS: a b c d old-a old-b old-c old-d ; #! I(X,Y,Z) = Y xor (X v not(Z)) rot swap bitnot bitor bitxor ; -: S11 7 ; inline -: S12 12 ; inline -: S13 17 ; inline -: S14 22 ; inline -: S21 5 ; inline -: S22 9 ; inline -: S23 14 ; inline -: S24 20 ; inline -: S31 4 ; inline -: S32 11 ; inline -: S33 16 ; inline -: S34 23 ; inline -: S41 6 ; inline -: S42 10 ; inline -: S43 15 ; inline -: S44 21 ; inline - -: (process-md5-block-F) ( block -- block ) - dup S11 1 0 [ F ] ABCD - dup S12 2 1 [ F ] DABC - dup S13 3 2 [ F ] CDAB - dup S14 4 3 [ F ] BCDA - dup S11 5 4 [ F ] ABCD - dup S12 6 5 [ F ] DABC - dup S13 7 6 [ F ] CDAB - dup S14 8 7 [ F ] BCDA - dup S11 9 8 [ F ] ABCD - dup S12 10 9 [ F ] DABC - dup S13 11 10 [ F ] CDAB - dup S14 12 11 [ F ] BCDA - dup S11 13 12 [ F ] ABCD - dup S12 14 13 [ F ] DABC - dup S13 15 14 [ F ] CDAB - dup S14 16 15 [ F ] BCDA ; - -: (process-md5-block-G) ( block -- block ) - dup S21 17 1 [ G ] ABCD - dup S22 18 6 [ G ] DABC - dup S23 19 11 [ G ] CDAB - dup S24 20 0 [ G ] BCDA - dup S21 21 5 [ G ] ABCD - dup S22 22 10 [ G ] DABC - dup S23 23 15 [ G ] CDAB - dup S24 24 4 [ G ] BCDA - dup S21 25 9 [ G ] ABCD - dup S22 26 14 [ G ] DABC - dup S23 27 3 [ G ] CDAB - dup S24 28 8 [ G ] BCDA - dup S21 29 13 [ G ] ABCD - dup S22 30 2 [ G ] DABC - dup S23 31 7 [ G ] CDAB - dup S24 32 12 [ G ] BCDA ; - -: (process-md5-block-H) ( block -- block ) - dup S31 33 5 [ H ] ABCD - dup S32 34 8 [ H ] DABC - dup S33 35 11 [ H ] CDAB - dup S34 36 14 [ H ] BCDA - dup S31 37 1 [ H ] ABCD - dup S32 38 4 [ H ] DABC - dup S33 39 7 [ H ] CDAB - dup S34 40 10 [ H ] BCDA - dup S31 41 13 [ H ] ABCD - dup S32 42 0 [ H ] DABC - dup S33 43 3 [ H ] CDAB - dup S34 44 6 [ H ] BCDA - dup S31 45 9 [ H ] ABCD - dup S32 46 12 [ H ] DABC - dup S33 47 15 [ H ] CDAB - dup S34 48 2 [ H ] BCDA ; - -: (process-md5-block-I) ( block -- block ) - dup S41 49 0 [ I ] ABCD - dup S42 50 7 [ I ] DABC - dup S43 51 14 [ I ] CDAB - dup S44 52 5 [ I ] BCDA - dup S41 53 12 [ I ] ABCD - dup S42 54 3 [ I ] DABC - dup S43 55 10 [ I ] CDAB - dup S44 56 1 [ I ] BCDA - dup S41 57 8 [ I ] ABCD - dup S42 58 15 [ I ] DABC - dup S43 59 6 [ I ] CDAB - dup S44 60 13 [ I ] BCDA - dup S41 61 4 [ I ] ABCD - dup S42 62 11 [ I ] DABC - dup S43 63 2 [ I ] CDAB - dup S44 64 9 [ I ] BCDA ; +CONSTANT: S11 7 +CONSTANT: S12 12 +CONSTANT: S13 17 +CONSTANT: S14 22 +CONSTANT: S21 5 +CONSTANT: S22 9 +CONSTANT: S23 14 +CONSTANT: S24 20 +CONSTANT: S31 4 +CONSTANT: S32 11 +CONSTANT: S33 16 +CONSTANT: S34 23 +CONSTANT: S41 6 +CONSTANT: S42 10 +CONSTANT: S43 15 +CONSTANT: S44 21 + +MACRO: with-md5-round ( ops func -- ) + '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ; + +: (process-md5-block-F) ( block -- ) + { + [ a b c d 0 S11 1 ] + [ d a b c 1 S12 2 ] + [ c d a b 2 S13 3 ] + [ b c d a 3 S14 4 ] + [ a b c d 4 S11 5 ] + [ d a b c 5 S12 6 ] + [ c d a b 6 S13 7 ] + [ b c d a 7 S14 8 ] + [ a b c d 8 S11 9 ] + [ d a b c 9 S12 10 ] + [ c d a b 10 S13 11 ] + [ b c d a 11 S14 12 ] + [ a b c d 12 S11 13 ] + [ d a b c 13 S12 14 ] + [ c d a b 14 S13 15 ] + [ b c d a 15 S14 16 ] + } [ F ] with-md5-round ; + +: (process-md5-block-G) ( block -- ) + { + [ a b c d 1 S21 17 ] + [ d a b c 6 S22 18 ] + [ c d a b 11 S23 19 ] + [ b c d a 0 S24 20 ] + [ a b c d 5 S21 21 ] + [ d a b c 10 S22 22 ] + [ c d a b 15 S23 23 ] + [ b c d a 4 S24 24 ] + [ a b c d 9 S21 25 ] + [ d a b c 14 S22 26 ] + [ c d a b 3 S23 27 ] + [ b c d a 8 S24 28 ] + [ a b c d 13 S21 29 ] + [ d a b c 2 S22 30 ] + [ c d a b 7 S23 31 ] + [ b c d a 12 S24 32 ] + } [ G ] with-md5-round ; + +: (process-md5-block-H) ( block -- ) + { + [ a b c d 5 S31 33 ] + [ d a b c 8 S32 34 ] + [ c d a b 11 S33 35 ] + [ b c d a 14 S34 36 ] + [ a b c d 1 S31 37 ] + [ d a b c 4 S32 38 ] + [ c d a b 7 S33 39 ] + [ b c d a 10 S34 40 ] + [ a b c d 13 S31 41 ] + [ d a b c 0 S32 42 ] + [ c d a b 3 S33 43 ] + [ b c d a 6 S34 44 ] + [ a b c d 9 S31 45 ] + [ d a b c 12 S32 46 ] + [ c d a b 15 S33 47 ] + [ b c d a 2 S34 48 ] + } [ H ] with-md5-round ; + +: (process-md5-block-I) ( block -- ) + { + [ a b c d 0 S41 49 ] + [ d a b c 7 S42 50 ] + [ c d a b 14 S43 51 ] + [ b c d a 5 S44 52 ] + [ a b c d 12 S41 53 ] + [ d a b c 3 S42 54 ] + [ c d a b 10 S43 55 ] + [ b c d a 1 S44 56 ] + [ a b c d 8 S41 57 ] + [ d a b c 15 S42 58 ] + [ c d a b 6 S43 59 ] + [ b c d a 13 S44 60 ] + [ a b c d 4 S41 61 ] + [ d a b c 11 S42 62 ] + [ c d a b 2 S43 63 ] + [ b c d a 9 S44 64 ] + } [ I ] with-md5-round ; : (process-md5-block) ( block -- ) - 4 [ le> ] map - - (process-md5-block-F) - (process-md5-block-G) - (process-md5-block-H) - (process-md5-block-I) - - drop + 4 [ le> ] map { + [ (process-md5-block-F) ] + [ (process-md5-block-G) ] + [ (process-md5-block-H) ] + [ (process-md5-block-I) ] + } cleave update-md ; diff --git a/basis/checksums/openssl/openssl-docs.factor b/basis/checksums/openssl/openssl-docs.factor index fd067997a7..750e05f3c8 100644 --- a/basis/checksums/openssl/openssl-docs.factor +++ b/basis/checksums/openssl/openssl-docs.factor @@ -4,8 +4,8 @@ USING: help.syntax help.markup ; HELP: openssl-checksum { $class-description "The class of checksum algorithms implemented by OpenSSL. The exact set of algorithms supported depends on how the OpenSSL library was compiled; " { $snippet "md5" } " and " { $snippet "sha1" } " should be universally available." } ; -HELP: ( name -- checksum ) -{ $values { "name" "an EVP message digest name" } { "checksum" openssl-checksum } } +HELP: +{ $values { "name" "an EVP message digest name" } { "openssl-checksum" openssl-checksum } } { $description "Creates a new OpenSSL checksum object." } ; HELP: openssl-md5 diff --git a/basis/checksums/sha1/sha1.factor b/basis/checksums/sha1/sha1.factor index 6cdc9270aa..ede8a8f653 100644 --- a/basis/checksums/sha1/sha1.factor +++ b/basis/checksums/sha1/sha1.factor @@ -3,7 +3,7 @@ USING: arrays combinators kernel io io.encodings.binary io.files io.streams.byte-array math.vectors strings sequences namespaces make math parser sequences assocs grouping vectors io.binary -hashtables symbols math.bitwise checksums checksums.common +hashtables math.bitwise checksums checksums.common checksums.stream ; IN: checksums.sha1 diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha2/sha2.factor index beb657bd3e..898a695b34 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha2/sha2.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel splitting grouping math sequences namespaces make -io.binary symbols math.bitwise checksums checksums.common +io.binary math.bitwise checksums checksums.common sbufs strings ; IN: checksums.sha2 diff --git a/basis/cocoa/application/application-docs.factor b/basis/cocoa/application/application-docs.factor index e12b6eb276..60a0232a2c 100644 --- a/basis/cocoa/application/application-docs.factor +++ b/basis/cocoa/application/application-docs.factor @@ -30,10 +30,6 @@ HELP: cocoa-app { $values { "quot" quotation } } { $description "Initializes Cocoa, calls the quotation, and starts the Cocoa event loop." } ; -HELP: do-event -{ $values { "app" "an " { $snippet "NSApplication" } } { "?" "a boolean" } } -{ $description "Processes a pending event in the queue, if any, returning a boolean indicating if there was one. Does not block." } ; - HELP: add-observer { $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } } { $description "Registers an observer with the " { $snippet "NSNotificationCenter" } " singleton." } ; @@ -52,7 +48,6 @@ HELP: objc-error ARTICLE: "cocoa-application-utils" "Cocoa application utilities" "Utilities:" { $subsection NSApp } -{ $subsection do-event } { $subsection add-observer } { $subsection remove-observer } { $subsection install-delegate } diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index a52aaedce2..ab2b6375a9 100644 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.syntax io kernel namespaces core-foundation -core-foundation.run-loop core-foundation.arrays -core-foundation.data core-foundation.strings cocoa.messages -cocoa cocoa.classes cocoa.runtime sequences threads init summary -kernel.private assocs ; +core-foundation.arrays core-foundation.data +core-foundation.strings cocoa.messages cocoa cocoa.classes +cocoa.runtime sequences threads init summary kernel.private +assocs ; IN: cocoa.application : ( str -- alien ) -> autorelease ; @@ -35,13 +35,6 @@ FUNCTION: void NSBeep ( ) ; : with-cocoa ( quot -- ) [ NSApp drop call ] with-autorelease-pool ; inline -: next-event ( app -- event ) - NSAnyEventMask f CFRunLoopDefaultMode 1 - -> nextEventMatchingMask:untilDate:inMode:dequeue: ; - -: do-event ( app -- ? ) - dup next-event [ dupd -> sendEvent: -> updateWindows t ] [ drop f ] if* ; - : add-observer ( observer selector name object -- ) [ [ NSNotificationCenter -> defaultCenter ] 2dip diff --git a/basis/cocoa/views/views-docs.factor b/basis/cocoa/views/views-docs.factor index a1cd792436..3b533f98c3 100644 --- a/basis/cocoa/views/views-docs.factor +++ b/basis/cocoa/views/views-docs.factor @@ -2,7 +2,7 @@ USING: help.syntax help.markup ; IN: cocoa.views HELP: -{ $values { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } } +{ $values { "attributes" "a sequence of attributes" } { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } } { $description "Creates an " { $snippet "NSOpenGLPixelFormat" } " with some reasonable defaults." } ; HELP: diff --git a/basis/cocoa/windows/windows.factor b/basis/cocoa/windows/windows.factor index 3a53a1cc3c..51f692d02d 100644 --- a/basis/cocoa/windows/windows.factor +++ b/basis/cocoa/windows/windows.factor @@ -14,7 +14,7 @@ IN: cocoa.windows : NSBackingStoreNonretained 1 ; inline : NSBackingStoreBuffered 2 ; inline -: standard-window-type +: standard-window-type ( -- n ) { NSTitledWindowMask NSClosableWindowMask diff --git a/basis/columns/columns-docs.factor b/basis/columns/columns-docs.factor index 27dc160812..1dd9257281 100644 --- a/basis/columns/columns-docs.factor +++ b/basis/columns/columns-docs.factor @@ -4,8 +4,8 @@ IN: columns HELP: column { $class-description "A virtual sequence which presents a fixed column of a matrix represented as a sequence of rows. New instances can be created by calling " { $link } "." } ; -HELP: ( seq n -- column ) -{ $values { "seq" sequence } { "n" "a non-negative integer" } { "column" column } } +HELP: +{ $values { "seq" sequence } { "col" "a non-negative integer" } { "column" column } } { $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of " { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." } { $examples { $example diff --git a/basis/columns/columns.factor b/basis/columns/columns.factor index 5ac8531f58..8f45dab872 100644 --- a/basis/columns/columns.factor +++ b/basis/columns/columns.factor @@ -9,7 +9,7 @@ TUPLE: column seq col ; C: column M: column virtual-seq seq>> ; -M: column virtual@ dup col>> -rot seq>> nth bounds-check ; +M: column virtual@ [ col>> swap ] [ seq>> ] bi nth bounds-check ; M: column length seq>> length ; INSTANCE: column virtual-sequence diff --git a/basis/combinators/smart/authors.txt b/basis/combinators/smart/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/combinators/smart/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/combinators/smart/smart-docs.factor b/basis/combinators/smart/smart-docs.factor new file mode 100644 index 0000000000..75f83c1a55 --- /dev/null +++ b/basis/combinators/smart/smart-docs.factor @@ -0,0 +1,125 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations math sequences +multiline ; +IN: combinators.smart + +HELP: inputarray +{ $values + { "quot" quotation } + { "newquot" quotation } +} +{ $description "Infers the number or outputs from the quotation and constructs an array from those outputs." } +{ $examples + { $example + <" USING: combinators combinators.smart math prettyprint ; +9 [ + { [ 1- ] [ 1+ ] [ sq ] } cleave +] output>array ."> + "{ 8 10 81 }" + } +} ; + +HELP: output>sequence +{ $values + { "quot" quotation } { "exemplar" "an exemplar" } + { "newquot" quotation } +} +{ $description "Infers the number of outputs from the quotation and constructs a new sequence from those objects of the same type as the exemplar." } +{ $examples + { $example + "USING: combinators.smart kernel math prettyprint ;" + "4 [ [ 1 + ] [ 2 + ] [ 3 + ] tri ] V{ } output>sequence ." + "V{ 5 6 7 }" + } +} ; + +HELP: reduce-outputs +{ $values + { "quot" quotation } { "operation" quotation } + { "newquot" quotation } +} +{ $description "Infers the number of outputs from " { $snippet "quot" } " and reduces them using " { $snippet "operation" } ". The identity for the " { $link reduce } " operation is the first output." } +{ $examples + { $example + "USING: combinators.smart kernel math prettyprint ;" + "3 [ [ 4 * ] [ 4 / ] [ 4 - ] tri ] [ * ] reduce-outputs ." + "-9" + } +} ; + +HELP: sum-outputs +{ $values + { "quot" quotation } + { "n" integer } +} +{ $description "Infers the number of outputs from " { $snippet "quot" } " and returns their sum." } +{ $examples + { $example + "USING: combinators.smart kernel math prettyprint ;" + "10 [ [ 1- ] [ 1+ ] bi ] sum-outputs ." + "20" + } +} ; + +HELP: append-outputs +{ $values + { "quot" quotation } + { "seq" sequence } +} +{ $description "Infers the number of outputs from " { $snippet "quot" } " and returns a sequence of the outputs appended." } +{ $examples + { $example + "USING: combinators.smart prettyprint ;" + "[ { 1 2 } { \"A\" \"b\" } ] append-outputs ." + "{ 1 2 \"A\" \"b\" }" + } +} ; + +HELP: append-outputs-as +{ $values + { "quot" quotation } { "exemplar" sequence } + { "seq" sequence } +} +{ $description "Infers the number of outputs from " { $snippet "quot" } " and returns a sequence of type " { $snippet "exemplar" } " of the outputs appended." } +{ $examples + { $example + "USING: combinators.smart prettyprint ;" + "[ { 1 2 } { \"A\" \"b\" } ] V{ } append-outputs-as ." + "V{ 1 2 \"A\" \"b\" }" + } +} ; + +{ append-outputs append-outputs-as } related-words + + +ARTICLE: "combinators.smart" "Smart combinators" +"The " { $vocab-link "combinators.smart" } " vocabulary implements " { $emphasis "smart combinators" } ". A smart combinator is one whose behavior depends on the static stack effect of an input quotation." $nl +"Smart inputs from a sequence:" +{ $subsection inputsequence } +{ $subsection output>array } +"Reducing the output of a quotation:" +{ $subsection reduce-outputs } +"Summing the output of a quotation:" +{ $subsection sum-outputs } +"Appending the results of a quotation:" +{ $subsection append-outputs } +{ $subsection append-outputs-as } ; + +ABOUT: "combinators.smart" diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor new file mode 100644 index 0000000000..370dc26960 --- /dev/null +++ b/basis/combinators/smart/smart-tests.factor @@ -0,0 +1,39 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test combinators.smart math kernel ; +IN: combinators.smart.tests + +: test-bi ( -- 9 11 ) + 10 [ 1- ] [ 1+ ] bi ; + +[ [ test-bi ] output>array ] must-infer +[ { 9 11 } ] [ [ test-bi ] output>array ] unit-test + +[ { 9 11 } [ + ] inputsequence ( quot exemplar -- newquot ) + [ dup infer out>> ] dip + '[ @ _ _ nsequence ] ; + +: output>array ( quot -- newquot ) + { } output>sequence ; inline + +MACRO: input> ] keep + '[ _ firstn @ ] ; + +MACRO: reduce-outputs ( quot operation -- newquot ) + [ dup infer out>> 1 [-] ] dip n*quot compose ; + +: sum-outputs ( quot -- n ) + [ + ] reduce-outputs ; inline + +MACRO: append-outputs-as ( quot exemplar -- newquot ) + [ dup infer out>> ] dip '[ @ _ _ nappend-as ] ; + +: append-outputs ( quot -- seq ) + { } append-outputs-as ; inline diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor index 7d5a041951..38d40d8482 100644 --- a/basis/command-line/command-line.factor +++ b/basis/command-line/command-line.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: init continuations hashtables io io.encodings.utf8 -io.files kernel kernel.private namespaces parser sequences -strings system splitting vocabs.loader ; +io.files io.pathnames kernel kernel.private namespaces parser +sequences strings system splitting vocabs.loader ; IN: command-line SYMBOL: script diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor index d8bad5ec41..81359690db 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor @@ -13,7 +13,7 @@ IN: compiler.cfg.alias-analysis.tests [ ] [ { - T{ ##load-indirect f V int-regs 1 "hello" } + T{ ##load-reference f V int-regs 1 "hello" } T{ ##slot-imm f V int-regs 0 V int-regs 1 0 3 } } alias-analysis drop ] unit-test diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index 90227bb5da..ec8fe62dfb 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -68,7 +68,8 @@ IN: compiler.cfg.alias-analysis ! Map vregs -> alias classes SYMBOL: vregs>acs -: check [ "BUG: static type error detected" throw ] unless* ; inline +: check ( obj -- obj ) + [ "BUG: static type error detected" throw ] unless* ; inline : vreg>ac ( vreg -- ac ) #! Only vregs produced by ##allot, ##peek and ##slot can @@ -223,7 +224,7 @@ GENERIC: analyze-aliases* ( insn -- insn' ) M: ##load-immediate analyze-aliases* dup [ val>> ] [ dst>> ] bi constants get set-at ; -M: ##load-indirect analyze-aliases* +M: ##load-reference analyze-aliases* dup dst>> set-heap-ac ; M: ##alien-global analyze-aliases* diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index c3cce1425e..0b303a8a43 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -14,7 +14,7 @@ kernel.private math ; [ ] [ dup ] [ swap ] - [ >r r> ] + [ [ ] dip ] [ fixnum+ ] [ fixnum+fast ] [ 3 fixnum+fast ] diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index c0d5bf79a6..817c0f4680 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -5,17 +5,17 @@ sequences classes.tuple cpu.architecture compiler.cfg.registers compiler.cfg.instructions ; IN: compiler.cfg.hats -: i int-regs next-vreg ; inline -: ^^i i dup ; inline -: ^^i1 [ ^^i ] dip ; inline -: ^^i2 [ ^^i ] 2dip ; inline -: ^^i3 [ ^^i ] 3dip ; inline +: i ( -- vreg ) int-regs next-vreg ; inline +: ^^i ( -- vreg vreg ) i dup ; inline +: ^^i1 ( obj -- vreg vreg obj ) [ ^^i ] dip ; inline +: ^^i2 ( obj obj -- vreg vreg obj obj ) [ ^^i ] 2dip ; inline +: ^^i3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^i ] 3dip ; inline -: d double-float-regs next-vreg ; inline -: ^^d d dup ; inline -: ^^d1 [ ^^d ] dip ; inline -: ^^d2 [ ^^d ] 2dip ; inline -: ^^d3 [ ^^d ] 3dip ; inline +: d ( -- vreg ) double-float-regs next-vreg ; inline +: ^^d ( -- vreg vreg ) d dup ; inline +: ^^d1 ( obj -- vreg vreg obj ) [ ^^d ] dip ; inline +: ^^d2 ( obj obj -- vreg vreg obj obj ) [ ^^d ] 2dip ; inline +: ^^d3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^d ] 3dip ; inline : ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline : ^^peek ( loc -- dst ) ^^i1 ##peek ; inline diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 5619a70740..d152a8cc33 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -36,13 +36,13 @@ TUPLE: ##alien-setter < ##effect { value vreg } ; ! Stack operations INSN: ##load-immediate < ##pure { val integer } ; -INSN: ##load-indirect < ##pure obj ; +INSN: ##load-reference < ##pure obj ; GENERIC: ##load-literal ( dst value -- ) M: fixnum ##load-literal tag-fixnum ##load-immediate ; M: f ##load-literal drop \ f tag-number ##load-immediate ; -M: object ##load-literal ##load-indirect ; +M: object ##load-literal ##load-reference ; INSN: ##peek < ##read { loc loc } ; INSN: ##replace < ##write { loc loc } ; diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor index 5a5df88112..30d062d4cc 100644 --- a/basis/compiler/cfg/instructions/syntax/syntax.factor +++ b/basis/compiler/cfg/instructions/syntax/syntax.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: classes.tuple classes.tuple.parser kernel words -make fry sequences parser ; +make fry sequences parser accessors ; IN: compiler.cfg.instructions.syntax : insn-word ( -- word ) @@ -10,10 +10,13 @@ IN: compiler.cfg.instructions.syntax #! this one. "insn" "compiler.cfg.instructions" lookup ; +: insn-effect ( word -- effect ) + boa-effect [ but-last ] change-in { } >>out ; + : INSN: parse-tuple-definition "regs" suffix [ dup tuple eq? [ drop insn-word ] when ] dip [ define-tuple-class ] [ 2drop save-location ] - [ 2drop dup '[ f _ boa , ] define-inline ] + [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ] 3tri ; parsing diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 5f75330865..3d0a7bec9c 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: qualified words sequences kernel combinators -cpu.architecture +USING: words sequences kernel combinators cpu.architecture compiler.cfg.hats compiler.cfg.instructions compiler.cfg.intrinsics.alien diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 948302c74b..4ddd1fdc0b 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1,7 +1,7 @@ IN: compiler.cfg.linear-scan.tests USING: tools.test random sorting sequences sets hashtables assocs kernel fry arrays splitting namespaces math accessors vectors -math.order +math.order grouping cpu.architecture compiler.cfg.instructions compiler.cfg.registers @@ -249,7 +249,7 @@ SYMBOL: max-uses ] with-scope ; : random-test ( num-intervals max-uses max-registers max-insns -- ) - over >r random-live-intervals r> int-regs associate check-linear-scan ; + over [ random-live-intervals ] dip int-regs associate check-linear-scan ; [ ] [ 30 2 1 60 random-test ] unit-test [ ] [ 60 2 2 60 random-test ] unit-test diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index 7433df9617..584c4cd662 100644 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -37,7 +37,7 @@ M: insn linearize-insn , drop ; M: ##branch linearize-insn drop dup successors>> first emit-branch ; -: (binary-conditional) +: (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc ) [ dup successors>> first2 ] [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor index 476ba7d0ab..cc790c6c0a 100644 --- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor +++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor @@ -39,8 +39,6 @@ GENERIC: >expr ( insn -- expr ) M: ##load-immediate >expr val>> ; -M: ##load-indirect >expr obj>> ; - M: ##unary >expr [ class ] [ src>> vreg>vn ] bi unary-expr boa ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index 641ccceb5d..ac9603522e 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -81,7 +81,7 @@ sequences ; [ { - T{ ##load-indirect f V int-regs 1 + } + T{ ##load-reference f V int-regs 1 + } T{ ##peek f V int-regs 2 D 0 } T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> } T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> } @@ -89,7 +89,7 @@ sequences ; } ] [ { - T{ ##load-indirect f V int-regs 1 + } + T{ ##load-reference f V int-regs 1 + } T{ ##peek f V int-regs 2 D 0 } T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> } T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc/= } @@ -99,7 +99,7 @@ sequences ; [ { - T{ ##load-indirect f V int-regs 1 + } + T{ ##load-reference f V int-regs 1 + } T{ ##peek f V int-regs 2 D 0 } T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= } T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> } @@ -107,7 +107,7 @@ sequences ; } ] [ { - T{ ##load-indirect f V int-regs 1 + } + T{ ##load-reference f V int-regs 1 + } T{ ##peek f V int-regs 2 D 0 } T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= } T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc= } diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 9f134c02d7..3d7f574cf8 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces make math math.order math.parser sequences accessors kernel kernel.private layouts assocs words summary arrays combinators classes.algebra alien alien.c-types alien.structs -alien.strings alien.arrays sets threads libc continuations.private +alien.strings alien.arrays sets libc continuations.private fry cpu.architecture compiler.errors compiler.alien @@ -11,7 +11,8 @@ compiler.cfg compiler.cfg.instructions compiler.cfg.registers compiler.cfg.builder -compiler.codegen.fixup ; +compiler.codegen.fixup +compiler.utilities ; IN: compiler.codegen GENERIC: generate-insn ( insn -- ) @@ -69,8 +70,8 @@ SYMBOL: labels M: ##load-immediate generate-insn [ dst>> register ] [ val>> ] bi %load-immediate ; -M: ##load-indirect generate-insn - [ dst>> register ] [ obj>> ] bi %load-indirect ; +M: ##load-reference generate-insn + [ dst>> register ] [ obj>> ] bi %load-reference ; M: ##peek generate-insn [ dst>> register ] [ loc>> ] bi %peek ; @@ -95,7 +96,7 @@ M: ##dispatch-label generate-insn label>> %dispatch-label ; M: ##dispatch generate-insn [ src>> register ] [ temp>> register ] [ offset>> ] tri %dispatch ; -: >slot< +: >slot< ( insn -- dst obj slot tag ) { [ dst>> register ] [ obj>> register ] @@ -109,7 +110,7 @@ M: ##slot generate-insn M: ##slot-imm generate-insn >slot< %slot-imm ; -: >set-slot< +: >set-slot< ( insn -- src obj slot tag ) { [ src>> register ] [ obj>> register ] @@ -209,7 +210,8 @@ M: ##alien-cell generate-insn dst/src %alien-cell ; M: ##alien-float generate-insn dst/src %alien-float ; M: ##alien-double generate-insn dst/src %alien-double ; -: >alien-setter< [ src>> register ] [ value>> register ] bi ; inline +: >alien-setter< ( insn -- src value ) + [ src>> register ] [ value>> register ] bi ; inline M: ##set-alien-integer-1 generate-insn >alien-setter< %set-alien-integer-1 ; M: ##set-alien-integer-2 generate-insn >alien-setter< %set-alien-integer-2 ; @@ -462,7 +464,7 @@ TUPLE: callback-context ; dup current-callback eq? [ drop ] [ - yield wait-to-return + yield-hook get call wait-to-return ] if ; : do-callback ( quot token -- ) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 0d24daef71..f2f4e7aa9e 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -1,14 +1,14 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel namespaces arrays sequences io words fry continuations vocabs assocs dlists definitions math -threads graphs generic combinators deques search-deques io +graphs generic combinators deques search-deques io stack-checker stack-checker.state stack-checker.inlining compiler.errors compiler.units compiler.tree.builder compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer compiler.cfg.linearization compiler.cfg.two-operand compiler.cfg.linear-scan -compiler.cfg.stack-frame compiler.codegen ; +compiler.cfg.stack-frame compiler.codegen compiler.utilities ; IN: compiler SYMBOL: compile-queue @@ -24,7 +24,7 @@ SYMBOL: compiled } cond drop ; : maybe-compile ( word -- ) - dup compiled>> [ drop ] [ queue-compile ] if ; + dup optimized>> [ drop ] [ queue-compile ] if ; SYMBOL: +failed+ @@ -107,10 +107,10 @@ t compile-dependencies? set-global ] with-return ; : compile-loop ( deque -- ) - [ (compile) yield ] slurp-deque ; + [ (compile) yield-hook get call ] slurp-deque ; : decompile ( word -- ) - f 2array 1array t modify-code-heap ; + f 2array 1array modify-code-heap ; : optimized-recompile-hook ( words -- alist ) [ diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index e743c8484b..78e95ffb91 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -75,7 +75,7 @@ unit-test -12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call ] unit-test -[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test +[ -1 2 ] [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test [ 12 13 ] [ -12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call @@ -88,13 +88,13 @@ unit-test ! Test slow shuffles [ 3 1 2 3 4 5 6 7 8 9 ] [ 1 2 3 4 5 6 7 8 9 - [ >r >r >r >r >r >r >r >r >r 3 r> r> r> r> r> r> r> r> r> ] + [ [ [ [ [ [ [ [ [ [ 3 ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] compile-call ] unit-test [ 2 2 2 2 2 2 2 2 2 2 1 ] [ 1 2 - [ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-call + [ swap [ dup dup dup dup dup dup dup dup dup ] dip ] compile-call ] unit-test [ ] [ [ 9 [ ] times ] compile-call ] unit-test @@ -110,7 +110,7 @@ unit-test float+ swap { [ "hey" ] [ "bye" ] } dispatch ; : try-breaking-dispatch-2 ( -- ? ) - 1 1.0 2.5 try-breaking-dispatch "bye" = >r 3.5 = r> and ; + 1 1.0 2.5 try-breaking-dispatch "bye" = [ 3.5 = ] dip and ; [ t ] [ 10000000 [ drop try-breaking-dispatch-2 ] all? @@ -131,10 +131,10 @@ unit-test 2dup 1 slot eq? [ 2drop ] [ 2dup array-nth tombstone? [ [ - [ array-nth ] 2keep >r 1 fixnum+fast r> array-nth + [ array-nth ] 2keep [ 1 fixnum+fast ] dip array-nth pick 2dup hellish-bug-1 3drop ] 2keep - ] unless >r 2 fixnum+fast r> hellish-bug-2 + ] unless [ 2 fixnum+fast ] dip hellish-bug-2 ] if ; inline recursive : hellish-bug-3 ( hash array -- ) @@ -159,9 +159,9 @@ TUPLE: my-tuple ; [ 5 ] [ "hi" foox ] unit-test ! Making sure we don't needlessly unbox/rebox -[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-call ] unit-test +[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test -[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call >r eq? r> ] unit-test +[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test [ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test @@ -188,7 +188,7 @@ TUPLE: my-tuple ; [ 2 1 ] [ 2 1 - [ 2dup fixnum< [ >r die r> ] when ] compile-call + [ 2dup fixnum< [ [ die ] dip ] when ] compile-call ] unit-test ! Regression @@ -211,7 +211,7 @@ TUPLE: my-tuple ; { tuple vector } 3 slot { word } declare dup 1 slot 0 fixnum-bitand { [ ] } dispatch ; -[ t ] [ \ dispatch-alignment-regression compiled>> ] unit-test +[ t ] [ \ dispatch-alignment-regression optimized>> ] unit-test [ vector ] [ dispatch-alignment-regression ] unit-test @@ -276,3 +276,9 @@ TUPLE: id obj ; [ 4 ] [ 2 [ dup fixnum* ] compile-call ] unit-test [ 7 ] [ 2 [ dup fixnum* 3 fixnum+fast ] compile-call ] unit-test + +TUPLE: cucumber ; + +M: cucumber equal? "The cucumber has no equal" throw ; + +[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test \ No newline at end of file diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor index ecc2d87b73..1857baf503 100644 --- a/basis/compiler/tests/curry.factor +++ b/basis/compiler/tests/curry.factor @@ -8,7 +8,7 @@ IN: compiler.tests [ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test [ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test [ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test -[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test +[ 3 ] [ 5 2 [ [ - ] 2curry [ 9 ] dip call /i ] compile-call ] unit-test [ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test @@ -21,14 +21,14 @@ IN: compiler.tests [ [ 6 2 + ] ] [ 2 5 - [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ] + [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry ] compile-call >quotation ] unit-test [ 8 ] [ 2 5 - [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ] + [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry call ] compile-call ] unit-test diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index fa6a3c7b21..c5bbe4a6c3 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -9,7 +9,7 @@ IN: optimizer.tests GENERIC: xyz ( obj -- obj ) M: array xyz xyz ; -[ t ] [ \ xyz compiled>> ] unit-test +[ t ] [ \ xyz optimized>> ] unit-test ! Test predicate inlining : pred-test-1 @@ -94,7 +94,7 @@ TUPLE: pred-test ; ! regression GENERIC: void-generic ( obj -- * ) : breakage ( -- * ) "hi" void-generic ; -[ t ] [ \ breakage compiled>> ] unit-test +[ t ] [ \ breakage optimized>> ] unit-test [ breakage ] must-fail ! regression @@ -119,7 +119,7 @@ GENERIC: void-generic ( obj -- * ) ! compiling with a non-literal class failed : -regression ( class -- tuple ) ; -[ t ] [ \ -regression compiled>> ] unit-test +[ t ] [ \ -regression optimized>> ] unit-test GENERIC: foozul ( a -- b ) M: reversed foozul ; @@ -228,7 +228,7 @@ USE: binary-search.private : node-successor-f-bug ( x -- * ) [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ; -[ t ] [ \ node-successor-f-bug compiled>> ] unit-test +[ t ] [ \ node-successor-f-bug optimized>> ] unit-test [ ] [ [ new ] build-tree optimize-tree drop ] unit-test @@ -242,18 +242,18 @@ USE: binary-search.private ] if ] if ; -[ t ] [ \ lift-throw-tail-regression compiled>> ] unit-test +[ t ] [ \ lift-throw-tail-regression optimized>> ] unit-test [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test : lift-loop-tail-test-1 ( a quot -- ) over even? [ - [ >r 3 - r> call ] keep lift-loop-tail-test-1 + [ [ 3 - ] dip call ] keep lift-loop-tail-test-1 ] [ over 0 < [ 2drop ] [ - [ >r 2 - r> call ] keep lift-loop-tail-test-1 + [ [ 2 - ] dip call ] keep lift-loop-tail-test-1 ] if ] if ; inline @@ -271,7 +271,7 @@ HINTS: recursive-inline-hang array ; : recursive-inline-hang-1 ( -- a ) { } recursive-inline-hang ; -[ t ] [ \ recursive-inline-hang-1 compiled>> ] unit-test +[ t ] [ \ recursive-inline-hang-1 optimized>> ] unit-test DEFER: recursive-inline-hang-3 @@ -290,7 +290,7 @@ HINTS: recursive-inline-hang-3 array ; ! Wow : counter-example ( a b c d -- a' b' c' d' ) - dup 0 > [ 1 - >r rot 2 * r> counter-example ] when ; inline + dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline : counter-example' ( -- a' b' c' d' ) 1 2 3.0 3 counter-example ; @@ -330,7 +330,7 @@ PREDICATE: list < improper-list [ 0 5 ] [ 0 interval-inference-bug ] unit-test : aggressive-flush-regression ( a -- b ) - f over >r drop r> 1 + ; + f over [ drop ] dip 1 + ; [ 1.0 aggressive-flush-regression drop ] must-fail diff --git a/basis/compiler/tests/peg-regression.factor b/basis/compiler/tests/peg-regression.factor index a0262fdc81..56a4021eed 100644 --- a/basis/compiler/tests/peg-regression.factor +++ b/basis/compiler/tests/peg-regression.factor @@ -22,5 +22,5 @@ pipeline = "hello" => [[ ast>pipeline-expr ]] USE: tools.test -[ t ] [ \ expr compiled>> ] unit-test -[ t ] [ \ ast>pipeline-expr compiled>> ] unit-test +[ t ] [ \ expr optimized>> ] unit-test +[ t ] [ \ ast>pipeline-expr optimized>> ] unit-test diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor index 1b349d2296..b5835de5fd 100644 --- a/basis/compiler/tests/redefine1.factor +++ b/basis/compiler/tests/redefine1.factor @@ -23,36 +23,36 @@ M: integer method-redefine-test 3 + ; : hey ( -- ) ; : there ( -- ) hey ; -[ t ] [ \ hey compiled>> ] unit-test -[ t ] [ \ there compiled>> ] unit-test +[ t ] [ \ hey optimized>> ] unit-test +[ t ] [ \ there optimized>> ] unit-test [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test -[ f ] [ \ hey compiled>> ] unit-test -[ f ] [ \ there compiled>> ] unit-test +[ f ] [ \ hey optimized>> ] unit-test +[ f ] [ \ there optimized>> ] unit-test [ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test -[ t ] [ \ there compiled>> ] unit-test +[ t ] [ \ there optimized>> ] unit-test : good ( -- ) ; : bad ( -- ) good ; : ugly ( -- ) bad ; -[ t ] [ \ good compiled>> ] unit-test -[ t ] [ \ bad compiled>> ] unit-test -[ t ] [ \ ugly compiled>> ] unit-test +[ t ] [ \ good optimized>> ] unit-test +[ t ] [ \ bad optimized>> ] unit-test +[ t ] [ \ ugly optimized>> ] unit-test [ f ] [ \ good compiled-usage assoc-empty? ] unit-test [ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test -[ f ] [ \ good compiled>> ] unit-test -[ f ] [ \ bad compiled>> ] unit-test -[ f ] [ \ ugly compiled>> ] unit-test +[ f ] [ \ good optimized>> ] unit-test +[ f ] [ \ bad optimized>> ] unit-test +[ f ] [ \ ugly optimized>> ] unit-test [ t ] [ \ good compiled-usage assoc-empty? ] unit-test [ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test -[ t ] [ \ good compiled>> ] unit-test -[ t ] [ \ bad compiled>> ] unit-test -[ t ] [ \ ugly compiled>> ] unit-test +[ t ] [ \ good optimized>> ] unit-test +[ t ] [ \ bad optimized>> ] unit-test +[ t ] [ \ ugly optimized>> ] unit-test [ f ] [ \ good compiled-usage assoc-empty? ] unit-test diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor index 941d086312..b25b5a1a5e 100644 --- a/basis/compiler/tests/redefine3.factor +++ b/basis/compiler/tests/redefine3.factor @@ -14,7 +14,7 @@ M: empty-mixin sheeple drop "wake up" ; : sheeple-test ( -- string ) { } sheeple ; [ "sheeple" ] [ sheeple-test ] unit-test -[ t ] [ \ sheeple-test compiled>> ] unit-test +[ t ] [ \ sheeple-test optimized>> ] unit-test [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test @@ -27,6 +27,6 @@ M: empty-mixin sheeple drop "wake up" ; [ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test [ "sheeple" ] [ sheeple-test ] unit-test -[ t ] [ \ sheeple-test compiled>> ] unit-test +[ t ] [ \ sheeple-test optimized>> ] unit-test [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index c1e23c3e1e..a6d6c5dfb9 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -237,6 +237,6 @@ M: f single-combination-test-2 single-combination-test-4 ; 10 [ [ "compiler.tests.foo" forget-vocab ] with-compilation-unit [ t ] [ - "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) compiled>>" eval + "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval ] unit-test ] times diff --git a/basis/compiler/tests/spilling.factor b/basis/compiler/tests/spilling.factor index ee8c2f056a..4092352fd5 100644 --- a/basis/compiler/tests/spilling.factor +++ b/basis/compiler/tests/spilling.factor @@ -47,7 +47,7 @@ IN: compiler.tests [ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ] [ 1.0 float-spill-bug ] unit-test -[ t ] [ \ float-spill-bug compiled>> ] unit-test +[ t ] [ \ float-spill-bug optimized>> ] unit-test : float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object ) { @@ -132,7 +132,7 @@ IN: compiler.tests [ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ] [ 1.0 float-fixnum-spill-bug ] unit-test -[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test +[ t ] [ \ float-fixnum-spill-bug optimized>> ] unit-test : resolve-spill-bug ( a b -- c ) [ 1 fixnum+fast ] bi@ dup 10 fixnum< [ @@ -159,7 +159,7 @@ IN: compiler.tests 16 narray ] if ; -[ t ] [ \ resolve-spill-bug compiled>> ] unit-test +[ t ] [ \ resolve-spill-bug optimized>> ] unit-test [ 4 ] [ 1 1 resolve-spill-bug ] unit-test diff --git a/basis/compiler/tree/checker/checker.factor b/basis/compiler/tree/checker/checker.factor index 4f99fa015d..a5f18d6389 100644 --- a/basis/compiler/tree/checker/checker.factor +++ b/basis/compiler/tree/checker/checker.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: sequences kernel sets namespaces accessors assocs arrays combinators continuations columns math vectors -stack-checker.branches +grouping stack-checker.branches compiler.tree compiler.tree.def-use compiler.tree.combinators ; diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index b64e30d8f9..7c28866e94 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/basis/compiler/tree/dead-code/dead-code-tests.factor @@ -79,7 +79,7 @@ IN: compiler.tree.dead-code.tests [ [ read drop 1 2 ] ] [ [ read [ 1 2 ] dip drop ] optimize-quot ] unit-test -[ [ over >r + r> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test +[ [ over >R + R> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test [ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index e75e7f6046..9f2cc0536e 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -4,7 +4,7 @@ USING: kernel assocs match fry accessors namespaces make effects sequences sequences.private quotations generic macros arrays prettyprint prettyprint.backend prettyprint.custom prettyprint.sections math words combinators -combinators.short-circuit io sorting hints qualified +combinators.short-circuit io sorting hints compiler.tree compiler.tree.recursive compiler.tree.normalization @@ -80,10 +80,12 @@ M: shuffle-node pprint* effect>> effect>string text ; [ out-d>> length 1 = ] } 1&& ; +SYMBOLS: >R R> ; + M: #shuffle node>quot { - { [ dup #>r? ] [ drop \ >r , ] } - { [ dup #r>? ] [ drop \ r> , ] } + { [ dup #>r? ] [ drop \ >R , ] } + { [ dup #r>? ] [ drop \ R> , ] } { [ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ] [ diff --git a/basis/compiler/tree/escape-analysis/branches/branches.factor b/basis/compiler/tree/escape-analysis/branches/branches.factor index 2eee3e698b..ca41ac59fc 100644 --- a/basis/compiler/tree/escape-analysis/branches/branches.factor +++ b/basis/compiler/tree/escape-analysis/branches/branches.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel namespaces sequences sets fry columns -stack-checker.branches +grouping stack-checker.branches compiler.tree compiler.tree.propagation.branches compiler.tree.escape-analysis.nodes diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor index b535dfe39c..5d6a9cdea1 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor @@ -8,13 +8,13 @@ compiler.tree.debugger ; : test-modular-arithmetic ( quot -- quot' ) build-tree optimize-tree nodes>quot ; -[ [ >r >fixnum r> >fixnum fixnum+fast ] ] +[ [ >R >fixnum R> >fixnum fixnum+fast ] ] [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test [ [ +-integer-integer dup >fixnum ] ] [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test -[ [ >r >fixnum r> >fixnum fixnum+fast 4 fixnum*fast ] ] +[ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] ] [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test TUPLE: declared-fixnum { x fixnum } ; diff --git a/basis/compiler/tree/propagation/copy/copy.factor b/basis/compiler/tree/propagation/copy/copy.factor index 53b7d17326..c989aaf672 100644 --- a/basis/compiler/tree/propagation/copy/copy.factor +++ b/basis/compiler/tree/propagation/copy/copy.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces sequences assocs math kernel accessors fry -combinators sets locals columns +combinators sets locals columns grouping stack-checker.branches compiler.tree compiler.tree.def-use diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index bd6d657442..7b3135e85c 100644 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -3,7 +3,7 @@ USING: accessors kernel arrays sequences math math.order math.partial-dispatch generic generic.standard generic.math classes.algebra classes.union sets quotations assocs combinators -words namespaces continuations classes fry +words namespaces continuations classes fry combinators.smart compiler.tree compiler.tree.builder compiler.tree.recursive @@ -134,17 +134,19 @@ DEFER: (flat-length) over 2 <= [ drop ] [ 2/ 1+ * ] if 24 swap [-] 4 /i ; : inlining-rank ( #call word -- n ) - [ classes-known? 2 0 ? ] [ - { - [ body-length-bias ] - [ "default" word-prop -4 0 ? ] - [ "specializer" word-prop 1 0 ? ] - [ method-body? 1 0 ? ] - } cleave - node-count-bias - loop-nesting get 0 or 2 * - ] bi* + + + + + + ; + [ classes-known? 2 0 ? ] + [ + { + [ body-length-bias ] + [ "default" word-prop -4 0 ? ] + [ "specializer" word-prop 1 0 ? ] + [ method-body? 1 0 ? ] + } cleave + node-count-bias + loop-nesting get 0 or 2 * + ] bi* + ] sum-outputs ; : should-inline? ( #call word -- ? ) dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ; diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 4d8d935477..d5aa5318a4 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private arrays assocs classes classes.algebra combinators generic.math splitting fry locals classes.tuple alien.accessors classes.tuple.private slots.private definitions strings.private -vectors hashtables +vectors hashtables generic stack-checker.state compiler.tree.comparisons compiler.tree.propagation.info @@ -337,3 +337,12 @@ generic-comparison-ops [ bi ] [ 2drop object-info ] if ] "outputs" set-word-prop + +\ equal? [ + ! If first input has a known type and second input is an + ! object, we convert this to [ swap equal? ]. + in-d>> first2 value-info class>> object class= [ + value-info class>> \ equal? specific-method + [ swap equal? ] f ? + ] [ drop f ] if +] "custom-inlining" set-word-prop diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index d95245fe83..b9a88de34a 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -18,7 +18,7 @@ IN: compiler.tree.propagation.tests [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test -[ V{ fixnum } ] [ [ 1 >r r> ] final-classes ] unit-test +[ V{ fixnum } ] [ [ 1 [ ] dip ] final-classes ] unit-test [ V{ fixnum object } ] [ [ 1 swap ] final-classes ] unit-test @@ -198,7 +198,7 @@ IN: compiler.tree.propagation.tests [ { fixnum byte-array } declare [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe - >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift + [ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift 255 min 0 max ] final-classes ] unit-test @@ -640,6 +640,10 @@ MIXIN: empty-mixin [ { fixnum } declare log2 0 >= ] final-classes ] unit-test +[ V{ POSTPONE: f } ] [ + [ { word object } declare equal? ] final-classes +] unit-test + ! [ V{ string } ] [ ! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes ! ] unit-test diff --git a/basis/compiler/utilities/utilities.factor b/basis/compiler/utilities/utilities.factor index 1f488b3dde..ec4ced8c9f 100644 --- a/basis/compiler/utilities/utilities.factor +++ b/basis/compiler/utilities/utilities.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private arrays vectors fry -math.order ; +math.order namespaces assocs ; IN: compiler.utilities : flattener ( seq quot -- seq vector quot' ) @@ -22,10 +22,6 @@ IN: compiler.utilities : 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline -: (3each) ( seq1 seq2 seq3 quot -- n quot' ) - [ [ [ length ] tri@ min min ] 3keep ] dip - '[ [ _ nth-unsafe ] [ _ nth-unsafe ] [ _ nth-unsafe ] tri @ ] ; inline +SYMBOL: yield-hook -: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline - -: 3map ( seq1 seq2 seq3 quot -- seq ) (3each) map ; inline +yield-hook global [ [ ] or ] change-at diff --git a/basis/concurrency/combinators/combinators.factor b/basis/concurrency/combinators/combinators.factor old mode 100644 new mode 100755 index 932605fc36..3d18b9e029 --- a/basis/concurrency/combinators/combinators.factor +++ b/basis/concurrency/combinators/combinators.factor @@ -28,7 +28,8 @@ PRIVATE> : [future] ( quot -- quot' ) '[ _ curry future ] ; inline -: future-values dup [ ?future ] change-each ; inline +: future-values ( futures -- futures ) + dup [ ?future ] change-each ; inline PRIVATE> diff --git a/basis/concurrency/distributed/distributed-tests.factor b/basis/concurrency/distributed/distributed-tests.factor index 1087823aa0..996e3db4c0 100644 --- a/basis/concurrency/distributed/distributed-tests.factor +++ b/basis/concurrency/distributed/distributed-tests.factor @@ -1,7 +1,8 @@ IN: concurrency.distributed.tests USING: tools.test concurrency.distributed kernel io.files -arrays io.sockets system combinators threads math sequences -concurrency.messaging continuations accessors prettyprint ; +io.files.temp io.directories arrays io.sockets system +combinators threads math sequences concurrency.messaging +continuations accessors prettyprint ; : test-node ( -- addrspec ) { diff --git a/basis/concurrency/distributed/distributed.factor b/basis/concurrency/distributed/distributed.factor index 99ad239011..ca1c5762f6 100644 --- a/basis/concurrency/distributed/distributed.factor +++ b/basis/concurrency/distributed/distributed.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: serialize sequences concurrency.messaging threads io io.servers.connection io.encodings.binary -qualified arrays namespaces kernel accessors ; +arrays namespaces kernel accessors ; FROM: io.sockets => host-name with-client ; IN: concurrency.distributed diff --git a/basis/concurrency/messaging/messaging-docs.factor b/basis/concurrency/messaging/messaging-docs.factor index 3bd2d330c3..41beedb6dc 100644 --- a/basis/concurrency/messaging/messaging-docs.factor +++ b/basis/concurrency/messaging/messaging-docs.factor @@ -53,7 +53,8 @@ ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous sends" { $subsection reply-synchronous } "An example:" { $example - "USING: concurrency.messaging kernel threads ;" + "USING: concurrency.messaging kernel prettyprint threads ;" + "IN: scratchpad" ": pong-server ( -- )" " receive [ \"pong\" ] dip reply-synchronous ;" "[ pong-server t ] \"pong-server\" spawn-server" diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor index 7a00f62e9e..61a3c38991 100644 --- a/basis/concurrency/messaging/messaging.factor +++ b/basis/concurrency/messaging/messaging.factor @@ -20,13 +20,13 @@ M: thread send ( message thread -- ) my-mailbox mailbox-get ?linked ; : receive-timeout ( timeout -- message ) - my-mailbox swap mailbox-get-timeout ?linked ; + [ my-mailbox ] dip mailbox-get-timeout ?linked ; : receive-if ( pred -- message ) - my-mailbox swap mailbox-get? ?linked ; inline + [ my-mailbox ] dip mailbox-get? ?linked ; inline : receive-if-timeout ( timeout pred -- message ) - my-mailbox -rot mailbox-get-timeout? ?linked ; inline + [ my-mailbox ] 2dip mailbox-get-timeout? ?linked ; inline : rethrow-linked ( error process supervisor -- ) [ ] dip send ; diff --git a/basis/cords/authors.txt b/basis/cords/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/cords/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/cords/cords-tests.factor b/basis/cords/cords-tests.factor new file mode 100644 index 0000000000..0058c8f07a --- /dev/null +++ b/basis/cords/cords-tests.factor @@ -0,0 +1,5 @@ +IN: cords.tests +USING: cords strings tools.test kernel sequences ; + +[ "hello world" ] [ "hello" " world" cord-append dup like ] unit-test +[ "hello world" ] [ { "he" "llo" " world" } cord-concat dup like ] unit-test diff --git a/basis/cords/cords.factor b/basis/cords/cords.factor new file mode 100644 index 0000000000..915744491f --- /dev/null +++ b/basis/cords/cords.factor @@ -0,0 +1,70 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs sequences sorting binary-search math +math.order arrays combinators kernel ; +IN: cords + +> length ] [ second>> length ] bi + ; + +M: simple-cord virtual-seq first>> ; + +M: simple-cord virtual@ + 2dup first>> length < + [ first>> ] [ [ first>> length - ] [ second>> ] bi ] if ; + +TUPLE: multi-cord count seqs ; + +M: multi-cord length count>> ; + +M: multi-cord virtual@ + dupd + seqs>> [ first <=> ] with search nip + [ first - ] [ second ] bi ; + +M: multi-cord virtual-seq + seqs>> [ f ] [ first second ] if-empty ; + +: ( seqs -- cord ) + dup length 2 = [ + first2 simple-cord boa + ] [ + [ 0 [ length + ] accumulate ] keep zip multi-cord boa + ] if ; + +PRIVATE> + +UNION: cord simple-cord multi-cord ; + +INSTANCE: cord virtual-sequence + +INSTANCE: multi-cord virtual-sequence + +: cord-append ( seq1 seq2 -- cord ) + { + { [ over empty? ] [ nip ] } + { [ dup empty? ] [ drop ] } + { [ 2dup [ cord? ] both? ] [ [ seqs>> values ] bi@ append ] } + { [ over cord? ] [ [ seqs>> values ] dip suffix ] } + { [ dup cord? ] [ seqs>> values swap prefix ] } + [ 2array ] + } cond ; + +: cord-concat ( seqs -- cord ) + { + { [ dup empty? ] [ drop f ] } + { [ dup length 1 = ] [ first ] } + [ + [ + { + { [ dup cord? ] [ seqs>> values ] } + { [ dup empty? ] [ drop { } ] } + [ 1array ] + } cond + ] map concat + ] + } cond ; diff --git a/basis/cords/summary.txt b/basis/cords/summary.txt new file mode 100644 index 0000000000..3c69862b71 --- /dev/null +++ b/basis/cords/summary.txt @@ -0,0 +1 @@ +Virtual sequence concatenation diff --git a/basis/cords/tags.txt b/basis/cords/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/basis/cords/tags.txt @@ -0,0 +1 @@ +collections diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor index 0f64c0666f..ec83ba7a8b 100644 --- a/basis/core-foundation/core-foundation.factor +++ b/basis/core-foundation/core-foundation.factor @@ -14,8 +14,7 @@ TYPEDEF: int SInt32 TYPEDEF: uint UInt32 TYPEDEF: ulong CFTypeID TYPEDEF: UInt32 CFOptionFlags -TYPEDEF: double CFTimeInterval -TYPEDEF: double CFAbsoluteTime +TYPEDEF: void* CFUUIDRef FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ; diff --git a/basis/core-foundation/data/data.factor b/basis/core-foundation/data/data.factor index 043fb905ad..f4d2babca7 100644 --- a/basis/core-foundation/data/data.factor +++ b/basis/core-foundation/data/data.factor @@ -8,7 +8,6 @@ TYPEDEF: void* CFDictionaryRef TYPEDEF: void* CFMutableDictionaryRef TYPEDEF: void* CFNumberRef TYPEDEF: void* CFSetRef -TYPEDEF: void* CFUUIDRef TYPEDEF: int CFNumberType : kCFNumberSInt8Type 1 ; inline diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index 7ed040b455..b0c299a831 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -5,7 +5,8 @@ math sequences namespaces make assocs init accessors continuations combinators io.encodings.utf8 destructors locals arrays specialized-arrays.direct.alien specialized-arrays.direct.int specialized-arrays.direct.longlong -core-foundation core-foundation.run-loop core-foundation.strings ; +core-foundation core-foundation.run-loop core-foundation.strings +core-foundation.time ; IN: core-foundation.fsevents : kFSEventStreamCreateFlagUseCFTypes 2 ; inline diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 475991a246..4b98e9a410 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -1,8 +1,10 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.syntax kernel namespaces core-foundation -core-foundation.strings core-foundation.file-descriptors -core-foundation.timers ; +USING: accessors alien alien.syntax kernel math namespaces +sequences destructors combinators threads heaps deques calendar +core-foundation core-foundation.strings +core-foundation.file-descriptors core-foundation.timers +core-foundation.time ; IN: core-foundation.run-loop : kCFRunLoopRunFinished 1 ; inline @@ -17,9 +19,9 @@ FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ; FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( ) ; FUNCTION: SInt32 CFRunLoopRunInMode ( - CFStringRef mode, - CFTimeInterval seconds, - Boolean returnAfterSourceHandled + CFStringRef mode, + CFTimeInterval seconds, + Boolean returnAfterSourceHandled ) ; FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource ( @@ -29,27 +31,27 @@ FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource ( ) ; FUNCTION: void CFRunLoopAddSource ( - CFRunLoopRef rl, - CFRunLoopSourceRef source, - CFStringRef mode + CFRunLoopRef rl, + CFRunLoopSourceRef source, + CFStringRef mode ) ; FUNCTION: void CFRunLoopRemoveSource ( - CFRunLoopRef rl, - CFRunLoopSourceRef source, - CFStringRef mode + CFRunLoopRef rl, + CFRunLoopSourceRef source, + CFStringRef mode ) ; FUNCTION: void CFRunLoopAddTimer ( - CFRunLoopRef rl, - CFRunLoopTimerRef timer, - CFStringRef mode + CFRunLoopRef rl, + CFRunLoopTimerRef timer, + CFStringRef mode ) ; FUNCTION: void CFRunLoopRemoveTimer ( - CFRunLoopRef rl, - CFRunLoopTimerRef timer, - CFStringRef mode + CFRunLoopRef rl, + CFRunLoopTimerRef timer, + CFStringRef mode ) ; : CFRunLoopDefaultMode ( -- alien ) @@ -59,3 +61,80 @@ FUNCTION: void CFRunLoopRemoveTimer ( "kCFRunLoopDefaultMode" dup \ CFRunLoopDefaultMode set-global ] when ; + +TUPLE: run-loop fds sources timers ; + +: ( -- run-loop ) + V{ } clone V{ } clone V{ } clone \ run-loop boa ; + +SYMBOL: expiry-check + +: run-loop ( -- run-loop ) + \ run-loop get-global not expiry-check get expired? or + [ + 31337 expiry-check set-global + dup \ run-loop set-global + ] [ \ run-loop get-global ] if ; + +: add-source-to-run-loop ( source -- ) + [ run-loop sources>> push ] + [ + CFRunLoopGetMain + swap CFRunLoopDefaultMode + CFRunLoopAddSource + ] bi ; + +: create-fd-source ( CFFileDescriptor -- source ) + f swap 0 CFFileDescriptorCreateRunLoopSource ; + +: add-fd-to-run-loop ( fd callback -- ) + [ + |CFRelease + [ run-loop fds>> push ] + [ create-fd-source |CFRelease add-source-to-run-loop ] + bi + ] with-destructors ; + +: add-timer-to-run-loop ( timer -- ) + [ run-loop timers>> push ] + [ + CFRunLoopGetMain + swap CFRunLoopDefaultMode + CFRunLoopAddTimer + ] bi ; + +CFAbsoluteTime CFRunLoopTimerSetNextFireDate ; + +: (reset-timer) ( timer counter -- ) + yield { + { [ dup 0 = ] [ now ((reset-timer)) ] } + { [ run-queue deque-empty? not ] [ 1- (reset-timer) ] } + { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] } + [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ] + } cond ; + +: reset-timer ( timer -- ) + 10 (reset-timer) ; + +PRIVATE> + +: reset-run-loop ( -- ) + run-loop + [ timers>> [ reset-timer ] each ] + [ fds>> [ enable-all-callbacks ] each ] bi ; + +: timer-callback ( -- callback ) + "void" { "CFRunLoopTimerRef" "void*" } "cdecl" + [ 2drop reset-run-loop yield ] alien-callback ; + +: init-thread-timer ( -- ) + timer-callback add-timer-to-run-loop ; + +: run-one-iteration ( us -- handled? ) + reset-run-loop + CFRunLoopDefaultMode + swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval + t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ; diff --git a/basis/core-foundation/strings/strings.factor b/basis/core-foundation/strings/strings.factor index 2e6180c897..c3a969a325 100644 --- a/basis/core-foundation/strings/strings.factor +++ b/basis/core-foundation/strings/strings.factor @@ -23,11 +23,11 @@ TYPEDEF: int CFStringEncoding : kCFStringEncodingUTF32LE HEX: 1c000100 ; FUNCTION: CFStringRef CFStringCreateWithBytes ( - CFAllocatorRef alloc, - UInt8* bytes, - CFIndex numBytes, - CFStringEncoding encoding, - Boolean isExternalRepresentation + CFAllocatorRef alloc, + UInt8* bytes, + CFIndex numBytes, + CFStringEncoding encoding, + Boolean isExternalRepresentation ) ; FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ; @@ -35,16 +35,16 @@ FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ; FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ; FUNCTION: Boolean CFStringGetCString ( - CFStringRef theString, - char* buffer, - CFIndex bufferSize, - CFStringEncoding encoding + CFStringRef theString, + char* buffer, + CFIndex bufferSize, + CFStringEncoding encoding ) ; FUNCTION: CFStringRef CFStringCreateWithCString ( - CFAllocatorRef alloc, - char* cStr, - CFStringEncoding encoding + CFAllocatorRef alloc, + char* cStr, + CFStringEncoding encoding ) ; : ( string -- alien ) diff --git a/basis/core-foundation/time/time.factor b/basis/core-foundation/time/time.factor new file mode 100644 index 0000000000..15ad7bb1a1 --- /dev/null +++ b/basis/core-foundation/time/time.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: calendar alien.syntax ; +IN: core-foundation.time + +TYPEDEF: double CFTimeInterval +TYPEDEF: double CFAbsoluteTime + +: >CFTimeInterval ( duration -- interval ) + duration>seconds ; inline + +: >CFAbsoluteTime ( timestamp -- time ) + T{ timestamp { year 2001 } { month 1 } { day 1 } } time- + duration>seconds ; inline diff --git a/basis/core-foundation/timers/timers.factor b/basis/core-foundation/timers/timers.factor index 049e80b20f..51ee982592 100644 --- a/basis/core-foundation/timers/timers.factor +++ b/basis/core-foundation/timers/timers.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax system math kernel core-foundation ; +USING: alien.syntax system math kernel calendar core-foundation +core-foundation.time ; IN: core-foundation.timers TYPEDEF: void* CFRunLoopTimerRef @@ -18,12 +19,16 @@ FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate ( ) ; : ( callback -- timer ) - [ f millis 1000 /f 60 0 0 ] dip f CFRunLoopTimerCreate ; + [ f now >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ; FUNCTION: void CFRunLoopTimerInvalidate ( CFRunLoopTimerRef timer ) ; +FUNCTION: Boolean CFRunLoopTimerIsValid ( + CFRunLoopTimerRef timer +) ; + FUNCTION: void CFRunLoopTimerSetNextFireDate ( CFRunLoopTimerRef timer, CFAbsoluteTime fireDate diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index c609b9e98d..5670110f04 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -38,7 +38,7 @@ M: object param-reg param-regs nth ; HOOK: two-operand? cpu ( -- ? ) HOOK: %load-immediate cpu ( reg obj -- ) -HOOK: %load-indirect cpu ( reg obj -- ) +HOOK: %load-reference cpu ( reg obj -- ) HOOK: %peek cpu ( vreg loc -- ) HOOK: %replace cpu ( vreg loc -- ) diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor index f94cc00abc..fbb878a888 100644 --- a/basis/cpu/ppc/assembler/assembler.factor +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -97,10 +97,10 @@ X: XOR 0 316 31 X: XOR. 1 316 31 X1: EXTSB 0 954 31 X1: EXTSB. 1 954 31 -: FMR ( a s -- ) 0 -rot 72 0 63 x-insn ; -: FMR. ( a s -- ) 0 -rot 72 1 63 x-insn ; -: FCTIWZ ( a s -- ) 0 -rot 0 15 63 x-insn ; -: FCTIWZ. ( a s -- ) 0 -rot 1 15 63 x-insn ; +: FMR ( a s -- ) [ 0 ] 2dip 72 0 63 x-insn ; +: FMR. ( a s -- ) [ 0 ] 2dip 72 1 63 x-insn ; +: FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ; +: FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ; ! XO-form XO: ADD 0 0 266 31 @@ -189,21 +189,21 @@ MTSPR: LR 8 MTSPR: CTR 9 ! Pseudo-instructions -: LI 0 rot ADDI ; inline -: SUBI neg ADDI ; inline -: LIS 0 rot ADDIS ; inline -: SUBIC neg ADDIC ; inline -: SUBIC. neg ADDIC. ; inline -: NOT dup NOR ; inline -: NOT. dup NOR. ; inline -: MR dup OR ; inline -: MR. dup OR. ; inline -: (SLWI) 0 31 pick - ; inline +: LI ( value dst -- ) 0 rot ADDI ; inline +: SUBI ( dst src1 src2 -- ) neg ADDI ; inline +: LIS ( value dst -- ) 0 rot ADDIS ; inline +: SUBIC ( dst src1 src2 -- ) neg ADDIC ; inline +: SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; inline +: NOT ( dst src -- ) dup NOR ; inline +: NOT. ( dst src -- ) dup NOR. ; inline +: MR ( dst src -- ) dup OR ; inline +: MR. ( dst src -- ) dup OR. ; inline +: (SLWI) ( d a b -- d a b x y ) 0 31 pick - ; inline : SLWI ( d a b -- ) (SLWI) RLWINM ; : SLWI. ( d a b -- ) (SLWI) RLWINM. ; -: (SRWI) 32 over - swap 31 ; inline +: (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline : SRWI ( d a b -- ) (SRWI) RLWINM ; : SRWI. ( d a b -- ) (SRWI) RLWINM. ; -: LOAD32 ( n r -- ) >r w>h/h r> tuck LIS dup rot ORI ; +: LOAD32 ( n r -- ) [ w>h/h ] dip tuck LIS dup rot ORI ; : immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ; : LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ; diff --git a/basis/cpu/ppc/assembler/backend/backend.factor b/basis/cpu/ppc/assembler/backend/backend.factor index 881b094ca2..c6a3a94194 100644 --- a/basis/cpu/ppc/assembler/backend/backend.factor +++ b/basis/cpu/ppc/assembler/backend/backend.factor @@ -74,13 +74,13 @@ IN: cpu.ppc.assembler.backend GENERIC# (B) 2 ( dest aa lk -- ) M: integer (B) 18 i-insn ; -M: word (B) 0 -rot (B) rc-relative-ppc-3 rel-word ; -M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ; +M: word (B) [ 0 ] 2dip (B) rc-relative-ppc-3 rel-word ; +M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ; GENERIC: BC ( a b c -- ) M: integer BC 0 0 16 b-insn ; -M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ; -M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ; +M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ; +M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ; : CREATE-B ( -- word ) scan "B" prepend create-in ; diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 445c7082bc..b27f3aee72 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -302,9 +302,7 @@ big-endian on 4 ds-reg 0 STW ] f f f \ -rot define-sub-primitive -[ jit->r ] f f f \ >r define-sub-primitive - -[ jit-r> ] f f f \ r> define-sub-primitive +[ jit->r ] f f f \ load-local define-sub-primitive ! Comparisons : jit-compare ( insn -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index c555c4b809..b177c71d77 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -34,7 +34,7 @@ M: ppc two-operand? f ; M: ppc %load-immediate ( reg n -- ) swap LOAD ; -M: ppc %load-indirect ( reg obj -- ) +M: ppc %load-reference ( reg obj -- ) [ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-immediate ] bi* ; M: ppc %alien-global ( register symbol dll -- ) @@ -261,7 +261,7 @@ M:: ppc %fixnum-mul-tail ( src1 src2 temp1 temp2 -- ) M:: ppc %integer>bignum ( dst src temp -- ) [ "end" define-label - dst 0 >bignum %load-indirect + dst 0 >bignum %load-reference ! Is it zero? Then just go to the end and return this zero 0 src 0 CMPI "end" get BEQ @@ -321,7 +321,7 @@ M:: ppc %integer>float ( dst src -- ) scratch-reg dup HEX: 8000 XORIS scratch-reg 1 4 scratch@ STW dst 1 0 scratch@ LFD - scratch-reg 4503601774854144.0 %load-indirect + scratch-reg 4503601774854144.0 %load-reference fp-scratch-reg scratch-reg float-offset LFD dst dst fp-scratch-reg FSUB ; @@ -467,26 +467,28 @@ M: ppc %gc M: ppc %prologue ( n -- ) 0 11 LOAD32 rc-absolute-ppc-2/2 rel-this 0 MFLR - 1 1 pick neg ADDI - 11 1 pick xt-save STW - dup 11 LI - 11 1 pick next-save STW - 0 1 rot lr-save + STW ; + { + [ [ 1 1 ] dip neg ADDI ] + [ [ 11 1 ] dip xt-save STW ] + [ 11 LI ] + [ [ 11 1 ] dip next-save STW ] + [ [ 0 1 ] dip lr-save + STW ] + } cleave ; M: ppc %epilogue ( n -- ) #! At the end of each word that calls a subroutine, we store #! the previous link register value in r0 by popping it off #! the stack, set the link register to the contents of r0, #! and jump to the link register. - 0 1 pick lr-save + LWZ - 1 1 rot ADDI + [ [ 0 1 ] dip lr-save + LWZ ] + [ [ 1 1 ] dip ADDI ] bi 0 MTLR ; :: (%boolean) ( dst temp word -- ) "end" define-label dst \ f tag-number %load-immediate "end" get word execute - dst \ t %load-indirect + dst \ t %load-reference "end" get resolve-label ; inline : %boolean ( dst temp cc -- ) @@ -541,17 +543,17 @@ GENERIC: STF ( src dst off reg-class -- ) M: single-float-regs STF drop STFS ; M: double-float-regs STF drop STFD ; -M: float-regs %save-param-reg >r 1 rot local@ r> STF ; +M: float-regs %save-param-reg [ 1 rot local@ ] dip STF ; GENERIC: LF ( dst src off reg-class -- ) M: single-float-regs LF drop LFS ; M: double-float-regs LF drop LFD ; -M: float-regs %load-param-reg >r 1 rot local@ r> LF ; +M: float-regs %load-param-reg [ 1 rot local@ ] dip LF ; M: stack-params %load-param-reg ( stack reg reg-class -- ) - drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ; + drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ; : next-param@ ( n -- x ) param@ stack-frame get total-size>> + ; @@ -559,8 +561,8 @@ M: stack-params %save-param-reg ( stack reg reg-class -- ) #! Funky. Read the parameter from the caller's stack frame. #! This word is used in callbacks drop - 0 1 rot next-param@ LWZ - 0 1 rot local@ STW ; + [ 0 1 ] dip next-param@ LWZ + [ 0 1 ] dip local@ STW ; M: ppc %prepare-unbox ( -- ) ! First parameter is top of stack @@ -580,14 +582,14 @@ M: ppc %unbox-long-long ( n func -- ) f %alien-invoke ! Store the return value on the C stack [ - 3 1 pick local@ STW - 4 1 rot cell + local@ STW + [ [ 3 1 ] dip local@ STW ] + [ [ 4 1 ] dip cell + local@ STW ] bi ] when* ; M: ppc %unbox-large-struct ( n c-type -- ) ! Value must be in r3 ! Compute destination address and load struct size - [ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi* + [ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi* ! Call the function "to_value_struct" f %alien-invoke ; @@ -595,15 +597,16 @@ M: ppc %box ( n reg-class func -- ) ! If the source is a stack location, load it into freg #0. ! If the source is f, then we assume the value is already in ! freg #0. - >r - over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if - r> f %alien-invoke ; + [ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip + f %alien-invoke ; M: ppc %box-long-long ( n func -- ) - >r [ - 3 1 pick local@ LWZ - 4 1 rot cell + local@ LWZ - ] when* r> f %alien-invoke ; + [ + [ + [ [ 3 1 ] dip local@ LWZ ] + [ [ 4 1 ] dip cell + local@ LWZ ] bi + ] when* + ] dip f %alien-invoke ; : struct-return@ ( n -- n ) [ stack-frame get params>> ] unless* local@ ; @@ -616,7 +619,7 @@ M: ppc %prepare-box-struct ( -- ) M: ppc %box-large-struct ( n c-type -- ) ! If n = f, then we're boxing a returned struct ! Compute destination address and load struct size - [ 3 1 rot struct-return@ ADDI ] [ heap-size 4 LI ] bi* + [ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi* ! Call the function "box_value_struct" f %alien-invoke ; @@ -634,7 +637,7 @@ M: ppc %alien-invoke ( symbol dll -- ) [ 11 ] 2dip %alien-global 11 MTLR BLRL ; M: ppc %alien-callback ( quot -- ) - 3 swap %load-indirect "c_to_factor" f %alien-invoke ; + 3 swap %load-reference "c_to_factor" f %alien-invoke ; M: ppc %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 5e06e72118..affd39ffc5 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -237,7 +237,7 @@ M: x86.32 %alien-indirect ( -- ) M: x86.32 %alien-callback ( quot -- ) 4 [ - EAX swap %load-indirect + EAX swap %load-reference EAX PUSH "c_to_factor" f %alien-invoke ] with-aligned-stack ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 2077f51e0a..8cc69958a4 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -37,7 +37,7 @@ M:: x86.64 %dispatch ( src temp offset -- ) M: x86.64 param-reg-1 int-regs param-regs first ; M: x86.64 param-reg-2 int-regs param-regs second ; -: param-reg-3 int-regs param-regs third ; inline +: param-reg-3 ( -- reg ) int-regs param-regs third ; inline M: int-regs return-reg drop RAX ; M: float-regs return-reg drop XMM0 ; @@ -50,8 +50,8 @@ M: x86.64 %prologue ( n -- ) M: stack-params %load-param-reg drop - >r R11 swap param@ MOV - r> param@ R11 MOV ; + [ R11 swap param@ MOV ] dip + param@ R11 MOV ; M: stack-params %save-param-reg drop @@ -176,7 +176,7 @@ M: x86.64 %alien-indirect ( -- ) RBP CALL ; M: x86.64 %alien-callback ( quot -- ) - param-reg-1 swap %load-indirect + param-reg-1 swap %load-reference "c_to_factor" f %alien-invoke ; M: x86.64 %callback-value ( ctype -- ) diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor index 6ddec4af07..343850f9e6 100644 --- a/basis/cpu/x86/assembler/syntax/syntax.factor +++ b/basis/cpu/x86/assembler/syntax/syntax.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel words sequences lexer parser fry ; +USING: kernel words words.symbol sequences lexer parser fry ; IN: cpu.x86.assembler.syntax : define-register ( name num size -- ) diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 42fcfaa6a2..5e3405e93a 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -79,9 +79,10 @@ big-endian off ! compute quotation location temp0 temp1 ADD ! load quotation - temp0 temp0 array-start-offset [+] MOV - ! execute branch - temp0 quot-xt-offset [+] JMP + arg temp0 array-start-offset [+] MOV + ! execute branch. the quot must be in arg, since it might + ! not be compiled yet + arg quot-xt-offset [+] JMP ] rc-absolute-cell rt-immediate 1 rex-length + jit-dispatch jit-define : jit->r ( -- ) @@ -318,9 +319,7 @@ big-endian off ds-reg [] temp1 MOV ] f f f \ -rot define-sub-primitive -[ jit->r ] f f f \ >r define-sub-primitive - -[ jit-r> ] f f f \ r> define-sub-primitive +[ jit->r ] f f f \ load-local define-sub-primitive ! Comparisons : jit-compare ( insn -- ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 44300a75f9..2859e71be2 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -21,7 +21,7 @@ HOOK: param-reg-2 cpu ( -- reg ) M: x86 %load-immediate MOV ; -M: x86 %load-indirect swap 0 MOV rc-absolute-cell rel-immediate ; +M: x86 %load-reference swap 0 MOV rc-absolute-cell rel-immediate ; HOOK: ds-reg cpu ( -- reg ) HOOK: rs-reg cpu ( -- reg ) @@ -188,7 +188,7 @@ M:: x86 %integer>bignum ( dst src temp -- ) [ "end" define-label ! Load cached zero value - dst 0 >bignum %load-indirect + dst 0 >bignum %load-reference src 0 CMP ! Is it zero? Then just go to the end and return this zero "end" get JE diff --git a/basis/csv/csv.factor b/basis/csv/csv.factor index 133223b6e4..483a5825a9 100644 --- a/basis/csv/csv.factor +++ b/basis/csv/csv.factor @@ -12,7 +12,7 @@ SYMBOL: delimiter CHAR: , delimiter set-global -: delimiter> delimiter get ; inline +: delimiter> ( -- delimiter ) delimiter get ; inline DEFER: quoted-field ( -- endchar ) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 8173ff6a5b..08544b3367 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -1,20 +1,20 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: classes kernel help.markup help.syntax sequences -alien assocs strings math multiline quotations ; +alien assocs strings math multiline quotations db.private ; IN: db -HELP: db -{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ; +HELP: db-connection +{ $description "The " { $snippet "db-connection" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries. Stores the current database object as a dynamic variable." } ; -HELP: new-db -{ $values { "class" class } { "obj" object } } +HELP: new-db-connection +{ $values { "class" class } { "obj" db-connection } } { $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." } { $notes "User-defined databases must call this constructor word instead of " { $link new } "." } ; HELP: db-open -{ $values { "db" db } { "db" db } } -{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ; +{ $values { "db" "a database configuration object" } { "db-connection" db-connection } } +{ $description "Opens a database using the configuration data stored in a " { $snippet "database configuration object" } "tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ; HELP: db-close { $values { "handle" alien } } @@ -141,13 +141,13 @@ HELP: rollback-transaction HELP: sql-command { $values { "sql" string } } -{ $description "Executes a SQL string using the databse in the " { $link db } " symbol." } ; +{ $description "Executes a SQL string using the databse in the " { $link db-connection } " symbol." } ; HELP: sql-query { $values { "sql" string } { "rows" "an array of arrays of strings" } } -{ $description "Runs a SQL query of raw text in the database in the " { $link db } " symbol. Each row is returned as an array of strings; no type-conversions are done on the resulting data." } ; +{ $description "Runs a SQL query of raw text in the database in the " { $link db-connection } " symbol. Each row is returned as an array of strings; no type-conversions are done on the resulting data." } ; { sql-command sql-query } related-words @@ -167,8 +167,8 @@ HELP: sql-row-typed HELP: with-db { $values - { "db" db } { "quot" quotation } } -{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ; + { "db" "a database configuration object" } { "quot" quotation } } +{ $description "Calls the quotation with a database bound to the " { $link db-connection } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ; HELP: with-transaction { $values @@ -244,13 +244,13 @@ ARTICLE: "db-protocol" "Low-level database protocol" ! { $subsection bind-tuple } ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial" -"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." +"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." $nl "Executing a SQL command:" { $subsection sql-command } "Executing a query directly:" { $subsection sql-query } "Here's an example usage where we'll make a book table, insert some objects, and query them." $nl -"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details." +"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details." { $code <" USING: db.sqlite db io.files ; : with-book-db ( quot -- ) diff --git a/basis/db/db.factor b/basis/db/db.factor index b7bd8218a2..0b18044f2b 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -5,25 +5,29 @@ namespaces sequences classes.tuple words strings tools.walker accessors combinators fry ; IN: db -TUPLE: db +>insert-statements H{ } clone >>update-statements H{ } clone >>delete-statements ; inline -GENERIC: db-open ( db -- db ) -HOOK: db-close db ( handle -- ) +PRIVATE> + +GENERIC: db-open ( db -- db-connection ) +HOOK: db-close db-connection ( handle -- ) : dispose-statements ( assoc -- ) values dispose-each ; -M: db dispose ( db -- ) - dup db [ +M: db-connection dispose ( db-connection -- ) + dup db-connection [ [ dispose-statements H{ } clone ] change-insert-statements [ dispose-statements H{ } clone ] change-update-statements [ dispose-statements H{ } clone ] change-delete-statements @@ -63,8 +67,8 @@ TUPLE: prepared-statement < statement ; swap >>in-params swap >>sql ; -HOOK: db ( string in out -- statement ) -HOOK: db ( string in out -- statement ) +HOOK: db-connection ( string in out -- statement ) +HOOK: db-connection ( string in out -- statement ) GENERIC: prepare-statement ( statement -- ) GENERIC: bind-statement* ( statement -- ) GENERIC: low-level-bind ( statement -- ) @@ -107,8 +111,8 @@ M: object execute-statement* ( statement type -- ) accumulator [ query-each ] dip { } like ; inline : with-db ( db quot -- ) - [ db-open db ] dip - '[ db get [ drop @ ] with-disposal ] with-variable ; inline + [ db-open db-connection ] dip + '[ db-connection get [ drop @ ] with-disposal ] with-variable ; inline ! Words for working with raw SQL statements : default-query ( query -- result-set ) @@ -126,13 +130,13 @@ M: object execute-statement* ( statement type -- ) ! Transactions SYMBOL: in-transaction -HOOK: begin-transaction db ( -- ) -HOOK: commit-transaction db ( -- ) -HOOK: rollback-transaction db ( -- ) +HOOK: begin-transaction db-connection ( -- ) +HOOK: commit-transaction db-connection ( -- ) +HOOK: rollback-transaction db-connection ( -- ) -M: db begin-transaction ( -- ) "BEGIN" sql-command ; -M: db commit-transaction ( -- ) "COMMIT" sql-command ; -M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ; +M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ; +M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ; +M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ; : in-transaction? ( -- ? ) in-transaction get ; diff --git a/basis/db/pools/pools-tests.factor b/basis/db/pools/pools-tests.factor index 0a68db501b..7ff2a33d92 100644 --- a/basis/db/pools/pools-tests.factor +++ b/basis/db/pools/pools-tests.factor @@ -1,6 +1,6 @@ IN: db.pools.tests -USING: db.pools tools.test continuations io.files namespaces -accessors kernel math destructors ; +USING: db.pools tools.test continuations io.files io.files.temp +io.directories namespaces accessors kernel math destructors ; \ must-infer diff --git a/basis/db/pools/pools.factor b/basis/db/pools/pools.factor index 8bc5e87f0e..55ff3a383b 100644 --- a/basis/db/pools/pools.factor +++ b/basis/db/pools/pools.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel arrays namespaces sequences continuations -io.pools db fry ; +io.pools db fry db.private ; IN: db.pools TUPLE: db-pool < pool db ; @@ -17,4 +17,4 @@ M: db-pool make-connection ( pool -- ) db>> db-open ; : with-pooled-db ( pool quot -- ) - '[ db _ with-variable ] with-pooled-connection ; inline + '[ db-connection _ with-variable ] with-pooled-connection ; inline diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 5149d14f3d..19cf5c5002 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/basis/db/postgresql/lib/lib.factor @@ -6,7 +6,7 @@ db.types tools.walker ascii splitting math.parser combinators libc shuffle calendar.format byte-arrays destructors prettyprint accessors strings serialize io.encodings.binary io.encodings.utf8 alien.strings io.streams.byte-array summary present urls -specialized-arrays.uint specialized-arrays.alien ; +specialized-arrays.uint specialized-arrays.alien db.private ; IN: db.postgresql.lib : postgresql-result-error-message ( res -- str/f ) @@ -24,7 +24,7 @@ IN: db.postgresql.lib "\n" split [ [ blank? ] trim ] map "\n" join ; : postgresql-error-message ( -- str ) - db get handle>> (postgresql-error-message) ; + db-connection get handle>> (postgresql-error-message) ; : postgresql-error ( res -- res ) dup [ postgresql-error-message throw ] unless ; @@ -44,7 +44,7 @@ M: postgresql-result-null summary ( obj -- str ) dup PQstatus zero? [ (postgresql-error-message) throw ] unless ; : do-postgresql-statement ( statement -- res ) - db get handle>> swap sql>> PQexec dup postgresql-result-ok? [ + db-connection get handle>> swap sql>> PQexec dup postgresql-result-ok? [ [ postgresql-result-error-message ] [ PQclear ] bi throw ] unless ; @@ -99,7 +99,7 @@ M: postgresql-result-null summary ( obj -- str ) : do-postgresql-bound-statement ( statement -- res ) [ - [ db get handle>> ] dip + [ db-connection get handle>> ] dip { [ sql>> ] [ bind-params>> length ] diff --git a/basis/db/postgresql/postgresql-tests.factor b/basis/db/postgresql/postgresql-tests.factor index bc5ec2f0c5..cf6dc903f1 100644 --- a/basis/db/postgresql/postgresql-tests.factor +++ b/basis/db/postgresql/postgresql-tests.factor @@ -1,5 +1,5 @@ USING: kernel db.postgresql alien continuations io classes -prettyprint sequences namespaces tools.test db +prettyprint sequences namespaces tools.test db db.private db.tuples db.types unicode.case accessors system ; IN: db.postgresql.tests @@ -92,7 +92,3 @@ os windows? cpu x86.64? and [ ] with-db ] unit-test ] unless - - -: with-dummy-db ( quot -- ) - [ T{ postgresql-db } db ] dip with-variable ; diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 90a875b8ff..1f55dcf769 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -4,23 +4,31 @@ USING: arrays assocs alien alien.syntax continuations io kernel math math.parser namespaces make prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges -combinators classes locals words tools.walker +combinators classes locals words tools.walker db.private nmake accessors random db.queries destructors db.tuples.private ; USE: tools.walker IN: db.postgresql -TUPLE: postgresql-db < db - host port pgopts pgtty database username password ; +TUPLE: postgresql-db host port pgopts pgtty database username password ; : ( -- postgresql-db ) - postgresql-db new-db ; + postgresql-db new ; + + ( handle -- db-connection ) + postgresql-db-connection new-db-connection + swap >>handle ; + +PRIVATE> TUPLE: postgresql-statement < statement ; TUPLE: postgresql-result-set < result-set ; -M: postgresql-db db-open ( db -- db ) - dup { +M: postgresql-db db-open ( db -- db-connection ) + { [ host>> ] [ port>> ] [ pgopts>> ] @@ -28,10 +36,9 @@ M: postgresql-db db-open ( db -- db ) [ database>> ] [ username>> ] [ password>> ] - } cleave connect-postgres >>handle ; + } cleave connect-postgres ; -M: postgresql-db db-close ( handle -- ) - PQfinish ; +M: postgresql-db-connection db-close ( handle -- ) PQfinish ; M: postgresql-statement bind-statement* ( statement -- ) drop ; @@ -48,8 +55,10 @@ M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- object ) [ swap slot-name>> rot set-slot-named ] [ ] bi ; M: postgresql-statement bind-tuple ( tuple statement -- ) - tuck in-params>> - [ postgresql-bind-conversion ] with map + [ nip ] [ + in-params>> + [ postgresql-bind-conversion ] with map + ] 2bi >>bind-params drop ; M: postgresql-result-set #rows ( result-set -- n ) @@ -98,25 +107,25 @@ M: postgresql-result-set dispose ( result-set -- ) M: postgresql-statement prepare-statement ( statement -- ) dup - [ db get handle>> f ] dip + [ db-connection get handle>> f ] dip [ sql>> ] [ in-params>> ] bi length f PQprepare postgresql-error >>handle drop ; -M: postgresql-db ( sql in out -- statement ) +M: postgresql-db-connection ( sql in out -- statement ) postgresql-statement new-statement ; -M: postgresql-db ( sql in out -- statement ) +M: postgresql-db-connection ( sql in out -- statement ) dup prepare-statement ; : bind-name% ( -- ) CHAR: $ 0, sql-counter [ inc ] [ get 0# ] bi ; -M: postgresql-db bind% ( spec -- ) +M: postgresql-db-connection bind% ( spec -- ) bind-name% 1, ; -M: postgresql-db bind# ( spec object -- ) +M: postgresql-db-connection bind# ( spec object -- ) [ bind-name% f swap type>> ] dip 1, ; @@ -162,7 +171,7 @@ M: postgresql-db bind# ( spec object -- ) "_seq'');' language sql;" 0% ] query-make ; -M: postgresql-db create-sql-statement ( class -- seq ) +M: postgresql-db-connection create-sql-statement ( class -- seq ) [ [ create-table-sql , ] keep dup db-assigned? [ create-function-sql , ] [ drop ] if @@ -182,13 +191,13 @@ M: postgresql-db create-sql-statement ( class -- seq ) "drop table " 0% 0% drop ] query-make ; -M: postgresql-db drop-sql-statement ( class -- seq ) +M: postgresql-db-connection drop-sql-statement ( class -- seq ) [ [ drop-table-sql , ] keep dup db-assigned? [ drop-function-sql , ] [ drop ] if ] { } make ; -M: postgresql-db ( class -- statement ) +M: postgresql-db-connection ( class -- statement ) [ "select add_" 0% 0% "(" 0% @@ -198,7 +207,7 @@ M: postgresql-db ( class -- statement ) ");" 0% ] query-make ; -M: postgresql-db ( class -- statement ) +M: postgresql-db-connection ( class -- statement ) [ "insert into " 0% 0% "(" 0% @@ -221,10 +230,10 @@ M: postgresql-db ( class -- statement ) ");" 0% ] query-make ; -M: postgresql-db insert-tuple-set-key ( tuple statement -- ) +M: postgresql-db-connection insert-tuple-set-key ( tuple statement -- ) query-modify-tuple ; -M: postgresql-db persistent-table ( -- hashtable ) +M: postgresql-db-connection persistent-table ( -- hashtable ) H{ { +db-assigned-id+ { "integer" "serial" f } } { +user-assigned-id+ { f f f } } @@ -264,7 +273,7 @@ M: postgresql-db persistent-table ( -- hashtable ) } ; ERROR: no-compound-found string object ; -M: postgresql-db compound ( string object -- string' ) +M: postgresql-db-connection compound ( string object -- string' ) over { { "default" [ first number>string " " glue ] } { "varchar" [ first number>string "(" ")" surround append ] } diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index a96398ff2c..2d7ea67107 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -3,7 +3,8 @@ USING: accessors kernel math namespaces make sequences random strings math.parser math.intervals combinators math.bitwise nmake db db.tuples db.types classes words shuffle arrays -destructors continuations db.tuples.private prettyprint ; +destructors continuations db.tuples.private prettyprint +db.private ; IN: db.queries GENERIC: where ( specs obj -- ) @@ -62,7 +63,7 @@ M: retryable execute-statement* ( statement type -- ) dup column-name>> 0% " = " 0% bind% ] interleave ; -M: db ( class -- statement ) +M: db-connection ( class -- statement ) [ "update " 0% 0% " set " 0% @@ -142,7 +143,7 @@ M: string where ( spec obj -- ) object-where ; : where-clause ( tuple specs -- ) dupd filter-slots [ drop ] [ many-where ] if-empty ; -M: db ( tuple table -- sql ) +M: db-connection ( tuple table -- sql ) [ "delete from " 0% 0% where-clause @@ -150,7 +151,7 @@ M: db ( tuple table -- sql ) ERROR: all-slots-ignored class ; -M: db ( tuple class -- statement ) +M: db-connection ( tuple class -- statement ) [ "select " 0% [ dupd filter-ignores ] dip @@ -185,13 +186,13 @@ M: db ( tuple class -- statement ) [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db query>statement ( query -- tuple ) +M: db-connection query>statement ( query -- tuple ) [ tuple>> dup class ] keep [ ] dip make-query* ; ! select ID, NAME, SCORE from EXAM limit 1 offset 3 -M: db ( query -- statement ) +M: db-connection ( query -- statement ) [ tuple>> dup class ] keep [ [ "select count(*) from " 0% 0% where-clause ] query-make ] dip make-query* ; diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index 1ec18260cd..b1bc9aa1a2 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -5,7 +5,8 @@ namespaces sequences db.sqlite.ffi db combinators continuations db.types calendar.format serialize io.streams.byte-array byte-arrays io.encodings.binary io.backend db.errors present urls io.encodings.utf8 -io.encodings.string accessors shuffle ; +io.encodings.string accessors shuffle io prettyprint +db.private ; IN: db.sqlite.lib ERROR: sqlite-error < db-error n string ; @@ -16,7 +17,7 @@ ERROR: sqlite-sql-error < sql-error n string ; : sqlite-statement-error ( -- * ) SQLITE_ERROR - db get handle>> sqlite3_errmsg sqlite-sql-error ; + db-connection get handle>> sqlite3_errmsg sqlite-sql-error ; : sqlite-check-result ( n -- ) { @@ -42,7 +43,7 @@ ERROR: sqlite-sql-error < sql-error n string ; sqlite3_bind_parameter_index ; : parameter-index ( handle name text -- handle name text ) - >r dupd sqlite-bind-parameter-index r> ; + [ dupd sqlite-bind-parameter-index ] dip ; : sqlite-bind-text ( handle index text -- ) utf8 encode dup length SQLITE_TRANSIENT @@ -124,7 +125,8 @@ ERROR: sqlite-sql-error < sql-error n string ; ] if* (sqlite-bind-type) ; : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ; -: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ; +: sqlite-reset ( handle -- ) +"resetting: " write dup . sqlite3_reset sqlite-check-result ; : sqlite-clear-bindings ( handle -- ) sqlite3_clear_bindings sqlite-check-result ; : sqlite-#columns ( query -- int ) sqlite3_column_count ; @@ -166,7 +168,7 @@ ERROR: sqlite-sql-error < sql-error n string ; : sqlite-row ( handle -- seq ) dup sqlite-#columns [ sqlite-column ] with map ; -: sqlite-step-has-more-rows? ( prepared -- bool ) +: sqlite-step-has-more-rows? ( prepared -- ? ) { { SQLITE_ROW [ t ] } { SQLITE_DONE [ f ] } diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor index fe95980bcf..6fb1cd19ad 100644 --- a/basis/db/sqlite/sqlite-tests.factor +++ b/basis/db/sqlite/sqlite-tests.factor @@ -1,10 +1,10 @@ -USING: io io.files io.launcher kernel namespaces -prettyprint tools.test db.sqlite db sequences +USING: io io.files io.files.temp io.directories io.launcher +kernel namespaces prettyprint tools.test db.sqlite db sequences continuations db.types db.tuples unicode.case ; IN: db.sqlite.tests -: db-path "test.db" temp-file ; -: test.db db-path ; +: db-path ( -- path ) "test.db" temp-file ; +: test.db ( -- sqlite-db ) db-path ; [ ] [ [ db-path delete-file ] ignore-errors ] unit-test diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 32c5ca0075..0f545030a3 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -6,33 +6,43 @@ sequences strings classes.tuple alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators math.intervals io nmake accessors vectors math.ranges random math.bitwise db.queries destructors db.tuples.private interpolate -io.streams.string multiline make ; +io.streams.string multiline make db.private ; IN: db.sqlite -TUPLE: sqlite-db < db path ; +TUPLE: sqlite-db path ; : ( path -- sqlite-db ) - sqlite-db new-db + sqlite-db new swap >>path ; -M: sqlite-db db-open ( db -- db ) - dup path>> sqlite-open >>handle ; + ( handle -- db-connection ) + sqlite-db-connection new-db-connection + swap >>handle ; + +PRIVATE> + +M: sqlite-db db-open ( db -- db-connection ) + path>> sqlite-open ; + +M: sqlite-db-connection db-close ( handle -- ) sqlite-close ; TUPLE: sqlite-statement < statement ; TUPLE: sqlite-result-set < result-set has-more? ; -M: sqlite-db ( str in out -- obj ) +M: sqlite-db-connection ( str in out -- obj ) ; -M: sqlite-db ( str in out -- obj ) +M: sqlite-db-connection ( str in out -- obj ) sqlite-statement new-statement ; : sqlite-maybe-prepare ( statement -- statement ) dup handle>> [ - db get handle>> over sql>> sqlite-prepare + db-connection get handle>> over sql>> sqlite-prepare >>handle ] unless ; @@ -89,10 +99,10 @@ M: sqlite-statement bind-tuple ( tuple statement -- ) ERROR: sqlite-last-id-fail ; : last-insert-id ( -- id ) - db get handle>> sqlite3_last_insert_rowid + db-connection get handle>> sqlite3_last_insert_rowid dup zero? [ sqlite-last-id-fail ] when ; -M: sqlite-db insert-tuple-set-key ( tuple statement -- ) +M: sqlite-db-connection insert-tuple-set-key ( tuple statement -- ) execute-statement last-insert-id swap set-primary-key ; M: sqlite-result-set #columns ( result-set -- n ) @@ -116,7 +126,7 @@ M: sqlite-statement query-results ( query -- result-set ) dup handle>> sqlite-result-set new-result-set dup advance-row ; -M: sqlite-db create-sql-statement ( class -- statement ) +M: sqlite-db-connection create-sql-statement ( class -- statement ) [ dupd "create table " 0% 0% @@ -135,10 +145,10 @@ M: sqlite-db create-sql-statement ( class -- statement ) "));" 0% ] query-make ; -M: sqlite-db drop-sql-statement ( class -- statement ) +M: sqlite-db-connection drop-sql-statement ( class -- statement ) [ "drop table " 0% 0% ";" 0% drop ] query-make ; -M: sqlite-db ( tuple -- statement ) +M: sqlite-db-connection ( tuple -- statement ) [ "insert into " 0% 0% "(" 0% @@ -159,19 +169,19 @@ M: sqlite-db ( tuple -- statement ) ");" 0% ] query-make ; -M: sqlite-db ( tuple -- statement ) +M: sqlite-db-connection ( tuple -- statement ) ; -M: sqlite-db bind# ( spec obj -- ) +M: sqlite-db-connection bind# ( spec obj -- ) [ [ column-name>> ":" next-sql-counter surround dup 0% ] [ type>> ] bi ] dip 1, ; -M: sqlite-db bind% ( spec -- ) +M: sqlite-db-connection bind% ( spec -- ) dup 1, column-name>> ":" prepend 0% ; -M: sqlite-db persistent-table ( -- assoc ) +M: sqlite-db-connection persistent-table ( -- assoc ) H{ { +db-assigned-id+ { "integer" "integer" f } } { +user-assigned-id+ { f f f } } @@ -306,7 +316,7 @@ M: sqlite-db persistent-table ( -- assoc ) delete-trigger-restrict sqlite-trigger, ] if ; -M: sqlite-db compound ( string seq -- new-string ) +M: sqlite-db-connection compound ( string seq -- new-string ) over { { "default" [ first number>string " " glue ] } { "references" [ diff --git a/basis/db/tester/authors.txt b/basis/db/tester/authors.txt new file mode 100644 index 0000000000..f372b574ae --- /dev/null +++ b/basis/db/tester/authors.txt @@ -0,0 +1,2 @@ +Slava Pestov +Doug Coleman diff --git a/basis/db/tester/tester-tests.factor b/basis/db/tester/tester-tests.factor new file mode 100644 index 0000000000..6b39a7e218 --- /dev/null +++ b/basis/db/tester/tester-tests.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test db.tester ; +IN: db.tester.tests + +[ ] [ sqlite-test-db db-tester ] unit-test +[ ] [ sqlite-test-db db-tester2 ] unit-test diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor new file mode 100644 index 0000000000..490f6bbef5 --- /dev/null +++ b/basis/db/tester/tester.factor @@ -0,0 +1,62 @@ +! Copyright (C) 2008 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: concurrency.combinators db.pools db.sqlite db.tuples +db.types kernel math random threads tools.test db sequences +io prettyprint ; +IN: db.tester + +TUPLE: test-1 id a b c ; + +test-1 "TEST1" { + { "id" "ID" INTEGER +db-assigned-id+ } + { "a" "A" { VARCHAR 256 } +not-null+ } + { "b" "B" { VARCHAR 256 } +not-null+ } + { "c" "C" { VARCHAR 256 } +not-null+ } +} define-persistent + +TUPLE: test-2 id x y z ; + +test-2 "TEST2" { + { "id" "ID" INTEGER +db-assigned-id+ } + { "x" "X" { VARCHAR 256 } +not-null+ } + { "y" "Y" { VARCHAR 256 } +not-null+ } + { "z" "Z" { VARCHAR 256 } +not-null+ } +} define-persistent + +: sqlite-test-db ( -- db ) "test.db" ; +: test-db ( -- db ) "test.db" ; + +: db-tester ( test-db -- ) + [ + [ + test-1 ensure-table + test-2 ensure-table + ] with-db + ] [ + 10 [ + drop + 10 [ + dup [ + f 100 random 100 random 100 random test-1 boa + insert-tuple yield + ] with-db + ] times + ] with parallel-each + ] bi ; + +: db-tester2 ( test-db -- ) + [ + [ + test-1 ensure-table + test-2 ensure-table + ] with-db + ] [ + [ + 10 [ + 10 [ + f 100 random 100 random 100 random test-1 boa + insert-tuple yield + ] times + ] parallel-each + ] with-pooled-db + ] bi ; diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor index 51830ee610..e853c55ede 100644 --- a/basis/db/tuples/tuples-docs.factor +++ b/basis/db/tuples/tuples-docs.factor @@ -199,7 +199,7 @@ ARTICLE: "db-tuples-protocol" "Tuple database protocol" { $subsection } ; ARTICLE: "db-tuples-tutorial" "Tuple database tutorial" -"Let's make a tuple and store it in a database. To follow along, click on each code example and run it in the listener. If you forget to run an example, just start at the top and run them all again in order." $nl +"Let's make a tuple and store it in a database. To follow along, click on each code example and run it in the listener. If you forget to run an example, just start at the top and run them all again in order." $nl "We're going to store books in this tutorial." { $code "TUPLE: book id title author date-published edition cover-price condition ;" } "The title, author, and publisher should be strings; the date-published a timestamp; the edition an integer; the cover-price a float. These are the Factor types for which we will need to look up the corresponding " { $link "db.types" } ". " $nl @@ -246,7 +246,7 @@ T{ book { $code <" [ book get update-tuple ] with-book-tutorial "> } -"And select it again. You can query the database by any field -- just set it in the exemplar tuple you pass to " { $link select-tuples } "." +"And select it again. You can query the database by any field -- just set it in the exemplar tuple you pass to " { $link select-tuples } "." { $code <" [ T{ book { title "Factor for Sheeple" } } select-tuples ] with-book-tutorial "> } diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 0432f38683..246946c715 100644 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: io.files kernel tools.test db db.tuples classes +USING: io.files io.files.temp kernel tools.test db db.tuples classes db.types continuations namespaces math math.ranges prettyprint calendar sequences db.sqlite math.intervals db.postgresql accessors random math.bitwise system -math.ranges strings urls fry db.tuples.private ; +math.ranges strings urls fry db.tuples.private db.private ; IN: db.tuples.tests : sqlite-db ( -- sqlite-db ) @@ -33,10 +33,10 @@ IN: db.tuples.tests ! These words leak resources, but are useful for interactivel testing : sqlite-test-db ( -- ) - sqlite-db db-open db set ; + sqlite-db db-open db-connection set ; : postgresql-test-db ( -- ) - postgresql-db db-open db set ; + postgresql-db db-open db-connection set ; TUPLE: person the-id the-name the-number the-real ts date time blob factor-blob url ; diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 7a5c9e41e6..219116aefd 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -3,20 +3,20 @@ USING: arrays assocs classes db kernel namespaces classes.tuple words sequences slots math accessors math.parser io prettyprint db.types continuations -destructors mirrors sets db.types ; +destructors mirrors sets db.types db.private ; IN: db.tuples -HOOK: create-sql-statement db ( class -- object ) -HOOK: drop-sql-statement db ( class -- object ) +HOOK: create-sql-statement db-connection ( class -- object ) +HOOK: drop-sql-statement db-connection ( class -- object ) -HOOK: db ( class -- object ) -HOOK: db ( class -- object ) -HOOK: db ( class -- object ) -HOOK: db ( tuple class -- object ) -HOOK: db ( tuple class -- tuple ) -HOOK: db ( query -- statement ) -HOOK: query>statement db ( query -- statement ) -HOOK: insert-tuple-set-key db ( tuple statement -- ) +HOOK: db-connection ( class -- object ) +HOOK: db-connection ( class -- object ) +HOOK: db-connection ( class -- object ) +HOOK: db-connection ( tuple class -- object ) +HOOK: db-connection ( tuple class -- tuple ) +HOOK: db-connection ( query -- statement ) +HOOK: query>statement db-connection ( query -- statement ) +HOOK: insert-tuple-set-key db-connection ( tuple statement -- ) > [ ] cache + db-connection get insert-statements>> + [ ] cache [ bind-tuple ] 2keep insert-tuple-set-key ; : insert-user-assigned-statement ( tuple -- ) dup class - db get insert-statements>> [ ] cache + db-connection get insert-statements>> + [ ] cache [ bind-tuple ] keep execute-statement ; : do-select ( exemplar-tuple statement -- tuples ) @@ -71,9 +73,10 @@ PRIVATE> ! High level ERROR: no-slots-named class seq ; : check-columns ( class columns -- ) - tuck - [ [ first ] map ] - [ all-slots [ name>> ] map ] bi* diff + [ nip ] [ + [ [ first ] map ] + [ all-slots [ name>> ] map ] bi* diff + ] 2bi [ drop ] [ no-slots-named ] if-empty ; : define-persistent ( class table columns -- ) @@ -117,7 +120,7 @@ M: tuple >query swap >>tuple ; : update-tuple ( tuple -- ) dup class - db get update-statements>> [ ] cache + db-connection get update-statements>> [ ] cache [ bind-tuple ] keep execute-statement ; : delete-tuples ( tuple -- ) diff --git a/basis/db/types/types-docs.factor b/basis/db/types/types-docs.factor index bd0b443fbe..d5908740c6 100644 --- a/basis/db/types/types-docs.factor +++ b/basis/db/types/types-docs.factor @@ -41,12 +41,15 @@ HELP: +user-assigned-id+ { $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ; HELP: +{ $values { "slot-name" object } { "key" object } { "generator-singleton" object } { "type" object } { "generator-bind" generator-bind } } { $description "" } ; HELP: +{ $values { "key" object } { "type" object } { "value" object } { "literal-bind" literal-bind } } { $description "" } ; HELP: +{ $values { "value" object } { "low-level-binding" low-level-binding } } { $description "" } ; HELP: BIG-INTEGER diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index da9fe39b80..2d4a6ff5fb 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -3,12 +3,12 @@ USING: arrays assocs db kernel math math.parser sequences continuations sequences.deep prettyprint words namespaces slots slots.private classes mirrors -classes.tuple combinators calendar.format symbols -classes.singleton accessors quotations random ; +classes.tuple combinators calendar.format classes.singleton +accessors quotations random db.private ; IN: db.types -HOOK: persistent-table db ( -- hash ) -HOOK: compound db ( string obj -- hash ) +HOOK: persistent-table db-connection ( -- hash ) +HOOK: compound db-connection ( string obj -- hash ) TUPLE: sql-spec class slot-name column-name type primary-key modifiers ; @@ -42,10 +42,10 @@ ERROR: no-slot ; slot-named dup [ no-slot ] unless offset>> ; : get-slot-named ( name tuple -- value ) - tuck offset-of-slot slot ; + [ nip ] [ offset-of-slot ] 2bi slot ; : set-slot-named ( value name obj -- ) - tuck offset-of-slot set-slot ; + [ nip ] [ offset-of-slot ] 2bi set-slot ; ERROR: not-persistent class ; @@ -158,8 +158,8 @@ ERROR: no-sql-type type ; modifiers>> [ lookup-modifier ] map " " join [ "" ] [ " " prepend ] if-empty ; -HOOK: bind% db ( spec -- ) -HOOK: bind# db ( spec obj -- ) +HOOK: bind% db-connection ( spec -- ) +HOOK: bind# db-connection ( spec obj -- ) ERROR: no-column column ; diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 4e0c4e8840..1440e7ca5d 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -2,14 +2,14 @@ ! See http://factorcode.org/license.txt for BSD license. USING: slots arrays definitions generic hashtables summary io kernel math namespaces make prettyprint prettyprint.config -sequences assocs sequences.private strings io.styles io.files -vectors words system splitting math.parser classes.mixin -classes.tuple continuations continuations.private combinators -generic.math classes.builtin classes compiler.units +sequences assocs sequences.private strings io.styles +io.pathnames vectors words system splitting math.parser +classes.mixin classes.tuple continuations continuations.private +combinators generic.math classes.builtin classes compiler.units generic.standard vocabs init kernel.private io.encodings accessors math.order destructors source-files parser classes.tuple.parser effects.parser lexer compiler.errors -generic.parser strings.parser ; +generic.parser strings.parser vocabs.parser ; IN: debugger GENERIC: error. ( error -- ) diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index d1e7d31656..7d297af1ed 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -20,7 +20,7 @@ PROTOCOL: baz foo { bar 0 } { whoa 1 } ; CONSULT: baz goodbye these>> ; M: hello foo this>> ; M: hello bar hello-test ; -M: hello whoa >r this>> r> + ; +M: hello whoa [ this>> ] dip + ; GENERIC: bing ( c -- d ) PROTOCOL: bee bing ; diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index 57f9b35c96..4da2244114 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors parser generic kernel classes classes.tuple words slots assocs sequences arrays vectors definitions -math hashtables sets generalizations namespaces make ; +math hashtables sets generalizations namespaces make +words.symbol ; IN: delegate : protocol-words ( protocol -- words ) diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor index c21f33ec8e..edbec804c1 100644 --- a/basis/delegate/protocols/protocols.factor +++ b/basis/delegate/protocols/protocols.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: delegate sequences.private sequences assocs -io definitions kernel continuations ; +io io.styles definitions kernel continuations ; IN: delegate.protocols PROTOCOL: sequence-protocol diff --git a/basis/deques/deques.factor b/basis/deques/deques.factor index f4e68c214b..73769cc4d2 100644 --- a/basis/deques/deques.factor +++ b/basis/deques/deques.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences math ; +USING: kernel sequences math fry ; IN: deques GENERIC: push-front* ( obj deque -- node ) @@ -34,7 +34,8 @@ GENERIC: deque-empty? ( deque -- ? ) [ peek-back ] [ pop-back* ] bi ; : slurp-deque ( deque quot -- ) - [ drop [ deque-empty? not ] curry ] - [ [ pop-back ] prepose curry ] 2bi [ ] while ; inline + [ drop '[ _ deque-empty? not ] ] + [ '[ _ pop-back @ ] ] + 2bi [ ] while ; inline MIXIN: deque diff --git a/basis/disjoint-sets/disjoint-sets.factor b/basis/disjoint-sets/disjoint-sets.factor index ea246cfa28..a3e5c7ceb7 100644 --- a/basis/disjoint-sets/disjoint-sets.factor +++ b/basis/disjoint-sets/disjoint-sets.factor @@ -60,8 +60,8 @@ GENERIC: add-atom ( a disjoint-set -- ) M: disjoint-set add-atom [ dupd parents>> set-at ] - [ 0 -rot ranks>> set-at ] - [ 1 -rot counts>> set-at ] + [ [ 0 ] 2dip ranks>> set-at ] + [ [ 1 ] 2dip counts>> set-at ] 2tri ; : add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ; diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor index dcff476166..8c575105d1 100644 --- a/basis/dlists/dlists.factor +++ b/basis/dlists/dlists.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2007, 2008 Mackenzie Straight, Doug Coleman, +! Copyright (C) 2007, 2009 Mackenzie Straight, Doug Coleman, ! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: combinators kernel math sequences accessors deques -search-deques summary hashtables ; +search-deques summary hashtables fry ; IN: dlists > ; [ front>> ] dip (dlist-find-node) ; inline : dlist-each-node ( dlist quot -- ) - [ f ] compose dlist-find-node 2drop ; inline + '[ @ f ] dlist-find-node 2drop ; inline : unlink-node ( dlist-node -- ) dup prev>> over next>> set-prev-when @@ -115,8 +115,7 @@ M: dlist pop-back* ( dlist -- ) normalize-front ; : dlist-find ( dlist quot -- obj/f ? ) - [ obj>> ] prepose - dlist-find-node [ obj>> t ] [ drop f f ] if ; inline + '[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline : dlist-contains? ( dlist quot -- ? ) dlist-find nip ; inline @@ -143,7 +142,7 @@ M: dlist delete-node ( dlist-node dlist -- ) ] if ; inline : delete-node-if ( dlist quot -- obj/f ) - [ obj>> ] prepose delete-node-if* drop ; inline + '[ obj>> @ ] delete-node-if* drop ; inline M: dlist clear-deque ( dlist -- ) f >>front @@ -151,7 +150,7 @@ M: dlist clear-deque ( dlist -- ) drop ; : dlist-each ( dlist quot -- ) - [ obj>> ] prepose dlist-each-node ; inline + '[ obj>> @ ] dlist-each-node ; inline : dlist>seq ( dlist -- seq ) [ ] accumulator [ dlist-each ] dip ; @@ -159,8 +158,6 @@ M: dlist clear-deque ( dlist -- ) : 1dlist ( obj -- dlist ) [ push-front ] keep ; M: dlist clone - [ - [ push-back ] curry dlist-each - ] keep ; + [ '[ _ push-back ] dlist-each ] keep ; INSTANCE: dlist deque diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor index 6993bcb65b..29f865cf3c 100644 --- a/basis/documents/documents.factor +++ b/basis/documents/documents.factor @@ -153,18 +153,18 @@ GENERIC: next-elt ( loc document elt -- newloc ) TUPLE: char-elt ; : (prev-char) ( loc document quot -- loc ) - -rot { - { [ over { 0 0 } = ] [ drop ] } - { [ over second zero? ] [ [ first 1- ] dip line-end ] } - [ pick call ] - } cond nip ; inline + { + { [ pick { 0 0 } = ] [ 2drop ] } + { [ pick second zero? ] [ drop [ first 1- ] dip line-end ] } + [ call ] + } cond ; inline : (next-char) ( loc document quot -- loc ) - -rot { - { [ 2dup doc-end = ] [ drop ] } - { [ 2dup line-end? ] [ drop first 1+ 0 2array ] } - [ pick call ] - } cond nip ; inline + { + { [ 2over doc-end = ] [ 2drop ] } + { [ 2over line-end? ] [ 2drop first 1+ 0 2array ] } + [ call ] + } cond ; inline M: char-elt prev-elt drop [ drop -1 +col ] (prev-char) ; diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 6b49c939c3..53887bd353 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser lexer kernel namespaces sequences definitions -io.files summary continuations tools.crossref tools.vocabs io -prettyprint source-files assocs vocabs vocabs.loader io.backend -splitting accessors ; +io.files io.backend io.pathnames io summary continuations +tools.crossref tools.vocabs prettyprint source-files assocs +vocabs vocabs.loader splitting accessors ; IN: editors TUPLE: no-edit-hook ; diff --git a/basis/editors/editpadlite/editpadlite.factor b/basis/editors/editpadlite/editpadlite.factor index c002c2fa75..d487ca776f 100644 --- a/basis/editors/editpadlite/editpadlite.factor +++ b/basis/editors/editpadlite/editpadlite.factor @@ -1,11 +1,12 @@ USING: definitions kernel parser words sequences math.parser namespaces editors io.launcher windows.shell32 io.files -io.paths.windows strings unicode.case make ; +io.directories.search.windows strings unicode.case make ; IN: editors.editpadlite : editpadlite-path ( -- path ) \ editpadlite-path get-global [ "JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files + [ "editpadlite.exe" ] unless* ] unless* ; : editpadlite ( file line -- ) diff --git a/basis/editors/editpadpro/editpadpro.factor b/basis/editors/editpadpro/editpadpro.factor index 2a7f92f932..09bfd69de8 100644 --- a/basis/editors/editpadpro/editpadpro.factor +++ b/basis/editors/editpadpro/editpadpro.factor @@ -1,11 +1,12 @@ USING: definitions kernel parser words sequences math.parser namespaces editors io.launcher windows.shell32 io.files -io.paths.windows strings unicode.case make ; +io.directories.search.windows strings unicode.case make ; IN: editors.editpadpro : editpadpro-path ( -- path ) \ editpadpro-path get-global [ "JGsoft" t [ >lower "editpadpro.exe" tail? ] find-in-program-files + [ "editpadpro.exe" ] unless* ] unless* ; : editpadpro ( file line -- ) diff --git a/basis/editors/editplus/editplus.factor b/basis/editors/editplus/editplus.factor index 9fa477f51a..affbcd4eb6 100644 --- a/basis/editors/editplus/editplus.factor +++ b/basis/editors/editplus/editplus.factor @@ -1,10 +1,12 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 make io.paths.windows ; +namespaces sequences windows.shell32 make +io.directories.search.windows ; IN: editors.editplus : editplus-path ( -- path ) \ editplus-path get-global [ "EditPlus 2" t [ "editplus.exe" tail? ] find-in-program-files + [ "editplus.exe" ] unless* ] unless* ; : editplus ( file line -- ) diff --git a/basis/editors/emeditor/emeditor.factor b/basis/editors/emeditor/emeditor.factor index fc3deae670..52c52bbb8b 100644 --- a/basis/editors/emeditor/emeditor.factor +++ b/basis/editors/emeditor/emeditor.factor @@ -1,10 +1,12 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 make io.paths.windows ; +namespaces sequences windows.shell32 make +io.directories.search.windows ; IN: editors.emeditor : emeditor-path ( -- path ) \ emeditor-path get-global [ "EmEditor" t [ "EmEditor.exe" tail? ] find-in-program-files + [ "EmEditor.exe" ] unless* ] unless* ; : emeditor ( file line -- ) diff --git a/basis/editors/etexteditor/etexteditor.factor b/basis/editors/etexteditor/etexteditor.factor index c4b3ad35c1..37c8d1b572 100755 --- a/basis/editors/etexteditor/etexteditor.factor +++ b/basis/editors/etexteditor/etexteditor.factor @@ -1,12 +1,13 @@ ! Copyright (C) 2008 Kibleur Christophe. ! See http://factorcode.org/license.txt for BSD license. -USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 io.paths.windows make ; +USING: editors io.files io.launcher kernel math.parser make +namespaces sequences windows.shell32 io.directories.search.windows ; IN: editors.etexteditor : etexteditor-path ( -- str ) \ etexteditor-path get-global [ "e" t [ "e.exe" tail? ] find-in-program-files + [ "e" ] unless* ] unless* ; : etexteditor ( file line -- ) diff --git a/basis/editors/gvim/gvim.factor b/basis/editors/gvim/gvim.factor index ad6fb65cfb..15fd52f5ee 100644 --- a/basis/editors/gvim/gvim.factor +++ b/basis/editors/gvim/gvim.factor @@ -3,12 +3,15 @@ namespaces sequences system combinators editors.vim vocabs.loader make ; IN: editors.gvim +! This code builds on the code in editors.vim; see there for +! more information. + SINGLETON: gvim HOOK: gvim-path io-backend ( -- path ) M: gvim vim-command ( file line -- string ) - [ gvim-path , swap , "+" swap number>string append , ] { } make ; + [ gvim-path , "+" swap number>string append , , ] { } make ; gvim vim-editor set-global diff --git a/basis/editors/gvim/unix/unix.factor b/basis/editors/gvim/unix/unix.factor index 82b6bf199d..3e2a42e6e5 100644 --- a/basis/editors/gvim/unix/unix.factor +++ b/basis/editors/gvim/unix/unix.factor @@ -1,5 +1,4 @@ -USING: io.unix.backend kernel namespaces editors.gvim -system ; +USING: kernel namespaces editors.gvim system ; IN: editors.gvim.unix M: unix gvim-path diff --git a/basis/editors/gvim/windows/windows.factor b/basis/editors/gvim/windows/windows.factor index 2f733f3c2f..4edc13b90c 100644 --- a/basis/editors/gvim/windows/windows.factor +++ b/basis/editors/gvim/windows/windows.factor @@ -1,8 +1,10 @@ -USING: editors.gvim io.files io.windows kernel namespaces -sequences windows.shell32 io.paths.windows system ; +USING: editors.gvim io.files kernel namespaces sequences +windows.shell32 io.directories.search.windows system +io.pathnames ; IN: editors.gvim.windows M: windows gvim-path \ gvim-path get-global [ "vim" t [ "gvim.exe" tail? ] find-in-program-files + [ "gvim.exe" ] unless* ] unless* ; diff --git a/basis/editors/jedit/jedit.factor b/basis/editors/jedit/jedit.factor index fe9abc0e76..e34f0ce175 100644 --- a/basis/editors/jedit/jedit.factor +++ b/basis/editors/jedit/jedit.factor @@ -4,7 +4,7 @@ USING: arrays definitions io kernel math namespaces parser prettyprint sequences strings words editors io.files io.sockets io.streams.byte-array io.binary math.parser io.encodings.ascii io.encodings.binary -io.encodings.utf8 io.files.private ; +io.encodings.utf8 io.files.private io.pathnames ; IN: editors.jedit : jedit-server-info ( -- port auth ) diff --git a/basis/editors/notepad/authors.txt b/basis/editors/notepad/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/editors/notepad/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/editors/notepad/notepad.factor b/basis/editors/notepad/notepad.factor new file mode 100755 index 0000000000..6094bf46b8 --- /dev/null +++ b/basis/editors/notepad/notepad.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: editors io.launcher kernel io.directories.search.windows +math.parser namespaces sequences io.files arrays windows.shell32 +io.directories.search ; +IN: editors.notepad + +: notepad-path ( -- path ) + \ notepad-path get [ + windows-directory t + [ "notepad.exe" tail? ] find-file + ] unless* ; + +: notepad ( file line -- ) + drop notepad-path swap 2array run-detached drop ; + +[ notepad ] edit-hook set-global + diff --git a/basis/editors/notepad2/notepad2.factor b/basis/editors/notepad2/notepad2.factor index e22de4f68d..dc1a8a7991 100644 --- a/basis/editors/notepad2/notepad2.factor +++ b/basis/editors/notepad2/notepad2.factor @@ -1,10 +1,11 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 make ; +namespaces sequences windows.shell32 make io.pathnames ; IN: editors.notepad2 : notepad2-path ( -- path ) \ notepad2-path get-global [ - "C:\\Windows\\system32\\notepad.exe" + windows-directory "system32\\notepad.exe" append-path + [ "notepad.exe" ] unless* ] unless* ; : notepad2 ( file line -- ) diff --git a/basis/editors/notepadpp/notepadpp.factor b/basis/editors/notepadpp/notepadpp.factor index d68008c2ca..1c856bd761 100644 --- a/basis/editors/notepadpp/notepadpp.factor +++ b/basis/editors/notepadpp/notepadpp.factor @@ -1,10 +1,11 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences io.paths.windows make ; +namespaces sequences io.directories.search.windows make ; IN: editors.notepadpp : notepadpp-path ( -- path ) \ notepadpp-path get-global [ "notepad++" t [ "notepad++.exe" tail? ] find-in-program-files + [ "notepad++.exe" ] unless* ] unless* ; : notepadpp ( file line -- ) diff --git a/basis/editors/scite/scite.factor b/basis/editors/scite/scite.factor index e0b48a3e72..fc7e9e319e 100644 --- a/basis/editors/scite/scite.factor +++ b/basis/editors/scite/scite.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Clemens F. Hofreither. ! See http://factorcode.org/license.txt for BSD license. ! clemens.hofreither@gmx.net -USING: io.files io.launcher kernel namespaces io.paths.windows +USING: io.files io.launcher kernel namespaces io.directories.search.windows math math.parser editors sequences make unicode.case ; IN: editors.scite @@ -9,6 +9,12 @@ IN: editors.scite \ scite-path get-global [ "Scintilla Text Editor" t [ >lower "scite.exe" tail? ] find-in-program-files + + [ + "SciTE Source Code Editor" t + [ >lower "scite.exe" tail? ] find-in-program-files + ] unless* + [ "scite.exe" ] unless* ] unless* ; : scite-command ( file line -- cmd ) diff --git a/basis/editors/ted-notepad/ted-notepad.factor b/basis/editors/ted-notepad/ted-notepad.factor index 994dc60ba3..301e82225c 100644 --- a/basis/editors/ted-notepad/ted-notepad.factor +++ b/basis/editors/ted-notepad/ted-notepad.factor @@ -1,10 +1,11 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences io.paths.windows make ; +namespaces sequences io.directories.search.windows make ; IN: editors.ted-notepad : ted-notepad-path ( -- path ) \ ted-notepad-path get-global [ "TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files + [ "TedNPad.exe" ] unless* ] unless* ; : ted-notepad ( file line -- ) diff --git a/basis/editors/textpad/authors.txt b/basis/editors/textpad/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/editors/textpad/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/editors/textpad/summary.txt b/basis/editors/textpad/summary.txt new file mode 100644 index 0000000000..c8820501ae --- /dev/null +++ b/basis/editors/textpad/summary.txt @@ -0,0 +1 @@ +TextPad editor integration diff --git a/basis/editors/textpad/tags.txt b/basis/editors/textpad/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/editors/textpad/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/editors/textpad/textpad.factor b/basis/editors/textpad/textpad.factor new file mode 100644 index 0000000000..ca9d5c486a --- /dev/null +++ b/basis/editors/textpad/textpad.factor @@ -0,0 +1,17 @@ +USING: editors io.files io.launcher kernel math.parser +namespaces sequences make io.directories.search +io.directories.search.windows ; +IN: editors.textpad + +: textpad-path ( -- path ) + \ textpad-path get-global [ + "TextPad 5" t [ "TextPad.exe" tail? ] find-in-program-files + [ "TextPad.exe" ] unless* + ] unless* ; + +: textpad ( file line -- ) + [ + textpad-path , [ , ] [ number>string "(" ",0)" surround , ] bi* + ] { } make run-detached drop ; + +[ textpad ] edit-hook set-global diff --git a/basis/editors/ultraedit/ultraedit.factor b/basis/editors/ultraedit/ultraedit.factor index f1929ebf64..b5bc229743 100644 --- a/basis/editors/ultraedit/ultraedit.factor +++ b/basis/editors/ultraedit/ultraedit.factor @@ -1,10 +1,11 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences io.paths.windows make ; +namespaces sequences io.directories.search.windows make ; IN: editors.ultraedit : ultraedit-path ( -- path ) \ ultraedit-path get-global [ "IDM Computer Solutions" t [ "uedit32.exe" tail? ] find-in-program-files + [ "uedit32.exe" ] unless* ] unless* ; : ultraedit ( file line -- ) diff --git a/basis/editors/vim/generate-syntax/generate-syntax.factor b/basis/editors/vim/generate-syntax/generate-syntax.factor index 325a451a0b..061e938dcf 100644 --- a/basis/editors/vim/generate-syntax/generate-syntax.factor +++ b/basis/editors/vim/generate-syntax/generate-syntax.factor @@ -1,11 +1,10 @@ ! Generate a new factor.vim file for syntax highlighting -USING: http.server.templating http.server.templating.fhtml -io.files ; +USING: html.templates html.templates.fhtml io.files io.pathnames ; IN: editors.vim.generate-syntax : generate-vim-syntax ( -- ) "misc/factor.vim.fgen" resource-path - "misc/factor.vim" resource-path + "misc/vim/syntax/factor.vim" resource-path template-convert ; MAIN: generate-vim-syntax diff --git a/basis/editors/vim/vim-docs.factor b/basis/editors/vim/vim-docs.factor index cf42884084..7f527bf18f 100644 --- a/basis/editors/vim/vim-docs.factor +++ b/basis/editors/vim/vim-docs.factor @@ -1,4 +1,5 @@ -USING: definitions help help.markup help.syntax io io.files editors words ; +USING: definitions editors help help.markup help.syntax io io.files + io.pathnames words ; IN: editors.vim ARTICLE: { "vim" "vim" } "Vim support" @@ -11,5 +12,6 @@ $nl "USE: vim" "\"c:\\\\program files\\\\vim\\\\vim70\\\\gvim\" vim-path set-global" } -"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "." ; - +"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "." +$nl +"You may also wish to install Vim support files to enable syntax hilighting and other features. These are in the " { $link resource-path } " in " { $snippet "misc/vim" } "." ; diff --git a/basis/editors/wordpad/wordpad.factor b/basis/editors/wordpad/wordpad.factor index fa0f6852dd..ef670d5d28 100644 --- a/basis/editors/wordpad/wordpad.factor +++ b/basis/editors/wordpad/wordpad.factor @@ -1,4 +1,4 @@ -USING: editors io.launcher kernel io.paths.windows +USING: editors io.launcher kernel io.directories.search.windows math.parser namespaces sequences io.files arrays ; IN: editors.wordpad diff --git a/basis/eval/eval-docs.factor b/basis/eval/eval-docs.factor index 057d291b7f..b53c3bae6b 100644 --- a/basis/eval/eval-docs.factor +++ b/basis/eval/eval-docs.factor @@ -11,7 +11,7 @@ HELP: eval>string { $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string." } ; ARTICLE: "eval" "Evaluating strings at runtime" -"Evaluating strings at runtime:" +"The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings at runtime." { $subsection eval } { $subsection eval>string } ; diff --git a/basis/eval/eval-tests.factor b/basis/eval/eval-tests.factor new file mode 100644 index 0000000000..675921944a --- /dev/null +++ b/basis/eval/eval-tests.factor @@ -0,0 +1,4 @@ +IN: eval.tests +USING: eval tools.test ; + +[ "4\n" ] [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-test diff --git a/basis/eval/eval.factor b/basis/eval/eval.factor index 5b22fec159..dfa9baf418 100644 --- a/basis/eval/eval.factor +++ b/basis/eval/eval.factor @@ -1,14 +1,24 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: splitting parser compiler.units kernel namespaces -debugger io.streams.string ; +debugger io.streams.string fry ; IN: eval +: parse-string ( str -- ) + [ string-lines parse-lines ] with-compilation-unit ; + +: (eval) ( str -- ) + parse-string call ; + : eval ( str -- ) - [ string-lines parse-fresh ] with-compilation-unit call ; + [ (eval) ] with-file-vocabs ; -: eval>string ( str -- output ) +: (eval>string) ( str -- output ) [ + "quiet" on parser-notes off - [ [ eval ] keep ] try drop + '[ _ (eval) ] try ] with-string-writer ; + +: eval>string ( str -- output ) + [ (eval>string) ] with-file-vocabs ; \ No newline at end of file diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor index 8e7270cc01..8c6b07a01c 100644 --- a/basis/farkup/farkup-docs.factor +++ b/basis/farkup/farkup-docs.factor @@ -14,8 +14,8 @@ HELP: parse-farkup ( string -- farkup ) { $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ; HELP: (write-farkup) -{ $values { "farkup" "a Farkup syntax tree node" } } -{ $description "Writes a Farkup syntax tree as HTML on " { $link output-stream } "." } ; +{ $values { "farkup" "a Farkup syntax tree node" } { "xml" "an XML chunk" } } +{ $description "Converts a Farkup syntax tree node to XML." } ; ARTICLE: "farkup-ast" "Farkup syntax tree nodes" "The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "." diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor index 27911a8d13..49c4dab0db 100644 --- a/basis/farkup/farkup-tests.factor +++ b/basis/farkup/farkup-tests.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: farkup kernel peg peg.ebnf tools.test namespaces ; +USING: farkup kernel peg peg.ebnf tools.test namespaces xml +urls.encoding assocs xml.utilities xml.data ; IN: farkup.tests relative-link-prefix off @@ -91,22 +92,22 @@ link-no-follow? off [ "

=

foo

" ] [ "===foo==" convert-farkup ] unit-test [ "

foo

=

" ] [ "=foo==" convert-farkup ] unit-test -[ "
int main()\n
" ] +[ "
int main()
" ] [ "[c{int main()}]" convert-farkup ] unit-test -[ "

" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test -[ "

teh lol

" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test -[ "

http://lol.com

" ] [ "[[http://lol.com]]" convert-farkup ] unit-test -[ "

haha

" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test -[ "

Bar

" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test +[ "

" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test +[ "

\"teh

" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test +[ "

http://lol.com

" ] [ "[[http://lol.com]]" convert-farkup ] unit-test +[ "

haha

" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test +[ "

Bar

" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test "/wiki/view/" relative-link-prefix [ - [ "

Bar

" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test + [ "

Bar

" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test ] with-variable [ ] [ "[{}]" convert-farkup drop ] unit-test -[ "
hello\n
" ] [ "[{hello}]" convert-farkup ] unit-test +[ "
hello
" ] [ "[{hello}]" convert-farkup ] unit-test [ "

Feature comparison:\n
aFactorJavaLisp
CoolnessYesNoNo
BadassYesNoNo
EnterpriseYesYesNo
KosherYesNoYes

" @@ -117,15 +118,15 @@ link-no-follow? off ] [ "Feature comparison:\n\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test [ - "

This wiki is written in Factor and is hosted on a http://linode.com virtual server.

" + "

This wiki is written in Factor and is hosted on a http://linode.com virtual server.

" ] [ "This wiki is written in [[Factor]] and is hosted on a [[http://linode.com|http://linode.com]] virtual server." convert-farkup ] unit-test -[ "

a c

" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test +[ "

a c

" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test -[ "

C++

" ] [ "[[C++]]" convert-farkup ] unit-test +[ "

C++

" ] [ "[[C++]]" convert-farkup ] unit-test [ "

<foo>

" ] [ "" convert-farkup ] unit-test @@ -137,10 +138,10 @@ link-no-follow? off [ "
" ] [ "___" convert-farkup ] unit-test [ "
\n" ] [ "___\n" convert-farkup ] unit-test -[ "

before:\n

{ 1 2 3 } 1 tail\n

" ] +[ "

before:\n

{ 1 2 3 } 1 tail

" ] [ "before:\n[factor{{ 1 2 3 } 1 tail}]" convert-farkup ] unit-test -[ "

Factor-rific!

" ] +[ "

Factor-rific!

" ] [ "[[Factor]]-rific!" convert-farkup ] unit-test [ "

[ factor { 1 2 3 }]

" ] @@ -157,3 +158,12 @@ link-no-follow? off [ "

hello_world how are you today?\n

  • hello_world how are you today?

" ] [ "hello_world how are you today?\n- hello_world how are you today?" convert-farkup ] unit-test + +: check-link-escaping ( string -- link ) + convert-farkup string>xml-chunk + "a" deep-tag-named "href" attr url-decode ; + +[ "Trader Joe\"s" ] [ "[[Trader Joe\"s]]" check-link-escaping ] unit-test +[ "" ] [ "[[]]" check-link-escaping ] unit-test +[ "&blah;" ] [ "[[&blah;]]" check-link-escaping ] unit-test +[ "C++" ] [ "[[C++]]" check-link-escaping ] unit-test diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 284d5758a3..b9e62717eb 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -2,8 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators html.elements io io.streams.string kernel math namespaces peg peg.ebnf -sequences sequences.deep strings xml.entities -vectors splitting xmode.code2html urls.encoding ; +sequences sequences.deep strings xml.entities xml.interpolate +vectors splitting xmode.code2html urls.encoding xml.data +xml.writer ; IN: farkup SYMBOL: relative-link-prefix @@ -74,6 +75,7 @@ inline-code = "%" (!("%" | nl).)+ "%" => [[ second >string inline-code boa ]] link-content = (!("|"|"]").)+ + => [[ >string ]] image-link = "[[image:" link-content "|" link-content "]]" => [[ [ second >string ] [ fourth >string ] bi image boa ]] @@ -146,7 +148,7 @@ named-code simple-code = "[{" (!("}]").)+ "}]" - => [[ second f swap code boa ]] + => [[ second >string f swap code boa ]] code = named-code | simple-code @@ -163,66 +165,78 @@ stand-alone { [ dup [ 127 > ] contains? ] [ drop invalid-url ] } { [ dup first "/\\" member? ] [ drop invalid-url ] } { [ CHAR: : over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] } - [ relative-link-prefix get prepend ] - } cond ; + [ relative-link-prefix get prepend "" like ] + } cond url-encode ; -: escape-link ( href text -- href-esc text-esc ) - [ check-url escape-quoted-string ] dip escape-string ; +: write-link ( href text -- xml ) + [ check-url link-no-follow? get "true" and ] dip + [XML nofollow=<->><-> XML] ; -: write-link ( href text -- ) - escape-link - [ ] - [ write ] - bi* ; - -: write-image-link ( href text -- ) +: write-image-link ( href text -- xml ) disable-images? get [ 2drop - "Images are not allowed" write + [XML Images are not allowed XML] ] [ - escape-link - [ ] bi* + [ check-url ] [ f like ] bi* + [XML alt=<->/> XML] ] if ; -: render-code ( string mode -- string' ) - [ string-lines ] dip - [ -
-            htmlize-lines
-        
- ] with-string-writer write ; - -GENERIC: (write-farkup) ( farkup -- ) -: ( string -- ) write ; -: ( string -- )
write ; -: in-tag. ( obj quot string -- ) [ call ] keep ; inline -M: heading1 (write-farkup) [ child>> (write-farkup) ] "h1" in-tag. ; -M: heading2 (write-farkup) [ child>> (write-farkup) ] "h2" in-tag. ; -M: heading3 (write-farkup) [ child>> (write-farkup) ] "h3" in-tag. ; -M: heading4 (write-farkup) [ child>> (write-farkup) ] "h4" in-tag. ; -M: strong (write-farkup) [ child>> (write-farkup) ] "strong" in-tag. ; -M: emphasis (write-farkup) [ child>> (write-farkup) ] "em" in-tag. ; -M: superscript (write-farkup) [ child>> (write-farkup) ] "sup" in-tag. ; -M: subscript (write-farkup) [ child>> (write-farkup) ] "sub" in-tag. ; -M: inline-code (write-farkup) [ child>> (write-farkup) ] "code" in-tag. ; -M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ; -M: unordered-list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ; -M: ordered-list (write-farkup) [ child>> (write-farkup) ] "ol" in-tag. ; -M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ; -M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ; -M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ; -M: code (write-farkup) [ string>> ] [ mode>> ] bi render-code ; -M: line (write-farkup) drop
; -M: line-break (write-farkup) drop
nl ; -M: table-row (write-farkup) ( obj -- ) - child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ; -M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ; -M: string (write-farkup) escape-string write ; -M: vector (write-farkup) [ (write-farkup) ] each ; -M: f (write-farkup) drop ; +: render-code ( string mode -- xml ) + [ string-lines ] dip htmlize-lines + [XML
<->
XML] ; -: write-farkup ( string -- ) +GENERIC: (write-farkup) ( farkup -- xml ) + +: farkup-inside ( farkup name -- xml ) + swap T{ attrs } swap + child>> (write-farkup) 1array ; + +M: heading1 (write-farkup) "h1" farkup-inside ; +M: heading2 (write-farkup) "h2" farkup-inside ; +M: heading3 (write-farkup) "h3" farkup-inside ; +M: heading4 (write-farkup) "h4" farkup-inside ; +M: strong (write-farkup) "strong" farkup-inside ; +M: emphasis (write-farkup) "em" farkup-inside ; +M: superscript (write-farkup) "sup" farkup-inside ; +M: subscript (write-farkup) "sub" farkup-inside ; +M: inline-code (write-farkup) "code" farkup-inside ; +M: list-item (write-farkup) "li" farkup-inside ; +M: unordered-list (write-farkup) "ul" farkup-inside ; +M: ordered-list (write-farkup) "ol" farkup-inside ; +M: paragraph (write-farkup) "p" farkup-inside ; +M: table (write-farkup) "table" farkup-inside ; + +M: link (write-farkup) + [ href>> ] [ text>> ] bi write-link ; + +M: image (write-farkup) + [ href>> ] [ text>> ] bi write-image-link ; + +M: code (write-farkup) + [ string>> ] [ mode>> ] bi render-code ; + +M: line (write-farkup) + drop [XML
XML] ; + +M: line-break (write-farkup) + drop [XML
XML] ; + +M: table-row (write-farkup) + child>> + [ (write-farkup) [XML <-> XML] ] map + [XML <-> XML] ; + +M: string (write-farkup) ; + +M: vector (write-farkup) [ (write-farkup) ] map ; + +M: f (write-farkup) ; + +: farkup>xml ( string -- xml ) parse-farkup (write-farkup) ; +: write-farkup ( string -- ) + farkup>xml write-xml ; + : convert-farkup ( string -- string' ) - parse-farkup [ (write-farkup) ] with-string-writer ; + [ write-farkup ] with-string-writer ; diff --git a/basis/formatting/authors.txt b/basis/formatting/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/basis/formatting/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/basis/formatting/formatting-docs.factor b/basis/formatting/formatting-docs.factor new file mode 100644 index 0000000000..196302f203 --- /dev/null +++ b/basis/formatting/formatting-docs.factor @@ -0,0 +1,129 @@ + +USING: help.syntax help.markup kernel prettyprint sequences strings ; + +IN: formatting + +HELP: printf +{ $values { "format-string" string } } +{ $description + "Writes the arguments (specified on the stack) formatted according to the format string.\n" + $nl + "Several format specifications exist for handling arguments of different types, and " + "specifying attributes for the result string, including such things as maximum width, " + "padding, and decimals.\n" + { $table + { "%%" "Single %" "" } + { "%P.Ds" "String format" "string" } + { "%P.DS" "String format uppercase" "string" } + { "%c" "Character format" "char" } + { "%C" "Character format uppercase" "char" } + { "%+Pd" "Integer format" "fixnum" } + { "%+P.De" "Scientific notation" "fixnum, float" } + { "%+P.DE" "Scientific notation" "fixnum, float" } + { "%+P.Df" "Fixed format" "fixnum, float" } + { "%+Px" "Hexadecimal" "hex" } + { "%+PX" "Hexadecimal uppercase" "hex" } + } + $nl + "A plus sign ('+') is used to optionally specify that the number should be " + "formatted with a '+' preceeding it if positive.\n" + $nl + "Padding ('P') is used to optionally specify the minimum width of the result " + "string, the padding character, and the alignment. By default, the padding " + "character defaults to a space and the alignment defaults to right-aligned. " + "For example:\n" + { $list + "\"%5s\" formats a string padding with spaces up to 5 characters wide." + "\"%08d\" formats an integer padding with zeros up to 3 characters wide." + "\"%'#5f\" formats a float padding with '#' up to 3 characters wide." + "\"%-10d\" formats an integer to 10 characters wide and left-aligns." + } + $nl + "Digits ('D') is used to optionally specify the maximum digits in the result " + "string. For example:\n" + { $list + "\"%.3s\" formats a string to truncate at 3 characters (from the left)." + "\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point." + "\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent." + } +} +{ $examples + { $example + "USING: formatting ;" + "123 \"%05d\" printf" + "00123" } + { $example + "USING: formatting ;" + "HEX: ff \"%04X\" printf" + "00FF" } + { $example + "USING: formatting ;" + "1.23456789 \"%.3f\" printf" + "1.235" } + { $example + "USING: formatting ;" + "1234567890 \"%.5e\" printf" + "1.23457e+09" } + { $example + "USING: formatting ;" + "12 \"%'#4d\" printf" + "##12" } + { $example + "USING: formatting ;" + "1234 \"%+d\" printf" + "+1234" } +} ; + +HELP: sprintf +{ $values { "format-string" string } { "result" string } } +{ $description "Returns the arguments (specified on the stack) formatted according to the format string as a result string." } +{ $see-also printf } ; + +HELP: strftime +{ $values { "format-string" string } } +{ $description + "Writes the timestamp (specified on the stack) formatted according to the format string.\n" + $nl + "Different attributes of the timestamp can be retrieved using format specifications.\n" + { $table + { "%a" "Abbreviated weekday name." } + { "%A" "Full weekday name." } + { "%b" "Abbreviated month name." } + { "%B" "Full month name." } + { "%c" "Date and time representation." } + { "%d" "Day of the month as a decimal number [01,31]." } + { "%H" "Hour (24-hour clock) as a decimal number [00,23]." } + { "%I" "Hour (12-hour clock) as a decimal number [01,12]." } + { "%j" "Day of the year as a decimal number [001,366]." } + { "%m" "Month as a decimal number [01,12]." } + { "%M" "Minute as a decimal number [00,59]." } + { "%p" "Either AM or PM." } + { "%S" "Second as a decimal number [00,59]." } + { "%U" "Week number of the year (Sunday as the first day of the week) as a decimal number [00,53]." } + { "%w" "Weekday as a decimal number [0(Sunday),6]." } + { "%W" "Week number of the year (Monday as the first day of the week) as a decimal number [00,53]." } + { "%x" "Date representation." } + { "%X" "Time representation." } + { "%y" "Year without century as a decimal number [00,99]." } + { "%Y" "Year with century as a decimal number." } + { "%Z" "Time zone name (no characters if no time zone exists)." } + { "%%" "A literal '%' character." } + } +} +{ $examples + { $unchecked-example + "USING: calendar formatting io ;" + "now \"%c\" strftime print" + "Mon Dec 15 14:40:43 2008" } +} ; + +ARTICLE: "formatting" "Formatted printing" +"The " { $vocab-link "formatting" } " vocabulary is used for formatted printing." +{ $subsection printf } +{ $subsection sprintf } +{ $subsection strftime } +; + +ABOUT: "formatting" + + diff --git a/basis/formatting/formatting-tests.factor b/basis/formatting/formatting-tests.factor new file mode 100644 index 0000000000..c7e9fb985e --- /dev/null +++ b/basis/formatting/formatting-tests.factor @@ -0,0 +1,97 @@ +! Copyright (C) 2008 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: calendar kernel formatting tools.test ; + +IN: formatting.tests + +[ "%s" printf ] must-infer +[ "%s" sprintf ] must-infer + +[ t ] [ "" "" sprintf = ] unit-test +[ t ] [ "asdf" "asdf" sprintf = ] unit-test +[ t ] [ "10" 10 "%d" sprintf = ] unit-test +[ t ] [ "+10" 10 "%+d" sprintf = ] unit-test +[ t ] [ "-10" -10 "%d" sprintf = ] unit-test +[ t ] [ " -10" -10 "%5d" sprintf = ] unit-test +[ t ] [ "-0010" -10 "%05d" sprintf = ] unit-test +[ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test +[ t ] [ "123.456000" 123.456 "%f" sprintf = ] unit-test +[ t ] [ "2.44" 2.436 "%.2f" sprintf = ] unit-test +[ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test +[ t ] [ "1.2346" 1.23456789 "%.4f" sprintf = ] unit-test +[ t ] [ " 1.23" 1.23456789 "%6.2f" sprintf = ] unit-test +[ t ] [ "1.234000e+08" 123400000 "%e" sprintf = ] unit-test +[ t ] [ "-1.234000e+08" -123400000 "%e" sprintf = ] unit-test +[ t ] [ "1.234567e+08" 123456700 "%e" sprintf = ] unit-test +[ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test +[ t ] [ "2.500000e-03" 0.0025 "%e" sprintf = ] unit-test +[ t ] [ "2.500000E-03" 0.0025 "%E" sprintf = ] unit-test +[ t ] [ " 1.0E+01" 10 "%10.1E" sprintf = ] unit-test +[ t ] [ " -1.0E+01" -10 "%10.1E" sprintf = ] unit-test +[ t ] [ " -1.0E+01" -10 "%+10.1E" sprintf = ] unit-test +[ t ] [ " +1.0E+01" 10 "%+10.1E" sprintf = ] unit-test +[ t ] [ "-001.0E+01" -10 "%+010.1E" sprintf = ] unit-test +[ t ] [ "+001.0E+01" 10 "%+010.1E" sprintf = ] unit-test +[ t ] [ "ff" HEX: ff "%x" sprintf = ] unit-test +[ t ] [ "FF" HEX: ff "%X" sprintf = ] unit-test +[ t ] [ "0f" HEX: f "%02x" sprintf = ] unit-test +[ t ] [ "0F" HEX: f "%02X" sprintf = ] unit-test +[ t ] [ "2008-09-10" + 2008 9 10 "%04d-%02d-%02d" sprintf = ] unit-test +[ t ] [ "Hello, World!" + "Hello, World!" "%s" sprintf = ] unit-test +[ t ] [ "printf test" + "printf test" sprintf = ] unit-test +[ t ] [ "char a = 'a'" + CHAR: a "char %c = 'a'" sprintf = ] unit-test +[ t ] [ "00" HEX: 0 "%02x" sprintf = ] unit-test +[ t ] [ "ff" HEX: ff "%02x" sprintf = ] unit-test +[ t ] [ "0 message(s)" + 0 "message" "%d %s(s)" sprintf = ] unit-test +[ t ] [ "0 message(s) with %" + 0 "message" "%d %s(s) with %%" sprintf = ] unit-test +[ t ] [ "justif: \"left \"" + "left" "justif: \"%-10s\"" sprintf = ] unit-test +[ t ] [ "justif: \" right\"" + "right" "justif: \"%10s\"" sprintf = ] unit-test +[ t ] [ " 3: 0003 zero padded" + 3 " 3: %04d zero padded" sprintf = ] unit-test +[ t ] [ " 3: 3 left justif" + 3 " 3: %-4d left justif" sprintf = ] unit-test +[ t ] [ " 3: 3 right justif" + 3 " 3: %4d right justif" sprintf = ] unit-test +[ t ] [ " -3: -003 zero padded" + -3 " -3: %04d zero padded" sprintf = ] unit-test +[ t ] [ " -3: -3 left justif" + -3 " -3: %-4d left justif" sprintf = ] unit-test +[ t ] [ " -3: -3 right justif" + -3 " -3: %4d right justif" sprintf = ] unit-test +[ t ] [ "There are 10 monkeys in the kitchen" + 10 "kitchen" "There are %d monkeys in the %s" sprintf = ] unit-test +[ f ] [ "%d" 10 "%d" sprintf = ] unit-test +[ t ] [ "[monkey]" "monkey" "[%s]" sprintf = ] unit-test +[ t ] [ "[ monkey]" "monkey" "[%10s]" sprintf = ] unit-test +[ t ] [ "[monkey ]" "monkey" "[%-10s]" sprintf = ] unit-test +[ t ] [ "[0000monkey]" "monkey" "[%010s]" sprintf = ] unit-test +[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test +[ t ] [ "[many monke]" "many monkeys" "[%10.10s]" sprintf = ] unit-test + + +[ "%H:%M:%S" strftime ] must-infer + +: testtime ( -- timestamp ) + 2008 10 9 12 3 15 instant ; + +[ t ] [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test +[ t ] [ "12:03:15" testtime "%X" strftime = ] unit-test +[ t ] [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test +[ t ] [ "10/09/2008" testtime "%x" strftime = ] unit-test +[ t ] [ "10/09/08" testtime "%m/%d/%y" strftime = ] unit-test +[ t ] [ "Thu" testtime "%a" strftime = ] unit-test +[ t ] [ "Thursday" testtime "%A" strftime = ] unit-test +[ t ] [ "Oct" testtime "%b" strftime = ] unit-test +[ t ] [ "October" testtime "%B" strftime = ] unit-test +[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test +[ t ] [ "PM" testtime "%p" strftime = ] unit-test + diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor new file mode 100644 index 0000000000..3f12c36bbd --- /dev/null +++ b/basis/formatting/formatting.factor @@ -0,0 +1,185 @@ +! Copyright (C) 2008 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors arrays ascii calendar combinators fry kernel +generalizations io io.encodings.ascii io.files io.streams.string +macros math math.functions math.parser peg.ebnf quotations +sequences splitting strings unicode.case vectors ; + +IN: formatting + +digits ( string -- digits ) + [ 0 ] [ string>number ] if-empty ; + +: pad-digits ( string digits -- string' ) + [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ; + +: max-digits ( n digits -- n' ) + 10 swap ^ [ * round ] keep / ; inline + +: >exp ( x -- exp base ) + [ + abs 0 swap + [ dup [ 10.0 >= ] [ 1.0 < ] bi or ] + [ dup 10.0 >= + [ 10.0 / [ 1+ ] dip ] + [ 10.0 * [ 1- ] dip ] if + ] [ ] while + ] keep 0 < [ neg ] when ; + +: exp>string ( exp base digits -- string ) + [ max-digits ] keep -rot + [ + [ 0 < "-" "+" ? ] + [ abs number>string 2 CHAR: 0 pad-left ] bi + "e" -rot 3append + ] + [ number>string ] bi* + rot pad-digits prepend ; + +EBNF: parse-printf + +zero = "0" => [[ CHAR: 0 ]] +char = "'" (.) => [[ second ]] + +pad-char = (zero|char)? => [[ CHAR: \s or ]] +pad-align = ("-")? => [[ \ pad-right \ pad-left ? ]] +pad-width = ([0-9])* => [[ >digits ]] +pad = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]] + +sign = ("+")? => [[ [ dup CHAR: - swap index [ "+" prepend ] unless ] [ ] ? ]] + +width_ = "." ([0-9])* => [[ second >digits '[ _ short head ] ]] +width = (width_)? => [[ [ ] or ]] + +digits_ = "." ([0-9])* => [[ second >digits ]] +digits = (digits_)? => [[ 6 or ]] + +fmt-% = "%" => [[ [ "%" ] ]] +fmt-c = "c" => [[ [ 1string ] ]] +fmt-C = "C" => [[ [ 1string >upper ] ]] +fmt-s = "s" => [[ [ ] ]] +fmt-S = "S" => [[ [ >upper ] ]] +fmt-d = "d" => [[ [ >fixnum number>string ] ]] +fmt-e = digits "e" => [[ first '[ >exp _ exp>string ] ]] +fmt-E = digits "E" => [[ first '[ >exp _ exp>string >upper ] ]] +fmt-f = digits "f" => [[ first dup '[ >float _ max-digits number>string _ pad-digits ] ]] +fmt-x = "x" => [[ [ >hex ] ]] +fmt-X = "X" => [[ [ >hex >upper ] ]] +unknown = (.)* => [[ "Unknown directive" throw ]] + +strings_ = fmt-c|fmt-C|fmt-s|fmt-S +strings = pad width strings_ => [[ reverse compose-all ]] + +numbers_ = fmt-d|fmt-e|fmt-E|fmt-f|fmt-x|fmt-X +numbers = sign pad numbers_ => [[ unclip-last prefix compose-all [ fix-sign ] append ]] + +formats = "%" (strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]] + +plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]] + +text = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]] + +;EBNF + +PRIVATE> + +MACRO: printf ( format-string -- ) + parse-printf [ length ] keep compose-all '[ _ @ reverse [ write ] each ] ; + +: sprintf ( format-string -- result ) + [ printf ] with-string-writer ; inline + + +string 2 CHAR: 0 pad-left ; inline + +: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-left ; inline + +: >time ( timestamp -- string ) + [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array + [ pad-00 ] map ":" join ; inline + +: >date ( timestamp -- string ) + [ month>> ] [ day>> ] [ year>> ] tri 3array + [ pad-00 ] map "/" join ; inline + +: >datetime ( timestamp -- string ) + { [ day-of-week day-abbreviation3 ] + [ month>> month-abbreviation ] + [ day>> pad-00 ] + [ >time ] + [ year>> number>string ] + } cleave 5 narray " " join ; inline + +: (week-of-year) ( timestamp day -- n ) + [ dup clone 1 >>month 1 >>day day-of-week dup ] dip > [ 7 swap - ] when + [ day-of-year ] dip 2dup < [ 0 2nip ] [ - 7 / 1+ >fixnum ] if ; + +: week-of-year-sunday ( timestamp -- n ) 0 (week-of-year) ; inline + +: week-of-year-monday ( timestamp -- n ) 1 (week-of-year) ; inline + +EBNF: parse-strftime + +fmt-% = "%" => [[ [ "%" ] ]] +fmt-a = "a" => [[ [ dup day-of-week day-abbreviation3 ] ]] +fmt-A = "A" => [[ [ dup day-of-week day-name ] ]] +fmt-b = "b" => [[ [ dup month>> month-abbreviation ] ]] +fmt-B = "B" => [[ [ dup month>> month-name ] ]] +fmt-c = "c" => [[ [ dup >datetime ] ]] +fmt-d = "d" => [[ [ dup day>> pad-00 ] ]] +fmt-H = "H" => [[ [ dup hour>> pad-00 ] ]] +fmt-I = "I" => [[ [ dup hour>> dup 12 > [ 12 - ] when pad-00 ] ]] +fmt-j = "j" => [[ [ dup day-of-year pad-000 ] ]] +fmt-m = "m" => [[ [ dup month>> pad-00 ] ]] +fmt-M = "M" => [[ [ dup minute>> pad-00 ] ]] +fmt-p = "p" => [[ [ dup hour>> 12 < "AM" "PM" ? ] ]] +fmt-S = "S" => [[ [ dup second>> floor pad-00 ] ]] +fmt-U = "U" => [[ [ dup week-of-year-sunday pad-00 ] ]] +fmt-w = "w" => [[ [ dup day-of-week number>string ] ]] +fmt-W = "W" => [[ [ dup week-of-year-monday pad-00 ] ]] +fmt-x = "x" => [[ [ dup >date ] ]] +fmt-X = "X" => [[ [ dup >time ] ]] +fmt-y = "y" => [[ [ dup year>> 100 mod pad-00 ] ]] +fmt-Y = "Y" => [[ [ dup year>> number>string ] ]] +fmt-Z = "Z" => [[ [ "Not yet implemented" throw ] ]] +unknown = (.)* => [[ "Unknown directive" throw ]] + +formats_ = fmt-%|fmt-a|fmt-A|fmt-b|fmt-B|fmt-c|fmt-d|fmt-H|fmt-I| + fmt-j|fmt-m|fmt-M|fmt-p|fmt-S|fmt-U|fmt-w|fmt-W|fmt-x| + fmt-X|fmt-y|fmt-Y|fmt-Z|unknown + +formats = "%" (formats_) => [[ second '[ _ dip ] ]] + +plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]] + +text = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]] + +;EBNF + +PRIVATE> + +MACRO: strftime ( format-string -- ) + parse-strftime [ length ] keep [ ] join + '[ _ @ reverse concat nip ] ; + + diff --git a/basis/formatting/summary.txt b/basis/formatting/summary.txt new file mode 100644 index 0000000000..da1aa31abb --- /dev/null +++ b/basis/formatting/summary.txt @@ -0,0 +1 @@ +Format data according to a specified format string, and writes (or returns) the result string. diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor index 1dff0942bd..5d750775e5 100644 --- a/basis/fry/fry-docs.factor +++ b/basis/fry/fry-docs.factor @@ -20,7 +20,7 @@ HELP: '[ { $examples "See " { $link "fry.examples" } "." } ; HELP: >r/r>-in-fry-error -{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to " { $link >r } " or " { $link r> } ". Explicit retain stack manipulation of this form does not work with fry; use " { $link dip } " instead." } ; +{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to retain stack manipulation primitives." } ; ARTICLE: "fry.examples" "Examples of fried quotations" "The easiest way to understand fried quotations is to look at some examples." @@ -69,18 +69,18 @@ ARTICLE: "fry.philosophy" "Fried quotation philosophy" "'[ [ _ key? ] all? ] filter" "[ [ key? ] curry all? ] curry filter" } -"There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a ``let'' form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:" +"There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a “let” form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:" { $code "'[ 3 _ + 4 _ / ]" "[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]" } ; ARTICLE: "fry" "Fried quotations" -"The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with ``holes'' (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack." +"The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with “holes” (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack." $nl "Fried quotations are started by a special parsing word:" { $subsection POSTPONE: '[ } -"There are two types of fry specifiers; the first can hold a value, and the second ``splices'' a quotation, as if it were inserted without surrounding brackets:" +"There are two types of fry specifiers; the first can hold a value, and the second “splices” a quotation, as if it were inserted without surrounding brackets:" { $subsection _ } { $subsection @ } "The holes are filled in with the top of stack going in the rightmost hole, the second item on the stack going in the second hole from the right, and so on." diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor index 0137e8be22..7189450394 100644 --- a/basis/fry/fry-tests.factor +++ b/basis/fry/fry-tests.factor @@ -56,7 +56,7 @@ sequences eval accessors ; 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call ] unit-test -[ "USING: fry kernel ; f '[ >r _ r> ]" eval ] +[ "USING: fry locals.backend ; f '[ load-local _ ]" eval ] [ error>> >r/r>-in-fry-error? ] must-fail-with [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [ diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor index f84ad233cd..e62a42749f 100644 --- a/basis/fry/fry.factor +++ b/basis/fry/fry.factor @@ -25,7 +25,7 @@ M: >r/r>-in-fry-error summary "Explicit retain stack manipulation is not permitted in fried quotations" ; : check-fry ( quot -- quot ) - dup { >r r> load-locals get-local drop-locals } intersect + dup { load-local load-locals get-local drop-locals } intersect empty? [ >r/r>-in-fry-error ] unless ; PREDICATE: fry-specifier < word { _ @ } memq? ; diff --git a/basis/ftp/client/client.factor b/basis/ftp/client/client.factor index 9c82cdbb50..ac21bb8f78 100644 --- a/basis/ftp/client/client.factor +++ b/basis/ftp/client/client.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays classes.singleton combinators continuations io io.encodings.binary io.encodings.utf8 -io.files io.sockets kernel io.streams.duplex math +io.files io.pathnames io.sockets kernel io.streams.duplex math math.parser sequences splitting namespaces strings fry ftp ftp.client.listing-parser urls ; IN: ftp.client @@ -104,7 +104,3 @@ ERROR: ftp-error got expected ; [ nip parent-directory ftp-cwd drop ] [ file-name (ftp-get) ] 2bi ] with-ftp-client ; - - - - diff --git a/basis/ftp/client/listing-parser/listing-parser.factor b/basis/ftp/client/listing-parser/listing-parser.factor index 04e96ed77a..6183165b3a 100644 --- a/basis/ftp/client/listing-parser/listing-parser.factor +++ b/basis/ftp/client/listing-parser/listing-parser.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io.files kernel math.parser +USING: accessors combinators io.files.types kernel math.parser sequences splitting ; IN: ftp.client.listing-parser diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index b0ec340202..20a753785c 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -2,12 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: combinators.short-circuit accessors combinators io io.encodings.8-bit io.encodings io.encodings.binary -io.encodings.utf8 io.files io.sockets kernel math.parser -namespaces make sequences ftp io.unix.launcher.parser -unicode.case splitting assocs classes io.servers.connection -destructors calendar io.timeouts io.streams.duplex threads -continuations math concurrency.promises byte-arrays -io.backend tools.hexdump tools.files io.streams.string ; +io.encodings.utf8 io.files io.files.info io.directories +io.sockets kernel math.parser namespaces make sequences +ftp io.launcher.unix.parser unicode.case splitting +assocs classes io.servers.connection destructors calendar +io.timeouts io.streams.duplex threads continuations math +concurrency.promises byte-arrays io.backend tools.hexdump +io.streams.string math.bitwise tools.files io.pathnames ; IN: ftp.server TUPLE: ftp-client url mode state command-promise user password ; @@ -48,7 +49,7 @@ C: ftp-list [ >>raw ] [ tokenize-command >>tokenized ] bi ; : (send-response) ( n string separator -- ) - rot number>string write write ftp-send ; + [ number>string write ] 2dip write ftp-send ; : send-response ( ftp-response -- ) [ n>> ] [ strings>> ] bi @@ -101,7 +102,7 @@ ERROR: type-error type ; : handle-TYPE ( obj -- ) [ tokenized>> second parse-type - 200 "Switching to " rot " mode" 3append server-response + [ 200 ] dip "Switching to " " mode" surround server-response ] [ 2drop "TYPE is binary only" ftp-error ] recover ; @@ -110,11 +111,11 @@ ERROR: type-error type ; remote-address get class new 0 >>port binary ; : port>bytes ( port -- hi lo ) - [ -8 shift ] keep [ HEX: ff bitand ] bi@ ; + [ -8 shift ] keep [ 8 bits ] bi@ ; : handle-PWD ( obj -- ) drop - 257 current-directory get "\"" "\"" surround server-response ; + 257 current-directory get "\"" dup surround server-response ; : handle-SYST ( obj -- ) drop @@ -154,15 +155,19 @@ M: ftp-list service-command ( stream obj -- ) finish-directory ; : transfer-outgoing-file ( path -- ) - 150 "Opening BINARY mode data connection for " - rot - [ file-name ] [ - " " swap file-info size>> number>string - "(" " bytes)." surround append - ] bi 3append server-response ; + [ + 150 + "Opening BINARY mode data connection for " + ] dip + [ + file-name + ] [ + file-info size>> number>string + "(" " bytes)." surround + ] bi " " glue append server-response ; : transfer-incoming-file ( path -- ) - 150 "Opening BINARY mode data connection for " rot append + [ 150 ] dip "Opening BINARY mode data connection for " prepend server-response ; : finish-file-transfer ( -- ) @@ -208,8 +213,9 @@ M: ftp-put service-command ( stream obj -- ) : handle-SIZE ( obj -- ) [ + [ 213 ] dip tokenized>> second file-info size>> - 213 swap number>string server-response + number>string server-response ] [ 2drop 550 "Could not get file size" server-response @@ -227,21 +233,20 @@ M: ftp-put service-command ( stream obj -- ) : handle-PASV ( obj -- ) drop client get passive >>mode drop - expect-connection - [ - "Entering Passive Mode (127,0,0,1," % - port>bytes [ number>string ] bi@ "," glue % - ")" % - ] "" make 227 swap server-response ; + 221 + expect-connection port>bytes [ number>string ] bi@ "," glue + "Entering Passive Mode (127,0,0,1," ")" surround + server-response ; : handle-EPSV ( obj -- ) drop client get command-promise>> [ "You already have a passive stream" ftp-error ] [ - 229 "Entering Extended Passive Mode (|||" + 229 expect-connection number>string - "|)" 3append server-response + "Entering Extended Passive Mode (|||" "|)" surround + server-response ] if ; ! LPRT 6,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,242,186 diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index 39923afee7..a5f3042b38 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -34,7 +34,7 @@ WW DEFINES ${W}${W} WHERE -: WW W twice ; inline +: WW ( a -- b ) \ W twice ; inline ;FUNCTOR @@ -45,3 +45,21 @@ WHERE \ sqsq must-infer [ 16 ] [ 2 sqsq ] unit-test + +<< + +FUNCTOR: wrapper-test-2 ( W -- ) + +W DEFINES ${W} + +WHERE + +: W ( a b -- c ) \ + execute ; + +;FUNCTOR + +"blah" wrapper-test-2 + +>> + +[ 4 ] [ 1 3 blah ] unit-test \ No newline at end of file diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 2029c0cf25..f4d35b6932 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -1,16 +1,43 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel quotations classes.tuple make combinators generic words interpolate namespaces sequences io.streams.string fry classes.mixin effects lexer parser classes.tuple.parser -effects.parser locals.types locals.parser locals.rewrite.closures ; +effects.parser locals.types locals.parser +locals.rewrite.closures vocabs.parser arrays accessors ; IN: functors -: scan-param ( -- obj ) - scan-object dup special? [ literalize ] unless ; +! This is a hack + +fake-quotations ( quot -- fake ) + +M: callable >fake-quotations + >array >fake-quotations fake-quotation boa ; + +M: array >fake-quotations [ >fake-quotations ] { } map-as ; + +M: object >fake-quotations ; + +GENERIC: fake-quotations> ( fake -- quot ) + +M: fake-quotation fake-quotations> + seq>> [ fake-quotations> ] map >quotation ; + +M: array fake-quotations> [ fake-quotations> ] map ; + +M: object fake-quotations> ; + +: parse-definition* ( -- ) + parse-definition >fake-quotations parsed \ fake-quotations> parsed ; + : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ; : `TUPLE: @@ -31,7 +58,7 @@ IN: functors scan-param parsed scan-param parsed \ create-method parsed - parse-definition parsed + parse-definition* DEFINE* ; parsing : `C: @@ -44,7 +71,7 @@ IN: functors : `: effect off scan-param parsed - parse-definition parsed + parse-definition* DEFINE* ; parsing : `INSTANCE: @@ -63,12 +90,16 @@ IN: functors [ scan interpolate-locals ] dip '[ _ with-string-writer @ ] parsed ; +PRIVATE> + : IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing : DEFINES [ create-in ] (INTERPOLATE) ; parsing DEFER: ;FUNCTOR delimiter + rewrite-closures first ; +PRIVATE> + : FUNCTOR: (FUNCTOR:) define ; parsing diff --git a/basis/furnace/alloy/alloy-docs.factor b/basis/furnace/alloy/alloy-docs.factor index f108428c90..f21fc237a8 100644 --- a/basis/furnace/alloy/alloy-docs.factor +++ b/basis/furnace/alloy/alloy-docs.factor @@ -5,7 +5,7 @@ HELP: init-furnace-tables { $description "Initializes database tables used by asides, conversations and session management. This word must be invoked inside a " { $link with-db } " scope." } ; HELP: -{ $values { "responder" "a responder" } { "db" db } { "responder'" "an alloy responder" } } +{ $values { "responder" "a responder" } { "db" "a database descriptor" } { "responder'" "an alloy responder" } } { $description "Wraps the responder with support for asides, conversations, sessions and database persistence." } { $examples "The " { $vocab-link "webapps.counter" } " vocabulary uses an alloy to configure the counter:" @@ -21,7 +21,7 @@ HELP: } ; HELP: start-expiring -{ $values { "db" db } } +{ $values { "db" "a database descriptor" } } { $description "Starts a timer which expires old session state from the given database." } ; ARTICLE: "furnace.alloy" "Furnace alloy responder" diff --git a/basis/furnace/auth/auth-docs.factor b/basis/furnace/auth/auth-docs.factor index e7e722344a..f1f68c975d 100644 --- a/basis/furnace/auth/auth-docs.factor +++ b/basis/furnace/auth/auth-docs.factor @@ -1,5 +1,5 @@ USING: assocs classes help.markup help.syntax kernel -quotations strings words furnace.auth.providers.db +quotations strings words words.symbol furnace.auth.providers.db checksums.sha2 furnace.auth.providers math byte-arrays http multiline ; IN: furnace.auth @@ -121,7 +121,7 @@ $nl { $subsection "furnace.auth.providers.db" } ; ARTICLE: "furnace.auth.features" "Optional authentication features" -"Vocabularies having names prefixed by " { $code "furnace.auth.features" } " implement optional features which can be enabled by calling special words. These words define new actions on an authentication realm." +"Vocabularies having names prefixed by " { $code "furnace.auth.features" } " implement optional features which can be enabled by calling special words. These words define new actions on an authentication realm." { $subsection "furnace.auth.features.deactivate-user" } { $subsection "furnace.auth.features.edit-profile" } { $subsection "furnace.auth.features.recover-password" } @@ -148,7 +148,7 @@ ARTICLE: "furnace.auth.users" "User profiles" "User profile variables have the same restrictions on their values as session variables; see " { $link "furnace.sessions.serialize" } " for a discussion." ; ARTICLE: "furnace.auth.example" "Furnace authentication example" -"The " { $vocab-link "webapps.todo" } " vocabulary wraps all of its responders in a protected responder. The " { $slot "description" } " slot is set so that the login page contains the message ``You must log in to view your todo list'':" +"The " { $vocab-link "webapps.todo" } " vocabulary wraps all of its responders in a protected responder. The " { $slot "description" } " slot is set so that the login page contains the message “You must log in to view your todo list”:" { $code <" "view your todo list" >>description"> diff --git a/basis/furnace/auth/features/recover-password/recover-password.factor b/basis/furnace/auth/features/recover-password/recover-password.factor index 77be30a2d1..aeaf9e9471 100644 --- a/basis/furnace/auth/features/recover-password/recover-password.factor +++ b/basis/furnace/auth/features/recover-password/recover-password.factor @@ -27,7 +27,7 @@ SYMBOL: lost-password-from over email>> 1array >>to [ "This e-mail was sent by the application server on " % current-host % "\n" % - "because somebody, maybe you, clicked on a ``recover password'' link in the\n" % + "because somebody, maybe you, clicked on a “recover password” link in the\n" % "login form, and requested a new password for the user named ``" % over username>> % "''.\n" % "\n" % diff --git a/basis/furnace/auth/providers/db/db-tests.factor b/basis/furnace/auth/providers/db/db-tests.factor index 3bcd82a15d..de7650d9ef 100644 --- a/basis/furnace/auth/providers/db/db-tests.factor +++ b/basis/furnace/auth/providers/db/db-tests.factor @@ -5,7 +5,7 @@ furnace.auth.login furnace.auth.providers furnace.auth.providers.db tools.test namespaces db db.sqlite db.tuples continuations -io.files accessors kernel ; +io.files io.files.temp io.directories accessors kernel ; "test" realm set diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor index 8ab70ded7b..1c320182bf 100644 --- a/basis/furnace/chloe-tags/chloe-tags.factor +++ b/basis/furnace/chloe-tags/chloe-tags.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel combinators assocs namespaces sequences splitting words -fry urls multiline present qualified +fry urls multiline present xml xml.data xml.entities @@ -32,7 +32,7 @@ IN: furnace.chloe-tags [ [ "/" ?tail drop "/" ] dip present 3append ] when* ; : a-url ( href rest query value-name -- url ) - dup [ >r 3drop r> value ] [ + dup [ [ 3drop ] dip value ] [ drop swap parse-query-attr >>query diff --git a/basis/furnace/conversations/conversations-docs.factor b/basis/furnace/conversations/conversations-docs.factor index 4ad2c8a249..2b644ef422 100644 --- a/basis/furnace/conversations/conversations-docs.factor +++ b/basis/furnace/conversations/conversations-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax urls http words kernel -furnace.sessions furnace.db ; +furnace.sessions furnace.db words.symbol ; IN: furnace.conversations HELP: diff --git a/basis/furnace/db/db-docs.factor b/basis/furnace/db/db-docs.factor index a7ef02b77f..c64356c812 100644 --- a/basis/furnace/db/db-docs.factor +++ b/basis/furnace/db/db-docs.factor @@ -3,7 +3,7 @@ IN: furnace.db HELP: { $values - { "responder" "a responder" } { "db" db } + { "responder" "a responder" } { "db" "a database descriptor" } { "responder'" db-persistence } } { $description "Wraps a responder with database persistence support. The responder's " { $link call-responder* } " method will run in a " { $link with-db } " scope." } ; diff --git a/basis/furnace/db/db.factor b/basis/furnace/db/db.factor index ed18e42a4f..d771d1d2d7 100644 --- a/basis/furnace/db/db.factor +++ b/basis/furnace/db/db.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors continuations namespaces destructors -db db.pools io.pools http.server http.server.filters ; +db db.private db.pools io.pools http.server http.server.filters ; IN: furnace.db TUPLE: db-persistence < filter-responder pool ; @@ -12,6 +12,6 @@ TUPLE: db-persistence < filter-responder pool ; M: db-persistence call-responder* [ pool>> [ acquire-connection ] keep - [ return-connection-later ] [ drop db set ] 2bi + [ return-connection-later ] [ drop db-connection set ] 2bi ] [ call-next-method ] bi ; diff --git a/basis/furnace/redirection/redirection-docs.factor b/basis/furnace/redirection/redirection-docs.factor index fd3671fa1c..b70ec0ae57 100644 --- a/basis/furnace/redirection/redirection-docs.factor +++ b/basis/furnace/redirection/redirection-docs.factor @@ -10,8 +10,8 @@ HELP: { $values { "url" url } { "response" response } } { $description "Creates a response which redirects the client to the given URL." } ; -HELP: ( responder -- responder' ) -{ $values { "responder" "a responder" } { "responder'" "a responder" } } +HELP: +{ $values { "responder" "a responder" } { "secure-only" "a responder" } } { $description "Creates a new responder which ensures that the client is connecting via HTTPS before delegating to the underlying responder. If the client is connecting via HTTP, a redirect is sent instead." } ; HELP: diff --git a/basis/furnace/sessions/sessions-docs.factor b/basis/furnace/sessions/sessions-docs.factor index 959d6b69b8..7a4de18eaf 100644 --- a/basis/furnace/sessions/sessions-docs.factor +++ b/basis/furnace/sessions/sessions-docs.factor @@ -1,4 +1,6 @@ -USING: help.markup help.syntax io.streams.string quotations strings calendar serialize kernel furnace.db words kernel ; +USING: help.markup help.syntax io.streams.string quotations +strings calendar serialize kernel furnace.db words words.symbol +kernel ; IN: furnace.sessions HELP: diff --git a/basis/furnace/sessions/sessions-tests.factor b/basis/furnace/sessions/sessions-tests.factor index 907e657125..14cdce3811 100644 --- a/basis/furnace/sessions/sessions-tests.factor +++ b/basis/furnace/sessions/sessions-tests.factor @@ -2,9 +2,9 @@ IN: furnace.sessions.tests USING: tools.test http furnace.sessions furnace.actions http.server http.server.responses math namespaces make kernel accessors io.sockets io.servers.connection prettyprint -io.streams.string io.files splitting destructors sequences db -db.tuples db.sqlite continuations urls math.parser furnace -furnace.utilities ; +io.streams.string io.files io.files.temp io.directories +splitting destructors sequences db db.tuples db.sqlite +continuations urls math.parser furnace furnace.utilities ; : with-session [ diff --git a/basis/furnace/syndication/syndication-docs.factor b/basis/furnace/syndication/syndication-docs.factor index 94a69ccd0e..1ce1cd7da1 100644 --- a/basis/furnace/syndication/syndication-docs.factor +++ b/basis/furnace/syndication/syndication-docs.factor @@ -29,7 +29,7 @@ HELP: feed-entry-date HELP: feed-entry-description { $values { "object" object } - { "description" null } + { "description" string } } { $contract "Outputs a feed entry description." } ; diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 7f71a131ed..f84519b9c1 100644 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -96,11 +96,7 @@ M: object modify-form drop ; dup method>> { { "GET" [ url>> query>> ] } { "HEAD" [ url>> query>> ] } - { "POST" [ - post-data>> - dup content-type>> "application/x-www-form-urlencoded" = - [ content>> ] [ drop f ] if - ] } + { "POST" [ post-data>> params>> ] } } case ; : referrer ( -- referrer/f ) diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 3979e0518a..a676be3be8 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -229,8 +229,9 @@ HELP: napply { $examples "Some core words expressed in terms of " { $link napply } ":" { $table - { { $link bi@ } { $snippet "1 napply" } } - { { $link tri@ } { $snippet "2 napply" } } + { { $link call } { $snippet "1 napply" } } + { { $link bi@ } { $snippet "2 napply" } } + { { $link tri@ } { $snippet "3 napply" } } } } ; @@ -258,6 +259,55 @@ HELP: mnswap } } ; +HELP: n*quot +{ $values + { "n" integer } { "seq" sequence } + { "seq'" sequence } +} +{ $examples + { $example "USING: generalizations prettyprint math ;" + "3 [ + ] n*quot ." + "[ + + + ]" + } +} +{ $description "Construct a quotation containing the contents of " { $snippet "seq" } " repeated " { $snippet "n"} " times." } ; + +HELP: nappend +{ $values + { "n" integer } + { "seq" sequence } +} +{ $description "Outputs a new sequence consisting of the elements of the top " { $snippet "n" } " sequences from the datastack in turn." } +{ $errors "Throws an error if any of the sequences contain elements that are not permitted in the sequence type of the first sequence." } +{ $examples + { $example "USING: generalizations prettyprint math ;" + "{ 1 2 } { 3 4 } { 5 6 } { 7 8 } 4 nappend ." + "{ 1 2 3 4 5 6 7 8 }" + } +} ; + +HELP: nappend-as +{ $values + { "n" integer } { "exemplar" sequence } + { "seq" sequence } +} +{ $description "Outputs a new sequence of type " { $snippet "exemplar" } " consisting of the elements of the top " { $snippet "n" } " sequences from the datastack in turn." } +{ $errors "Throws an error if any of the sequences contain elements that are not permitted in the sequence type of the first sequence." } +{ $examples + { $example "USING: generalizations prettyprint math ;" + "{ 1 2 } { 3 4 } { 5 6 } { 7 8 } 4 V{ } nappend-as ." + "V{ 1 2 3 4 5 6 7 8 }" + } +} ; + +{ nappend nappend-as } related-words + +HELP: ntuck +{ $values + { "n" integer } +} +{ $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ; + ARTICLE: "generalizations" "Generalized shuffle words and combinators" "The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in " "macros where the arity of the input quotations depends on an " @@ -267,6 +317,8 @@ $nl { $subsection narray } { $subsection nsequence } { $subsection firstn } +{ $subsection nappend } +{ $subsection nappend-as } "Generated stack shuffle operations:" { $subsection ndup } { $subsection npick } @@ -274,6 +326,7 @@ $nl { $subsection -nrot } { $subsection nnip } { $subsection ndrop } +{ $subsection ntuck } { $subsection nrev } { $subsection mnswap } "Generalized combinators:" diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index 1291012700..35e02f08b4 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -1,10 +1,11 @@ -USING: tools.test generalizations kernel math arrays sequences ; +USING: tools.test generalizations kernel math arrays sequences ascii ; IN: generalizations.tests { 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test { 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test { 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test { 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test + [ 1 1 ndup ] must-infer { 1 1 } [ 1 1 ndup ] unit-test { 1 2 1 2 } [ 1 2 2 ndup ] unit-test @@ -22,12 +23,16 @@ IN: generalizations.tests { 4 } [ 1 2 3 4 3 nnip ] unit-test [ 1 2 3 4 4 ndrop ] must-infer { 0 } [ 0 1 2 3 4 4 ndrop ] unit-test +[ [ 1 ] 5 ndip ] must-infer +[ 1 2 3 4 ] [ 2 3 4 [ 1 ] 3 ndip ] unit-test [ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer { 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer { 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test [ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test + +[ "HELLO" ] [ "hello" [ >upper ] 1 napply ] unit-test [ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test [ [ dup 2^ 2array ] 5 napply ] must-infer @@ -42,3 +47,9 @@ IN: generalizations.tests [ 4 5 1 2 3 ] [ 1 2 3 4 5 2 3 mnswap ] unit-test [ 1 2 3 4 5 6 ] [ 1 2 3 4 5 6 2 4 mnswap 4 2 mnswap ] unit-test + +[ { 1 2 3 4 } ] [ { 1 } { 2 } { 3 } { 4 } 4 nappend ] unit-test +[ V{ 1 2 3 4 } ] [ { 1 } { 2 } { 3 } { 4 } 4 V{ } nappend-as ] unit-test + +[ 4 nappend ] must-infer +[ 4 { } nappend-as ] must-infer diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index ae7437b346..c6a17df099 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -2,7 +2,7 @@ ! Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private math math.ranges -combinators macros quotations fry ; +combinators macros quotations fry macros locals ; IN: generalizations << @@ -73,10 +73,13 @@ MACRO: ncleave ( quots n -- ) [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi compose ; -MACRO: napply ( n -- ) - 2 [a,b] - [ [ 1- ] [ ] bi '[ _ ntuck _ nslip ] ] - map concat >quotation [ call ] append ; +MACRO: napply ( quot n -- ) + swap spread>quot ; MACRO: mnswap ( m n -- ) 1+ '[ _ -nrot ] spread>quot ; + +: nappend-as ( n exemplar -- seq ) + [ narray concat ] dip like ; inline + +: nappend ( n -- seq ) narray concat ; inline diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index 3b3a98eabd..e4ad97abd0 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -20,17 +20,21 @@ ARTICLE: "grouping" "Groups and clumps" { $unchecked-example "dup n groups concat sequence= ." "t" } } { "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:" - { $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" } + { $unchecked-example "dup n clumps unclip-last [ [ first ] map ] dip append sequence= ." "t" } } -} ; +} +"A combinator built using clumps:" +{ $subsection monotonic? } +"Testing how elements are related:" +{ $subsection all-eq? } +{ $subsection all-equal? } ; ABOUT: "grouping" HELP: groups { $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively." $nl -"New groups are created by calling " { $link } " and " { $link } "." } -{ $see-also group } ; +"New groups are created by calling " { $link } " and " { $link } "." } ; HELP: group { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } } @@ -48,11 +52,16 @@ HELP: "USING: arrays kernel prettyprint sequences grouping ;" "9 >array 3 dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }" } + { $example + "USING: kernel prettyprint sequences grouping ;" + "{ 1 2 3 4 5 6 } 3 first ." + "{ 1 2 3 }" + } } ; HELP: { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } } -{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." } +{ $description "Outputs a virtual sequence whose elements are slices of disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." } { $examples { $example "USING: arrays kernel prettyprint sequences grouping ;" @@ -60,6 +69,11 @@ HELP: "dup [ reverse-here ] each concat >array ." "{ 2 1 0 5 4 3 8 7 6 }" } + { $example + "USING: kernel prettyprint sequences grouping ;" + "{ 1 2 3 4 5 6 } 3 second ." + "T{ slice { from 3 } { to 6 } { seq { 1 2 3 4 5 6 } } }" + } } ; HELP: clumps @@ -89,11 +103,23 @@ HELP: "share-price 4 [ [ sum ] [ length ] bi / ] map ." "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }" } + { $example + "USING: kernel sequences grouping prettyprint ;" + "{ 1 2 3 4 5 6 } 3 second ." + "{ 2 3 4 }" + } } ; HELP: { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } } -{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ; +{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } +{ $examples + { $example + "USING: kernel sequences grouping prettyprint ;" + "{ 1 2 3 4 5 6 } 3 second ." + "T{ slice { from 1 } { to 4 } { seq { 1 2 3 4 5 6 } } }" + } +} ; { clumps groups } related-words @@ -102,3 +128,23 @@ HELP: { } related-words { } related-words + +HELP: monotonic? +{ $values { "seq" sequence } { "quot" { $quotation "( elt elt -- ? )" } } { "?" "a boolean" } } +{ $description "Applies the relation to successive pairs of elements in the sequence, testing for a truth value. The relation should be a transitive relation, such as a total order or an equality relation." } +{ $examples + "Testing if a sequence is non-decreasing:" + { $example "USING: grouping math prettyprint ;" "{ 1 1 2 } [ <= ] monotonic? ." "t" } + "Testing if a sequence is decreasing:" + { $example "USING: grouping math prettyprint ;" "{ 9 8 6 7 } [ < ] monotonic? ." "f" } +} ; + +HELP: all-equal? +{ $values { "seq" sequence } { "?" "a boolean" } } +{ $description "Tests if all elements in the sequence are equal. Yields true with an empty sequence." } ; + +HELP: all-eq? +{ $values { "seq" sequence } { "?" "a boolean" } } +{ $description "Tests if all elements in the sequence are the same identical object. Yields true with an empty sequence." } ; + +{ monotonic? all-eq? all-equal? } related-words diff --git a/basis/grouping/grouping-tests.factor b/basis/grouping/grouping-tests.factor index cfcc653776..c91e5a56d6 100644 --- a/basis/grouping/grouping-tests.factor +++ b/basis/grouping/grouping-tests.factor @@ -1,4 +1,5 @@ -USING: grouping tools.test kernel sequences arrays ; +USING: grouping tools.test kernel sequences arrays +math ; IN: grouping.tests [ { 1 2 3 } 0 group ] must-fail @@ -12,3 +13,11 @@ IN: grouping.tests ] unit-test [ { { 1 2 } { 2 3 } } ] [ { 1 2 3 } 2 [ >array ] map ] unit-test + +[ f ] [ [ { } { } "Hello" ] all-equal? ] unit-test +[ f ] [ [ { 2 } { } { } ] all-equal? ] unit-test +[ t ] [ [ ] all-equal? ] unit-test +[ t ] [ [ 1234 ] all-equal? ] unit-test +[ f ] [ [ 1.0 1 1 ] all-equal? ] unit-test +[ t ] [ { 1 2 3 4 } [ < ] monotonic? ] unit-test +[ f ] [ { 1 2 3 4 } [ > ] monotonic? ] unit-test diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index 0fa20b41fc..ec13e3a750 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -1,14 +1,15 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.order strings arrays vectors sequences -sequences.private accessors ; +sequences.private accessors fry ; IN: grouping { } like ; : clump ( seq n -- array ) { } like ; + +: monotonic? ( seq quot -- ? ) + over length 2 < [ 2drop t ] [ + over length 2 = [ + [ first2-unsafe ] dip call + ] [ + [ 2 ] dip + '[ first2-unsafe @ ] all? + ] if + ] if ; inline + +: all-equal? ( seq -- ? ) [ = ] monotonic? ; + +: all-eq? ( seq -- ? ) [ eq? ] monotonic? ; \ No newline at end of file diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor index e28eb3007a..7e780cbe5e 100644 --- a/basis/heaps/heaps-tests.factor +++ b/basis/heaps/heaps-tests.factor @@ -32,10 +32,8 @@ IN: heaps.tests : random-alist ( n -- alist ) [ - [ - 32 random-bits dup number>string swap set - ] times - ] H{ } make-assoc ; + drop 32 random-bits dup number>string + ] H{ } map>assoc ; : test-heap-sort ( n -- ? ) random-alist dup >alist sort-keys swap heap-sort = ; @@ -61,7 +59,7 @@ IN: heaps.tests random-alist [ heap-push-all ] keep dup data>> clone swap - ] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times + ] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times data>> [ [ key>> ] map ] bi@ [ natural-sort ] bi@ ; diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor index ba95a9f249..aa1ebf7786 100644 --- a/basis/heaps/heaps.factor +++ b/basis/heaps/heaps.factor @@ -87,7 +87,8 @@ M: heap heap-size ( heap -- n ) GENERIC: heap-compare ( pair1 pair2 heap -- ? ) -: (heap-compare) drop [ key>> ] compare ; inline +: (heap-compare) ( pair1 pair2 heap -- <=> ) + drop [ key>> ] compare ; inline M: min-heap heap-compare (heap-compare) +gt+ eq? ; diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index e72fbb439c..ebc711d527 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -100,14 +100,12 @@ $nl { $code "10 [ \"Factor rocks!\" print ] times" } "Now we can look at a new data type, the array:" { $code "{ 1 2 3 }" } -"An array looks like a quotation except it cannot be evaluated; it simply stores data." +"An array differs from a quotation in that it cannot be evaluated; it simply stores data." $nl "You can perform an operation on each element of an array:" { $example "{ 1 2 3 } [ \"The number is \" write . ] each" - "The number is 1" - "The number is 2" - "The number is 3" + "The number is 1\nThe number is 2\nThe number is 3" } "You can transform each element, collecting the results in a new array:" { $example "{ 5 12 0 -12 -5 } [ sq ] map ." "{ 25 144 0 144 25 }" } @@ -269,8 +267,8 @@ $nl { $heading "Example: ls" } "Here is an example implementing a simplified version of the Unix " { $snippet "ls" } " command in Factor:" { $code - <" USING: command-line namespaces io io.files tools.files -sequences kernel ; + <" USING: command-line namespaces io io.files +io.pathnames tools.files sequences kernel ; command-line get [ current-directory get directory. @@ -360,7 +358,7 @@ ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid" { $list "Factor only makes use of one native thread, and Factor threads are scheduled co-operatively. C library calls block the entire VM." "Factor does not hide anything from the programmer, all internals are exposed. It is your responsibility to avoid writing fragile code which depends too much on implementation detail." - { "When a source file uses two vocabularies which define words with the same name, the order of the vocabularies in the " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " forms is important. The parser prints warnings when vocabularies shadow words from other vocabularies; see " { $link "vocabulary-search-shadow" } ". The " { $vocab-link "qualified" } " vocabulary implements qualified naming, which can be used to resolve ambiguities." } + { "When a source file uses two vocabularies which define words with the same name, the order of the vocabularies in the " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " forms is important. The " { $link POSTPONE: QUALIFIED: } " word implements qualified naming, which can be used to resolve ambiguities." } { "If a literal object appears in a word definition, the object itself is pushed on the stack when the word executes, not a copy. If you intend to mutate this object, you must " { $link clone } " it first. See " { $link "syntax-literals" } "." } { "For a discussion of potential issues surrounding the " { $link f } " object, see " { $link "booleans" } "." } { "Factor's object system is quite flexible. Careless usage of union, mixin and predicate classes can lead to similar problems to those caused by ``multiple inheritance'' in other languages. In particular, it is possible to have two classes such that they have a non-empty intersection and yet neither is a subclass of the other. If a generic word defines methods on two such classes, various disambiguation rules are applied to ensure method dispatch remains deterministic, however they may not be what you expect. See " { $link "method-order" } " for details." } diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index cc36e9faab..39b5a13e30 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -162,12 +162,18 @@ ARTICLE: "encodings-introduction" "An introduction to encodings" { $code "\"file.txt\" utf16 file-contents" } "Encoding descriptors are also used by " { $link "io.streams.byte-array" } " and taken by combinators like " { $link with-file-writer } " and " { $link with-byte-reader } " which deal with streams. It is " { $emphasis "not" } " used with " { $link "io.streams.string" } " because these deal with abstract text." $nl -"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." ; +"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." +{ $see-also "stream-elements" } ; ARTICLE: "io" "Input and output" { $heading "Streams" } { $subsection "streams" } { $subsection "io.files" } +{ $heading "The file system" } +{ $subsection "io.pathnames" } +{ $subsection "io.files.info" } +{ $subsection "io.files.links" } +{ $subsection "io.directories" } { $heading "Encodings" } { $subsection "encodings-introduction" } { $subsection "io.encodings" } @@ -178,7 +184,7 @@ ARTICLE: "io" "Input and output" { $subsection "io.streams.byte-array" } { $heading "Utilities" } { $subsection "stream-binary" } -{ $subsection "styles" } +{ $subsection "io.styles" } { $subsection "checksums" } { $heading "Implementation" } { $subsection "io.streams.c" } @@ -204,7 +210,8 @@ ARTICLE: "tools" "Developer tools" { $subsection "timing" } { $subsection "tools.disassembler" } "Deployment tools:" -{ $subsection "tools.deploy" } ; +{ $subsection "tools.deploy" } +{ $see-also "ui-tools" } ; ARTICLE: "article-index" "Article index" { $index [ articles get keys ] } ; diff --git a/basis/help/help-docs.factor b/basis/help/help-docs.factor index 4a06235c69..6b77f656c0 100644 --- a/basis/help/help-docs.factor +++ b/basis/help/help-docs.factor @@ -36,6 +36,7 @@ ARTICLE: "block-elements" "Block elements" "Elements used in " { $link $values } " forms:" { $subsection $instance } { $subsection $maybe } +{ $subsection $or } { $subsection $quotation } "Boilerplate paragraphs:" { $subsection $low-level-note } @@ -88,6 +89,12 @@ $nl { "an array of markup elements," } { "or an array of the form " { $snippet "{ $directive content... }" } ", where " { $snippet "$directive" } " is a markup word whose name starts with " { $snippet "$" } ", and " { $snippet "content..." } " is a series of markup elements" } } +"Here is a more formal schema for the help markup language:" +{ $code +" ::== | | " +" ::== { * }" +" ::== { }" +} { $subsection "element-types" } { $subsection "printing-elements" } "Related words can be cross-referenced:" @@ -119,7 +126,7 @@ ARTICLE: "help" "Help system" "The help system maintains documentation written in a simple markup language, along with cross-referencing and search. Documentation can either exist as free-standing " { $emphasis "articles" } " or be associated with words." { $subsection "browsing-help" } { $subsection "writing-help" } -{ $vocab-subsection "Help lint tool" "help.lint" } +{ $subsection "help.lint" } { $subsection "help-impl" } ; IN: help @@ -327,7 +334,7 @@ HELP: $table HELP: $values { $values { "element" "an array of pairs of markup elements" } } -{ $description "Prints the description of arguments and values found on every word help page. The first element of a pair is the argument name and is output with " { $link $snippet } ". The remainder is either a single class word, or an element. If it is a class word " { $snippet "class" } ", it is intereted as if it were shorthand for " { $snippet "{ $instance class }" } "." } +{ $description "Prints the description of arguments and values found on every word help page. The first element of a pair is the argument name and is output with " { $link $snippet } ". The remainder is either a single class word, or an element. If it is a class word " { $snippet "class" } ", it is inserted as if it were shorthand for " { $snippet "{ $instance class }" } "." } { $see-also $maybe $instance $quotation } ; HELP: $instance diff --git a/basis/help/help-tests.factor b/basis/help/help-tests.factor index e38f2fc15d..e091278359 100644 --- a/basis/help/help-tests.factor +++ b/basis/help/help-tests.factor @@ -3,3 +3,4 @@ USING: tools.test help kernel ; [ 3 throw ] must-fail [ ] [ :help ] unit-test +[ ] [ f print-topic ] unit-test \ No newline at end of file diff --git a/basis/help/help.factor b/basis/help/help.factor index 5d12438e0d..272bdc1db3 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays io io.styles kernel namespaces make -parser prettyprint sequences words assocs definitions generic -quotations effects slots continuations classes.tuple debugger -combinators vocabs help.stylesheet help.topics help.crossref -help.markup sorting classes vocabs.loader ; +parser prettyprint sequences words words.symbol assocs +definitions generic quotations effects slots continuations +classes.tuple debugger combinators vocabs help.stylesheet +help.topics help.crossref help.markup sorting classes +vocabs.loader ; IN: help GENERIC: word-help* ( word -- content ) @@ -111,6 +112,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ; ] with-style nl ; : print-topic ( topic -- ) + >link last-element off dup $title article-content print-content nl ; diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index a9df0bea81..ec52264643 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary -io.files html.streams html.elements help kernel +io.files io.files.temp io.directories html.streams html.elements help kernel assocs sequences make words accessors arrays help.topics vocabs tools.vocabs tools.vocabs.browser namespaces prettyprint io vocabs.loader serialize fry memoize unicode.case math.order diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index fbebc7f0f6..30d5ef49df 100644 --- a/basis/help/lint/lint.factor +++ b/basis/help/lint/lint.factor @@ -1,25 +1,29 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: fry accessors sequences parser kernel help help.markup help.topics words strings classes tools.vocabs namespaces make io io.streams.string prettyprint definitions arrays vectors combinators combinators.short-circuit splitting debugger hashtables sorting effects vocabs vocabs.loader assocs editors -continuations classes.predicate macros math sets eval ; +continuations classes.predicate macros math sets eval +vocabs.parser words.symbol values grouping unicode.categories +sequences.deep ; IN: help.lint +SYMBOL: vocabs-quot + : check-example ( element -- ) - rest [ - but-last "\n" join 1vector - [ - use [ clone ] change - [ eval>string ] with-datastack - ] with-scope peek "\n" ?tail drop - ] keep - peek assert= ; + [ + rest [ + but-last "\n" join 1vector + [ (eval>string) ] with-datastack + peek "\n" ?tail drop + ] keep + peek assert= + ] vocabs-quot get call ; -: check-examples ( word element -- ) - nip \ $example swap elements [ check-example ] each ; +: check-examples ( element -- ) + \ $example swap elements [ check-example ] each ; : extract-values ( element -- seq ) \ $values swap elements dup empty? [ @@ -41,25 +45,40 @@ IN: help.lint $error-description } swap '[ _ elements empty? not ] contains? ; +: don't-check-word? ( word -- ? ) + { + [ macro? ] + [ symbol? ] + [ value-word? ] + [ parsing-word? ] + [ "declared-effect" word-prop not ] + } 1|| ; + : check-values ( word element -- ) { - [ drop "declared-effect" word-prop not ] - [ nip contains-funky-elements? ] - [ drop macro? ] [ - [ effect-values >array ] - [ extract-values >array ] - bi* = + [ don't-check-word? ] + [ contains-funky-elements? ] + bi* or + ] [ + [ effect-values ] + [ extract-values ] + bi* sequence= ] } 2|| [ "$values don't match stack effect" throw ] unless ; -: check-see-also ( word element -- ) - nip \ $see-also swap elements [ +: check-nulls ( element -- ) + \ $values swap elements + null swap deep-member? + [ "$values should not contain null" throw ] when ; + +: check-see-also ( element -- ) + \ $see-also swap elements [ rest dup prune [ length ] bi@ assert= ] each ; : vocab-exists? ( name -- ? ) - dup vocab swap "all-vocabs" get member? or ; + [ vocab ] [ "all-vocabs" get member? ] bi or ; : check-modules ( element -- ) \ $vocab-link swap elements [ @@ -68,43 +87,78 @@ IN: help.lint ] each ; : check-rendering ( element -- ) - [ print-topic ] with-string-writer drop ; + [ print-content ] with-string-writer drop ; + +: check-strings ( str -- ) + [ + "\n\t" intersects? + [ "Paragraph text should not contain \\n or \\t" throw ] when + ] [ + " " swap subseq? + [ "Paragraph text should not contain double spaces" throw ] when + ] bi ; + +: check-whitespace ( str1 str2 -- ) + [ " " tail? ] [ " " head? ] bi* or + [ "Missing whitespace between strings" throw ] unless ; + +: check-bogus-nl ( element -- ) + { { $nl } { { $nl } } } [ head? ] with contains? + [ "Simple element should not begin with a paragraph break" throw ] when ; + +: check-elements ( element -- ) + { + [ check-bogus-nl ] + [ [ string? ] filter [ check-strings ] each ] + [ [ simple-element? ] filter [ check-elements ] each ] + [ 2 [ [ string? ] all? ] filter [ first2 check-whitespace ] each ] + } cleave ; + +: check-markup ( element -- ) + { + [ check-elements ] + [ check-rendering ] + [ check-examples ] + [ check-modules ] + } cleave ; : all-word-help ( words -- seq ) [ word-help ] filter ; -TUPLE: help-error topic error ; +TUPLE: help-error error topic ; C: help-error M: help-error error. - "In " write dup topic>> pprint nl - error>> error. ; + [ "In " write topic>> pprint nl ] + [ error>> error. ] + bi ; : check-something ( obj quot -- ) - flush [ , ] recover ; inline + flush '[ _ assert-depth ] swap '[ _ , ] recover ; inline : check-word ( word -- ) + [ with-file-vocabs ] vocabs-quot set dup word-help [ - [ - dup word-help '[ - _ _ { - [ check-examples ] - [ check-values ] - [ check-see-also ] - [ [ check-rendering ] [ check-modules ] bi* ] - } 2cleave - ] assert-depth + dup '[ + _ dup word-help + [ check-values ] + [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2bi ] check-something ] [ drop ] if ; : check-words ( words -- ) [ check-word ] each ; +: check-article-title ( article -- ) + article-title first LETTER? + [ "Article title must begin with a capital letter" throw ] unless ; + : check-article ( article -- ) - [ - dup article-content - '[ _ check-rendering _ check-modules ] - assert-depth + [ with-interactive-vocabs ] vocabs-quot set + dup '[ + _ + [ check-article-title ] + [ article-content check-markup ] bi ] check-something ; : files>vocabs ( -- assoc ) @@ -124,7 +178,7 @@ M: help-error error. ] keep ; : check-about ( vocab -- ) - [ vocab-help [ article drop ] when* ] check-something ; + dup '[ _ vocab-help [ article drop ] when* ] check-something ; : check-vocab ( vocab -- seq ) "Checking " write dup write "..." print diff --git a/basis/help/markup/markup-tests.factor b/basis/help/markup/markup-tests.factor index b9ec34a831..0d8aa53d44 100644 --- a/basis/help/markup/markup-tests.factor +++ b/basis/help/markup/markup-tests.factor @@ -1,5 +1,6 @@ USING: definitions help help.markup kernel sequences tools.test -words parser namespaces assocs generic io.streams.string accessors ; +words parser namespaces assocs generic io.streams.string accessors +strings math ; IN: help.markup.tests TUPLE: blahblah quux ; @@ -15,3 +16,12 @@ TUPLE: blahblah quux ; [ ] [ \ fooey print-topic ] unit-test [ ] [ gensym print-topic ] unit-test + +[ "a string" ] +[ [ { $or string } print-element ] with-string-writer ] unit-test + +[ "a string or an integer" ] +[ [ { $or string integer } print-element ] with-string-writer ] unit-test + +[ "a string, a fixnum, or an integer" ] +[ [ { $or string fixnum integer } print-element ] with-string-writer ] unit-test diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index a7501dc242..2fd8d55d10 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -1,20 +1,12 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays definitions generic io kernel assocs hashtables namespaces make parser prettyprint sequences strings io.styles vectors words math sorting splitting classes slots -vocabs help.stylesheet help.topics vocabs.loader alias -quotations ; +vocabs help.stylesheet help.topics vocabs.loader quotations +combinators ; IN: help.markup -! Simple markup language. - -! ::== | | -! ::== { * } -! ::== { } - -! Element types are words whose name begins with $. - PREDICATE: simple-element < array [ t ] [ first word? not ] if-empty ; @@ -251,8 +243,21 @@ M: f ($instance) : $instance ( element -- ) first ($instance) ; +: $or ( element -- ) + dup length { + { 1 [ first ($instance) ] } + { 2 [ first2 [ ($instance) " or " print-element ] [ ($instance) ] bi* ] } + [ + drop + unclip-last + [ [ ($instance) ", " print-element ] each ] + [ "or " print-element ($instance) ] + bi* + ] + } case ; + : $maybe ( element -- ) - $instance " or " print-element { f } $instance ; + f suffix $or ; : $quotation ( element -- ) { "a " { $link quotation } " with stack effect " } print-element diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor index 9a372174ba..9f98ba6d8d 100644 --- a/basis/help/syntax/syntax.factor +++ b/basis/help/syntax/syntax.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel parser sequences words help -help.topics namespaces vocabs definitions compiler.units ; +help.topics namespaces vocabs definitions compiler.units +vocabs.parser ; IN: help.syntax : HELP: diff --git a/basis/help/tutorial/tutorial.factor b/basis/help/tutorial/tutorial.factor index 9ed36ac77c..efb1e0a0f7 100644 --- a/basis/help/tutorial/tutorial.factor +++ b/basis/help/tutorial/tutorial.factor @@ -30,7 +30,7 @@ ARTICLE: "first-program-logic" "Writing some logic in your first program" "! See http://factorcode.org/license.txt for BSD license." "IN: palindrome" } -"We will now write our first word using " { $link POSTPONE: : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "." +"We will now write our first word using " { $link POSTPONE: : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "." $nl "Recall that a string is a palindrome if it is spelled the same forwards or backwards; that is, if the string is equal to its reverse. We can express this in Factor as follows:" { $code ": palindrome? ( string -- ? ) dup reverse = ;" } @@ -94,7 +94,7 @@ $nl "For example, we'd like it to identify the following as a palindrome:" { $code "\"A man, a plan, a canal: Panama.\"" } "However, right now, the simplistic algorithm we use says this is not a palindrome:" -{ $example "\"A man, a plan, a canal: Panama.\" palindrome?" "f" } +{ $unchecked-example "\"A man, a plan, a canal: Panama.\" palindrome?" "f" } "We would like it to output " { $link t } " there. We can encode this requirement with a unit test that we add to " { $snippet "palindrome-tests.factor" } ":" { $code "[ t ] [ \"A man, a plan, a canal: Panama.\" palindrome? ] unit-test" } "If you now run unit tests, you will see a unit test failure:" @@ -106,12 +106,12 @@ $nl "Start by pushing a character on the stack; notice that characters are really just integers:" { $code "CHAR: a" } "Now, use the " { $link Letter? } " word to test if it is an alphabetical character, upper or lower case:" -{ $example "Letter? ." "t" } +{ $unchecked-example "Letter? ." "t" } "This gives the expected result." $nl "Now try with a non-alphabetical character:" { $code "CHAR: #" } -{ $example "Letter? ." "f" } +{ $unchecked-example "Letter? ." "f" } "What we want to do is given a string, remove all characters which do not match the " { $link Letter? } " predicate. Let's push a string on the stack:" { $code "\"A man, a plan, a canal: Panama.\"" } "Now, place a quotation containing " { $link Letter? } " on the stack; quoting code places it on the stack instead of executing it immediately:" diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 240acf74b1..b6af773ce5 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -3,7 +3,8 @@ USING: parser words definitions kernel sequences assocs arrays kernel.private fry combinators accessors vectors strings sbufs byte-arrays byte-vectors io.binary io.streams.string splitting -math generic generic.standard generic.standard.engines classes ; +math generic generic.standard generic.standard.engines classes +hashtables ; IN: hints GENERIC: specializer-predicate ( spec -- quot ) @@ -50,14 +51,10 @@ M: object specializer-declaration class ; ] [ drop f ] if ; : specialized-def ( word -- quot ) - dup def>> swap { - { - [ dup "specializer" word-prop ] - [ "specializer" word-prop specialize-quot ] - } - { [ dup standard-method? ] [ specialize-method ] } - [ drop ] - } cond ; + [ def>> ] keep + [ dup standard-method? [ specialize-method ] [ drop ] if ] + [ "specializer" word-prop [ specialize-quot ] when* ] + bi ; : specialized-length ( specializer -- n ) dup [ array? ] all? [ first ] when length ; @@ -120,3 +117,7 @@ M: object specializer-declaration class ; \ >le { { fixnum fixnum } { bignum fixnum } } "specializer" set-word-prop \ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop + +\ hashtable \ at* method { { fixnum hashtable } { word hashtable } } "specializer" set-word-prop + +\ hashtable \ set-at method { { object fixnum object } { object word object } } "specializer" set-word-prop diff --git a/basis/html/components/components-docs.factor b/basis/html/components/components-docs.factor index d131cc3e03..39c17a4708 100644 --- a/basis/html/components/components-docs.factor +++ b/basis/html/components/components-docs.factor @@ -70,8 +70,8 @@ HELP: render { $description "Renders an HTML component to the " { $link output-stream } "." } ; HELP: render* -{ $values { "value" "a value" } { "name" "a value name" } { "renderer" "a component renderer" } } -{ $contract "Renders an HTML component to the " { $link output-stream } "." } ; +{ $values { "value" "a value" } { "name" "a value name" } { "renderer" "a component renderer" } { "xml" "an XML chunk" } } +{ $contract "Renders an HTML component, outputting an XHTML snippet." } ; ARTICLE: "html.components" "HTML components" "The " { $vocab-link "html.components" } " vocabulary provides various HTML form components." diff --git a/basis/html/components/components-tests.factor b/basis/html/components/components-tests.factor index b4247e6e30..09bb5860ad 100644 --- a/basis/html/components/components-tests.factor +++ b/basis/html/components/components-tests.factor @@ -31,7 +31,7 @@ TUPLE: color red green blue ; ] with-string-writer ] unit-test -[ "" ] [ +[ "\" name=\"red\" type=\"hidden\"/>" ] [ [ "red" hidden render ] with-string-writer @@ -39,13 +39,13 @@ TUPLE: color red green blue ; [ ] [ "'jimmy'" "red" set-value ] unit-test -[ "" ] [ +[ "" ] [ [ "red" 5 >>size render ] with-string-writer ] unit-test -[ "" ] [ +[ "" ] [ [ "red" 5 >>size render ] with-string-writer @@ -105,7 +105,7 @@ TUPLE: color red green blue ; [ ] [ t "delivery" set-value ] unit-test -[ "Delivery" ] [ +[ "Delivery" ] [ [ "delivery" @@ -116,7 +116,7 @@ TUPLE: color red green blue ; [ ] [ f "delivery" set-value ] unit-test -[ "Delivery" ] [ +[ "Delivery" ] [ [ "delivery" @@ -133,7 +133,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ ] [ link-test "link" set-value ] unit-test -[ "<Link Title>" ] [ +[ "<Link Title>" ] [ [ "link" link new render ] with-string-writer ] unit-test @@ -149,7 +149,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ ] [ "java" "mode" set-value ] unit-test -[ "int x = 4;\n" ] [ +[ "int x = 4;" ] [ [ "code" "mode" >>mode render ] with-string-writer ] unit-test @@ -163,6 +163,8 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ t ] [ [ "object" inspector render ] with-string-writer + USING: splitting sequences ; + "\"" split "'" join ! replace " with ' for now [ "object" value [ describe ] with-html-writer ] with-string-writer = ] unit-test diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index 6f35ba5d97..462c9b3c78 100644 --- a/basis/html/components/components.factor +++ b/basis/html/components/components.factor @@ -3,13 +3,13 @@ USING: accessors kernel namespaces io math.parser assocs classes classes.tuple words arrays sequences splitting mirrors hashtables combinators continuations math strings inspector -fry locals calendar calendar.format xml.entities -validators urls present -xmode.code2html lcs.diff2html farkup +fry locals calendar calendar.format xml.entities xml.data +validators urls present xml.writer xml.interpolate xml +xmode.code2html lcs.diff2html farkup io.streams.string html.elements html.streams html.forms ; IN: html.components -GENERIC: render* ( value name renderer -- ) +GENERIC: render* ( value name renderer -- xml ) : render ( name renderer -- ) prepare-value @@ -19,38 +19,36 @@ GENERIC: render* ( value name renderer -- ) [ f swap ] if ] 2dip - render* + render* write-xml [ render-error ] when* ; ; +: render-input ( value name type -- xml ) + [XML name=<-> type=<->/> XML] ; PRIVATE> SINGLETON: label -M: label render* 2drop present escape-string write ; +M: label render* + 2drop present ; SINGLETON: hidden -M: hidden render* drop "hidden" render-input ; +M: hidden render* + drop "hidden" render-input ; -: render-field ( value name size type -- ) - ; +: render-field ( value name size type -- xml ) + [XML name=<-> size=<-> type=<->/> XML] ; TUPLE: field size ; : ( -- field ) field new ; -M: field render* size>> "text" render-field ; +M: field render* + size>> "text" render-field ; TUPLE: password size ; @@ -67,14 +65,15 @@ TUPLE: textarea rows cols ; : ; +M:: textarea render* ( value name area -- xml ) + area rows>> :> rows + area cols>> :> cols + [XML + + XML] ; ! Choice TUPLE: choice size multiple choices ; @@ -82,24 +81,23 @@ TUPLE: choice size multiple choices ; : ( -- choice ) choice new ; -: render-option ( text selected? -- ) - ; - -: render-options ( options selected -- ) - '[ dup _ member? render-option ] each ; - -M: choice render* - ; +: render-option ( text selected? -- xml ) + "selected" and swap + [XML XML] ; + +: render-options ( value choice -- xml ) + [ choices>> value ] [ multiple>> ] bi + [ swap ] [ swap 1array ] if + '[ dup _ member? render-option ] map ; + +M:: choice render* ( value name choice -- xml ) + choice size>> :> size + choice multiple>> "true" and :> multiple + value choice render-options :> contents + [XML XML] ; ! Checkboxes TUPLE: checkbox label ; @@ -108,13 +106,10 @@ TUPLE: checkbox label ; checkbox new ; M: checkbox render* - - label>> escape-string write - ; + [ "true" and ] [ ] [ label>> ] tri* + [XML name=<->><-> XML] ; ! Link components GENERIC: link-title ( obj -- string ) @@ -129,10 +124,9 @@ M: url link-href ; TUPLE: link target ; M: link render* - nip - > [ =target ] when* dup link-href =href a> - link-title present escape-string write - ; + nip swap + [ target>> ] [ [ link-href ] [ link-title ] bi ] bi* + [XML href=<->><-> XML] ; ! XMode code component TUPLE: code mode ; @@ -161,7 +155,7 @@ M: farkup render* nip [ no-follow>> [ string>boolean link-no-follow? set ] when* ] [ disable-images>> [ string>boolean disable-images? set ] when* ] - [ parsed>> string>boolean [ (write-farkup) ] [ write-farkup ] if ] + [ parsed>> string>boolean [ (write-farkup) ] [ farkup>xml ] if ] tri ] with-scope ; @@ -169,7 +163,9 @@ M: farkup render* SINGLETON: inspector M: inspector render* - 2drop [ describe ] with-html-writer ; + 2drop [ + [ describe ] with-html-writer + ] with-string-writer ; ! Diff component SINGLETON: comparison @@ -180,4 +176,4 @@ M: comparison render* ! HTML component SINGLETON: html -M: html render* 2drop write ; +M: html render* 2drop ; diff --git a/basis/html/elements/elements-docs.factor b/basis/html/elements/elements-docs.factor index f6e15e46cd..dab9376413 100644 --- a/basis/html/elements/elements-docs.factor +++ b/basis/html/elements/elements-docs.factor @@ -14,7 +14,7 @@ $nl { $code " \"Click me\" write " } { $code " \"click\" write " } { $code " \"click\" write " } -"Tags that have no ``closing'' equivalent have a trailing " { $snippet "tag/>" } " form:" +"Tags that have no “closing” equivalent have a trailing " { $snippet "tag/>" } " form:" { $code "" } "For the full list of HTML tags and attributes, consult the word list for the " { $vocab-link "html.elements" } " vocabulary. In addition to HTML tag and attribute words, a few utilities are provided." $nl diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor index 2149bf7bf6..a6e1928f83 100644 --- a/basis/html/elements/elements.factor +++ b/basis/html/elements/elements.factor @@ -1,11 +1,9 @@ -! cont-html v0.6 -! -! Copyright (C) 2004 Chris Double. +! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. - -USING: io kernel namespaces prettyprint quotations +USING: io io.styles kernel namespaces prettyprint quotations sequences strings words xml.entities compiler.units effects -urls math math.parser combinators present fry ; +xml.data xml.interpolate urls math math.parser combinators +present fry io.streams.string xml.writer ; IN: html.elements @@ -135,17 +133,18 @@ SYMBOL: html "" write-html ; : simple-page ( title head-quot body-quot -- ) - #! Call the quotation, with all output going to the - #! body of an html page with the given title. - spin - xhtml-preamble - - - write - call - - call - ; inline + [ with-string-writer ] bi@ + + + + + <-> + <-> + + <-> + + XML> write-xml ; inline : render-error ( message -- ) - escape-string write ; + [XML <-> XML] write-xml ; diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor index 1f2975bce1..f6408d3b59 100644 --- a/basis/html/templates/chloe/chloe-docs.factor +++ b/basis/html/templates/chloe/chloe-docs.factor @@ -4,8 +4,8 @@ html.templates html.templates.chloe.syntax html.templates.chloe.compiler html.templates.chloe.components math xml.data strings quotations namespaces ; -HELP: ( path -- template ) -{ $values { "path" "a pathname string without the trailing " { $snippet ".xml" } " extension" } { "template" chloe } } +HELP: +{ $values { "path" "a pathname string without the trailing " { $snippet ".xml" } " extension" } { "chloe" chloe } } { $description "Creates a new Chloe template object which can be passed to " { $link call-template } "." } ; HELP: required-attr diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor index 5114b4088a..19b67f7018 100644 --- a/basis/html/templates/chloe/chloe-tests.factor +++ b/basis/html/templates/chloe/chloe-tests.factor @@ -1,7 +1,8 @@ USING: html.templates html.templates.chloe tools.test io.streams.string kernel sequences ascii boxes namespaces xml html.components html.forms -splitting unicode.categories furnace accessors ; +splitting unicode.categories furnace accessors +html.templates.chloe.compiler ; IN: html.templates.chloe.tests : run-template @@ -158,8 +159,14 @@ TUPLE: person first-name last-name ; "true" "b" set-value ] unit-test -[ "ab" ] [ +[ "ab" ] [ [ "test12" test-template call-template ] run-template ] unit-test + +[ + [ + "test13" test-template call-template + ] run-template +] [ error>> T{ unknown-chloe-tag f "this-tag-does-not-exist" } = ] must-fail-with diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor index 73cc239a56..c3c1ec2b9e 100644 --- a/basis/html/templates/chloe/chloe.factor +++ b/basis/html/templates/chloe/chloe.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel sequences combinators kernel fry namespaces make classes.tuple assocs splitting words arrays io -io.files io.encodings.utf8 io.streams.string unicode.case -mirrors math urls present multiline quotations xml logging -continuations +io.files io.files.info io.encodings.utf8 io.streams.string +unicode.case mirrors math urls present multiline quotations xml +logging continuations xml.data html.forms html.elements diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor index d4f34ab8aa..4034b67d45 100644 --- a/basis/html/templates/chloe/compiler/compiler.factor +++ b/basis/html/templates/chloe/compiler/compiler.factor @@ -7,16 +7,16 @@ html.templates html.templates.chloe.syntax continuations ; IN: html.templates.chloe.compiler : chloe-attrs-only ( assoc -- assoc' ) - [ drop url>> chloe-ns = ] assoc-filter ; + [ drop chloe-name? ] assoc-filter ; : non-chloe-attrs-only ( assoc -- assoc' ) - [ drop url>> chloe-ns = not ] assoc-filter ; + [ drop chloe-name? not ] assoc-filter ; : chloe-tag? ( tag -- ? ) dup xml? [ body>> ] when { { [ dup tag? not ] [ f ] } - { [ dup url>> chloe-ns = not ] [ f ] } + { [ dup chloe-name? not ] [ f ] } [ t ] } cond nip ; @@ -59,7 +59,7 @@ DEFER: compile-element : compile-start-tag ( tag -- ) "<" [write] - [ name>string [write] ] [ compile-attrs ] bi + [ name>string [write] ] [ attrs>> compile-attrs ] bi ">" [write] ; : compile-end-tag ( tag -- ) @@ -76,10 +76,13 @@ DEFER: compile-element [ drop tag-stack get pop* ] } cleave ; +ERROR: unknown-chloe-tag tag ; + : compile-chloe-tag ( tag -- ) - ! "Unknown chloe tag: " prepend throw dup main>> dup tags get at - [ curry assert-depth ] [ 2drop ] ?if ; + [ curry assert-depth ] + [ unknown-chloe-tag ] + ?if ; : compile-element ( element -- ) { @@ -87,7 +90,7 @@ DEFER: compile-element { [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] } { [ dup string? ] [ escape-string [write] ] } { [ dup comment? ] [ drop ] } - [ [ write-xml-chunk ] [code-with] ] + [ [ write-xml ] [code-with] ] } cond ; : with-compiler ( quot -- quot' ) @@ -123,7 +126,7 @@ DEFER: compile-element : compile-prologue ( xml -- ) [ - [ prolog>> [ write-prolog ] [code-with] ] + [ prolog>> [ write-xml ] [code-with] ] [ before>> compile-chunk ] bi ] compile-quot diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor index 90c171917b..fb457ff1df 100644 --- a/basis/html/templates/chloe/syntax/syntax.factor +++ b/basis/html/templates/chloe/syntax/syntax.factor @@ -21,14 +21,14 @@ tags global [ H{ } clone or ] change-at : chloe-ns "http://factorcode.org/chloe/1.0" ; inline -: chloe-name ( string -- name ) - name new - swap >>main - chloe-ns >>url ; +: chloe-name? ( name -- ? ) + url>> chloe-ns = ; + +XML-NS: chloe-name http://factorcode.org/chloe/1.0 : required-attr ( tag name -- value ) - dup chloe-name rot at* - [ nip ] [ drop " attribute is required" append throw ] if ; + tuck chloe-name attr + [ nip ] [ " attribute is required" append throw ] if* ; : optional-attr ( tag name -- value ) - chloe-name swap at ; + chloe-name attr ; diff --git a/basis/html/templates/chloe/test/test13.xml b/basis/html/templates/chloe/test/test13.xml new file mode 100644 index 0000000000..adf5daf93c --- /dev/null +++ b/basis/html/templates/chloe/test/test13.xml @@ -0,0 +1,7 @@ + + + + + + + diff --git a/basis/html/templates/fhtml/fhtml-docs.factor b/basis/html/templates/fhtml/fhtml-docs.factor index c302a581ab..e775651cbc 100644 --- a/basis/html/templates/fhtml/fhtml-docs.factor +++ b/basis/html/templates/fhtml/fhtml-docs.factor @@ -1,7 +1,7 @@ IN: html.templates.fhtml USING: help.markup help.syntax ; -HELP: ( path -- fhtml ) +HELP: { $values { "path" "a pathname string" } { "fhtml" fhtml } } { $description "Creates an FHTML template descriptor." } ; diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor index 7742ff9bc6..992b660070 100644 --- a/basis/html/templates/fhtml/fhtml.factor +++ b/basis/html/templates/fhtml/fhtml.factor @@ -3,7 +3,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: continuations sequences kernel namespaces debugger combinators math quotations generic strings splitting -accessors assocs fry +accessors assocs fry vocabs.parser parser lexer io io.files io.streams.string io.encodings.utf8 html.elements html.templates ; diff --git a/basis/http/client/client-docs.factor b/basis/http/client/client-docs.factor index 7a35ba812b..9a8aa48738 100644 --- a/basis/http/client/client-docs.factor +++ b/basis/http/client/client-docs.factor @@ -1,6 +1,6 @@ -USING: http help.markup help.syntax io.files io.streams.string +USING: http help.markup help.syntax io.pathnames io.streams.string io.encodings.8-bit io.encodings.binary kernel strings urls -urls.encoding byte-arrays strings assocs sequences ; +urls.encoding byte-arrays strings assocs sequences destructors ; IN: http.client HELP: download-failed @@ -36,7 +36,12 @@ HELP: http-get HELP: http-post { $values { "post-data" object } { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } } -{ $description "Submits a form at a URL." } +{ $description "Submits an HTTP POST request." } +{ $errors "Throws an error if the HTTP request fails." } ; + +HELP: http-put +{ $values { "post-data" object } { "url" "a " { $link url } " or " { $link string } } { "response" response } { "data" sequence } } +{ $description "Submits an HTTP PUT request." } { $errors "Throws an error if the HTTP request fails." } ; HELP: with-http-get @@ -67,17 +72,36 @@ ARTICLE: "http.client.get" "GET requests with the HTTP client" { $subsection with-http-get } { $subsection with-http-request } ; -ARTICLE: "http.client.post" "POST requests with the HTTP client" -"As with GET requests, there is a high-level word which takes a " { $link url } " and a lower-level word which constructs an HTTP request object which can be passed to " { $link http-request } ":" -{ $subsection http-post } -{ $subsection } -"Both words take a post data parameter, which can be one of the following:" +ARTICLE: "http.client.post-data" "HTTP client submission data" +"HTTP POST and PUT request words take a post data parameter, which can be one of the following:" { $list - { "a " { $link byte-array } " or " { $link string } " is sent the server without further encoding" } - { "an " { $link assoc } " is interpreted as a series of form parameters, which are encoded with " { $link assoc>query } } + { "a " { $link byte-array } ": the data is sent the server without further encoding" } + { "a " { $link string } ": the data is encoded and then sent as a series of bytes" } + { "an " { $link assoc } ": the assoc is interpreted as a series of form parameters, which are encoded with " { $link assoc>query } } + { "an input stream: the contents of the input stream are transmitted to the server without being read entirely into memory - this is useful for large requests" } { { $link f } " denotes that there is no post data" } + { "a " { $link post-data } " tuple, for additional control" } +} +"When passing a stream, you must ensure the stream is closed afterwards. The best way is to use " { $link with-disposal } " or " { $link "destructors" } ". For example," +{ $code + "\"my-large-post-request.txt\" ascii " + "[ URL\" http://www.my-company.com/web-service\" http-post ] with-disposal" } ; +ARTICLE: "http.client.post" "POST requests with the HTTP client" +"Basic usage involves passing post data and a " { $link url } ", and getting a " { $link response } " and data back:" +{ $subsection http-post } +"Advanced usage involves constructing a " { $link request } ", which allows " { $link "http.cookies" } " and " { $link "http.headers" } " to be set:" +{ $subsection } +"Both words take a post data parameter; see " { $link "http.client.post-data" } "." ; + +ARTICLE: "http.client.put" "PUT requests with the HTTP client" +"Basic usage involves passing post data and a " { $link url } ", and getting a " { $link response } " and data back:" +{ $subsection http-post } +"Advanced usage involves constructing a " { $link request } ", which allows " { $link "http.cookies" } " and " { $link "http.headers" } " to be set:" +{ $subsection } +"Both words take a post data parameter; see " { $link "http.client.post-data" } "." ; + ARTICLE: "http.client.encoding" "Character encodings and the HTTP client" "The " { $link http-request } ", " { $link http-get } " and " { $link http-post } " words output a sequence containing data that was sent by the server." $nl @@ -95,11 +119,14 @@ ARTICLE: "http.client.errors" "HTTP client errors" ARTICLE: "http.client" "HTTP client" "The " { $vocab-link "http.client" } " vocabulary implements an HTTP and HTTPS client on top of " { $link "http" } "." $nl -"For HTTPS support, you must load the " { $vocab-link "urls.secure" } " vocab first. If you don't load it, HTTPS will not load and images generated by " { $vocab-link "tools.deploy" } " will be smaller as a result." +"For HTTPS support, you must load the " { $vocab-link "urls.secure" } " vocab first. If you don't need HTTPS support, don't load " { $vocab-link "urls.secure" } "; this will reduce the size of images generated by " { $vocab-link "tools.deploy" } "." $nl "There are two primary usage patterns, data retrieval with GET requests and form submission with POST requests:" { $subsection "http.client.get" } { $subsection "http.client.post" } +{ $subsection "http.client.put" } +"Submission data for POST and PUT requests:" +{ $subsection "http.client.post-data" } "More esoteric use-cases, for example HTTP methods other than the above, are accomodated by constructing an empty request object with " { $link } " and filling everything in by hand." { $subsection "http.client.encoding" } { $subsection "http.client.errors" } diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index 9c56411290..d4d0978912 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -1,20 +1,21 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs kernel math math.parser namespaces make -sequences io io.sockets io.streams.string io.files io.timeouts -strings splitting calendar continuations accessors vectors +sequences strings splitting calendar continuations accessors vectors math.order hashtables byte-arrays destructors -io.encodings -io.encodings.string -io.encodings.ascii -io.encodings.utf8 -io.encodings.8-bit -io.encodings.binary -io.streams.duplex -fry ascii urls urls.encoding present -http http.parsers ; +io io.sockets io.streams.string io.files io.timeouts +io.pathnames io.encodings io.encodings.string io.encodings.ascii +io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf +io.streams.duplex fry ascii urls urls.encoding present +http http.parsers http.client.post-data ; IN: http.client +ERROR: too-many-redirects ; + +CONSTANT: max-redirects 10 + +> write bl ] @@ -26,36 +27,19 @@ IN: http.client [ host>> ] [ port>> ] bi dup "http" protocol-port = [ drop ] [ ":" swap number>string 3append ] if ; +: set-host-header ( request header -- request header ) + over url>> url-host "host" pick set-at ; + +: set-cookie-header ( header cookies -- header ) + unparse-cookie "cookie" pick set-at ; + : write-request-header ( request -- request ) dup header>> >hashtable - over url>> host>> [ over url>> url-host "host" pick set-at ] when - over post-data>> [ - [ raw>> length "content-length" pick set-at ] - [ content-type>> "content-type" pick set-at ] - bi - ] when* - over cookies>> [ unparse-cookie "cookie" pick set-at ] unless-empty + over url>> host>> [ set-host-header ] when + over post-data>> [ set-post-data-headers ] when* + over cookies>> [ set-cookie-header ] unless-empty write-header ; -GENERIC: >post-data ( object -- post-data ) - -M: post-data >post-data ; - -M: string >post-data utf8 encode "application/octet-stream" ; - -M: byte-array >post-data "application/octet-stream" ; - -M: assoc >post-data assoc>query ascii encode "application/x-www-form-urlencoded" ; - -M: f >post-data ; - -: unparse-post-data ( request -- request ) - [ >post-data ] change-post-data ; - -: write-post-data ( request -- request ) - dup method>> [ "POST" = ] [ "PUT" = ] bi or - [ dup post-data>> [ raw>> write ] when* ] when ; - : write-request ( request -- ) unparse-post-data write-request-line @@ -83,17 +67,7 @@ M: f >post-data ; read-response-line read-response-header ; -: max-redirects 10 ; - -ERROR: too-many-redirects ; - -M: too-many-redirects summary - drop - [ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ; - -DEFER: with-http-request - - ( -- stream ) request get url>> url-addr ascii drop @@ -160,6 +129,13 @@ PRIVATE> [ do-redirect ] [ nip ] if ] with-variable ; inline recursive +: ( url method -- request ) + + swap >>method + swap >url ensure-port >>url ; inline + +PRIVATE> + : success? ( code -- ? ) 200 299 between? ; ERROR: download-failed response data ; @@ -171,8 +147,8 @@ M: download-failed error. : check-response* ( response data -- response data ) over code>> success? [ download-failed ] unless ; -: check-response ( response -- response ) - f check-response* drop ; +: with-http-request ( request quot -- response ) + [ (with-http-request) check-response ] with-destructors ; inline : http-request ( request -- response data ) [ [ % ] with-http-request ] B{ } make @@ -185,7 +161,7 @@ M: download-failed error. swap >>post-data ; : ( url -- request ) - "GET" >>method ; + "GET" ; : http-get ( url -- response data ) http-request ; @@ -215,15 +191,17 @@ M: download-failed error. dup download-name download-to ; : ( post-data url -- request ) - "POST" >>method ; + "POST" + swap >>post-data ; : http-post ( post-data url -- response data ) http-request ; -: ( data url -- request ) - "PUT" >>method ; +: ( post-data url -- request ) + "PUT" + swap >>post-data ; -: http-put ( data url -- response data ) +: http-put ( post-data url -- response data ) http-request ; USING: vocabs vocabs.loader ; diff --git a/basis/http/client/post-data/authors.txt b/basis/http/client/post-data/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/http/client/post-data/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/http/client/post-data/post-data-tests.factor b/basis/http/client/post-data/post-data-tests.factor new file mode 100644 index 0000000000..2704ce169f --- /dev/null +++ b/basis/http/client/post-data/post-data-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test http.client.post-data ; +IN: http.client.post-data.tests diff --git a/basis/http/client/post-data/post-data.factor b/basis/http/client/post-data/post-data.factor new file mode 100644 index 0000000000..b7551d86b9 --- /dev/null +++ b/basis/http/client/post-data/post-data.factor @@ -0,0 +1,91 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs destructors http io io.encodings.ascii +io.encodings.binary io.encodings.string io.encodings.utf8 +io.files io.files.info io.pathnames kernel math.parser +namespaces sequences strings urls.encoding ; +IN: http.client.post-data + +TUPLE: measured-stream stream size ; + +C: measured-stream + +> "content-length" pick set-at ; + +M: object (set-post-data-headers) + drop "chunked" "transfer-encoding" pick set-at ; + +PRIVATE> + +: set-post-data-headers ( header post-data -- header ) + [ data>> (set-post-data-headers) ] + [ content-type>> "content-type" pick set-at ] bi ; + +> [ [ write ] each-block ] with-input-stream ; + +: write-chunk ( chunk -- ) + [ length >hex ";\r\n" append ascii encode write ] [ write ] bi ; + +M: object (write-post-data) + [ [ write-chunk ] each-block ] with-input-stream + "0;\r\n" ascii encode write ; + +GENERIC: >post-data ( object -- post-data ) + +M: f >post-data ; + +M: post-data >post-data ; + +M: string >post-data + utf8 encode + "application/octet-stream" + swap >>data ; + +M: assoc >post-data + "application/x-www-form-urlencoded" + swap >>params ; + +M: object >post-data + "application/octet-stream" + swap >>data ; + +: pathname>measured-stream ( pathname -- stream ) + string>> + [ binary &dispose ] + [ file-info size>> ] bi + ; + +: normalize-post-data ( request -- request ) + dup post-data>> [ + dup params>> [ + assoc>query ascii encode >>data + ] when* + dup data>> pathname? [ + [ pathname>measured-stream ] change-data + ] when + drop + ] when* ; + +PRIVATE> + +: unparse-post-data ( request -- request ) + [ >post-data ] change-post-data + normalize-post-data ; + +: write-post-data ( request -- request ) + dup post-data>> [ data>> (write-post-data) ] when* ; diff --git a/basis/http/http-docs.factor b/basis/http/http-docs.factor index 6fb5b73fad..fc3f65fa56 100644 --- a/basis/http/http-docs.factor +++ b/basis/http/http-docs.factor @@ -30,7 +30,7 @@ $nl { $table { { $slot "version" } { "The HTTP version. Default is " { $snippet "1.1" } " and should not be changed without good reason." } } { { $slot "code" } { "HTTP status code, an " { $link integer } ". Examples are 200 for success, 404 for file not found, and so on." } } - { { $slot "message" } { "HTTP status message, only displayed to the user. If the status code is 200, the status message might be ``Success'', for example." } } + { { $slot "message" } { "HTTP status message, only displayed to the user. If the status code is 200, the status message might be “Success”, for example." } } { { $slot "header" } { "An assoc of HTTP header values. See " { $link "http.headers" } } } { { $slot "cookies" } { "A sequence of HTTP cookies. See " { $link "http.cookies" } } } { { $slot "content-type" } { "an HTTP content type" } } @@ -49,7 +49,7 @@ $nl { $table { { $slot "version" } { "The HTTP version. Default is " { $snippet "1.1" } " and should not be changed without good reason." } } { { $slot "code" } { "HTTP status code, an " { $link integer } ". Examples are 200 for success, 404 for file not found, and so on." } } - { { $slot "message" } { "HTTP status message, only displayed to the user. If the status code is 200, the status message might be ``Success'', for example." } } + { { $slot "message" } { "HTTP status message, only displayed to the user. If the status code is 200, the status message might be “Success”, for example." } } { { $slot "body" } { "an HTTP response body" } } } } ; @@ -90,7 +90,7 @@ HELP: put-cookie { $side-effects "request/response" } ; HELP: -{ $values { "raw" byte-array } { "content-type" "a MIME type string" } { "post-data" post-data } } +{ $values { "content-type" "a MIME type string" } { "post-data" post-data } } { $description "Creates a new " { $link post-data } "." } ; HELP: header @@ -110,7 +110,7 @@ $nl HELP: set-header { $values { "request/response" "a " { $link request } " or a " { $link response } } { "value" object } { "key" string } } { $description "Stores a value into the HTTP header of a request or response. The value can be any object supported by " { $link present } "." } -{ $notes "This word always returns the same object that was input. This allows for a ``pipeline'' coding style, where several header parameters are set in a row." } +{ $notes "This word always returns the same object that was input. This allows for a “pipeline” coding style, where several header parameters are set in a row." } { $side-effects "request/response" } ; ARTICLE: "http.cookies" "HTTP cookies" diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 6e93d5ee3a..6103fb622f 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -1,8 +1,8 @@ -USING: http http.server http.client tools.test multiline +USING: http http.server http.client http.client.private tools.test multiline io.streams.string io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.encodings.string kernel arrays splitting sequences assocs io.sockets db db.sqlite continuations urls -hashtables accessors namespaces ; +hashtables accessors namespaces xml.data ; IN: http.tests [ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test @@ -35,7 +35,7 @@ blah { method "POST" } { version "1.1" } { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } } - { post-data T{ post-data { content "blah" } { raw "blah" } { content-type "application/octet-stream" } } } + { post-data T{ post-data { data "blah" } { content-type "application/octet-stream" } } } { cookies V{ } } } ] [ @@ -179,7 +179,7 @@ Set-Cookie: oo="bar; a=b"; comment="your mom"; httponly=yes ! Live-fire exercise USING: http.server http.server.static furnace.sessions furnace.alloy furnace.actions furnace.auth furnace.auth.login furnace.db http.client -io.servers.connection io.files io io.encodings.ascii +io.servers.connection io.files io.files.temp io.directories io io.encodings.ascii accessors namespaces threads http.server.responses http.server.redirection furnace.redirection http.server.dispatchers db.tuples ; @@ -322,7 +322,7 @@ SYMBOL: a 3 a set-global -: test-a string>xml "input" tag-named "value" swap at ; +: test-a string>xml "input" tag-named "value" attr ; [ "3" ] [ "http://localhost/" add-port http-get diff --git a/basis/http/http.factor b/basis/http/http.factor old mode 100644 new mode 100755 index bbb0335ae4..cda3460c71 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -6,9 +6,9 @@ quotations arrays byte-arrays math.parser calendar calendar.format present urls io io.encodings io.encodings.iana io.encodings.binary -io.encodings.8-bit +io.encodings.8-bit io.crlf -unicode.case unicode.categories qualified +unicode.case unicode.categories http.parsers ; @@ -16,12 +16,6 @@ EXCLUDE: fry => , ; IN: http -: crlf ( -- ) "\r\n" write ; - -: read-crlf ( -- bytes ) - "\r" read-until - [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ; - : (read-header) ( -- alist ) [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ; @@ -45,8 +39,8 @@ IN: http : check-header-string ( str -- str ) #! http://en.wikipedia.org/wiki/HTTP_Header_Injection - dup "\r\n\"" intersect empty? - [ "Header injection attack" throw ] unless ; + dup "\r\n\"" intersects? + [ "Header injection attack" throw ] when ; : write-header ( assoc -- ) >alist sort-keys [ @@ -97,8 +91,8 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s ] { } make ; : check-cookie-string ( string -- string' ) - dup "=;'\"\r\n" intersect empty? - [ "Bad cookie name or value" throw ] unless ; + dup "=;'\"\r\n" intersects? + [ "Bad cookie name or value" throw ] when ; : unparse-cookie-value ( key value -- ) { @@ -213,12 +207,11 @@ body ; raw-response new "1.1" >>version ; -TUPLE: post-data raw content content-type ; +TUPLE: post-data data params content-type content-encoding ; -: ( raw content-type -- post-data ) +: ( content-type -- post-data ) post-data new - swap >>content-type - swap >>raw ; + swap >>content-type ; : parse-content-type-attributes ( string -- attributes ) " " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ; diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index e618249ff4..a64fe9af3c 100644 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs io.files io.streams.duplex -combinators arrays io.launcher io.encodings.binary io +combinators arrays io.launcher io.encodings io.encodings.binary io http.server.static http.server http accessors sequences strings math.parser fry urls urls.encoding calendar ; IN: http.server.cgi @@ -34,7 +34,7 @@ IN: http.server.cgi request get "accept" header "HTTP_ACCEPT" set post-request? [ - request get post-data>> raw>> + request get post-data>> data>> [ "CONTENT_TYPE" set ] [ length number>string "CONTENT_LENGTH" set ] bi @@ -52,12 +52,15 @@ IN: http.server.cgi 200 >>code "CGI output follows" >>message swap '[ + binary encode-output _ output-stream get swap binary [ - post-request? [ request get post-data>> raw>> write flush ] when - input-stream get swap (stream-copy) + post-request? [ request get post-data>> data>> write flush ] when + '[ _ write ] each-block ] with-stream ] >>body ; +SLOT: special + : enable-cgi ( responder -- responder ) [ serve-cgi ] "application/x-cgi-script" pick special>> set-at ; diff --git a/basis/http/server/dispatchers/dispatchers-docs.factor b/basis/http/server/dispatchers/dispatchers-docs.factor index 71842f6491..e0f7f20e69 100644 --- a/basis/http/server/dispatchers/dispatchers-docs.factor +++ b/basis/http/server/dispatchers/dispatchers-docs.factor @@ -41,7 +41,7 @@ main-responder set-global"> } "In the above example, visiting any URL other than " { $snippet "/new" } ", " { $snippet "/edit" } ", " { $snippet "/delete" } ", or " { $snippet "/" } " will result in a 404 error." { $heading "Another pathname dispatcher" } -"On the other hand, suppose we wanted to route all unrecognized paths to a ``view'' action:" +"On the other hand, suppose we wanted to route all unrecognized paths to a “view” action:" { $code <" "new" add-responder diff --git a/basis/http/server/server-docs.factor b/basis/http/server/server-docs.factor index 12183f1b25..29f61416fa 100644 --- a/basis/http/server/server-docs.factor +++ b/basis/http/server/server-docs.factor @@ -4,8 +4,8 @@ IN: http.server HELP: trivial-responder { $description "The class of trivial responders, which output the same response for every request. New instances are created by calling " { $link } "." } ; -HELP: ( response -- responder ) -{ $values { "response" response } { "responder" trivial-responder } } +HELP: +{ $values { "response" response } { "trivial-responder" trivial-responder } } { $description "Creates a new trivial responder which outputs the same response for every request." } ; HELP: benchmark? diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor old mode 100644 new mode 100755 index 697dec24ce..a886d7bae7 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -12,9 +12,13 @@ io.encodings.utf8 io.encodings.ascii io.encodings.binary io.streams.limited +io.streams.string io.servers.connection io.timeouts +io.crlf fry logging logging.insomniac calendar urls urls.encoding +mime.multipart +unicode.categories http http.parsers http.server.responses @@ -24,8 +28,6 @@ html.elements html.streams ; IN: http.server -\ parse-cookie DEBUG add-input-logging - : check-absolute ( url -- url ) dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline @@ -36,17 +38,34 @@ IN: http.server : read-request-header ( request -- request ) read-header >>header ; -: parse-post-data ( post-data -- post-data ) - [ ] [ raw>> ] [ content-type>> ] tri - "application/x-www-form-urlencoded" = [ query>assoc ] when - >>content ; +ERROR: no-boundary ; + +: parse-multipart-form-data ( string -- separator ) + ";" split1 nip + "=" split1 nip [ no-boundary ] unless* ; + +: read-multipart-data ( request -- mime-parts ) + [ "content-type" header ] + [ "content-length" header string>number ] bi + unlimit-input + stream-eofs limit-input + binary decode-input + parse-multipart-form-data parse-multipart ; + +: read-content ( request -- bytes ) + "content-length" header string>number read ; + +: parse-content ( request content-type -- post-data ) + [ swap ] keep { + { "multipart/form-data" [ read-multipart-data >>params ] } + { "application/x-www-form-urlencoded" [ read-content query>assoc >>params ] } + [ drop read-content >>data ] + } case ; : read-post-data ( request -- request ) dup method>> "POST" = [ - [ ] - [ "content-length" header string>number read ] - [ "content-type" header ] tri - parse-post-data >>post-data + dup dup "content-type" header + ";" split1 drop parse-content >>post-data ] when ; : extract-host ( request -- request ) @@ -80,7 +99,7 @@ GENERIC: write-full-response ( request response -- ) [ content-type>> "application/octet-stream" or ] [ content-charset>> encoding>name ] bi - [ "; charset=" swap 3append ] when* ; + [ "; charset=" glue ] when* ; : ensure-domain ( cookie -- cookie ) [ @@ -179,8 +198,8 @@ LOG: httpd-hit NOTICE LOG: httpd-header NOTICE -: log-header ( headers name -- ) - tuck header 2array httpd-header ; +: log-header ( request name -- ) + [ nip ] [ header ] 2bi 2array httpd-header ; : log-request ( request -- ) [ [ method>> ] [ url>> ] bi 2array httpd-hit ] @@ -236,7 +255,7 @@ TUPLE: http-server < threaded-server ; M: http-server handle-client* drop [ - 64 1024 * limit-input + 64 1024 * stream-throws limit-input ?refresh-all [ read-request ] ?benchmark [ do-request ] ?benchmark diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 0bc644d019..b19bf2ae55 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -1,14 +1,11 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: calendar io io.files kernel math math.order -math.parser namespaces parser sequences strings -assocs hashtables debugger mime.types sorting logging -calendar.format accessors splitting -io.encodings.binary fry xml.entities destructors urls -html.elements html.templates.fhtml -http -http.server -http.server.responses +USING: calendar kernel math math.order math.parser namespaces +parser sequences strings assocs hashtables debugger mime.types +sorting logging calendar.format accessors splitting io io.files +io.files.info io.directories io.pathnames io.encodings.binary +fry xml.entities destructors urls html.elements +html.templates.fhtml http http.server http.server.responses http.server.redirection ; IN: http.server.static diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor index b47426f5bb..9c61d092e5 100644 --- a/basis/inspector/inspector.factor +++ b/basis/inspector/inspector.factor @@ -3,7 +3,7 @@ USING: accessors arrays generic hashtables io kernel assocs math namespaces prettyprint sequences strings io.styles vectors words quotations mirrors splitting math.parser classes vocabs refs -sets sorting summary debugger continuations ; +sets sorting summary debugger continuations fry ; IN: inspector : value-editor ( path -- ) @@ -53,7 +53,7 @@ SYMBOL: +editable+ [ drop ] [ dup enum? [ +sequence+ on ] when standard-table-style [ - swap [ -rot describe-row ] curry each-index + swap '[ [ _ ] 2dip describe-row ] each-index ] tabular-output ] if-empty ; @@ -64,7 +64,7 @@ M: tuple error. describe ; : namestack. ( seq -- ) [ [ global eq? not ] filter [ keys ] gather ] keep - [ dupd assoc-stack ] curry H{ } map>assoc describe ; + '[ dup _ assoc-stack ] H{ } map>assoc describe ; : .vars ( -- ) namestack namestack. ; diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor index 5e4805a8ac..5c859f8947 100644 --- a/basis/interpolate/interpolate.factor +++ b/basis/interpolate/interpolate.factor @@ -1,9 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io kernel macros make multiline namespaces parser present sequences strings splitting fry accessors ; IN: interpolate +> '[ _ get present write ] ] + [ name>> @ '[ _ @ present write ] ] [ '[ _ write ] ] if - ] map [ ] join ; + ] map [ ] join ; inline + +PRIVATE> + +MACRO: interpolate ( string -- ) + [ [ get ] ] (interpolate) ; : interpolate-locals ( string -- quot ) - parse-interpolate [ - dup interpolate-var? - [ name>> search '[ _ present write ] ] - [ '[ _ write ] ] - if - ] map [ ] join ; + [ search [ ] ] (interpolate) ; -: I[ "]I" parse-multiline-string - interpolate-locals parsed \ call parsed ; parsing +: I[ + "]I" parse-multiline-string + interpolate-locals over push-all ; parsing diff --git a/basis/interval-maps/interval-maps-docs.factor b/basis/interval-maps/interval-maps-docs.factor index 1a862fbe2d..de18458546 100644 --- a/basis/interval-maps/interval-maps-docs.factor +++ b/basis/interval-maps/interval-maps-docs.factor @@ -18,7 +18,8 @@ HELP: { $description "From a specification, produce an interval tree. The specification is an assoc where the keys are intervals, or pairs of numbers to represent intervals, or individual numbers to represent singleton intervals. The values are the values int he interval map. Construction time is O(n log n)." } ; ARTICLE: "interval-maps" "Interval maps" -"Interval maps are a mechanism, similar to assocs, where a set of closed intervals of keys are associated with values. As such, interval maps do not conform to the assoc protocol, because intervals of floats, for example, can be used, and it is impossible to get a list of keys in between." +"The " { $vocab-link "interval-maps" } " vocabulary implements a data structure, similar to assocs, where a set of closed intervals of keys are associated with values. As such, interval maps do not conform to the assoc protocol, because intervals of floats, for example, can be used, and it is impossible to get a list of keys in between." +$nl "The following operations are used to query interval maps:" { $subsection interval-at* } { $subsection interval-at } diff --git a/basis/interval-maps/interval-maps.factor b/basis/interval-maps/interval-maps.factor index 34e43ddc75..4fd4592ee1 100644 --- a/basis/interval-maps/interval-maps.factor +++ b/basis/interval-maps/interval-maps.factor @@ -31,7 +31,8 @@ PRIVATE> : interval-at* ( key map -- value ? ) [ drop ] [ array>> find-interval ] 2bi - tuck interval-contains? [ third t ] [ drop f f ] if ; + [ nip ] [ interval-contains? ] 2bi + [ third t ] [ drop f f ] if ; : interval-at ( key map -- value ) interval-at* drop ; diff --git a/basis/io/backend/unix/authors.txt b/basis/io/backend/unix/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/backend/unix/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/backend/unix/bsd/authors.txt b/basis/io/backend/unix/bsd/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/backend/unix/bsd/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/backend/unix/bsd/bsd.factor b/basis/io/backend/unix/bsd/bsd.factor new file mode 100644 index 0000000000..e0a675a8fc --- /dev/null +++ b/basis/io/backend/unix/bsd/bsd.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces system kernel accessors assocs continuations +unix io.backend io.backend.unix io.backend.unix.multiplexers +io.backend.unix.multiplexers.kqueue io.files.unix ; +IN: io.backend.unix.bsd + +M: bsd init-io ( -- ) + mx set-global ; + +! M: bsd (monitor) ( path recursive? mailbox -- ) +! swap [ "Recursive kqueue monitors not supported" throw ] when +! ; diff --git a/basis/io/backend/unix/bsd/tags.txt b/basis/io/backend/unix/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/bsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/freebsd/freebsd.factor b/basis/io/backend/unix/freebsd/freebsd.factor new file mode 100644 index 0000000000..1c0471b330 --- /dev/null +++ b/basis/io/backend/unix/freebsd/freebsd.factor @@ -0,0 +1,3 @@ +USING: io.backend.unix.bsd io.backend system ; + +freebsd set-io-backend diff --git a/basis/io/backend/unix/freebsd/tags.txt b/basis/io/backend/unix/freebsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/freebsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/linux/authors.txt b/basis/io/backend/unix/linux/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/backend/unix/linux/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/backend/unix/linux/linux.factor b/basis/io/backend/unix/linux/linux.factor new file mode 100644 index 0000000000..54b20d1b44 --- /dev/null +++ b/basis/io/backend/unix/linux/linux.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel system namespaces io.files.unix io.backend +io.backend.unix io.backend.unix.multiplexers +io.backend.unix.multiplexers.epoll ; +IN: io.backend.unix.linux + +M: linux init-io ( -- ) + mx set-global ; + +linux set-io-backend diff --git a/basis/io/backend/unix/linux/tags.txt b/basis/io/backend/unix/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/macosx/macosx.factor b/basis/io/backend/unix/macosx/macosx.factor new file mode 100644 index 0000000000..e669875448 --- /dev/null +++ b/basis/io/backend/unix/macosx/macosx.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.backend system namespaces io.backend.unix.bsd +io.backend.unix.multiplexers io.backend.unix.multiplexers.run-loop ; +IN: io.backend.macosx + +M: macosx init-io ( -- ) + mx set-global ; + +macosx set-io-backend diff --git a/basis/io/backend/unix/macosx/tags.txt b/basis/io/backend/unix/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/macosx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/multiplexers/epoll/authors.txt b/basis/io/backend/unix/multiplexers/epoll/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/epoll/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/backend/unix/multiplexers/epoll/epoll.factor b/basis/io/backend/unix/multiplexers/epoll/epoll.factor new file mode 100644 index 0000000000..a91f62f1df --- /dev/null +++ b/basis/io/backend/unix/multiplexers/epoll/epoll.factor @@ -0,0 +1,66 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types kernel destructors bit-arrays +sequences assocs struct-arrays math namespaces locals fry unix +unix.linux.epoll unix.time io.ports io.backend.unix +io.backend.unix.multiplexers ; +IN: io.backend.unix.multiplexers.epoll + +TUPLE: epoll-mx < mx events ; + +: max-events ( -- n ) + #! We read up to 256 events at a time. This is an arbitrary + #! constant... + 256 ; inline + +: ( -- mx ) + epoll-mx new-mx + max-events epoll_create dup io-error >>fd + max-events "epoll-event" >>events ; + +M: epoll-mx dispose fd>> close-file ; + +: make-event ( fd events -- event ) + "epoll-event" + [ set-epoll-event-events ] keep + [ set-epoll-event-fd ] keep ; + +:: do-epoll-ctl ( fd mx what events -- ) + mx fd>> what fd fd events make-event epoll_ctl io-error ; + +: do-epoll-add ( fd mx events -- ) + EPOLL_CTL_ADD swap EPOLLONESHOT bitor do-epoll-ctl ; + +: do-epoll-del ( fd mx events -- ) + EPOLL_CTL_DEL swap do-epoll-ctl ; + +M: epoll-mx add-input-callback ( thread fd mx -- ) + [ EPOLLIN do-epoll-add ] [ call-next-method ] 2bi ; + +M: epoll-mx add-output-callback ( thread fd mx -- ) + [ EPOLLOUT do-epoll-add ] [ call-next-method ] 2bi ; + +M: epoll-mx remove-input-callbacks ( fd mx -- seq ) + 2dup reads>> key? [ + [ call-next-method ] [ EPOLLIN do-epoll-del ] 2bi + ] [ 2drop f ] if ; + +M: epoll-mx remove-output-callbacks ( fd mx -- seq ) + 2dup writes>> key? [ + [ EPOLLOUT do-epoll-del ] [ call-next-method ] 2bi + ] [ 2drop f ] if ; + +: wait-event ( mx us -- n ) + [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi* + epoll_wait multiplexer-error ; + +: handle-event ( event mx -- ) + [ epoll-event-fd ] dip + [ EPOLLIN EPOLLOUT bitor do-epoll-del ] + [ input-available ] [ output-available ] 2tri ; + +: handle-events ( mx n -- ) + [ dup events>> ] dip head-slice swap '[ _ handle-event ] each ; + +M: epoll-mx wait-for-events ( us mx -- ) + swap 60000000 or dupd wait-event handle-events ; diff --git a/basis/io/backend/unix/multiplexers/epoll/tags.txt b/basis/io/backend/unix/multiplexers/epoll/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/multiplexers/epoll/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/multiplexers/kqueue/authors.txt b/basis/io/backend/unix/multiplexers/kqueue/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/kqueue/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor new file mode 100644 index 0000000000..2a6648981b --- /dev/null +++ b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types combinators destructors +io.backend.unix kernel math.bitwise sequences struct-arrays unix +unix.kqueue unix.time assocs io.backend.unix.multiplexers ; +IN: io.backend.unix.multiplexers.kqueue + +TUPLE: kqueue-mx < mx events ; + +: max-events ( -- n ) + #! We read up to 256 events at a time. This is an arbitrary + #! constant... + 256 ; inline + +: ( -- mx ) + kqueue-mx new-mx + kqueue dup io-error >>fd + max-events "kevent" >>events ; + +M: kqueue-mx dispose fd>> close-file ; + +: make-kevent ( fd filter flags -- event ) + "kevent" + [ set-kevent-flags ] keep + [ set-kevent-filter ] keep + [ set-kevent-ident ] keep ; + +: register-kevent ( kevent mx -- ) + fd>> swap 1 f 0 f kevent io-error ; + +M: kqueue-mx add-input-callback ( thread fd mx -- ) + [ call-next-method ] [ + [ EVFILT_READ { EV_ADD EV_ONESHOT } flags make-kevent ] dip + register-kevent + ] 2bi ; + +M: kqueue-mx add-output-callback ( thread fd mx -- ) + [ call-next-method ] [ + [ EVFILT_WRITE { EV_ADD EV_ONESHOT } flags make-kevent ] dip + register-kevent + ] 2bi ; + +M: kqueue-mx remove-input-callbacks ( fd mx -- seq ) + 2dup reads>> key? [ + [ call-next-method ] [ + [ EVFILT_READ EV_DELETE make-kevent ] dip + register-kevent + ] 2bi + ] [ 2drop f ] if ; + +M: kqueue-mx remove-output-callbacks ( fd mx -- seq ) + 2dup writes>> key? [ + [ + [ EVFILT_WRITE EV_DELETE make-kevent ] dip + register-kevent + ] [ call-next-method ] 2bi + ] [ 2drop f ] if ; + +: wait-kevent ( mx timespec -- n ) + [ + [ fd>> f 0 ] + [ events>> [ underlying>> ] [ length ] bi ] bi + ] dip kevent multiplexer-error ; + +: handle-kevent ( mx kevent -- ) + [ kevent-ident swap ] [ kevent-filter ] bi { + { EVFILT_READ [ input-available ] } + { EVFILT_WRITE [ output-available ] } + } case ; + +: handle-kevents ( mx n -- ) + [ dup events>> ] dip head-slice [ handle-kevent ] with each ; + +M: kqueue-mx wait-for-events ( us mx -- ) + swap dup [ make-timespec ] when + dupd wait-kevent handle-kevents ; diff --git a/basis/io/backend/unix/multiplexers/kqueue/tags.txt b/basis/io/backend/unix/multiplexers/kqueue/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/multiplexers/kqueue/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/multiplexers/multiplexers.factor b/basis/io/backend/unix/multiplexers/multiplexers.factor new file mode 100644 index 0000000000..844670d635 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/multiplexers.factor @@ -0,0 +1,35 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors assocs sequences threads ; +IN: io.backend.unix.multiplexers + +TUPLE: mx fd reads writes ; + +: new-mx ( class -- obj ) + new + H{ } clone >>reads + H{ } clone >>writes ; inline + +GENERIC: add-input-callback ( thread fd mx -- ) + +M: mx add-input-callback reads>> push-at ; + +GENERIC: add-output-callback ( thread fd mx -- ) + +M: mx add-output-callback writes>> push-at ; + +GENERIC: remove-input-callbacks ( fd mx -- callbacks ) + +M: mx remove-input-callbacks reads>> delete-at* drop ; + +GENERIC: remove-output-callbacks ( fd mx -- callbacks ) + +M: mx remove-output-callbacks writes>> delete-at* drop ; + +GENERIC: wait-for-events ( ms mx -- ) + +: input-available ( fd mx -- ) + reads>> delete-at* drop [ resume ] each ; + +: output-available ( fd mx -- ) + writes>> delete-at* drop [ resume ] each ; diff --git a/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor b/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor new file mode 100644 index 0000000000..84a609643a --- /dev/null +++ b/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel arrays namespaces math accessors alien locals +destructors system threads io.backend.unix.multiplexers +io.backend.unix.multiplexers.kqueue core-foundation +core-foundation.run-loop ; +IN: io.backend.unix.multiplexers.run-loop + +TUPLE: run-loop-mx kqueue-mx ; + +: file-descriptor-callback ( -- callback ) + "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" } + "cdecl" [ + 3drop + 0 mx get kqueue-mx>> wait-for-events + reset-run-loop + yield + ] alien-callback ; + +: ( -- mx ) + [ + |dispose + dup fd>> file-descriptor-callback add-fd-to-run-loop + run-loop-mx boa + ] with-destructors ; + +M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ; +M: run-loop-mx add-output-callback kqueue-mx>> add-output-callback ; +M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ; +M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ; + +M: run-loop-mx wait-for-events ( us mx -- ) + swap run-one-iteration [ 0 swap wait-for-events ] [ drop ] if ; diff --git a/basis/io/backend/unix/multiplexers/run-loop/tags.txt b/basis/io/backend/unix/multiplexers/run-loop/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/multiplexers/run-loop/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/multiplexers/select/authors.txt b/basis/io/backend/unix/multiplexers/select/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/select/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/backend/unix/multiplexers/select/select.factor b/basis/io/backend/unix/multiplexers/select/select.factor new file mode 100644 index 0000000000..c62101e478 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/select/select.factor @@ -0,0 +1,56 @@ +! Copyright (C) 2004, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types kernel bit-arrays sequences assocs unix +math namespaces accessors math.order locals unix.time fry +io.ports io.backend.unix io.backend.unix.multiplexers ; +IN: io.backend.unix.multiplexers.select + +TUPLE: select-mx < mx read-fdset write-fdset ; + +! Factor's bit-arrays are an array of bytes, OS X expects +! FD_SET to be an array of cells, so we have to account for +! byte order differences on big endian platforms +: munge ( i -- i' ) + little-endian? [ BIN: 11000 bitxor ] unless ; inline + +: ( -- mx ) + select-mx new-mx + FD_SETSIZE 8 * >>read-fdset + FD_SETSIZE 8 * >>write-fdset ; + +: clear-nth ( n seq -- ? ) + [ nth ] [ [ f ] 2dip set-nth ] 2bi ; + +:: check-fd ( fd fdset mx quot -- ) + fd munge fdset clear-nth [ fd mx quot call ] when ; inline + +: check-fdset ( fds fdset mx quot -- ) + [ check-fd ] 3curry each ; inline + +: init-fdset ( fds fdset -- ) + '[ t swap munge _ set-nth ] each ; + +: read-fdset/tasks ( mx -- seq fdset ) + [ reads>> keys ] [ read-fdset>> ] bi ; + +: write-fdset/tasks ( mx -- seq fdset ) + [ writes>> keys ] [ write-fdset>> ] bi ; + +: max-fd ( assoc -- n ) + dup assoc-empty? [ drop 0 ] [ keys supremum ] if ; + +: num-fds ( mx -- n ) + [ reads>> max-fd ] [ writes>> max-fd ] bi max 1+ ; + +: init-fdsets ( mx -- nfds read write except ) + [ num-fds ] + [ read-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] + [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri + f ; + +M:: select-mx wait-for-events ( us mx -- ) + mx + [ init-fdsets us dup [ make-timeval ] when select multiplexer-error drop ] + [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ] + [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ] + tri ; diff --git a/basis/io/backend/unix/multiplexers/select/tags.txt b/basis/io/backend/unix/multiplexers/select/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/multiplexers/select/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/netbsd/netbsd.factor b/basis/io/backend/unix/netbsd/netbsd.factor new file mode 100644 index 0000000000..a47be300f8 --- /dev/null +++ b/basis/io/backend/unix/netbsd/netbsd.factor @@ -0,0 +1,3 @@ +USING: io.backend.unix.bsd io.backend system ; + +netbsd set-io-backend diff --git a/basis/io/backend/unix/netbsd/tags.txt b/basis/io/backend/unix/netbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/netbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/openbsd/openbsd.factor b/basis/io/backend/unix/openbsd/openbsd.factor new file mode 100644 index 0000000000..a9e25134de --- /dev/null +++ b/basis/io/backend/unix/openbsd/openbsd.factor @@ -0,0 +1,3 @@ +USING: io.backend.unix.bsd io.backend system ; + +openbsd set-io-backend diff --git a/basis/io/backend/unix/openbsd/tags.txt b/basis/io/backend/unix/openbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/openbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/summary.txt b/basis/io/backend/unix/summary.txt new file mode 100644 index 0000000000..8f66d889cc --- /dev/null +++ b/basis/io/backend/unix/summary.txt @@ -0,0 +1 @@ +Non-blocking I/O and sockets on Unix-like systems diff --git a/basis/io/backend/unix/tags.txt b/basis/io/backend/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/unix/unix-tests.factor b/basis/io/backend/unix/unix-tests.factor new file mode 100644 index 0000000000..2e94d7a2df --- /dev/null +++ b/basis/io/backend/unix/unix-tests.factor @@ -0,0 +1,150 @@ +USING: io.files io.files.temp io.directories io.sockets io kernel threads +namespaces tools.test continuations strings byte-arrays +sequences prettyprint system io.encodings.binary io.encodings.ascii +io.streams.duplex destructors make io.launcher ; +IN: io.backend.unix.tests + +! Unix domain stream sockets +: socket-server "unix-domain-socket-test" temp-file ; + +[ + [ socket-server delete-file ] ignore-errors + + socket-server + ascii [ + accept drop [ + "Hello world" print flush + readln "XYZ" = "FOO" "BAR" ? print flush + ] with-stream + ] with-disposal + + socket-server delete-file +] "Test" spawn drop + +yield + +[ { "Hello world" "FOO" } ] [ + [ + socket-server ascii [ + readln , + "XYZ" print flush + readln , + ] with-client + ] { } make +] unit-test + +: datagram-server "unix-domain-datagram-test" temp-file ; +: datagram-client "unix-domain-datagram-test-2" temp-file ; + +! Unix domain datagram sockets +[ datagram-server delete-file ] ignore-errors +[ datagram-client delete-file ] ignore-errors + +[ + [ + datagram-server "d" set + + "Receive 1" print + + "d" get receive [ reverse ] dip + + "Send 1" print + dup . + + "d" get send + + "Receive 2" print + + "d" get receive [ " world" append ] dip + + "Send 1" print + dup . + + "d" get send + + "d" get dispose + + "Done" print + + datagram-server delete-file + ] with-scope +] "Test" spawn drop + +yield + +[ datagram-client delete-file ] ignore-errors + +datagram-client +"d" set + +[ ] [ + "hello" >byte-array + datagram-server + "d" get send +] unit-test + +[ "olleh" t ] [ + "d" get receive + datagram-server = + [ >string ] dip +] unit-test + +[ ] [ + "hello" >byte-array + datagram-server + "d" get send +] unit-test + +[ "hello world" t ] [ + "d" get receive + datagram-server = + [ >string ] dip +] unit-test + +[ ] [ "d" get dispose ] unit-test + +! Test error behavior +: another-datagram "unix-domain-datagram-test-3" temp-file ; + +[ another-datagram delete-file ] ignore-errors + +datagram-client delete-file + +[ ] [ datagram-client "d" set ] unit-test + +[ B{ 1 2 3 } another-datagram "d" get send ] must-fail + +[ ] [ "d" get dispose ] unit-test + +! See what happens on send/receive after close + +[ "d" get receive ] must-fail + +[ B{ 1 2 } datagram-server "d" get send ] must-fail + +! Invalid parameter tests + +[ + image binary [ input-stream get accept ] with-file-reader +] must-fail + +[ + image binary [ input-stream get receive ] with-file-reader +] must-fail + +[ + image binary [ + B{ 1 2 } datagram-server + input-stream get send + ] with-file-reader +] must-fail + +! closing stdin caused some problems +[ ] [ + [ + vm , + "-i=" image append , + "-run=none" , + "-e=USING: destructors namespaces io calendar threads ; input-stream get dispose 1 seconds sleep" , + ] { } make try-process +] unit-test diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor new file mode 100644 index 0000000000..c4883f54ef --- /dev/null +++ b/basis/io/backend/unix/unix.factor @@ -0,0 +1,185 @@ +! Copyright (C) 2004, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types alien.syntax generic assocs kernel +kernel.private math io.ports sequences strings sbufs threads +unix vectors io.buffers io.backend io.encodings math.parser +continuations system libc namespaces make io.timeouts +io.encodings.utf8 destructors accessors summary combinators +locals unix.time fry io.backend.unix.multiplexers ; +QUALIFIED: io +IN: io.backend.unix + +GENERIC: handle-fd ( handle -- fd ) + +TUPLE: fd fd disposed ; + +: init-fd ( fd -- fd ) + [ + |dispose + dup fd>> F_SETFL O_NONBLOCK fcntl io-error + dup fd>> F_SETFD FD_CLOEXEC fcntl io-error + ] with-destructors ; + +: ( n -- fd ) + #! We drop the error code rather than calling io-error, + #! since on OS X 10.3, this operation fails from init-io + #! when running the Factor.app (presumably because fd 0 and + #! 1 are closed). + f fd boa ; + +M: fd dispose + dup disposed>> [ drop ] [ + [ cancel-operation ] + [ t >>disposed drop ] + [ fd>> close-file ] + tri + ] if ; + +M: fd handle-fd dup check-disposed fd>> ; + +M: fd cancel-operation ( fd -- ) + dup disposed>> [ drop ] [ + fd>> + mx get-global + [ remove-input-callbacks [ t swap resume-with ] each ] + [ remove-output-callbacks [ t swap resume-with ] each ] + 2bi + ] if ; + +SYMBOL: +retry+ ! just try the operation again without blocking +SYMBOL: +input+ +SYMBOL: +output+ + +ERROR: io-timeout ; + +M: io-timeout summary drop "I/O operation timed out" ; + +: wait-for-fd ( handle event -- ) + dup +retry+ eq? [ 2drop ] [ + '[ + swap handle-fd mx get-global _ { + { +input+ [ add-input-callback ] } + { +output+ [ add-output-callback ] } + } case + ] "I/O" suspend nip [ io-timeout ] when + ] if ; + +: wait-for-port ( port event -- ) + '[ handle>> _ wait-for-fd ] with-timeout ; + +! Some general stuff +: file-mode OCT: 0666 ; + +! Readers +: (refill) ( port -- n ) + [ handle>> ] + [ buffer>> buffer-end ] + [ buffer>> buffer-capacity ] tri read ; + +! Returns an event to wait for which will ensure completion of +! this request +GENERIC: refill ( port handle -- event/f ) + +M: fd refill + fd>> over buffer>> [ buffer-end ] [ buffer-capacity ] bi read + { + { [ dup 0 >= ] [ swap buffer>> n>buffer f ] } + { [ err_no EINTR = ] [ 2drop +retry+ ] } + { [ err_no EAGAIN = ] [ 2drop +input+ ] } + [ (io-error) ] + } cond ; + +M: unix (wait-to-read) ( port -- ) + dup + dup handle>> dup check-disposed refill dup + [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ; + +! Writers +GENERIC: drain ( port handle -- event/f ) + +M: fd drain + fd>> over buffer>> [ buffer@ ] [ buffer-length ] bi write + { + { [ dup 0 >= ] [ + over buffer>> buffer-consume + buffer>> buffer-empty? f +output+ ? + ] } + { [ err_no EINTR = ] [ 2drop +retry+ ] } + { [ err_no EAGAIN = ] [ 2drop +output+ ] } + [ (io-error) ] + } cond ; + +M: unix (wait-to-write) ( port -- ) + dup + dup handle>> dup check-disposed drain + dup [ wait-for-port ] [ 2drop ] if ; + +M: unix io-multiplex ( ms/f -- ) + mx get-global wait-for-events ; + +! On Unix, you're not supposed to set stdin to non-blocking +! because the fd might be shared with another process (either +! parent or child). So what we do is have the VM start a thread +! which pumps data from the real stdin to a pipe. We set the +! pipe to non-blocking, and read from it instead of the real +! stdin. Very crufty, but it will suffice until we get native +! threading support at the language level. +TUPLE: stdin control size data disposed ; + +M: stdin dispose* + [ + [ control>> &dispose drop ] + [ size>> &dispose drop ] + [ data>> &dispose drop ] + tri + ] with-destructors ; + +: wait-for-stdin ( stdin -- n ) + [ control>> CHAR: X over io:stream-write1 io:stream-flush ] + [ size>> "ssize_t" heap-size swap io:stream-read *int ] + bi ; + +:: refill-stdin ( buffer stdin size -- ) + stdin data>> handle-fd buffer buffer-end size read + dup 0 < [ + drop + err_no EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if + ] [ + size = [ "Error reading stdin pipe" throw ] unless + size buffer n>buffer + ] if ; + +M: stdin refill + [ buffer>> ] [ dup wait-for-stdin ] bi* refill-stdin f ; + +: control-write-fd ( -- fd ) &: control_write *uint ; + +: size-read-fd ( -- fd ) &: size_read *uint ; + +: data-read-fd ( -- fd ) &: stdin_read *uint ; + +: ( -- stdin ) + stdin new + control-write-fd >>control + size-read-fd init-fd >>size + data-read-fd >>data ; + +M: unix (init-stdio) + + 1 + 2 ; + +! mx io-task for embedding an fd-based mx inside another mx +TUPLE: mx-port < port mx ; + +: ( mx -- port ) + dup fd>> mx-port swap >>mx ; + +: multiplexer-error ( n -- n ) + dup 0 < [ + err_no [ EAGAIN = ] [ EINTR = ] bi or + [ drop 0 ] [ (io-error) ] if + ] when ; + +: ?flag ( n mask symbol -- n ) + pick rot bitand 0 > [ , ] [ drop ] if ; diff --git a/basis/io/backend/windows/authors.txt b/basis/io/backend/windows/authors.txt new file mode 100644 index 0000000000..781acc2b62 --- /dev/null +++ b/basis/io/backend/windows/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Mackenzie Straight diff --git a/basis/io/backend/windows/nt/authors.txt b/basis/io/backend/windows/nt/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/basis/io/backend/windows/nt/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor new file mode 100755 index 0000000000..c6b24a0a11 --- /dev/null +++ b/basis/io/backend/windows/nt/nt.factor @@ -0,0 +1,128 @@ +USING: alien alien.c-types arrays assocs combinators +continuations destructors io io.backend io.ports io.timeouts +io.backend.windows io.files.windows io.files.windows.nt io.files +io.pathnames io.buffers io.streams.c libc kernel math namespaces +sequences threads windows windows.errors windows.kernel32 +strings splitting ascii system accessors locals ; +QUALIFIED: windows.winsock +IN: io.backend.windows.nt + +! Global variable with assoc mapping overlapped to threads +SYMBOL: pending-overlapped + +TUPLE: io-callback port thread ; + +C: io-callback + +: (make-overlapped) ( -- overlapped-ext ) + "OVERLAPPED" malloc-object &free ; + +: make-overlapped ( port -- overlapped-ext ) + [ (make-overlapped) ] dip + handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ; + +M: winnt FileArgs-overlapped ( port -- overlapped ) + make-overlapped ; + +: ( handle existing -- handle ) + f 1 CreateIoCompletionPort dup win32-error=0/f ; + +SYMBOL: master-completion-port + +: ( -- handle ) + INVALID_HANDLE_VALUE f ; + +M: winnt add-completion ( win32-handle -- ) + handle>> master-completion-port get-global drop ; + +: eof? ( error -- ? ) + [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] bi or ; + +: twiddle-thumbs ( overlapped port -- bytes-transferred ) + [ + drop + [ pending-overlapped get-global set-at ] curry "I/O" suspend + { + { [ dup integer? ] [ ] } + { [ dup array? ] [ + first dup eof? + [ drop 0 ] [ (win32-error-string) throw ] if + ] } + } cond + ] with-timeout ; + +:: wait-for-overlapped ( us -- bytes-transferred overlapped error? ) + master-completion-port get-global + 0 [ ! bytes + f ! key + f [ ! overlapped + us [ 1000 /i ] [ INFINITE ] if* ! timeout + GetQueuedCompletionStatus zero? + ] keep *void* + ] keep *int spin ; + +: resume-callback ( result overlapped -- ) + pending-overlapped get-global delete-at* drop resume-with ; + +: handle-overlapped ( us -- ? ) + wait-for-overlapped [ + dup [ + [ drop GetLastError 1array ] dip resume-callback t + ] [ 2drop f ] if + ] [ resume-callback t ] if ; + +M: win32-handle cancel-operation + [ check-disposed ] [ handle>> CancelIo drop ] bi ; + +M: winnt io-multiplex ( us -- ) + handle-overlapped [ 0 io-multiplex ] when ; + +M: winnt init-io ( -- ) + master-completion-port set-global + H{ } clone pending-overlapped set-global + windows.winsock:init-winsock ; + +: file-error? ( n -- eof? ) + zero? [ + GetLastError { + { [ dup expected-io-error? ] [ drop f ] } + { [ dup eof? ] [ drop t ] } + [ (win32-error-string) throw ] + } cond + ] [ f ] if ; + +: wait-for-file ( FileArgs n port -- n ) + swap file-error? + [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ; + +: update-file-ptr ( n port -- ) + handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ; + +: finish-write ( n port -- ) + [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ; + +M: winnt (wait-to-write) + [ + [ make-FileArgs dup setup-write WriteFile ] + [ wait-for-file ] + [ finish-write ] + tri + ] with-destructors ; + +: finish-read ( n port -- ) + [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ; + +M: winnt (wait-to-read) ( port -- ) + [ + [ make-FileArgs dup setup-read ReadFile ] + [ wait-for-file ] + [ finish-read ] + tri + ] with-destructors ; + +: console-app? ( -- ? ) GetConsoleWindow >boolean ; + +M: winnt (init-stdio) + console-app? [ init-c-stdio t ] [ f f f f ] if ; + +winnt set-io-backend diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor new file mode 100755 index 0000000000..64218f75b0 --- /dev/null +++ b/basis/io/backend/windows/nt/privileges/privileges.factor @@ -0,0 +1,52 @@ +USING: alien alien.c-types alien.syntax arrays continuations +destructors generic io.mmap io.ports io.backend.windows io.files.windows +kernel libc math math.bitwise namespaces quotations sequences windows +windows.advapi32 windows.kernel32 io.backend system accessors +io.backend.windows.privileges ; +IN: io.backend.windows.nt.privileges + +TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES + +! Security tokens +! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/ + +: (open-process-token) ( handle -- handle ) + { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags "PHANDLE" + [ OpenProcessToken win32-error=0/f ] keep *void* ; + +: open-process-token ( -- handle ) + #! remember to CloseHandle + GetCurrentProcess (open-process-token) ; + +: with-process-token ( quot -- ) + #! quot: ( token-handle -- token-handle ) + [ open-process-token ] dip + [ keep ] curry + [ CloseHandle drop ] [ ] cleanup ; inline + +: lookup-privilege ( string -- luid ) + [ f ] dip "LUID" + [ LookupPrivilegeValue win32-error=0/f ] keep ; + +: make-token-privileges ( name ? -- obj ) + "TOKEN_PRIVILEGES" + 1 [ over set-TOKEN_PRIVILEGES-PrivilegeCount ] keep + "LUID_AND_ATTRIBUTES" malloc-array &free + over set-TOKEN_PRIVILEGES-Privileges + + swap [ + SE_PRIVILEGE_ENABLED over TOKEN_PRIVILEGES-Privileges + set-LUID_AND_ATTRIBUTES-Attributes + ] when + + [ lookup-privilege ] dip + [ + TOKEN_PRIVILEGES-Privileges + set-LUID_AND_ATTRIBUTES-Luid + ] keep ; + +M: winnt set-privilege ( name ? -- ) + [ + -rot 0 -rot make-token-privileges + dup length f f AdjustTokenPrivileges win32-error=0/f + ] with-process-token ; diff --git a/basis/io/backend/windows/nt/privileges/tags.txt b/basis/io/backend/windows/nt/privileges/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/windows/nt/privileges/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/windows/nt/tags.txt b/basis/io/backend/windows/nt/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/windows/nt/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/windows/privileges/privileges.factor b/basis/io/backend/windows/privileges/privileges.factor new file mode 100644 index 0000000000..8661ba99d9 --- /dev/null +++ b/basis/io/backend/windows/privileges/privileges.factor @@ -0,0 +1,14 @@ +USING: io.backend kernel continuations sequences +system vocabs.loader combinators ; +IN: io.backend.windows.privileges + +HOOK: set-privilege io-backend ( name ? -- ) inline + +: with-privileges ( seq quot -- ) + over [ [ t set-privilege ] each ] curry compose + swap [ [ f set-privilege ] each ] curry [ ] cleanup ; inline + +{ + { [ os winnt? ] [ "io.backend.windows.nt.privileges" require ] } + { [ os wince? ] [ "io.backend.windows.ce.privileges" require ] } +} cond diff --git a/basis/io/backend/windows/privileges/tags.txt b/basis/io/backend/windows/privileges/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/windows/privileges/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/windows/summary.txt b/basis/io/backend/windows/summary.txt new file mode 100644 index 0000000000..2a2d5443b2 --- /dev/null +++ b/basis/io/backend/windows/summary.txt @@ -0,0 +1 @@ +Microsoft Windows native I/O implementation diff --git a/basis/io/backend/windows/tags.txt b/basis/io/backend/windows/tags.txt new file mode 100755 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/backend/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/backend/windows/windows.factor b/basis/io/backend/windows/windows.factor new file mode 100755 index 0000000000..6ecbc49f2a --- /dev/null +++ b/basis/io/backend/windows/windows.factor @@ -0,0 +1,54 @@ +! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types arrays destructors io io.backend +io.buffers io.files io.ports io.binary io.timeouts +windows.errors strings kernel math namespaces sequences windows +windows.kernel32 windows.shell32 windows.types windows.winsock +splitting continuations math.bitwise system accessors ; +IN: io.backend.windows + +: set-inherit ( handle ? -- ) + [ HANDLE_FLAG_INHERIT ] dip + >BOOLEAN SetHandleInformation win32-error=0/f ; + +TUPLE: win32-handle handle disposed ; + +: new-win32-handle ( handle class -- win32-handle ) + new swap [ >>handle ] [ f set-inherit ] bi ; + +: ( handle -- win32-handle ) + win32-handle new-win32-handle ; + +M: win32-handle dispose* ( handle -- ) + handle>> CloseHandle drop ; + +TUPLE: win32-file < win32-handle ptr ; + +: ( handle -- win32-file ) + win32-file new-win32-handle ; + +M: win32-file dispose + dup disposed>> [ drop ] [ + [ cancel-operation ] [ call-next-method ] bi + ] if ; + +HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) +HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) +HOOK: add-completion io-backend ( port -- ) + +: opened-file ( handle -- win32-file ) + dup invalid-handle? + |dispose + dup add-completion ; + +: share-mode ( -- fixnum ) + { + FILE_SHARE_READ + FILE_SHARE_WRITE + FILE_SHARE_DELETE + } flags ; foldable + +: default-security-attributes ( -- obj ) + "SECURITY_ATTRIBUTES" + "SECURITY_ATTRIBUTES" heap-size + over set-SECURITY_ATTRIBUTES-nLength ; \ No newline at end of file diff --git a/basis/io/crlf/authors.txt b/basis/io/crlf/authors.txt new file mode 100644 index 0000000000..33616a2d6a --- /dev/null +++ b/basis/io/crlf/authors.txt @@ -0,0 +1,2 @@ +Daniel Ehrenberg +Slava Pestov diff --git a/basis/io/crlf/crlf-docs.factor b/basis/io/crlf/crlf-docs.factor new file mode 100644 index 0000000000..ac7c8c324e --- /dev/null +++ b/basis/io/crlf/crlf-docs.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup sequences ; +IN: io.crlf + +HELP: crlf +{ $values } +{ $description "Prints a carriage return and line feed to the current output stream, used to indicate a newline for certain network protocols." } ; + +HELP: read-crlf +{ $values { "seq" sequence } } +{ $description "Reads until the next CRLF (carriage return followed by line feed) from the current input stream, throwing an error if there is not a CRLF remaining, or if CR is present without immediately being followed by LF." } ; diff --git a/basis/io/crlf/crlf.factor b/basis/io/crlf/crlf.factor new file mode 100644 index 0000000000..53dddce199 --- /dev/null +++ b/basis/io/crlf/crlf.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: io kernel ; +IN: io.crlf + +: crlf ( -- ) + "\r\n" write ; + +: read-crlf ( -- seq ) + "\r" read-until + [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ; diff --git a/basis/io/crlf/summary.txt b/basis/io/crlf/summary.txt new file mode 100644 index 0000000000..2fa6a6e2c1 --- /dev/null +++ b/basis/io/crlf/summary.txt @@ -0,0 +1 @@ +Writing and reading until \r\n diff --git a/basis/io/directories/authors.txt b/basis/io/directories/authors.txt new file mode 100644 index 0000000000..f372b574ae --- /dev/null +++ b/basis/io/directories/authors.txt @@ -0,0 +1,2 @@ +Slava Pestov +Doug Coleman diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor new file mode 100644 index 0000000000..7318df9cac --- /dev/null +++ b/basis/io/directories/directories-docs.factor @@ -0,0 +1,172 @@ +USING: help.markup help.syntax io.files.private io.pathnames +quotations ; +IN: io.directories + +HELP: cwd +{ $values { "path" "a pathname string" } } +{ $description "Outputs the current working directory of the Factor process." } +{ $errors "Windows CE has no concept of “current directory”, so this word throws an error there." } +{ $notes "User code should use the value of the " { $link current-directory } " variable instead." } ; + +HELP: cd +{ $values { "path" "a pathname string" } } +{ $description "Changes the current working directory of the Factor process." } +{ $errors "Windows CE has no concept of “current directory”, so this word throws an error there." } +{ $notes "User code should use " { $link with-directory } " or " { $link set-current-directory } " instead." } ; + +{ cd cwd current-directory set-current-directory with-directory } related-words + +HELP: current-directory +{ $description "A variable holding the current directory as an absolute path. Words that use the filesystem do so in relation to this variable." +$nl +"This variable should never be set directly; instead, use " { $link set-current-directory } " or " { $link with-directory } ". This preserves the invariant that the value of this variable is an absolute path." } ; + +HELP: set-current-directory +{ $values { "path" "a pathname string" } } +{ $description "Changes the " { $link current-directory } " variable." +$nl +"If " { $snippet "path" } " is relative, it is first resolved relative to the current directory. If " { $snippet "path" } " is absolute, it becomes the new current directory." } ; + +HELP: with-directory +{ $values { "path" "a pathname string" } { "quot" quotation } } +{ $description "Calls the quotation in a new dynamic scope with the " { $link current-directory } " variable rebound." +$nl +"If " { $snippet "path" } " is relative, it is first resolved relative to the current directory. If " { $snippet "path" } " is absolute, it becomes the new current directory." } ; + +HELP: (directory-entries) +{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } } +{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } +{ $notes "This is a low-level word, and user code should call one of the related words instead." } ; + +HELP: directory-entries +{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $link directory-entry } " objects" } } +{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ; + +HELP: directory-files +{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } } +{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ; + +HELP: with-directory-files +{ $values { "path" "a pathname string" } { "quot" quotation } } +{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ; + +HELP: with-directory-entries +{ $values { "path" "a pathname string" } { "quot" quotation } } +{ $description "Calls the quotation with the directory entries on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ; + +HELP: delete-file +{ $values { "path" "a pathname string" } } +{ $description "Deletes a file." } +{ $errors "Throws an error if the file could not be deleted." } ; + +HELP: make-directory +{ $values { "path" "a pathname string" } } +{ $description "Creates a directory." } +{ $errors "Throws an error if the directory could not be created." } ; + +HELP: make-directories +{ $values { "path" "a pathname string" } } +{ $description "Creates a directory and any parent directories which do not yet exist." } +{ $errors "Throws an error if the directories could not be created." } ; + +HELP: delete-directory +{ $values { "path" "a pathname string" } } +{ $description "Deletes a directory. The directory must be empty." } +{ $errors "Throws an error if the directory could not be deleted." } ; + +HELP: touch-file +{ $values { "path" "a pathname string" } } +{ $description "Updates the modification time of a file or directory. If the file does not exist, creates a new, empty file." } +{ $errors "Throws an error if the file could not be touched." } ; + +HELP: move-file +{ $values { "from" "a pathname string" } { "to" "a pathname string" } } +{ $description "Moves or renames a file." } +{ $errors "Throws an error if the file does not exist or if the move operation fails." } ; + +HELP: move-file-into +{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } } +{ $description "Moves a file to another directory without renaming it." } +{ $errors "Throws an error if the file does not exist or if the move operation fails." } ; + +HELP: move-files-into +{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } } +{ $description "Moves a set of files to another directory." } +{ $errors "Throws an error if the file does not exist or if the move operation fails." } ; + +HELP: copy-file +{ $values { "from" "a pathname string" } { "to" "a pathname string" } } +{ $description "Copies a file." } +{ $notes "This operation attempts to preserve the original file's attributes, however not all attributes may be preserved." } +{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ; + +HELP: copy-file-into +{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } } +{ $description "Copies a file to another directory." } +{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ; + +HELP: copy-files-into +{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } } +{ $description "Copies a set of files to another directory." } +{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ; + +ARTICLE: "current-directory" "Current working directory" +"File system I/O operations use the value of a variable to resolve relative pathnames:" +{ $subsection current-directory } +"This variable can be changed with a pair of words:" +{ $subsection set-current-directory } +{ $subsection with-directory } +"This variable is independent of the operating system notion of “current working directory”. While all Factor I/O operations use the variable and not the operating system's value, care must be taken when making FFI calls which expect a pathname. The first option is to resolve relative paths:" +{ $subsection (normalize-path) } +"The second is to change the working directory of the current process:" +{ $subsection cd } +{ $subsection cwd } ; + +ARTICLE: "io.directories.listing" "Directory listing" +"Directory listing:" +{ $subsection directory-entries } +{ $subsection directory-files } +{ $subsection with-directory-entries } +{ $subsection with-directory-files } ; + +ARTICLE: "io.directories.create" "Creating directories" +{ $subsection make-directory } +{ $subsection make-directories } ; + +ARTICLE: "delete-move-copy" "Deleting, moving, and copying files" +"Operations for deleting and copying files come in two forms:" +{ $list + { "Words named " { $snippet { $emphasis "operation" } "-file" } " which work on regular files only." } + { "Words named " { $snippet { $emphasis "operation" } "-tree" } " works on directory trees recursively, and also accepts regular files." } +} +"The operations for moving and copying files come in three flavors:" +{ $list + { "A word named " { $snippet { $emphasis "operation" } } " which takes a source and destination path." } + { "A word named " { $snippet { $emphasis "operation" } "-into" } " which takes a source path and destination directory. The destination file will be stored in the destination directory and will have the same file name as the source path." } + { "A word named " { $snippet { $emphasis "operation" } "s-into" } " which takes a sequence of source paths and destination directory." } +} +"Since both of the above lists apply to copying files, that this means that there are a total of six variations on copying a file." +$nl +"Deleting files:" +{ $subsection delete-file } +{ $subsection delete-directory } +"Moving files:" +{ $subsection move-file } +{ $subsection move-file-into } +{ $subsection move-files-into } +"Copying files:" +{ $subsection copy-file } +{ $subsection copy-file-into } +{ $subsection copy-files-into } +"On most operating systems, files can only be moved within the same file system. To move files between file systems, use " { $link copy-file } " followed by " { $link delete-file } " on the old name." ; + +ARTICLE: "io.directories" "Directory manipulation" +"The " { $vocab-link "io.directories" } " vocabulary defines words for inspecting and manipulating directory trees." +{ $subsection home } +{ $subsection "current-directory" } +{ $subsection "io.directories.listing" } +{ $subsection "io.directories.create" } +{ $subsection "delete-move-copy" } +{ $subsection "io.directories.hierarchy" } ; + +ABOUT: "io.directories" diff --git a/basis/io/directories/directories-tests.factor b/basis/io/directories/directories-tests.factor new file mode 100644 index 0000000000..b703421b45 --- /dev/null +++ b/basis/io/directories/directories-tests.factor @@ -0,0 +1,189 @@ +USING: continuations destructors io io.directories +io.directories.hierarchy io.encodings.ascii io.encodings.utf8 +io.files io.files.info io.files.temp io.pathnames kernel +sequences tools.test ; +IN: io.directories.tests + +[ { "kernel" } ] [ + "core" resource-path [ + "." directory-files [ "kernel" = ] filter + ] with-directory +] unit-test + +[ { "kernel" } ] [ + "resource:core" [ + "." directory-files [ "kernel" = ] filter + ] with-directory +] unit-test + +[ { "kernel" } ] [ + "resource:core" [ + [ "kernel" = ] filter + ] with-directory-files +] unit-test + +[ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test +[ ] [ "blahblah" temp-file make-directory ] unit-test +[ t ] [ "blahblah" temp-file file-info directory? ] unit-test + +[ t ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "loldir" make-directory + ] with-directory + temp-directory "loldir" append-path exists? +] unit-test + +[ ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "loldir" make-directory + "loldir" delete-directory + ] with-directory +] unit-test + +[ "file1 contents" ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "file1 contents" "file1" utf8 set-file-contents + "file1" "file2" copy-file + "file2" utf8 file-contents + ] with-directory + "file1" temp-file delete-file + "file2" temp-file delete-file +] unit-test + +[ "file3 contents" ] [ + temp-directory [ + "file3 contents" "file3" utf8 set-file-contents + "file3" "file4" move-file + "file4" utf8 file-contents + ] with-directory + "file4" temp-file delete-file +] unit-test + +[ "file5" temp-file delete-file ] ignore-errors + +[ ] [ + temp-directory [ + "file5" touch-file + "file5" delete-file + ] with-directory +] unit-test + +[ "file6" temp-file delete-file ] ignore-errors + +[ ] [ + temp-directory [ + "file6" touch-file + "file6" link-info drop + ] with-directory +] unit-test + +[ ] [ + { "Hello world." } + "test-foo.txt" temp-file ascii set-file-lines +] unit-test + +[ ] [ + "test-foo.txt" temp-file ascii [ + "Hello appender." print + ] with-file-appender +] unit-test + +[ ] [ + "test-bar.txt" temp-file ascii [ + "Hello appender." print + ] with-file-appender +] unit-test + +[ "Hello world.\nHello appender.\n" ] [ + "test-foo.txt" temp-file ascii file-contents +] unit-test + +[ "Hello appender.\n" ] [ + "test-bar.txt" temp-file ascii file-contents +] unit-test + +[ ] [ "test-foo.txt" temp-file delete-file ] unit-test + +[ ] [ "test-bar.txt" temp-file delete-file ] unit-test + +[ f ] [ "test-foo.txt" temp-file exists? ] unit-test + +[ f ] [ "test-bar.txt" temp-file exists? ] unit-test + +[ "test-blah" temp-file delete-tree ] ignore-errors + +[ ] [ "test-blah" temp-file make-directory ] unit-test + +[ ] [ + "test-blah/fooz" temp-file ascii dispose +] unit-test + +[ t ] [ + "test-blah/fooz" temp-file exists? +] unit-test + +[ ] [ "test-blah/fooz" temp-file delete-file ] unit-test + +[ ] [ "test-blah" temp-file delete-directory ] unit-test + +[ f ] [ "test-blah" temp-file exists? ] unit-test + +[ ] [ "delete-tree-test/a/b/c" temp-file make-directories ] unit-test + +[ ] [ + { "Hi" } + "delete-tree-test/a/b/c/d" temp-file ascii set-file-lines +] unit-test + +[ ] [ + "delete-tree-test" temp-file delete-tree +] unit-test + +[ ] [ + "copy-tree-test/a/b/c" temp-file make-directories +] unit-test + +[ ] [ + "Foobar" + "copy-tree-test/a/b/c/d" temp-file + ascii set-file-contents +] unit-test + +[ ] [ + "copy-tree-test" temp-file + "copy-destination" temp-file copy-tree +] unit-test + +[ "Foobar" ] [ + "copy-destination/a/b/c/d" temp-file ascii file-contents +] unit-test + +[ ] [ + "copy-destination" temp-file delete-tree +] unit-test + +[ ] [ + "copy-tree-test" temp-file + "copy-destination" temp-file copy-tree-into +] unit-test + +[ "Foobar" ] [ + "copy-destination/copy-tree-test/a/b/c/d" temp-file ascii file-contents +] unit-test + +[ ] [ + "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-into +] unit-test + +[ "Foobar" ] [ + "d" temp-file ascii file-contents +] unit-test + +[ ] [ "d" temp-file delete-file ] unit-test + +[ ] [ "copy-destination" temp-file delete-tree ] unit-test + +[ ] [ "copy-tree-test" temp-file delete-tree ] unit-test diff --git a/basis/io/directories/directories.factor b/basis/io/directories/directories.factor new file mode 100755 index 0000000000..6ae55b7f7b --- /dev/null +++ b/basis/io/directories/directories.factor @@ -0,0 +1,90 @@ +! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators destructors io io.backend +io.encodings.binary io.files io.pathnames kernel namespaces +sequences system vocabs.loader fry ; +IN: io.directories + +: set-current-directory ( path -- ) + (normalize-path) current-directory set ; + +: with-directory ( path quot -- ) + [ (normalize-path) current-directory ] dip with-variable ; inline + +! Creating directories +HOOK: make-directory io-backend ( path -- ) + +: make-directories ( path -- ) + normalize-path trim-right-separators { + { [ dup "." = ] [ ] } + { [ dup root-directory? ] [ ] } + { [ dup empty? ] [ ] } + { [ dup exists? ] [ ] } + [ + dup parent-directory make-directories + dup make-directory + ] + } cond drop ; + +! Listing directories +TUPLE: directory-entry name type ; + +HOOK: >directory-entry os ( byte-array -- directory-entry ) + +HOOK: (directory-entries) os ( path -- seq ) + +: directory-entries ( path -- seq ) + normalize-path + (directory-entries) + [ name>> { "." ".." } member? not ] filter ; + +: directory-files ( path -- seq ) + directory-entries [ name>> ] map ; + +: with-directory-entries ( path quot -- ) + '[ "" directory-entries @ ] with-directory ; inline + +: with-directory-files ( path quot -- ) + '[ "" directory-files @ ] with-directory ; inline + +! Touching files +HOOK: touch-file io-backend ( path -- ) + +! Deleting files +HOOK: delete-file io-backend ( path -- ) + +HOOK: delete-directory io-backend ( path -- ) + +: to-directory ( from to -- from to' ) + over file-name append-path ; + +! Moving and renaming files +HOOK: move-file io-backend ( from to -- ) + +: move-file-into ( from to -- ) + to-directory move-file ; + +: move-files-into ( files to -- ) + '[ _ move-file-into ] each ; + +! Copying files +HOOK: copy-file io-backend ( from to -- ) + +M: object copy-file + dup parent-directory make-directories + binary [ + swap binary [ + swap stream-copy + ] with-disposal + ] with-disposal ; + +: copy-file-into ( from to -- ) + to-directory copy-file ; + +: copy-files-into ( files to -- ) + '[ _ copy-file-into ] each ; + +{ + { [ os unix? ] [ "io.directories.unix" require ] } + { [ os windows? ] [ "io.directories.windows" require ] } +} cond \ No newline at end of file diff --git a/basis/io/directories/hierarchy/authors.txt b/basis/io/directories/hierarchy/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/directories/hierarchy/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/directories/hierarchy/hierarchy-docs.factor b/basis/io/directories/hierarchy/hierarchy-docs.factor new file mode 100644 index 0000000000..8b3ca7391d --- /dev/null +++ b/basis/io/directories/hierarchy/hierarchy-docs.factor @@ -0,0 +1,36 @@ +USING: help.markup help.syntax ; +IN: io.directories.hierarchy + +HELP: delete-tree +{ $values { "path" "a pathname string" } } +{ $description "Deletes a file or directory, recursing into subdirectories." } +{ $errors "Throws an error if the deletion fails." } +{ $warning "Misuse of this word can lead to catastrophic data loss." } ; + +HELP: copy-tree +{ $values { "from" "a pathname string" } { "to" "a pathname string" } } +{ $description "Copies a directory tree recursively." } +{ $notes "This operation attempts to preserve original file attributes, however not all attributes may be preserved." } +{ $errors "Throws an error if the copy operation fails." } ; + +HELP: copy-tree-into +{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } } +{ $description "Copies a directory tree to another directory, recursively." } +{ $errors "Throws an error if the copy operation fails." } ; + +HELP: copy-trees-into +{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } } +{ $description "Copies a set of directory trees to another directory, recursively." } +{ $errors "Throws an error if the copy operation fails." } ; + +ARTICLE: "io.directories.hierarchy" "Directory hierarchy manipulation" +"The " { $vocab-link "io.directories.hierarchy" } " vocabulary defines words for operating on directory hierarchies recursively." +$nl +"Deleting directory trees recursively:" +{ $subsection delete-tree } +"Copying directory trees recursively:" +{ $subsection copy-tree } +{ $subsection copy-tree-into } +{ $subsection copy-trees-into } ; + +ABOUT: "io.directories.hierarchy" diff --git a/basis/io/directories/hierarchy/hierarchy.factor b/basis/io/directories/hierarchy/hierarchy.factor new file mode 100644 index 0000000000..555f001bfc --- /dev/null +++ b/basis/io/directories/hierarchy/hierarchy.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors sequences combinators fry io.directories +io.pathnames io.files.info io.files.types io.files.links +io.backend ; +IN: io.directories.hierarchy + +: delete-tree ( path -- ) + dup link-info directory? [ + [ [ [ delete-tree ] each ] with-directory-files ] + [ delete-directory ] + bi + ] [ delete-file ] if ; + +DEFER: copy-tree-into + +: copy-tree ( from to -- ) + normalize-path + over link-info type>> + { + { +symbolic-link+ [ copy-link ] } + { +directory+ [ '[ [ _ copy-tree-into ] each ] with-directory-files ] } + [ drop copy-file ] + } case ; + +: copy-tree-into ( from to -- ) + to-directory copy-tree ; + +: copy-trees-into ( files to -- ) + '[ _ copy-tree-into ] each ; + diff --git a/basis/io/directories/hierarchy/summary.txt b/basis/io/directories/hierarchy/summary.txt new file mode 100644 index 0000000000..3480f88d49 --- /dev/null +++ b/basis/io/directories/hierarchy/summary.txt @@ -0,0 +1 @@ +Deleting and copying directory hierarchies diff --git a/basis/io/directories/search/authors.txt b/basis/io/directories/search/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/io/directories/search/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor new file mode 100644 index 0000000000..99135b7953 --- /dev/null +++ b/basis/io/directories/search/search-docs.factor @@ -0,0 +1,66 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations ; +IN: io.directories.search + +HELP: each-file +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } +} +{ $description "Performs a directory traversal, breadth-first or depth-first, and calls the quotation on the full pathname of each file." } +{ $examples + { $unchecked-example "USING: sequences io.directories.search ;" + "\"resource:misc\" t [ . ] each-file" + "! Recursive directory listing prints here" + } +} ; + +HELP: recursive-directory +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } + { "paths" "a sequence of pathname strings" } +} +{ $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ; + +HELP: find-file +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "path/f" "a pathname string or f" } +} +{ $description "Finds the first file in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +HELP: find-in-directories +{ $values + { "directories" "a sequence of pathnames" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "path'/f" "a pathname string or f" } +} +{ $description "Finds the first file in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +HELP: find-all-files +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "paths/f" "a sequence of pathname strings or f" } +} +{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +HELP: find-all-in-directories +{ $values + { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "paths/f" "a sequence of pathname strings or f" } +} +{ $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +{ find-file find-all-files find-in-directories find-all-in-directories } related-words + +ARTICLE: "io.directories.search" "Searching directories" +"The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl +"Traversing directories:" +{ $subsection recursive-directory } +{ $subsection each-file } +"Finding files:" +{ $subsection find-file } +{ $subsection find-all-files } +{ $subsection find-in-directories } +{ $subsection find-all-in-directories } ; + +ABOUT: "io.directories.search" diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor new file mode 100644 index 0000000000..a8b8bf9215 --- /dev/null +++ b/basis/io/directories/search/search-tests.factor @@ -0,0 +1,10 @@ +USING: io.directories.search io.files io.files.unique +io.pathnames kernel namespaces sequences sorting tools.test ; +IN: io.directories.search.tests + +[ t ] [ + [ + 10 [ "io.paths.test" "gogogo" make-unique-file ] replicate + current-temporary-directory get t [ ] find-all-files + ] with-unique-directory drop [ natural-sort ] bi@ = +] unit-test diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor new file mode 100755 index 0000000000..41031f8ac3 --- /dev/null +++ b/basis/io/directories/search/search.factor @@ -0,0 +1,66 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays continuations deques dlists fry +io.directories io.files io.files.info io.pathnames kernel +sequences system vocabs.loader ; +IN: io.directories.search + +> ] [ bfs>> ] bi + [ push-front ] [ push-back ] if + ] curry each ; + +: ( path bfs? -- iterator ) + directory-iterator boa + dup path>> over push-directory ; + +: next-file ( iter -- file/f ) + dup queue>> deque-empty? [ drop f ] [ + dup queue>> pop-back dup link-info directory? + [ over push-directory next-file ] [ nip ] if + ] if ; + +: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) + over next-file [ + over call + [ 2nip ] [ iterate-directory ] if* + ] [ + 2drop f + ] if* ; inline recursive + +PRIVATE> + +: each-file ( path bfs? quot: ( obj -- ) -- ) + [ ] dip + [ f ] compose iterate-directory drop ; inline + +: recursive-directory ( path bfs? -- paths ) + [ ] accumulator [ each-file ] dip ; + +: find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) + '[ + _ _ _ [ ] dip + [ keep and ] curry iterate-directory + ] [ drop f ] recover ; inline + +: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths/f ) + '[ + _ _ _ [ ] dip + pusher [ [ f ] compose iterate-directory drop ] dip + ] [ drop f ] recover ; inline + +: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f ) + '[ _ _ find-file ] attempt-all ; + +: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f ) + '[ _ _ find-all-files ] map concat ; + +os windows? [ "io.directories.search.windows" require ] when diff --git a/basis/io/directories/search/windows/authors.txt b/basis/io/directories/search/windows/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/io/directories/search/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/io/directories/search/windows/tags.txt b/basis/io/directories/search/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/directories/search/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/directories/search/windows/windows.factor b/basis/io/directories/search/windows/windows.factor new file mode 100644 index 0000000000..755710befd --- /dev/null +++ b/basis/io/directories/search/windows/windows.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays fry io.pathnames kernel sequences windows.shell32 +io.directories.search ; +IN: io.directories.search.windows + +: program-files-directories ( -- array ) + program-files program-files-x86 2array harvest ; inline + +: find-in-program-files ( base-directory bfs? quot -- path ) + [ + [ program-files-directories ] dip '[ _ append-path ] map + ] 2dip find-in-directories ; inline diff --git a/basis/io/directories/summary.txt b/basis/io/directories/summary.txt new file mode 100644 index 0000000000..b77012207b --- /dev/null +++ b/basis/io/directories/summary.txt @@ -0,0 +1 @@ +Listing directories, moving, copying and deleting files diff --git a/basis/io/directories/unix/tags.txt b/basis/io/directories/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/directories/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor new file mode 100644 index 0000000000..1ef80b3438 --- /dev/null +++ b/basis/io/directories/unix/unix.factor @@ -0,0 +1,73 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.strings combinators +continuations destructors fry io io.backend io.backend.unix +io.directories io.encodings.binary io.encodings.utf8 io.files +io.pathnames io.files.types kernel math.bitwise sequences system +unix unix.stat ; +IN: io.directories.unix + +: touch-mode ( -- n ) + { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable + +M: unix touch-file ( path -- ) + normalize-path + dup exists? [ touch ] [ + touch-mode file-mode open-file close-file + ] if ; + +M: unix move-file ( from to -- ) + [ normalize-path ] bi@ rename io-error ; + +M: unix delete-file ( path -- ) normalize-path unlink-file ; + +M: unix make-directory ( path -- ) + normalize-path OCT: 777 mkdir io-error ; + +M: unix delete-directory ( path -- ) + normalize-path rmdir io-error ; + +: (copy-file) ( from to -- ) + dup parent-directory make-directories + binary [ + swap binary [ + swap stream-copy + ] with-disposal + ] with-disposal ; + +M: unix copy-file ( from to -- ) + [ normalize-path ] bi@ (copy-file) ; + +: with-unix-directory ( path quot -- ) + [ opendir dup [ (io-error) ] unless ] dip + dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline + +: find-next-file ( DIR* -- byte-array ) + "dirent" + f + [ readdir_r 0 = [ (io-error) ] unless ] 2keep + *void* [ drop f ] unless ; + +: dirent-type>file-type ( ch -- type ) + { + { DT_BLK [ +block-device+ ] } + { DT_CHR [ +character-device+ ] } + { DT_DIR [ +directory+ ] } + { DT_LNK [ +symbolic-link+ ] } + { DT_SOCK [ +socket+ ] } + { DT_FIFO [ +fifo+ ] } + { DT_REG [ +regular-file+ ] } + { DT_WHT [ +whiteout+ ] } + [ drop +unknown+ ] + } case ; + +M: unix >directory-entry ( byte-array -- directory-entry ) + [ dirent-d_name utf8 alien>string ] + [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ; + +M: unix (directory-entries) ( path -- seq ) + [ + '[ _ find-next-file dup ] + [ >directory-entry ] + [ drop ] produce + ] with-unix-directory ; diff --git a/basis/io/directories/windows/tags.txt b/basis/io/directories/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/directories/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor new file mode 100755 index 0000000000..a6dacc1841 --- /dev/null +++ b/basis/io/directories/windows/windows.factor @@ -0,0 +1,68 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: system io.directories io.encodings.utf16n alien.strings +io.pathnames io.backend io.files.windows destructors +kernel accessors calendar windows windows.errors +windows.kernel32 alien.c-types sequences splitting +fry continuations ; +IN: io.directories.windows + +M: windows touch-file ( path -- ) + [ + normalize-path + maybe-create-file [ &dispose ] dip + [ drop ] [ handle>> f now dup (set-file-times) ] if + ] with-destructors ; + +M: windows move-file ( from to -- ) + [ normalize-path ] bi@ MoveFile win32-error=0/f ; + +M: windows delete-file ( path -- ) + normalize-path DeleteFile win32-error=0/f ; + +M: windows copy-file ( from to -- ) + dup parent-directory make-directories + [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ; + +M: windows make-directory ( path -- ) + normalize-path + f CreateDirectory win32-error=0/f ; + +M: windows delete-directory ( path -- ) + normalize-path + RemoveDirectory win32-error=0/f ; + +: find-first-file ( path -- WIN32_FIND_DATA handle ) + "WIN32_FIND_DATA" + [ nip ] [ FindFirstFile ] 2bi + [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; + +: find-next-file ( path -- WIN32_FIND_DATA/f ) + "WIN32_FIND_DATA" + [ nip ] [ FindNextFile ] 2bi 0 = [ + GetLastError ERROR_NO_MORE_FILES = [ + win32-error + ] unless drop f + ] when ; + +TUPLE: windows-directory-entry < directory-entry attributes ; + +M: windows >directory-entry ( byte-array -- directory-entry ) + [ WIN32_FIND_DATA-cFileName utf16n alien>string ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ] + tri + dupd remove windows-directory-entry boa ; + +M: windows (directory-entries) ( path -- seq ) + "\\" ?tail drop "\\*" append + find-first-file [ >directory-entry ] dip + [ + '[ + [ _ find-next-file dup ] + [ >directory-entry ] + [ drop ] produce + over name>> "." = [ nip ] [ swap prefix ] if + ] + ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ; + diff --git a/basis/io/encodings/8-bit/8-bit-docs.factor b/basis/io/encodings/8-bit/8-bit-docs.factor index 8f5e955998..9ba4fcf44d 100644 --- a/basis/io/encodings/8-bit/8-bit-docs.factor +++ b/basis/io/encodings/8-bit/8-bit-docs.factor @@ -4,7 +4,7 @@ USING: help.syntax help.markup io.encodings.8-bit.private strings ; IN: io.encodings.8-bit -ARTICLE: "io.encodings.8-bit" "8-bit encodings" +ARTICLE: "io.encodings.8-bit" "Legacy 8-bit encodings" "Many encodings are a simple mapping of bytes onto characters. The " { $vocab-link "io.encodings.8-bit" } " vocabulary implements these generically using existing resource files. These encodings should be used with extreme caution, as fully general Unicode encodings like UTF-8 are nearly always more appropriate. The following 8-bit encodings are already defined:" { $subsection latin1 } { $subsection latin2 } diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index 2cafb6be47..6ac0ed399e 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: math.parser arrays io.encodings sequences kernel assocs hashtables io.encodings.ascii generic parser classes.tuple words -io io.files splitting namespaces math compiler.units accessors ; +words.symbol io io.files splitting namespaces math +compiler.units accessors ; IN: io.encodings.8-bit [ >fixnum ] [ drop replacement-char ] if ] [ 2drop f ] if ; inline + [ [ nip ] [ > ] 2bi [ >fixnum ] [ drop replacement-char ] if ] + [ 2drop f ] if ; inline PRIVATE> SINGLETON: ascii diff --git a/basis/io/encodings/binary/authors.txt b/basis/io/encodings/binary/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/io/encodings/binary/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/io/encodings/binary/binary-docs.factor b/basis/io/encodings/binary/binary-docs.factor new file mode 100644 index 0000000000..4da1e0811f --- /dev/null +++ b/basis/io/encodings/binary/binary-docs.factor @@ -0,0 +1,11 @@ +USING: help.syntax help.markup ; +IN: io.encodings.binary + +HELP: binary +{ $class-description "Encoding descriptor for binary I/O." } ; + +ARTICLE: "io.encodings.binary" "Binary encoding" +"Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." +{ $subsection binary } ; + +ABOUT: "io.encodings.binary" diff --git a/basis/io/encodings/binary/binary.factor b/basis/io/encodings/binary/binary.factor new file mode 100644 index 0000000000..e54163f632 --- /dev/null +++ b/basis/io/encodings/binary/binary.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: io.encodings kernel ; +IN: io.encodings.binary + +SINGLETON: binary +M: binary drop ; +M: binary drop ; diff --git a/basis/io/encodings/binary/summary.txt b/basis/io/encodings/binary/summary.txt new file mode 100644 index 0000000000..a1eb4bc664 --- /dev/null +++ b/basis/io/encodings/binary/summary.txt @@ -0,0 +1 @@ +Dummy encoding for binary I/O diff --git a/basis/io/encodings/binary/tags.txt b/basis/io/encodings/binary/tags.txt new file mode 100644 index 0000000000..8e27be7d61 --- /dev/null +++ b/basis/io/encodings/binary/tags.txt @@ -0,0 +1 @@ +text diff --git a/basis/io/files/info/authors.txt b/basis/io/files/info/authors.txt new file mode 100644 index 0000000000..f372b574ae --- /dev/null +++ b/basis/io/files/info/authors.txt @@ -0,0 +1,2 @@ +Slava Pestov +Doug Coleman diff --git a/basis/io/files/info/info-docs.factor b/basis/io/files/info/info-docs.factor new file mode 100644 index 0000000000..8db780f976 --- /dev/null +++ b/basis/io/files/info/info-docs.factor @@ -0,0 +1,41 @@ +USING: help.markup help.syntax arrays io.files ; +IN: io.files.info + +HELP: file-info +{ $values { "path" "a pathname string" } { "info" file-info } } +{ $description "Queries the file system for metadata. If " { $snippet "path" } " refers to a symbolic link, it is followed. See the article " { $link "file-types" } " for a list of metadata symbols." } +{ $errors "Throws an error if the file does not exist." } ; + +HELP: link-info +{ $values { "path" "a pathname string" } { "info" "a file-info tuple" } } +{ $description "Queries the file system for metadata. If path refers to a symbolic link, information about the symbolic link itself is returned. If the file does not exist, an exception is thrown." } ; + +{ file-info link-info } related-words + +HELP: directory? +{ $values { "file-info" file-info } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "file-info" } " is a directory." } ; + +HELP: file-systems +{ $values { "array" array } } +{ $description "Returns an array of " { $link file-system-info } " objects returned by iterating the mount points and calling " { $link file-system-info } " on each." } ; + +HELP: file-system-info +{ $values +{ "path" "a pathname string" } +{ "file-system-info" file-system-info } } +{ $description "Returns a platform-specific object describing the file-system that contains the path. The cross-platform slot is " { $slot "free-space" } "." } ; + +ARTICLE: "io.files.info" "File system meta-data" +"File meta-data:" +{ $subsection file-info } +{ $subsection link-info } +{ $subsection exists? } +{ $subsection directory? } +"File types:" +{ $subsection "file-types" } +"File system meta-data:" +{ $subsection file-system-info } +{ $subsection file-systems } ; + +ABOUT: "io.files.info" diff --git a/basis/io/files/info/info-tests.factor b/basis/io/files/info/info-tests.factor new file mode 100644 index 0000000000..b94bc0635c --- /dev/null +++ b/basis/io/files/info/info-tests.factor @@ -0,0 +1,19 @@ +USING: io.files.info io.pathnames io.encodings.utf8 io.files +io.directories kernel io.pathnames accessors tools.test +sequences io.files.temp ; +IN: io.files.info.tests + +\ file-info must-infer +\ link-info must-infer + +[ t ] [ + temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory + temp-directory "test41" append-path utf8 file-contents "hi41" = +] unit-test + +[ t ] [ + temp-directory [ "test41" file-info size>> ] with-directory 4 = +] unit-test + +[ t ] [ "/" file-system-info file-system-info? ] unit-test +[ t ] [ file-systems [ file-system-info? ] all? ] unit-test diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor new file mode 100644 index 0000000000..fd21850612 --- /dev/null +++ b/basis/io/files/info/info.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2008 Doug Coleman, Eduardo Cavazos. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel system sequences combinators +vocabs.loader io.files.types ; +IN: io.files.info + +! File info +TUPLE: file-info type size permissions created modified +accessed ; + +HOOK: file-info os ( path -- info ) + +HOOK: link-info os ( path -- info ) + +: directory? ( file-info -- ? ) type>> +directory+ = ; + +! File systems +HOOK: file-systems os ( -- array ) + +TUPLE: file-system-info device-name mount-point type +available-space free-space used-space total-space ; + +HOOK: file-system-info os ( path -- file-system-info ) + +{ + { [ os unix? ] [ "io.files.info.unix." os name>> append ] } + { [ os windows? ] [ "io.files.info.windows" ] } +} cond require \ No newline at end of file diff --git a/basis/io/files/info/summary.txt b/basis/io/files/info/summary.txt new file mode 100644 index 0000000000..5d354fb573 --- /dev/null +++ b/basis/io/files/info/summary.txt @@ -0,0 +1 @@ +File and file system meta-data diff --git a/basis/io/files/info/unix/bsd/bsd.factor b/basis/io/files/info/unix/bsd/bsd.factor new file mode 100644 index 0000000000..6d0f3e7161 --- /dev/null +++ b/basis/io/files/info/unix/bsd/bsd.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel alien.syntax math io.files.unix system +unix.stat accessors combinators calendar.unix +io.files.info.unix ; +IN: io.files.info.unix.bsd + +TUPLE: bsd-file-info < unix-file-info birth-time flags gen ; + +M: bsd new-file-info ( -- class ) bsd-file-info new ; + +M: bsd stat>file-info ( stat -- file-info ) + [ call-next-method ] keep + { + [ stat-st_flags >>flags ] + [ stat-st_gen >>gen ] + [ + stat-st_birthtimespec timespec>unix-time + >>birth-time + ] + } cleave ; diff --git a/basis/io/files/info/unix/bsd/tags.txt b/basis/io/files/info/unix/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/unix/bsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/unix/freebsd/freebsd.factor b/basis/io/files/info/unix/freebsd/freebsd.factor new file mode 100644 index 0000000000..61d7a1d921 --- /dev/null +++ b/basis/io/files/info/unix/freebsd/freebsd.factor @@ -0,0 +1,55 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.syntax combinators +io.backend io.files io.files.info io.files.unix kernel math system unix +unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd +sequences grouping alien.strings io.encodings.utf8 unix.types +specialized-arrays.direct.uint arrays io.files.info.unix ; +IN: io.files.info.unix.freebsd + +TUPLE: freebsd-file-system-info < unix-file-system-info +version io-size owner syncreads syncwrites asyncreads asyncwrites ; + +M: freebsd new-file-system-info freebsd-file-system-info new ; + +M: freebsd file-system-statfs ( path -- byte-array ) + "statfs" [ statfs io-error ] keep ; + +M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-info ) + { + [ statfs-f_version >>version ] + [ statfs-f_type >>type ] + [ statfs-f_flags >>flags ] + [ statfs-f_bsize >>block-size ] + [ statfs-f_iosize >>io-size ] + [ statfs-f_blocks >>blocks ] + [ statfs-f_bfree >>blocks-free ] + [ statfs-f_bavail >>blocks-available ] + [ statfs-f_files >>files ] + [ statfs-f_ffree >>files-free ] + [ statfs-f_syncwrites >>syncwrites ] + [ statfs-f_asyncwrites >>asyncwrites ] + [ statfs-f_syncreads >>syncreads ] + [ statfs-f_asyncreads >>asyncreads ] + [ statfs-f_namemax >>name-max ] + [ statfs-f_owner >>owner ] + [ statfs-f_fsid 2 >array >>id ] + [ statfs-f_fstypename utf8 alien>string >>type ] + [ statfs-f_mntfromname utf8 alien>string >>device-name ] + [ statfs-f_mntonname utf8 alien>string >>mount-point ] + } cleave ; + +M: freebsd file-system-statvfs ( path -- byte-array ) + "statvfs" [ statvfs io-error ] keep ; + +M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info ) + { + [ statvfs-f_favail >>files-available ] + [ statvfs-f_frsize >>preferred-block-size ] + } cleave ; + +M: freebsd file-systems ( -- array ) + f 0 0 getfsstat dup io-error + "statfs" dup dup length 0 getfsstat io-error + "statfs" heap-size group + [ statfs-f_mntonname alien>native-string file-system-info ] map ; diff --git a/basis/io/files/info/unix/freebsd/tags.txt b/basis/io/files/info/unix/freebsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/unix/freebsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor new file mode 100644 index 0000000000..5dddca4f9d --- /dev/null +++ b/basis/io/files/info/unix/linux/linux.factor @@ -0,0 +1,99 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.syntax combinators csv +io.backend io.encodings.utf8 io.files io.files.info io.streams.string +io.files.unix kernel math.order namespaces sequences sorting +system unix unix.statfs.linux unix.statvfs.linux io.files.links +specialized-arrays.direct.uint arrays io.files.info.unix assocs +io.pathnames unix.types ; +IN: io.files.info.unix.linux + +TUPLE: linux-file-system-info < unix-file-system-info +namelen ; + +M: linux new-file-system-info linux-file-system-info new ; + +M: linux file-system-statfs ( path -- byte-array ) + "statfs64" [ statfs64 io-error ] keep ; + +M: linux statfs>file-system-info ( struct -- statfs ) + { + [ statfs64-f_type >>type ] + [ statfs64-f_bsize >>block-size ] + [ statfs64-f_blocks >>blocks ] + [ statfs64-f_bfree >>blocks-free ] + [ statfs64-f_bavail >>blocks-available ] + [ statfs64-f_files >>files ] + [ statfs64-f_ffree >>files-free ] + [ statfs64-f_fsid 2 >array >>id ] + [ statfs64-f_namelen >>namelen ] + [ statfs64-f_frsize >>preferred-block-size ] + ! [ statfs64-f_spare >>spare ] + } cleave ; + +M: linux file-system-statvfs ( path -- byte-array ) + "statvfs64" [ statvfs64 io-error ] keep ; + +M: linux statvfs>file-system-info ( struct -- statfs ) + { + [ statvfs64-f_flag >>flags ] + [ statvfs64-f_namemax >>name-max ] + } cleave ; + +TUPLE: mtab-entry file-system-name mount-point type options +frequency pass-number ; + +: mtab-csv>mtab-entry ( csv -- mtab-entry ) + [ mtab-entry new ] dip + { + [ first >>file-system-name ] + [ second >>mount-point ] + [ third >>type ] + [ fourth csv first >>options ] + [ 4 swap nth >>frequency ] + [ 5 swap nth >>pass-number ] + } cleave ; + +: parse-mtab ( -- array ) + [ + "/etc/mtab" utf8 + CHAR: \s delimiter set csv + ] with-scope + [ mtab-csv>mtab-entry ] map ; + +M: linux file-systems + parse-mtab [ + [ mount-point>> file-system-info ] keep + { + [ file-system-name>> >>device-name ] + [ mount-point>> >>mount-point ] + [ type>> >>type ] + } cleave + ] map ; + +: (find-mount-point) ( path mtab-paths -- mtab-entry ) + [ follow-links ] dip 2dup at* [ + 2nip + ] [ + drop [ parent-directory ] dip (find-mount-point) + ] if ; + +: find-mount-point ( path -- mtab-entry ) + parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc (find-mount-point) ; + +ERROR: file-system-not-found ; + +M: linux file-system-info ( path -- ) + normalize-path + [ + [ new-file-system-info ] dip + [ file-system-statfs statfs>file-system-info ] + [ file-system-statvfs statvfs>file-system-info ] bi + file-system-calculations + ] keep + find-mount-point + { + [ file-system-name>> >>device-name drop ] + [ mount-point>> >>mount-point drop ] + [ type>> >>type ] + } 2cleave ; diff --git a/basis/io/files/info/unix/linux/tags.txt b/basis/io/files/info/unix/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/unix/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/unix/macosx/macosx.factor b/basis/io/files/info/unix/macosx/macosx.factor new file mode 100644 index 0000000000..cfc13ba015 --- /dev/null +++ b/basis/io/files/info/unix/macosx/macosx.factor @@ -0,0 +1,52 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.strings combinators +grouping io.encodings.utf8 io.files kernel math sequences +system unix io.files.unix specialized-arrays.direct.uint arrays +unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx +io.files.info.unix io.files.info ; +IN: io.files.info.unix.macosx + +TUPLE: macosx-file-system-info < unix-file-system-info +io-size owner type-id filesystem-subtype ; + +M: macosx file-systems ( -- array ) + f dup 0 getmntinfo64 dup io-error + [ *void* ] dip + "statfs64" heap-size [ * memory>byte-array ] keep group + [ statfs64-f_mntonname utf8 alien>string file-system-info ] map ; + ! [ [ new-file-system-info ] dip statfs>file-system-info ] map ; + +M: macosx new-file-system-info macosx-file-system-info new ; + +M: macosx file-system-statfs ( normalized-path -- statfs ) + "statfs64" [ statfs64 io-error ] keep ; + +M: macosx file-system-statvfs ( normalized-path -- statvfs ) + "statvfs" [ statvfs io-error ] keep ; + +M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' ) + { + [ statfs64-f_bsize >>block-size ] + [ statfs64-f_iosize >>io-size ] + [ statfs64-f_blocks >>blocks ] + [ statfs64-f_bfree >>blocks-free ] + [ statfs64-f_bavail >>blocks-available ] + [ statfs64-f_files >>files ] + [ statfs64-f_ffree >>files-free ] + [ statfs64-f_fsid 2 >array >>id ] + [ statfs64-f_owner >>owner ] + [ statfs64-f_type >>type-id ] + [ statfs64-f_flags >>flags ] + [ statfs64-f_fssubtype >>filesystem-subtype ] + [ statfs64-f_fstypename utf8 alien>string >>type ] + [ statfs64-f_mntonname utf8 alien>string >>mount-point ] + [ statfs64-f_mntfromname utf8 alien>string >>device-name ] + } cleave ; + +M: macosx statvfs>file-system-info ( file-system-info byte-array -- file-system-info' ) + { + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_namemax >>name-max ] + } cleave ; diff --git a/basis/io/files/info/unix/macosx/tags.txt b/basis/io/files/info/unix/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/unix/macosx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/unix/netbsd/netbsd.factor b/basis/io/files/info/unix/netbsd/netbsd.factor new file mode 100644 index 0000000000..4f284b5f44 --- /dev/null +++ b/basis/io/files/info/unix/netbsd/netbsd.factor @@ -0,0 +1,53 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel unix.stat math unix +combinators system io.backend accessors alien.c-types +io.encodings.utf8 alien.strings unix.types io.files.unix +io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays +grouping sequences io.encodings.utf8 +specialized-arrays.direct.uint io.files.info.unix ; +IN: io.files.info.unix.netbsd + +TUPLE: netbsd-file-system-info < unix-file-system-info +blocks-reserved files-reserved +owner io-size sync-reads sync-writes async-reads async-writes +idx mount-from ; + +M: netbsd new-file-system-info netbsd-file-system-info new ; + +M: netbsd file-system-statvfs + "statvfs" [ statvfs io-error ] keep ; + +M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) + { + [ statvfs-f_flag >>flags ] + [ statvfs-f_bsize >>block-size ] + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_iosize >>io-size ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_bfree >>blocks-free ] + [ statvfs-f_bavail >>blocks-available ] + [ statvfs-f_bresvd >>blocks-reserved ] + [ statvfs-f_files >>files ] + [ statvfs-f_ffree >>files-free ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_fresvd >>files-reserved ] + [ statvfs-f_syncreads >>sync-reads ] + [ statvfs-f_syncwrites >>sync-writes ] + [ statvfs-f_asyncreads >>async-reads ] + [ statvfs-f_asyncwrites >>async-writes ] + [ statvfs-f_fsidx 2 >array >>idx ] + [ statvfs-f_fsid >>id ] + [ statvfs-f_namemax >>name-max ] + [ statvfs-f_owner >>owner ] + ! [ statvfs-f_spare >>spare ] + [ statvfs-f_fstypename utf8 alien>string >>type ] + [ statvfs-f_mntonname utf8 alien>string >>mount-point ] + [ statvfs-f_mntfromname utf8 alien>string >>device-name ] + } cleave ; + +M: netbsd file-systems ( -- array ) + f 0 0 getvfsstat dup io-error + "statvfs" dup dup length 0 getvfsstat io-error + "statvfs" heap-size group + [ statvfs-f_mntonname utf8 alien>string file-system-info ] map ; diff --git a/basis/io/files/info/unix/netbsd/tags.txt b/basis/io/files/info/unix/netbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/unix/netbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/unix/openbsd/openbsd.factor b/basis/io/files/info/unix/openbsd/openbsd.factor new file mode 100644 index 0000000000..0fe4c4bec0 --- /dev/null +++ b/basis/io/files/info/unix/openbsd/openbsd.factor @@ -0,0 +1,55 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.strings alien.syntax +combinators io.backend io.files io.files.info io.files.unix kernel math +sequences system unix unix.getfsstat.openbsd grouping +unix.statfs.openbsd unix.statvfs.openbsd unix.types +specialized-arrays.direct.uint arrays io.files.info.unix ; +IN: io.files.unix.openbsd + +TUPLE: freebsd-file-system-info < unix-file-system-info +io-size sync-writes sync-reads async-writes async-reads +owner ; + +M: openbsd new-file-system-info freebsd-file-system-info new ; + +M: openbsd file-system-statfs + "statfs" [ statfs io-error ] keep ; + +M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info' ) + { + [ statfs-f_flags >>flags ] + [ statfs-f_bsize >>block-size ] + [ statfs-f_iosize >>io-size ] + [ statfs-f_blocks >>blocks ] + [ statfs-f_bfree >>blocks-free ] + [ statfs-f_bavail >>blocks-available ] + [ statfs-f_files >>files ] + [ statfs-f_ffree >>files-free ] + [ statfs-f_favail >>files-available ] + [ statfs-f_syncwrites >>sync-writes ] + [ statfs-f_syncreads >>sync-reads ] + [ statfs-f_asyncwrites >>async-writes ] + [ statfs-f_asyncreads >>async-reads ] + [ statfs-f_fsid 2 >array >>id ] + [ statfs-f_namemax >>name-max ] + [ statfs-f_owner >>owner ] + ! [ statfs-f_spare >>spare ] + [ statfs-f_fstypename alien>native-string >>type ] + [ statfs-f_mntonname alien>native-string >>mount-point ] + [ statfs-f_mntfromname alien>native-string >>device-name ] + } cleave ; + +M: openbsd file-system-statvfs ( normalized-path -- statvfs ) + "statvfs" [ statvfs io-error ] keep ; + +M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) + { + [ statvfs-f_frsize >>preferred-block-size ] + } cleave ; + +M: openbsd file-systems ( -- seq ) + f 0 0 getfsstat dup io-error + "statfs" dup dup length 0 getfsstat io-error + "statfs" heap-size group + [ statfs-f_mntonname alien>native-string file-system-info ] map ; diff --git a/basis/io/files/info/unix/openbsd/tags.txt b/basis/io/files/info/unix/openbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/unix/openbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/unix/tags.txt b/basis/io/files/info/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/unix/unix-docs.factor b/basis/io/files/info/unix/unix-docs.factor new file mode 100644 index 0000000000..a6ee2b9597 --- /dev/null +++ b/basis/io/files/info/unix/unix-docs.factor @@ -0,0 +1,277 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: classes help.markup help.syntax io.streams.string +strings math calendar io.files.info io.files.info.unix ; +IN: io.files.unix + +HELP: file-group-id +{ $values + { "path" "a pathname string" } + { "gid" integer } } +{ $description "Returns the group id for a given file." } ; + +HELP: file-group-name +{ $values + { "path" "a pathname string" } + { "string" string } } +{ $description "Returns the group name for a given file." } ; + +HELP: file-permissions +{ $values + { "path" "a pathname string" } + { "n" integer } } +{ $description "Returns the Unix file permissions for a given file." } ; + +HELP: file-user-name +{ $values + { "path" "a pathname string" } + { "string" string } } +{ $description "Returns the user-name for a given file." } ; + +HELP: file-user-id +{ $values + { "path" "a pathname string" } + { "uid" integer } } +{ $description "Returns the user id for a given file." } ; + +HELP: group-execute? +{ $values + { "obj" "a pathname string or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: group-read? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: group-write? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: other-execute? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: other-read? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: other-write? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: set-file-access-time +{ $values + { "path" "a pathname string" } { "timestamp" timestamp } } +{ $description "Sets a file's last access timestamp." } ; + +HELP: set-file-group +{ $values + { "path" "a pathname string" } { "string/id" "a string or a group id" } } +{ $description "Sets a file's group id from the given group id or group name." } ; + +HELP: set-file-ids +{ $values + { "path" "a pathname string" } { "uid" integer } { "gid" integer } } +{ $description "Sets the user id and group id of a file with a single library call." } ; + +HELP: set-file-permissions +{ $values + { "path" "a pathname string" } { "n" "an integer, interepreted as a string of bits" } } +{ $description "Sets the file permissions for a given file with the supplied Unix permissions integer. Supplying an octal number with " { $link POSTPONE: OCT: } " is recommended." } +{ $examples "Using the tradidional octal value:" + { $unchecked-example "USING: io.files.unix kernel ;" + "\"resource:license.txt\" OCT: 755 set-file-permissions" + "" + } + "Higher-level, setting named bits:" + { $unchecked-example "USING: io.files.unix kernel math.bitwise ;" + "\"resource:license.txt\"" + "{ USER-ALL GROUP-READ GROUP-EXECUTE OTHER-READ OTHER-EXECUTE }" + "flags set-file-permissions" + "" } +} ; + +HELP: set-file-times +{ $values + { "path" "a pathname string" } { "timestamps" "an array of two timestamps" } } +{ $description "Sets the access and write timestamps for a file as provided in the input array. A value of " { $link f } " provided for either of the timestamps will not change that timestamp." } ; + +HELP: set-file-user +{ $values + { "path" "a pathname string" } { "string/id" "a string or a user id" } } +{ $description "Sets a file's user id from the given user id or user-name." } ; + +HELP: set-file-modified-time +{ $values + { "path" "a pathname string" } { "timestamp" timestamp } } +{ $description "Sets a file's last modified timestamp, or write timestamp." } ; + +HELP: set-gid +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "gid" } " bit of a file to true or false." } ; + +HELP: gid? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: set-group-execute +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "group execute" } " bit of a file to true or false." } ; + +HELP: set-group-read +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "group read" } " bit of a file to true or false." } ; + +HELP: set-group-write +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "group write" } " bit of a file to true or false." } ; + +HELP: set-other-execute +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ; + +HELP: set-other-read +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "other read" } " bit of a file to true or false." } ; + +HELP: set-other-write +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ; + +HELP: set-sticky +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "sticky" } " bit of a file to true or false." } ; + +HELP: sticky? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "sticky" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: set-uid +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "uid" } " bit of a file to true or false." } ; + +HELP: uid? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "uid" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: set-user-execute +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "user execute" } " bit of a file to true or false." } ; + +HELP: set-user-read +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "user read" } " bit of a file to true or false." } ; + +HELP: set-user-write +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "user write" } " bit of a file to true or false." } ; + +HELP: user-execute? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: user-read? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +HELP: user-write? +{ $values + { "obj" "a pathname string, file-info object, or an integer" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file, " { $link file-info } ", or an integer." } ; + +ARTICLE: "unix-file-permissions" "Unix file permissions" +"Reading all file permissions:" +{ $subsection file-permissions } +"Reading individual file permissions:" +{ $subsection uid? } +{ $subsection gid? } +{ $subsection sticky? } +{ $subsection user-read? } +{ $subsection user-write? } +{ $subsection user-execute? } +{ $subsection group-read? } +{ $subsection group-write? } +{ $subsection group-execute? } +{ $subsection other-read? } +{ $subsection other-write? } +{ $subsection other-execute? } +"Writing all file permissions:" +{ $subsection set-file-permissions } +"Writing individual file permissions:" +{ $subsection set-uid } +{ $subsection set-gid } +{ $subsection set-sticky } +{ $subsection set-user-read } +{ $subsection set-user-write } +{ $subsection set-user-execute } +{ $subsection set-group-read } +{ $subsection set-group-write } +{ $subsection set-group-execute } +{ $subsection set-other-read } +{ $subsection set-other-write } +{ $subsection set-other-execute } ; + +ARTICLE: "unix-file-timestamps" "Unix file timestamps" +"To read file times, use the accessors on the object returned by the " { $link file-info } " word." $nl +"Setting multiple file times:" +{ $subsection set-file-times } +"Setting just the last access time:" +{ $subsection set-file-access-time } +"Setting just the last modified time:" +{ $subsection set-file-modified-time } ; + + +ARTICLE: "unix-file-ids" "Unix file user and group ids" +"Reading file user data:" +{ $subsection file-user-id } +{ $subsection file-user-name } +"Setting file user data:" +{ $subsection set-file-user } +"Reading file group data:" +{ $subsection file-group-id } +{ $subsection file-group-name } +"Setting file group data:" +{ $subsection set-file-group } ; + + +ARTICLE: "io.files.info.unix" "Unix file attributes" +"The " { $vocab-link "io.files.info.unix" } " vocabulary implements a high-level way to set Unix-specific permissions, timestamps, and user and group IDs for files." +{ $subsection "unix-file-permissions" } +{ $subsection "unix-file-timestamps" } +{ $subsection "unix-file-ids" } ; + +ABOUT: "io.files.info.unix" diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor new file mode 100644 index 0000000000..b7edc14c2c --- /dev/null +++ b/basis/io/files/info/unix/unix.factor @@ -0,0 +1,273 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel system math math.bitwise strings arrays +sequences combinators combinators.short-circuit alien.c-types +vocabs.loader calendar calendar.unix io.files.info +io.files.types io.backend unix unix.stat unix.time unix.users +unix.groups ; +IN: io.files.info.unix + +TUPLE: unix-file-system-info < file-system-info +block-size preferred-block-size +blocks blocks-free blocks-available +files files-free files-available +name-max flags id ; + +HOOK: new-file-system-info os ( -- file-system-info ) + +M: unix new-file-system-info ( -- ) unix-file-system-info new ; + +HOOK: file-system-statfs os ( path -- statfs ) + +M: unix file-system-statfs drop f ; + +HOOK: file-system-statvfs os ( path -- statvfs ) + +M: unix file-system-statvfs drop f ; + +HOOK: statfs>file-system-info os ( file-system-info statfs -- file-system-info' ) + +M: unix statfs>file-system-info drop ; + +HOOK: statvfs>file-system-info os ( file-system-info statvfs -- file-system-info' ) + +M: unix statvfs>file-system-info drop ; + +: file-system-calculations ( file-system-info -- file-system-info' ) + dup [ blocks-available>> ] [ block-size>> ] bi * >>available-space + dup [ blocks-free>> ] [ block-size>> ] bi * >>free-space + dup [ blocks>> ] [ block-size>> ] bi * >>total-space + dup [ total-space>> ] [ free-space>> ] bi - >>used-space ; + +M: unix file-system-info + normalize-path + [ new-file-system-info ] dip + [ file-system-statfs statfs>file-system-info ] + [ file-system-statvfs statvfs>file-system-info ] bi + file-system-calculations ; + +TUPLE: unix-file-info < file-info uid gid dev ino +nlink rdev blocks blocksize ; + +HOOK: new-file-info os ( -- file-info ) + +HOOK: stat>file-info os ( stat -- file-info ) + +HOOK: stat>type os ( stat -- file-info ) + +M: unix file-info ( path -- info ) + normalize-path file-status stat>file-info ; + +M: unix link-info ( path -- info ) + normalize-path link-status stat>file-info ; + +M: unix new-file-info ( -- class ) unix-file-info new ; + +M: unix stat>file-info ( stat -- file-info ) + [ new-file-info ] dip + { + [ stat>type >>type ] + [ stat-st_size >>size ] + [ stat-st_mode >>permissions ] + [ stat-st_ctimespec timespec>unix-time >>created ] + [ stat-st_mtimespec timespec>unix-time >>modified ] + [ stat-st_atimespec timespec>unix-time >>accessed ] + [ stat-st_uid >>uid ] + [ stat-st_gid >>gid ] + [ stat-st_dev >>dev ] + [ stat-st_ino >>ino ] + [ stat-st_nlink >>nlink ] + [ stat-st_rdev >>rdev ] + [ stat-st_blocks >>blocks ] + [ stat-st_blksize >>blocksize ] + } cleave ; + +: n>file-type ( n -- type ) + S_IFMT bitand { + { S_IFREG [ +regular-file+ ] } + { S_IFDIR [ +directory+ ] } + { S_IFCHR [ +character-device+ ] } + { S_IFBLK [ +block-device+ ] } + { S_IFIFO [ +fifo+ ] } + { S_IFLNK [ +symbolic-link+ ] } + { S_IFSOCK [ +socket+ ] } + [ drop +unknown+ ] + } case ; + +M: unix stat>type ( stat -- type ) + stat-st_mode n>file-type ; + +> ] dip mask? ; + +PRIVATE> + +: UID OCT: 0004000 ; inline +: GID OCT: 0002000 ; inline +: STICKY OCT: 0001000 ; inline +: USER-ALL OCT: 0000700 ; inline +: USER-READ OCT: 0000400 ; inline +: USER-WRITE OCT: 0000200 ; inline +: USER-EXECUTE OCT: 0000100 ; inline +: GROUP-ALL OCT: 0000070 ; inline +: GROUP-READ OCT: 0000040 ; inline +: GROUP-WRITE OCT: 0000020 ; inline +: GROUP-EXECUTE OCT: 0000010 ; inline +: OTHER-ALL OCT: 0000007 ; inline +: OTHER-READ OCT: 0000004 ; inline +: OTHER-WRITE OCT: 0000002 ; inline +: OTHER-EXECUTE OCT: 0000001 ; inline + +: uid? ( obj -- ? ) UID file-mode? ; +: gid? ( obj -- ? ) GID file-mode? ; +: sticky? ( obj -- ? ) STICKY file-mode? ; +: user-read? ( obj -- ? ) USER-READ file-mode? ; +: user-write? ( obj -- ? ) USER-WRITE file-mode? ; +: user-execute? ( obj -- ? ) USER-EXECUTE file-mode? ; +: group-read? ( obj -- ? ) GROUP-READ file-mode? ; +: group-write? ( obj -- ? ) GROUP-WRITE file-mode? ; +: group-execute? ( obj -- ? ) GROUP-EXECUTE file-mode? ; +: other-read? ( obj -- ? ) OTHER-READ file-mode? ; +: other-write? ( obj -- ? ) OTHER-WRITE file-mode? ; +: other-execute? ( obj -- ? ) OTHER-EXECUTE file-mode? ; + +: any-read? ( obj -- ? ) + { [ user-read? ] [ group-read? ] [ other-read? ] } 1|| ; + +: any-write? ( obj -- ? ) + { [ user-write? ] [ group-write? ] [ other-write? ] } 1|| ; + +: any-execute? ( obj -- ? ) + { [ user-execute? ] [ group-execute? ] [ other-execute? ] } 1|| ; + +: set-uid ( path ? -- ) UID swap chmod-set-bit ; +: set-gid ( path ? -- ) GID swap chmod-set-bit ; +: set-sticky ( path ? -- ) STICKY swap chmod-set-bit ; +: set-user-read ( path ? -- ) USER-READ swap chmod-set-bit ; +: set-user-write ( path ? -- ) USER-WRITE swap chmod-set-bit ; +: set-user-execute ( path ? -- ) USER-EXECUTE swap chmod-set-bit ; +: set-group-read ( path ? -- ) GROUP-READ swap chmod-set-bit ; +: set-group-write ( path ? -- ) GROUP-WRITE swap chmod-set-bit ; +: set-group-execute ( path ? -- ) GROUP-EXECUTE swap chmod-set-bit ; +: set-other-read ( path ? -- ) OTHER-READ swap chmod-set-bit ; +: set-other-write ( path ? -- ) OTHER-WRITE swap chmod-set-bit ; +: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ; + +: set-file-permissions ( path n -- ) + [ normalize-path ] dip chmod io-error ; + +: file-permissions ( path -- n ) + normalize-path file-info permissions>> ; + + ] unless* ] map concat ; + +: timestamp>timeval ( timestamp -- timeval ) + unix-1970 time- duration>microseconds make-timeval ; + +: timestamps>byte-array ( timestamps -- byte-array ) + [ dup [ timestamp>timeval ] when ] map make-timeval-array ; + +PRIVATE> + +: set-file-times ( path timestamps -- ) + #! set access, write + [ normalize-path ] dip + timestamps>byte-array utimes io-error ; + +: set-file-access-time ( path timestamp -- ) + f 2array set-file-times ; + +: set-file-modified-time ( path timestamp -- ) + f swap 2array set-file-times ; + +: set-file-ids ( path uid gid -- ) + [ normalize-path ] 2dip + [ [ -1 ] unless* ] bi@ chown io-error ; + +GENERIC: set-file-user ( path string/id -- ) + +GENERIC: set-file-group ( path string/id -- ) + +M: integer set-file-user ( path uid -- ) + f set-file-ids ; + +M: string set-file-user ( path string -- ) + user-id f set-file-ids ; + +M: integer set-file-group ( path gid -- ) + f swap set-file-ids ; + +M: string set-file-group ( path string -- ) + group-id + f swap set-file-ids ; + +: file-user-id ( path -- uid ) + normalize-path file-info uid>> ; + +: file-user-name ( path -- string ) + file-user-id user-name ; + +: file-group-id ( path -- gid ) + normalize-path file-info gid>> ; + +: file-group-name ( path -- string ) + file-group-id group-name ; + +: ch>file-type ( ch -- type ) + { + { CHAR: b [ +block-device+ ] } + { CHAR: c [ +character-device+ ] } + { CHAR: d [ +directory+ ] } + { CHAR: l [ +symbolic-link+ ] } + { CHAR: s [ +socket+ ] } + { CHAR: p [ +fifo+ ] } + { CHAR: - [ +regular-file+ ] } + [ drop +unknown+ ] + } case ; + +: file-type>ch ( type -- ch ) + { + { +block-device+ [ CHAR: b ] } + { +character-device+ [ CHAR: c ] } + { +directory+ [ CHAR: d ] } + { +symbolic-link+ [ CHAR: l ] } + { +socket+ [ CHAR: s ] } + { +fifo+ [ CHAR: p ] } + { +regular-file+ [ CHAR: - ] } + [ drop CHAR: - ] + } case ; + +executable ( directory-entry -- string ) + name>> any-execute? "*" "" ? ; + +PRIVATE> + +: file-type>trailing ( directory-entry -- string ) + dup type>> + { + { +directory+ [ drop "/" ] } + { +symbolic-link+ [ drop "@" ] } + { +fifo+ [ drop "|" ] } + { +socket+ [ drop "=" ] } + { +whiteout+ [ drop "%" ] } + { +unknown+ [ file-type>executable ] } + { +regular-file+ [ file-type>executable ] } + [ drop file-type>executable ] + } case ; diff --git a/basis/io/files/info/windows/tags.txt b/basis/io/files/info/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/info/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor new file mode 100755 index 0000000000..cf826a59d3 --- /dev/null +++ b/basis/io/files/info/windows/windows.factor @@ -0,0 +1,201 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: byte-arrays math io.backend io.files.info +io.files.windows io.files.windows.nt kernel windows.kernel32 +windows.time windows accessors alien.c-types combinators +generalizations system alien.strings io.encodings.utf16n +sequences splitting windows.errors fry continuations destructors +calendar ascii combinators.short-circuit ; +IN: io.files.info.windows + +TUPLE: windows-file-info < file-info attributes ; + +: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) + [ \ windows-file-info new ] dip + { + [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ] + [ + [ WIN32_FIND_DATA-nFileSizeLow ] + [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size + ] + [ WIN32_FIND_DATA-dwFileAttributes >>permissions ] + [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ] + [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ] + [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ] + } cleave ; + +: find-first-file-stat ( path -- WIN32_FIND_DATA ) + "WIN32_FIND_DATA" [ + FindFirstFile + [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep + FindClose win32-error=0/f + ] keep ; + +: BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info ) + [ \ windows-file-info new ] dip + { + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ] + [ + [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] + [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size + ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ] + [ + BY_HANDLE_FILE_INFORMATION-ftCreationTime + FILETIME>timestamp >>created + ] + [ + BY_HANDLE_FILE_INFORMATION-ftLastWriteTime + FILETIME>timestamp >>modified + ] + [ + BY_HANDLE_FILE_INFORMATION-ftLastAccessTime + FILETIME>timestamp >>accessed + ] + ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ] + ! [ + ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ] + ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit + ! ] + } cleave ; + +: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION ) + [ + "BY_HANDLE_FILE_INFORMATION" + [ GetFileInformationByHandle win32-error=0/f ] keep + ] keep CloseHandle win32-error=0/f ; + +: get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION ) + dup + GENERIC_READ FILE_SHARE_READ f + OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f + CreateFileW dup INVALID_HANDLE_VALUE = [ + drop find-first-file-stat WIN32_FIND_DATA>file-info + ] [ + nip + get-file-information BY_HANDLE_FILE_INFORMATION>file-info + ] if ; + +M: windows file-info ( path -- info ) + normalize-path get-file-information-stat ; + +M: windows link-info ( path -- info ) + file-info ; + +: volume-information ( normalized-path -- volume-name volume-serial max-component flags type ) + MAX_PATH 1+ [ ] keep + "DWORD" + "DWORD" + "DWORD" + MAX_PATH 1+ [ ] keep + [ GetVolumeInformation win32-error=0/f ] 7 nkeep + drop 5 nrot drop + [ utf16n alien>string ] 4 ndip + utf16n alien>string ; + +: file-system-space ( normalized-path -- available-space total-space free-space ) + "ULARGE_INTEGER" + "ULARGE_INTEGER" + "ULARGE_INTEGER" + [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; + +: calculate-file-system-info ( file-system-info -- file-system-info' ) + [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] keep ; + +TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ; + +ERROR: not-absolute-path ; + +: root-directory ( string -- string' ) + unicode-prefix ?head drop + dup { + [ length 2 >= ] + [ second CHAR: : = ] + [ first Letter? ] + } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; + +M: winnt file-system-info ( path -- file-system-info ) + normalize-path root-directory + dup [ volume-information ] [ file-system-space ] bi + \ win32-file-system-info new + swap *ulonglong >>free-space + swap *ulonglong >>total-space + swap *ulonglong >>available-space + swap >>type + swap *uint >>flags + swap *uint >>max-component + swap *uint >>device-serial + swap >>device-name + swap >>mount-point + calculate-file-system-info ; + +: volume>paths ( string -- array ) + 16384 "ushort" tuck dup length + 0 dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [ + win32-error-string throw + ] [ + *uint "ushort" heap-size * head + utf16n alien>string CHAR: \0 split + ] if ; + +: find-first-volume ( -- string handle ) + MAX_PATH 1+ [ ] keep + dupd + FindFirstVolume dup win32-error=0/f + [ utf16n alien>string ] dip ; + +: find-next-volume ( handle -- string/f ) + MAX_PATH 1+ [ tuck ] keep + FindNextVolume 0 = [ + GetLastError ERROR_NO_MORE_FILES = + [ drop f ] [ win32-error-string throw ] if + ] [ + utf16n alien>string + ] if ; + +: find-volumes ( -- array ) + find-first-volume + [ + '[ + [ _ find-next-volume dup ] + [ ] + [ drop ] produce + swap prefix + ] + ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; + +M: winnt file-systems ( -- array ) + find-volumes [ volume>paths ] map + concat [ + [ file-system-info ] + [ drop \ file-system-info new swap >>mount-point ] recover + ] map ; + +: file-times ( path -- timestamp timestamp timestamp ) + [ + normalize-path open-existing &dispose handle>> + "FILETIME" + "FILETIME" + "FILETIME" + [ GetFileTime win32-error=0/f ] 3keep + [ FILETIME>timestamp >local-time ] tri@ + ] with-destructors ; + +: set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) + #! timestamp order: creation access write + [ + [ + normalize-path open-existing &dispose handle>> + ] 3dip (set-file-times) + ] with-destructors ; + +: set-file-create-time ( path timestamp -- ) + f f set-file-times ; + +: set-file-access-time ( path timestamp -- ) + [ f ] dip f set-file-times ; + +: set-file-write-time ( path timestamp -- ) + [ f f ] dip set-file-times ; diff --git a/basis/io/files/links/authors.txt b/basis/io/files/links/authors.txt new file mode 100644 index 0000000000..f372b574ae --- /dev/null +++ b/basis/io/files/links/authors.txt @@ -0,0 +1,2 @@ +Slava Pestov +Doug Coleman diff --git a/basis/io/files/links/links-docs.factor b/basis/io/files/links/links-docs.factor new file mode 100644 index 0000000000..8419399c92 --- /dev/null +++ b/basis/io/files/links/links-docs.factor @@ -0,0 +1,56 @@ +USING: help.markup help.syntax io.files.info math ; +IN: io.files.links + +HELP: make-link +{ $values { "target" "a path to the symbolic link's target" } { "symlink" "a path to new symbolic link" } } +{ $description "Creates a symbolic link." } ; + +HELP: read-link +{ $values { "symlink" "a path to an existing symbolic link" } { "path" "the path pointed to by the symbolic link" } } +{ $description "Reads the symbolic link and returns its target path." } ; + +HELP: copy-link +{ $values { "target" "a path to an existing symlink" } { "symlink" "a path to a new symbolic link" } } +{ $description "Copies a symbolic link without following the link." } ; + +HELP: follow-link +{ $values + { "path" "a pathname string" } + { "path'" "a pathname string" } +} +{ $description "Returns an absolute path from " { $link read-link } "." } ; + +HELP: follow-links +{ $values + { "path" "a pathname string" } + { "path'" "a pathname string" } +} +{ $description "Follows a chain of symlinks up to " { $link symlink-depth } "." } ; + +{ read-link follow-link follow-links } related-words + +HELP: symlink-depth +{ $values + { "value" integer } +} +{ $description "The number of redirections " { $link follow-links } " will follow." } ; + +HELP: too-many-symlinks +{ $values + { "path" "a pathname string" } { "n" integer } +} +{ $description "An error thrown when the number of redirections in a chain of symlinks surpasses the value in the " { $link symlink-depth } " variable." } ; + +ARTICLE: "io.files.links" "Symbolic links" +"Reading links:" +{ $subsection read-link } +{ $subsection follow-link } +{ $subsection follow-links } +"Creating links:" +{ $subsection make-link } +"Copying links:" +{ $subsection copy-link } +"Not all operating systems support symbolic links." +{ $see-also link-info } ; + +ABOUT: "io.files.links" diff --git a/basis/io/files/links/links.factor b/basis/io/files/links/links.factor new file mode 100644 index 0000000000..1212d579db --- /dev/null +++ b/basis/io/files/links/links.factor @@ -0,0 +1,35 @@ +! Copyright (C) 2008 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors io.backend io.files.info io.files.types +io.pathnames kernel math namespaces system vocabs.loader ; +IN: io.files.links + +HOOK: make-link os ( target symlink -- ) + +HOOK: read-link os ( symlink -- path ) + +: copy-link ( target symlink -- ) + [ read-link ] dip make-link ; + +os unix? [ "io.files.links.unix" require ] when + +: follow-link ( path -- path' ) + [ parent-directory ] [ read-link ] bi append-path ; + +SYMBOL: symlink-depth +10 symlink-depth set-global + +ERROR: too-many-symlinks path n ; + +> +symbolic-link+ = + [ [ 1- ] [ follow-link ] bi* (follow-links) ] + [ nip ] if ; inline recursive + +PRIVATE> + +: follow-links ( path -- path' ) + [ symlink-depth get ] dip normalize-path (follow-links) ; diff --git a/basis/io/files/links/summary.txt b/basis/io/files/links/summary.txt new file mode 100644 index 0000000000..6f5e4598db --- /dev/null +++ b/basis/io/files/links/summary.txt @@ -0,0 +1 @@ +Working with symbolic links diff --git a/basis/io/files/links/unix/tags.txt b/basis/io/files/links/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/links/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/links/unix/unix-tests.factor b/basis/io/files/links/unix/unix-tests.factor new file mode 100644 index 0000000000..dd5eb5c8d9 --- /dev/null +++ b/basis/io/files/links/unix/unix-tests.factor @@ -0,0 +1,38 @@ +USING: io.directories io.files.links tools.test sequences +io.files.unique tools.files fry math kernel math.parser +io.pathnames namespaces ; +IN: io.files.links.unix.tests + +: make-test-links ( n path -- ) + [ '[ [ 1+ ] keep [ number>string _ prepend ] bi@ make-link ] each ] + [ [ number>string ] dip prepend touch-file ] 2bi ; inline + +[ t ] [ + [ + current-temporary-directory get [ + 5 "lol" make-test-links + "lol1" follow-links + current-temporary-directory get "lol5" append-path = + ] with-directory + ] cleanup-unique-directory +] unit-test + +[ + [ + current-temporary-directory get [ + 100 "laf" make-test-links "laf1" follow-links + ] with-directory + ] with-unique-directory +] [ too-many-symlinks? ] must-fail-with + +[ t ] [ + 110 symlink-depth [ + [ + current-temporary-directory get [ + 100 "laf" make-test-links + "laf1" follow-links + current-temporary-directory get "laf100" append-path = + ] with-directory + ] cleanup-unique-directory + ] with-variable +] unit-test diff --git a/basis/io/files/links/unix/unix.factor b/basis/io/files/links/unix/unix.factor new file mode 100644 index 0000000000..2f38c39e02 --- /dev/null +++ b/basis/io/files/links/unix/unix.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.backend io.files.links system unix ; +IN: io.files.links.unix + +M: unix make-link ( path1 path2 -- ) + normalize-path symlink io-error ; + +M: unix read-link ( path -- path' ) + normalize-path read-symbolic-link ; diff --git a/basis/io/files/temp/temp-docs.factor b/basis/io/files/temp/temp-docs.factor new file mode 100644 index 0000000000..e9f49283de --- /dev/null +++ b/basis/io/files/temp/temp-docs.factor @@ -0,0 +1,9 @@ +USING: help.markup help.syntax ; +IN: io.files.temp + +ARTICLE: "io.files.temp" "Temporary files" +"Pathnames relative to Factor's temporary files directory:" +{ $subsection temp-directory } +{ $subsection temp-file } ; + +ABOUT: "io.files.temp" diff --git a/basis/io/files/temp/temp.factor b/basis/io/files/temp/temp.factor new file mode 100644 index 0000000000..7ace21932a --- /dev/null +++ b/basis/io/files/temp/temp.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel io.pathnames io.directories ; +IN: io.files.temp + +: temp-directory ( -- path ) + "temp" resource-path dup make-directories ; + +: temp-file ( name -- path ) + temp-directory prepend-path ; \ No newline at end of file diff --git a/basis/io/files/types/types-docs.factor b/basis/io/files/types/types-docs.factor new file mode 100644 index 0000000000..a6402851ea --- /dev/null +++ b/basis/io/files/types/types-docs.factor @@ -0,0 +1,40 @@ +USING: help.markup help.syntax ; +IN: io.files.types + +HELP: +regular-file+ +{ $description "A regular file. This type exists on all platforms. See " { $link "io.files" } " for words operating on files." } ; + +HELP: +directory+ +{ $description "A directory. This type exists on all platforms. See " { $link "io.directories" } " for words operating on directories." } ; + +HELP: +symbolic-link+ +{ $description "A symbolic link file. This type is currently implemented on Unix platforms only. See " { $link "io.files.links" } " for words operating on symbolic links." } ; + +HELP: +character-device+ +{ $description "A Unix character device file. This type exists on Unix platforms only." } ; + +HELP: +block-device+ +{ $description "A Unix block device file. This type exists on Unix platforms only." } ; + +HELP: +fifo+ +{ $description "A Unix fifo file. This type exists on Unix platforms only." } ; + +HELP: +socket+ +{ $description "A Unix socket file. This type exists on Unix platforms only." } ; + +HELP: +unknown+ +{ $description "A unknown file type." } ; + +ARTICLE: "file-types" "File types" +"Platform-independent types:" +{ $subsection +regular-file+ } +{ $subsection +directory+ } +"Platform-specific types:" +{ $subsection +character-device+ } +{ $subsection +block-device+ } +{ $subsection +fifo+ } +{ $subsection +symbolic-link+ } +{ $subsection +socket+ } +{ $subsection +unknown+ } ; + +ABOUT: "file-types" diff --git a/basis/io/files/types/types.factor b/basis/io/files/types/types.factor new file mode 100644 index 0000000000..bf8be9ec9b --- /dev/null +++ b/basis/io/files/types/types.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: io.files.types + +SYMBOL: +regular-file+ +SYMBOL: +directory+ +SYMBOL: +symbolic-link+ +SYMBOL: +character-device+ +SYMBOL: +block-device+ +SYMBOL: +fifo+ +SYMBOL: +socket+ +SYMBOL: +whiteout+ +SYMBOL: +unknown+ diff --git a/basis/io/files/unique/unique-docs.factor b/basis/io/files/unique/unique-docs.factor index bfde09dc48..b8a4431a73 100644 --- a/basis/io/files/unique/unique-docs.factor +++ b/basis/io/files/unique/unique-docs.factor @@ -1,8 +1,9 @@ USING: help.markup help.syntax io io.ports kernel math -io.files.unique.private math.parser io.files ; +io.pathnames io.directories math.parser io.files strings +quotations io.files.unique.private ; IN: io.files.unique -HELP: temporary-path +HELP: default-temporary-directory { $values { "path" "a pathname string" } } @@ -25,42 +26,66 @@ HELP: unique-retries HELP: make-unique-file ( prefix suffix -- path ) { $values { "prefix" "a string" } { "suffix" "a string" } { "path" "a pathname string" } } -{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } +{ $description "Creates a file that is guaranteed not to exist in the directory stored in " { $link current-temporary-directory } ". The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } { $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ; -HELP: make-unique-file* -{ $values - { "prefix" null } { "suffix" null } - { "path" "a pathname string" } -} -{ $description "Creates a file that is guaranteed not to exist in the directory in the " { $link current-directory } " variable. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } ; +{ unique-file make-unique-file cleanup-unique-file } related-words -{ make-unique-file make-unique-file* with-unique-file } related-words - -HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- ) +HELP: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- ) { $values { "prefix" "a string" } { "suffix" "a string" } { "quot" "a quotation" } } { $description "Creates a file with " { $link make-unique-file } " and calls the quotation with the path name on the stack." } { $notes "The unique file will be deleted after calling this word." } ; -HELP: make-unique-directory ( -- path ) +HELP: unique-directory ( -- path ) { $values { "path" "a pathname string" } } -{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." } +{ $description "Creates a directory in the value in " { $link current-temporary-directory } " that is guaranteed not to exist in and returns the full pathname." } { $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ; -HELP: with-unique-directory ( quot -- ) +HELP: cleanup-unique-directory ( quot -- ) { $values { "quot" "a quotation" } } -{ $description "Creates a directory with " { $link make-unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-directory } " combinator. The quotation can access the " { $link current-directory } " symbol for the name of the temporary directory." } -{ $notes "The directory will be deleted after calling this word, even if an error is thrown in the quotation." } ; +{ $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." } +{ $notes "The directory will be deleted after calling this word, even if an error is thrown in the quotation. This combinator is like " { $link with-unique-directory } " but does not delete the directory." } ; + +HELP: with-unique-directory +{ $values + { "quot" quotation } + { "path" "a pathname string" } +} +{ $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." } ; + +HELP: current-temporary-directory +{ $values + { "value" "a path" } +} +{ $description "The temporary directory used for creating unique files and directories." } ; + +HELP: unique-file +{ $values + { "path" "a pathname string" } + { "path'" "a pathname string" } +} +{ $description "Creates a temporary file in the directory stored in " { $link current-temporary-directory } " and outputs the path name." } ; + +HELP: with-temporary-directory +{ $values + { "path" "a pathname string" } { "quot" quotation } +} +{ $description "Sets " { $link current-temporary-directory } " to " { $snippet "path" } " and calls the quotation, restoring the previous temporary path after execution completes." } ; -ARTICLE: "io.files.unique" "Temporary files" -"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl -"Files:" +ARTICLE: "io.files.unique" "Unique files" +"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform unique file creation in temporary directories in a high-level and secure way." $nl +"Changing the temporary path:" +{ $subsection current-temporary-directory } +"Creating unique files:" +{ $subsection unique-file } +{ $subsection cleanup-unique-file } { $subsection make-unique-file } -{ $subsection make-unique-file* } -{ $subsection with-unique-file } -"Directories:" -{ $subsection make-unique-directory } -{ $subsection with-unique-directory } ; +"Creating unique directories:" +{ $subsection unique-directory } +{ $subsection with-unique-directory } +{ $subsection cleanup-unique-directory } +"Default temporary directory:" +{ $subsection default-temporary-directory } ; ABOUT: "io.files.unique" diff --git a/basis/io/files/unique/unique-tests.factor b/basis/io/files/unique/unique-tests.factor index 178e4572d0..fd8cf2c69f 100644 --- a/basis/io/files/unique/unique-tests.factor +++ b/basis/io/files/unique/unique-tests.factor @@ -1,20 +1,41 @@ USING: io.encodings.ascii sequences strings io io.files accessors -tools.test kernel io.files.unique namespaces continuations ; +tools.test kernel io.files.unique namespaces continuations +io.files.info io.pathnames io.directories ; IN: io.files.unique.tests [ 123 ] [ "core" ".test" [ [ [ 123 CHAR: a ] dip ascii set-file-contents ] [ file-info size>> ] bi - ] with-unique-file + ] cleanup-unique-file ] unit-test [ t ] [ - [ current-directory get file-info directory? ] with-unique-directory + [ current-directory get file-info directory? ] cleanup-unique-directory ] unit-test [ t ] [ current-directory get - [ [ "FAILDOG" throw ] with-unique-directory ] [ drop ] recover + [ [ "FAILDOG" throw ] cleanup-unique-directory ] [ drop ] recover current-directory get = ] unit-test + +[ t ] [ + [ + "asdf" unique-file drop + "asdf2" unique-file drop + current-temporary-directory get directory-files length 2 = + ] cleanup-unique-directory +] unit-test + +[ t ] [ + [ ] with-unique-directory >boolean +] unit-test + +[ t ] [ + [ + "asdf" unique-file drop + "asdf" unique-file drop + current-temporary-directory get directory-files length 2 = + ] with-unique-directory drop +] unit-test diff --git a/basis/io/files/unique/unique.factor b/basis/io/files/unique/unique.factor index 66540fb48e..7bd96aa63b 100644 --- a/basis/io/files/unique/unique.factor +++ b/basis/io/files/unique/unique.factor @@ -1,12 +1,18 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.bitwise math.parser random sequences -continuations namespaces io.files io arrays system -combinators vocabs.loader fry io.backend ; +USING: arrays combinators continuations fry io io.backend +io.directories io.directories.hierarchy io.files io.pathnames +kernel math math.bitwise math.parser namespaces random +sequences system vocabs.loader ; IN: io.files.unique -HOOK: touch-unique-file io-backend ( path -- ) -HOOK: temporary-path io-backend ( -- path ) +HOOK: (touch-unique-file) io-backend ( path -- ) +: touch-unique-file ( path -- ) + normalize-path (touch-unique-file) ; + +HOOK: default-temporary-directory io-backend ( -- path ) + +SYMBOL: current-temporary-directory SYMBOL: unique-length SYMBOL: unique-retries @@ -14,6 +20,9 @@ SYMBOL: unique-retries 10 unique-length set-global 10 unique-retries set-global +: with-temporary-directory ( path quot -- ) + [ current-temporary-directory ] dip with-variable ; inline + +: random-name ( -- string ) + unique-length get [ random-ch ] "" replicate-as ; : (make-unique-file) ( path prefix suffix -- path ) '[ - _ _ _ unique-length get random-name glue append-path + _ _ _ random-name glue append-path dup touch-unique-file ] unique-retries get retry ; -: make-unique-file ( prefix suffix -- path ) - [ temporary-path ] 2dip (make-unique-file) ; +PRIVATE> -: make-unique-file* ( prefix suffix -- path ) - [ current-directory get ] 2dip (make-unique-file) ; +: make-unique-file ( prefix suffix -- path ) + [ current-temporary-directory get ] 2dip (make-unique-file) ; -: with-unique-file ( prefix suffix quot: ( path -- ) -- ) +: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- ) [ make-unique-file ] dip [ delete-file ] bi ; inline -: make-unique-directory ( -- path ) +: unique-directory ( -- path ) [ - temporary-path unique-length get random-name append-path + current-temporary-directory get + random-name append-path dup make-directory ] unique-retries get retry ; -: with-unique-directory ( quot: ( -- ) -- ) - [ make-unique-directory ] dip - '[ _ with-directory ] [ delete-tree ] bi ; inline +: with-unique-directory ( quot -- path ) + [ unique-directory ] dip + [ with-temporary-directory ] [ drop ] 2bi ; inline + +: cleanup-unique-directory ( quot: ( -- ) -- ) + [ unique-directory ] dip + '[ _ with-temporary-directory ] [ delete-tree ] bi ; inline + +: unique-file ( path -- path' ) + "" make-unique-file ; { - { [ os unix? ] [ "io.unix.files.unique" ] } - { [ os windows? ] [ "io.windows.files.unique" ] } + { [ os unix? ] [ "io.files.unique.unix" ] } + { [ os windows? ] [ "io.files.unique.windows" ] } } cond require + +default-temporary-directory current-temporary-directory set-global diff --git a/basis/io/files/unique/unix/tags.txt b/basis/io/files/unique/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/unique/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/unique/unix/unix.factor b/basis/io/files/unique/unix/unix.factor new file mode 100644 index 0000000000..9f35f440c7 --- /dev/null +++ b/basis/io/files/unique/unix/unix.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel io.ports io.backend.unix math.bitwise +unix system io.files.unique ; +IN: io.files.unique.unix + +: open-unique-flags ( -- flags ) + { O_RDWR O_CREAT O_EXCL } flags ; + +M: unix (touch-unique-file) ( path -- ) + open-unique-flags file-mode open-file close-file ; + +M: unix default-temporary-directory ( -- path ) "/tmp" ; diff --git a/basis/io/files/unique/windows/tags.txt b/basis/io/files/unique/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/unique/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/unique/windows/windows.factor b/basis/io/files/unique/windows/windows.factor new file mode 100644 index 0000000000..2c722426dc --- /dev/null +++ b/basis/io/files/unique/windows/windows.factor @@ -0,0 +1,10 @@ +USING: kernel system windows.kernel32 io.backend.windows +io.files.windows io.ports windows destructors environment +io.files.unique ; +IN: io.files.unique.windows + +M: windows (touch-unique-file) ( path -- ) + GENERIC_WRITE CREATE_NEW 0 open-file dispose ; + +M: windows default-temporary-directory ( -- path ) + "TEMP" os-env ; diff --git a/basis/io/files/unix/authors.txt b/basis/io/files/unix/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/files/unix/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/files/unix/summary.txt b/basis/io/files/unix/summary.txt new file mode 100644 index 0000000000..57527bef70 --- /dev/null +++ b/basis/io/files/unix/summary.txt @@ -0,0 +1 @@ +Implementation of reading and writing files on Unix-like systems diff --git a/basis/io/files/unix/tags.txt b/basis/io/files/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/unix/unix-tests.factor b/basis/io/files/unix/unix-tests.factor new file mode 100644 index 0000000000..d2f4494b0c --- /dev/null +++ b/basis/io/files/unix/unix-tests.factor @@ -0,0 +1,165 @@ +USING: tools.test io.files io.files.temp io.pathnames +io.directories io.files.info io.files.info.unix continuations +kernel io.files.unix math.bitwise calendar accessors +math.functions math unix.users unix.groups arrays sequences +grouping ; +IN: io.files.unix.tests + +[ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test +[ "/etc/" ] [ "/etc/passwd" parent-directory ] unit-test +[ "/" ] [ "/etc/" parent-directory ] unit-test +[ "/" ] [ "/etc" parent-directory ] unit-test +[ "/" ] [ "/" parent-directory ] unit-test + +[ f ] [ "" root-directory? ] unit-test +[ t ] [ "/" root-directory? ] unit-test +[ t ] [ "//" root-directory? ] unit-test +[ t ] [ "///////" root-directory? ] unit-test + +[ "/" ] [ "/" file-name ] unit-test +[ "///" ] [ "///" file-name ] unit-test + +[ "/" ] [ "/" "../.." append-path ] unit-test +[ "/" ] [ "/" "../../" append-path ] unit-test +[ "/lib" ] [ "/" "../lib" append-path ] unit-test +[ "/lib/" ] [ "/" "../lib/" append-path ] unit-test +[ "/lib" ] [ "/" "../../lib" append-path ] unit-test +[ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test + +[ "/lib" ] [ "/usr/" "/lib" append-path ] unit-test +[ "/lib/" ] [ "/usr/" "/lib/" append-path ] unit-test +[ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test +[ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test +[ t ] [ "/foo" absolute-path? ] unit-test + +: test-file ( -- path ) + "permissions" temp-file ; + +: prepare-test-file ( -- ) + [ test-file delete-file ] ignore-errors + test-file touch-file ; + +: perms ( -- n ) + test-file file-permissions OCT: 7777 mask ; + +prepare-test-file + +[ t ] +[ test-file { USER-ALL GROUP-ALL OTHER-ALL } flags set-file-permissions perms OCT: 777 = ] unit-test + +[ t ] [ test-file user-read? ] unit-test +[ t ] [ test-file user-write? ] unit-test +[ t ] [ test-file user-execute? ] unit-test +[ t ] [ test-file group-read? ] unit-test +[ t ] [ test-file group-write? ] unit-test +[ t ] [ test-file group-execute? ] unit-test +[ t ] [ test-file other-read? ] unit-test +[ t ] [ test-file other-write? ] unit-test +[ t ] [ test-file other-execute? ] unit-test + +[ t ] [ test-file f set-other-execute perms OCT: 776 = ] unit-test +[ f ] [ test-file file-info other-execute? ] unit-test + +[ t ] [ test-file f set-other-write perms OCT: 774 = ] unit-test +[ f ] [ test-file file-info other-write? ] unit-test + +[ t ] [ test-file f set-other-read perms OCT: 770 = ] unit-test +[ f ] [ test-file file-info other-read? ] unit-test + +[ t ] [ test-file f set-group-execute perms OCT: 760 = ] unit-test +[ f ] [ test-file file-info group-execute? ] unit-test + +[ t ] [ test-file f set-group-write perms OCT: 740 = ] unit-test +[ f ] [ test-file file-info group-write? ] unit-test + +[ t ] [ test-file f set-group-read perms OCT: 700 = ] unit-test +[ f ] [ test-file file-info group-read? ] unit-test + +[ t ] [ test-file f set-user-execute perms OCT: 600 = ] unit-test +[ f ] [ test-file file-info other-execute? ] unit-test + +[ t ] [ test-file f set-user-write perms OCT: 400 = ] unit-test +[ f ] [ test-file file-info other-write? ] unit-test + +[ t ] [ test-file f set-user-read perms OCT: 000 = ] unit-test +[ f ] [ test-file file-info other-read? ] unit-test + +[ t ] +[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test + +prepare-test-file + +[ t ] +[ + test-file now + [ set-file-access-time ] 2keep + [ file-info accessed>> ] + [ [ [ truncate >integer ] change-second ] bi@ ] bi* = +] unit-test + +[ t ] +[ + test-file now + [ set-file-modified-time ] 2keep + [ file-info modified>> ] + [ [ [ truncate >integer ] change-second ] bi@ ] bi* = +] unit-test + +[ t ] +[ + test-file now [ dup 2array set-file-times ] 2keep + [ file-info [ modified>> ] [ accessed>> ] bi ] dip + 3array + [ [ truncate >integer ] change-second ] map all-equal? +] unit-test + +[ ] [ test-file f now 2array set-file-times ] unit-test +[ ] [ test-file now f 2array set-file-times ] unit-test +[ ] [ test-file f f 2array set-file-times ] unit-test + + +[ ] [ test-file real-user-name set-file-user ] unit-test +[ ] [ test-file real-user-id set-file-user ] unit-test +[ ] [ test-file real-group-name set-file-group ] unit-test +[ ] [ test-file real-group-id set-file-group ] unit-test + +[ t ] [ test-file file-user-name real-user-name = ] unit-test +[ t ] [ test-file file-group-name real-group-name = ] unit-test + +[ ] +[ test-file real-user-id real-group-id set-file-ids ] unit-test + +[ ] +[ test-file f real-group-id set-file-ids ] unit-test + +[ ] +[ test-file real-user-id f set-file-ids ] unit-test + +[ ] +[ test-file f f set-file-ids ] unit-test + +[ t ] [ OCT: 4000 uid? ] unit-test +[ t ] [ OCT: 2000 gid? ] unit-test +[ t ] [ OCT: 1000 sticky? ] unit-test +[ t ] [ OCT: 400 user-read? ] unit-test +[ t ] [ OCT: 200 user-write? ] unit-test +[ t ] [ OCT: 100 user-execute? ] unit-test +[ t ] [ OCT: 040 group-read? ] unit-test +[ t ] [ OCT: 020 group-write? ] unit-test +[ t ] [ OCT: 010 group-execute? ] unit-test +[ t ] [ OCT: 004 other-read? ] unit-test +[ t ] [ OCT: 002 other-write? ] unit-test +[ t ] [ OCT: 001 other-execute? ] unit-test + +[ f ] [ 0 uid? ] unit-test +[ f ] [ 0 gid? ] unit-test +[ f ] [ 0 sticky? ] unit-test +[ f ] [ 0 user-read? ] unit-test +[ f ] [ 0 user-write? ] unit-test +[ f ] [ 0 user-execute? ] unit-test +[ f ] [ 0 group-read? ] unit-test +[ f ] [ 0 group-write? ] unit-test +[ f ] [ 0 group-execute? ] unit-test +[ f ] [ 0 other-read? ] unit-test +[ f ] [ 0 other-write? ] unit-test +[ f ] [ 0 other-execute? ] unit-test diff --git a/basis/io/files/unix/unix.factor b/basis/io/files/unix/unix.factor new file mode 100644 index 0000000000..9518d1c754 --- /dev/null +++ b/basis/io/files/unix/unix.factor @@ -0,0 +1,42 @@ +! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: unix byte-arrays kernel io.backend.unix math.bitwise +io.ports io.files io.files.private io.pathnames environment +destructors system ; +IN: io.files.unix + +M: unix cwd ( -- path ) + MAXPATHLEN [ ] keep getcwd + [ (io-error) ] unless* ; + +M: unix cd ( path -- ) [ chdir ] unix-system-call drop ; + +: read-flags ( -- n ) O_RDONLY ; inline + +: open-read ( path -- fd ) O_RDONLY file-mode open-file ; + +M: unix (file-reader) ( path -- stream ) + open-read init-fd ; + +: write-flags ( -- n ) + { O_WRONLY O_CREAT O_TRUNC } flags ; inline + +: open-write ( path -- fd ) + write-flags file-mode open-file ; + +M: unix (file-writer) ( path -- stream ) + open-write init-fd ; + +: append-flags ( -- n ) + { O_WRONLY O_APPEND O_CREAT } flags ; inline + +: open-append ( path -- fd ) + [ + append-flags file-mode open-file |dispose + dup 0 SEEK_END lseek io-error + ] with-destructors ; + +M: unix (file-appender) ( path -- stream ) + open-append init-fd ; + +M: unix home "HOME" os-env ; diff --git a/basis/io/files/windows/nt/authors.txt b/basis/io/files/windows/nt/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/basis/io/files/windows/nt/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/basis/io/files/windows/nt/nt-tests.factor b/basis/io/files/windows/nt/nt-tests.factor new file mode 100644 index 0000000000..e934dc8cd2 --- /dev/null +++ b/basis/io/files/windows/nt/nt-tests.factor @@ -0,0 +1,55 @@ +USING: io.files io.pathnames kernel tools.test io.backend +io.files.windows.nt splitting sequences ; +IN: io.files.windows.nt.tests + +[ f ] [ "\\foo" absolute-path? ] unit-test +[ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test +[ t ] [ "\\\\?\\c:\\" absolute-path? ] unit-test +[ t ] [ "\\\\?\\c:" absolute-path? ] unit-test +[ t ] [ "c:\\foo" absolute-path? ] unit-test +[ t ] [ "c:" absolute-path? ] unit-test +[ t ] [ "c:\\" absolute-path? ] unit-test +[ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test + +[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test +[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test +[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test +! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing +[ "c:\\" ] [ "c:\\" parent-directory ] unit-test +[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test +[ "c:" ] [ "c:" parent-directory ] unit-test +[ "Z:" ] [ "Z:" parent-directory ] unit-test + +[ f ] [ "" root-directory? ] unit-test +[ t ] [ "\\" root-directory? ] unit-test +[ t ] [ "\\\\" root-directory? ] unit-test +[ t ] [ "/" root-directory? ] unit-test +[ t ] [ "//" root-directory? ] unit-test +[ t ] [ "c:\\" trim-right-separators root-directory? ] unit-test +[ t ] [ "Z:\\" trim-right-separators root-directory? ] unit-test +[ f ] [ "c:\\foo" root-directory? ] unit-test +[ f ] [ "." root-directory? ] unit-test +[ f ] [ ".." root-directory? ] unit-test +[ t ] [ "\\\\?\\c:\\" root-directory? ] unit-test +[ t ] [ "\\\\?\\c:" root-directory? ] unit-test +[ f ] [ "\\\\?\\c:\\bar" root-directory? ] unit-test + +[ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test + +[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [ + "C:\\builds\\factor\\12345\\" + "..\\log.txt" append-path normalize-path +] unit-test + +[ "\\\\?\\C:\\builds\\" ] [ + "C:\\builds\\factor\\12345\\" + "..\\.." append-path normalize-path +] unit-test + +[ "\\\\?\\C:\\builds\\" ] [ + "C:\\builds\\factor\\12345\\" + "..\\.." append-path normalize-path +] unit-test + +[ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test +[ t ] [ "" resource-path 2 tail exists? ] unit-test diff --git a/basis/io/files/windows/nt/nt.factor b/basis/io/files/windows/nt/nt.factor new file mode 100755 index 0000000000..3241d19efa --- /dev/null +++ b/basis/io/files/windows/nt/nt.factor @@ -0,0 +1,61 @@ +USING: continuations destructors io.buffers io.files io.backend +io.timeouts io.ports io.pathnames io.files.private +io.backend.windows io.files.windows io.encodings.utf16n windows +windows.kernel32 kernel libc math threads system environment +alien.c-types alien.arrays alien.strings sequences combinators +combinators.short-circuit ascii splitting alien strings assocs +namespaces make accessors tr windows.time ; +IN: io.files.windows.nt + +M: winnt cwd + MAX_UNICODE_PATH dup "ushort" + [ GetCurrentDirectory win32-error=0/f ] keep + utf16n alien>string ; + +M: winnt cd + SetCurrentDirectory win32-error=0/f ; + +: unicode-prefix ( -- seq ) + "\\\\?\\" ; inline + +M: winnt root-directory? ( path -- ? ) + { + { [ dup empty? ] [ drop f ] } + { [ dup [ path-separator? ] all? ] [ drop t ] } + { [ dup trim-right-separators { [ length 2 = ] + [ second CHAR: : = ] } 1&& ] [ drop t ] } + { [ dup unicode-prefix head? ] + [ trim-right-separators length unicode-prefix length 2 + = ] } + [ drop f ] + } cond ; + +: prepend-prefix ( string -- string' ) + dup unicode-prefix head? [ + unicode-prefix prepend + ] unless ; + +TR: normalize-separators "/" "\\" ; + +M: winnt normalize-path ( string -- string' ) + (normalize-path) + normalize-separators + prepend-prefix ; + +M: winnt CreateFile-flags ( DWORD -- DWORD ) + FILE_FLAG_OVERLAPPED bitor ; + + + [ GetFileAttributesEx win32-error=0/f ] keep + [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeLow ] + [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeHigh ] bi >64bit ; + +PRIVATE> + +M: winnt open-append + [ dup windows-file-size ] [ drop 0 ] recover + [ (open-append) ] dip >>ptr ; + +M: winnt home "USERPROFILE" os-env ; diff --git a/basis/io/files/windows/nt/tags.txt b/basis/io/files/windows/nt/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/windows/nt/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/windows/tags.txt b/basis/io/files/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor new file mode 100755 index 0000000000..444ba98c7d --- /dev/null +++ b/basis/io/files/windows/windows.factor @@ -0,0 +1,133 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types io.binary io.backend io.files +io.files.types io.buffers io.encodings.utf16n io.ports +io.backend.windows kernel math splitting fry alien.strings +windows windows.kernel32 windows.time calendar combinators +math.functions sequences namespaces make words system +destructors accessors math.bitwise continuations windows.errors +arrays byte-arrays generalizations ; +IN: io.files.windows + +: open-file ( path access-mode create-mode flags -- handle ) + [ + [ share-mode default-security-attributes ] 2dip + CreateFile-flags f CreateFile opened-file + ] with-destructors ; + +: open-r/w ( path -- win32-file ) + { GENERIC_READ GENERIC_WRITE } flags + OPEN_EXISTING 0 open-file ; + +: open-read ( path -- win32-file ) + GENERIC_READ OPEN_EXISTING 0 open-file 0 >>ptr ; + +: open-write ( path -- win32-file ) + GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 >>ptr ; + +: (open-append) ( path -- win32-file ) + GENERIC_WRITE OPEN_ALWAYS 0 open-file ; + +: open-existing ( path -- win32-file ) + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_EXISTING + FILE_FLAG_BACKUP_SEMANTICS + f CreateFileW dup win32-error=0/f ; + +: maybe-create-file ( path -- win32-file ? ) + #! return true if file was just created + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_ALWAYS + 0 CreateFile-flags + f CreateFileW dup win32-error=0/f + GetLastError ERROR_ALREADY_EXISTS = not ; + +: set-file-pointer ( handle length method -- ) + [ dupd d>w/w ] dip SetFilePointer + INVALID_SET_FILE_POINTER = [ + CloseHandle "SetFilePointer failed" throw + ] when drop ; + +HOOK: open-append os ( path -- win32-file ) + +TUPLE: FileArgs + hFile lpBuffer nNumberOfBytesToRead + lpNumberOfBytesRet lpOverlapped ; + +C: FileArgs + +: make-FileArgs ( port -- ) + { + [ handle>> check-disposed ] + [ handle>> handle>> ] + [ buffer>> ] + [ buffer>> buffer-length ] + [ drop "DWORD" ] + [ FileArgs-overlapped ] + } cleave ; + +: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) + { + [ hFile>> ] + [ lpBuffer>> buffer-end ] + [ lpBuffer>> buffer-capacity ] + [ lpNumberOfBytesRet>> ] + [ lpOverlapped>> ] + } cleave ; + +: setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) + { + [ hFile>> ] + [ lpBuffer>> buffer@ ] + [ lpBuffer>> buffer-length ] + [ lpNumberOfBytesRet>> ] + [ lpOverlapped>> ] + } cleave ; + +M: windows (file-reader) ( path -- stream ) + open-read ; + +M: windows (file-writer) ( path -- stream ) + open-write ; + +M: windows (file-appender) ( path -- stream ) + open-append ; + +SYMBOLS: +read-only+ +hidden+ +system+ ++archive+ +device+ +normal+ +temporary+ ++sparse-file+ +reparse-point+ +compressed+ +offline+ ++not-content-indexed+ +encrypted+ ; + +: win32-file-attribute ( n attr symbol -- ) + rot mask? [ , ] [ drop ] if ; + +: win32-file-attributes ( n -- seq ) + [ + { + [ +read-only+ FILE_ATTRIBUTE_READONLY win32-file-attribute ] + [ +hidden+ FILE_ATTRIBUTE_HIDDEN win32-file-attribute ] + [ +system+ FILE_ATTRIBUTE_SYSTEM win32-file-attribute ] + [ +directory+ FILE_ATTRIBUTE_DIRECTORY win32-file-attribute ] + [ +archive+ FILE_ATTRIBUTE_ARCHIVE win32-file-attribute ] + [ +device+ FILE_ATTRIBUTE_DEVICE win32-file-attribute ] + [ +normal+ FILE_ATTRIBUTE_NORMAL win32-file-attribute ] + [ +temporary+ FILE_ATTRIBUTE_TEMPORARY win32-file-attribute ] + [ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE win32-file-attribute ] + [ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT win32-file-attribute ] + [ +compressed+ FILE_ATTRIBUTE_COMPRESSED win32-file-attribute ] + [ +offline+ FILE_ATTRIBUTE_OFFLINE win32-file-attribute ] + [ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED win32-file-attribute ] + [ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED win32-file-attribute ] + } cleave + ] { } make ; + +: win32-file-type ( n -- symbol ) + FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; + +: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- ) + [ timestamp>FILETIME ] tri@ + SetFileTime win32-error=0/f ; diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor old mode 100644 new mode 100755 index 7bafb95376..f5809223fc --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -261,8 +261,7 @@ M: object run-pipeline-element drop ; { - { [ os unix? ] [ "io.unix.launcher" require ] } - { [ os winnt? ] [ "io.windows.nt.launcher" require ] } - { [ os wince? ] [ "io.windows.launcher" require ] } + { [ os unix? ] [ "io.launcher.unix" require ] } + { [ os winnt? ] [ "io.launcher.windows.nt" require ] } [ ] } cond diff --git a/basis/io/launcher/unix/authors.txt b/basis/io/launcher/unix/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/launcher/unix/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/launcher/unix/parser/parser-tests.factor b/basis/io/launcher/unix/parser/parser-tests.factor new file mode 100644 index 0000000000..07502e87a4 --- /dev/null +++ b/basis/io/launcher/unix/parser/parser-tests.factor @@ -0,0 +1,33 @@ +IN: io.launcher.unix.parser.tests +USING: io.launcher.unix.parser tools.test ; + +[ "" tokenize-command ] must-fail +[ " " tokenize-command ] must-fail +[ V{ "a" } ] [ "a" tokenize-command ] unit-test +[ V{ "abc" } ] [ "abc" tokenize-command ] unit-test +[ V{ "abc" } ] [ "abc " tokenize-command ] unit-test +[ V{ "abc" } ] [ " abc" tokenize-command ] unit-test +[ V{ "abc" "def" } ] [ "abc def" tokenize-command ] unit-test +[ V{ "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test +[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test +[ V{ "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test +[ V{ "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test +[ V{ "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test +[ V{ "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test +[ "'abc def' \"hey" tokenize-command ] must-fail +[ "'abc def" tokenize-command ] must-fail +[ V{ "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\" " tokenize-command ] unit-test + +[ + V{ + "Hello world.app/Contents/MacOS/hello-ui" + "-i=boot.macosx-ppc.image" + "-include= math compiler ui" + "-deploy-vocab=hello-ui" + "-output-image=Hello world.app/Contents/Resources/hello-ui.image" + "-no-stack-traces" + "-no-user-init" + } +] [ + "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize-command +] unit-test diff --git a/basis/io/launcher/unix/parser/parser.factor b/basis/io/launcher/unix/parser/parser.factor new file mode 100644 index 0000000000..97e6dee95f --- /dev/null +++ b/basis/io/launcher/unix/parser/parser.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: peg peg.parsers kernel sequences strings words ; +IN: io.launcher.unix.parser + +! Our command line parser. Supported syntax: +! foo bar baz -- simple tokens +! foo\ bar -- escaping the space +! 'foo bar' -- quotation +! "foo bar" -- quotation +: 'escaped-char' ( -- parser ) + "\\" token any-char 2seq [ second ] action ; + +: 'quoted-char' ( delimiter -- parser' ) + 'escaped-char' + swap [ member? not ] curry satisfy + 2choice ; inline + +: 'quoted' ( delimiter -- parser ) + dup 'quoted-char' repeat0 swap dup surrounded-by ; + +: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ; + +: 'argument' ( -- parser ) + "\"" 'quoted' + "'" 'quoted' + 'unquoted' 3choice + [ >string ] action ; + +PEG: tokenize-command ( command -- ast/f ) + 'argument' " " token repeat1 list-of + " " token repeat0 tuck pack + just ; diff --git a/basis/io/launcher/unix/parser/tags.txt b/basis/io/launcher/unix/parser/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/launcher/unix/parser/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/launcher/unix/tags.txt b/basis/io/launcher/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/launcher/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/launcher/unix/unix-tests.factor b/basis/io/launcher/unix/unix-tests.factor new file mode 100644 index 0000000000..f375bb41e8 --- /dev/null +++ b/basis/io/launcher/unix/unix-tests.factor @@ -0,0 +1,138 @@ +IN: io.launcher.unix.tests +USING: io.files io.files.temp io.directories io.pathnames +tools.test io.launcher arrays io namespaces continuations math +io.encodings.binary io.encodings.ascii accessors kernel +sequences io.encodings.utf8 destructors io.streams.duplex locals +concurrency.promises threads unix.process ; + +[ ] [ + [ "launcher-test-1" temp-file delete-file ] ignore-errors +] unit-test + +[ ] [ + "touch" + "launcher-test-1" temp-file + 2array + try-process +] unit-test + +[ t ] [ "launcher-test-1" temp-file exists? ] unit-test + +[ ] [ + [ "launcher-test-1" temp-file delete-file ] ignore-errors +] unit-test + +[ ] [ + + "echo Hello" >>command + "launcher-test-1" temp-file >>stdout + try-process +] unit-test + +[ "Hello\n" ] [ + "cat" + "launcher-test-1" temp-file + 2array + ascii contents +] unit-test + +[ ] [ + [ "launcher-test-1" temp-file delete-file ] ignore-errors +] unit-test + +[ ] [ + + "cat" >>command + +closed+ >>stdin + "launcher-test-1" temp-file >>stdout + try-process +] unit-test + +[ f ] [ + "cat" + "launcher-test-1" temp-file + 2array + ascii contents +] unit-test + +[ ] [ + 2 [ + "launcher-test-1" temp-file binary [ + + swap >>stdout + "echo Hello" >>command + try-process + ] with-disposal + ] times +] unit-test + +[ "Hello\nHello\n" ] [ + "cat" + "launcher-test-1" temp-file + 2array + ascii contents +] unit-test + +[ t ] [ + + "env" >>command + { { "A" "B" } } >>environment + ascii lines + "A=B" swap member? +] unit-test + +[ { "A=B" } ] [ + + "env" >>command + { { "A" "B" } } >>environment + +replace-environment+ >>environment-mode + ascii lines +] unit-test + +[ "hi\n" ] [ + temp-directory [ + [ "aloha" delete-file ] ignore-errors + + { "echo" "hi" } >>command + "aloha" >>stdout + try-process + ] with-directory + temp-directory "aloha" append-path + utf8 file-contents +] unit-test + +[ "append-test" temp-file delete-file ] ignore-errors + +[ "hi\nhi\n" ] [ + 2 [ + + "echo hi" >>command + "append-test" temp-file >>stdout + try-process + ] times + "append-test" temp-file utf8 file-contents +] unit-test + +[ t ] [ "ls" utf8 contents >boolean ] unit-test + +[ "Hello world.\n" ] [ + "cat" utf8 [ + "Hello world.\n" write + output-stream get dispose + input-stream get contents + ] with-stream +] unit-test + +! Killed processes were exiting with code 0 on FreeBSD +[ f ] [ + [let | p [ ] + s [ ] | + [ + "sleep 1000" run-detached + [ p fulfill ] [ wait-for-process s fulfill ] bi + ] in-thread + + p ?promise handle>> 9 kill drop + s ?promise 0 = + ] +] unit-test diff --git a/basis/io/launcher/unix/unix.factor b/basis/io/launcher/unix/unix.factor new file mode 100644 index 0000000000..ac25e4ec2f --- /dev/null +++ b/basis/io/launcher/unix/unix.factor @@ -0,0 +1,106 @@ +! Copyright (C) 2007, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types arrays assocs combinators +continuations environment io io.backend io.backend.unix +io.files io.files.private io.files.unix io.launcher +io.launcher.unix.parser io.pathnames io.ports kernel math +namespaces sequences strings system threads unix unix +unix.process ; +IN: io.launcher.unix + +! Search unix first +USE: unix + +: get-arguments ( process -- seq ) + command>> dup string? [ tokenize-command ] when ; + +: assoc>env ( assoc -- env ) + [ "=" glue ] { } assoc>map ; + +: setup-priority ( process -- process ) + dup priority>> [ + H{ + { +lowest-priority+ 20 } + { +low-priority+ 10 } + { +normal-priority+ 0 } + { +high-priority+ -10 } + { +highest-priority+ -20 } + { +realtime-priority+ -20 } + } at set-priority + ] when* ; + +: reset-fd ( fd -- ) + [ F_SETFL 0 fcntl io-error ] [ F_SETFD 0 fcntl io-error ] bi ; + +: redirect-fd ( oldfd fd -- ) + 2dup = [ 2drop ] [ dup2 io-error ] if ; + +: redirect-file ( obj mode fd -- ) + [ [ normalize-path ] dip file-mode open-file ] dip redirect-fd ; + +: redirect-file-append ( obj mode fd -- ) + [ drop path>> normalize-path open-append ] dip redirect-fd ; + +: redirect-closed ( obj mode fd -- ) + [ drop "/dev/null" ] 2dip redirect-file ; + +: redirect ( obj mode fd -- ) + { + { [ pick not ] [ 3drop ] } + { [ pick string? ] [ redirect-file ] } + { [ pick appender? ] [ redirect-file-append ] } + { [ pick +closed+ eq? ] [ redirect-closed ] } + { [ pick fd? ] [ [ drop fd>> dup reset-fd ] dip redirect-fd ] } + [ [ underlying-handle ] 2dip redirect ] + } cond ; + +: ?closed ( obj -- obj' ) + dup +closed+ eq? [ drop "/dev/null" ] when ; + +: setup-redirection ( process -- process ) + dup stdin>> ?closed read-flags 0 redirect + dup stdout>> ?closed write-flags 1 redirect + dup stderr>> dup +stdout+ eq? [ + drop 1 2 dup2 io-error + ] [ + ?closed write-flags 2 redirect + ] if ; + +: setup-environment ( process -- process ) + dup pass-environment? [ + dup get-environment set-os-envs + ] when ; + +: spawn-process ( process -- * ) + [ setup-priority ] [ 250 _exit ] recover + [ setup-redirection ] [ 251 _exit ] recover + [ current-directory get (normalize-path) cd ] [ 252 _exit ] recover + [ setup-environment ] [ 253 _exit ] recover + [ get-arguments exec-args-with-path ] [ 254 _exit ] recover + 255 _exit ; + +M: unix current-process-handle ( -- handle ) getpid ; + +M: unix run-process* ( process -- pid ) + [ spawn-process ] curry [ ] with-fork ; + +M: unix kill-process* ( pid -- ) + SIGTERM kill io-error ; + +: find-process ( handle -- process ) + processes get swap [ nip swap handle>> = ] curry + assoc-find 2drop ; + +TUPLE: signal n ; + +: code>status ( code -- obj ) + dup WIFEXITED [ WEXITSTATUS ] [ WTERMSIG signal boa ] if ; + +M: unix wait-for-processes ( -- ? ) + -1 0 tuck WNOHANG waitpid + dup 0 <= [ + 2drop t + ] [ + find-process dup + [ swap *int code>status notify-exit f ] [ 2drop f ] if + ] if ; diff --git a/basis/io/launcher/windows/authors.txt b/basis/io/launcher/windows/authors.txt new file mode 100755 index 0000000000..5674120196 --- /dev/null +++ b/basis/io/launcher/windows/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Slava Pestov diff --git a/basis/io/launcher/windows/nt/authors.txt b/basis/io/launcher/windows/nt/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/basis/io/launcher/windows/nt/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/basis/io/launcher/windows/nt/nt-tests.factor b/basis/io/launcher/windows/nt/nt-tests.factor new file mode 100644 index 0000000000..93b1e8c2ff --- /dev/null +++ b/basis/io/launcher/windows/nt/nt-tests.factor @@ -0,0 +1,161 @@ +USING: io.launcher tools.test calendar accessors environment +namespaces kernel system arrays io io.files io.encodings.ascii +sequences parser assocs hashtables math continuations eval +io.files.temp io.directories io.pathnames ; +IN: io.launcher.windows.nt.tests + +[ ] [ + + "notepad" >>command + 1/2 seconds >>timeout + "notepad" set +] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ f ] [ "notepad" get process-started? ] unit-test + +[ ] [ "notepad" [ run-detached ] change ] unit-test + +[ "notepad" get wait-for-process ] must-fail + +[ t ] [ "notepad" get killed>> ] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ ] [ + + vm "-quiet" "-run=hello-world" 3array >>command + "out.txt" temp-file >>stdout + try-process +] unit-test + +[ "Hello world" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + + vm "-run=listener" 2array >>command + +closed+ >>stdin + try-process +] unit-test + +: launcher-test-path ( -- str ) + "resource:basis/io/launcher/windows/nt/test" ; + +[ ] [ + launcher-test-path [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + "err.txt" temp-file >>stderr + try-process + ] with-directory +] unit-test + +[ "output" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "error" ] [ + "err.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + launcher-test-path [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + +stdout+ >>stderr + try-process + ] with-directory +] unit-test + +[ "outputerror" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "output" ] [ + launcher-test-path [ + + vm "-script" "stderr.factor" 3array >>command + "err2.txt" temp-file >>stderr + ascii lines first + ] with-directory +] unit-test + +[ "error" ] [ + "err2.txt" temp-file ascii file-lines first +] unit-test + +[ t ] [ + launcher-test-path [ + + vm "-script" "env.factor" 3array >>command + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ t ] [ + launcher-test-path [ + + vm "-script" "env.factor" 3array >>command + +replace-environment+ >>environment-mode + os-envs >>environment + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ "B" ] [ + launcher-test-path [ + + vm "-script" "env.factor" 3array >>command + { { "A" "B" } } >>environment + ascii contents + ] with-directory eval + + "A" swap at +] unit-test + +[ f ] [ + launcher-test-path [ + + vm "-script" "env.factor" 3array >>command + { { "USERPROFILE" "XXX" } } >>environment + +prepend-environment+ >>environment-mode + ascii contents + ] with-directory eval + + "USERPROFILE" swap at "XXX" = +] unit-test + +2 [ + [ ] [ + + "cmd.exe /c dir" >>command + "dir.txt" temp-file >>stdout + try-process + ] unit-test + + [ ] [ "dir.txt" temp-file delete-file ] unit-test +] times + +[ "append-test" temp-file delete-file ] ignore-errors + +[ "Hello appender\r\nHello appender\r\n" ] [ + 2 [ + launcher-test-path [ + + vm "-script" "append.factor" 3array >>command + "append-test" temp-file >>stdout + try-process + ] with-directory + ] times + + "append-test" temp-file ascii file-contents +] unit-test diff --git a/basis/io/launcher/windows/nt/nt.factor b/basis/io/launcher/windows/nt/nt.factor new file mode 100755 index 0000000000..5ebb38abc2 --- /dev/null +++ b/basis/io/launcher/windows/nt/nt.factor @@ -0,0 +1,110 @@ +! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types arrays continuations destructors io +io.backend.windows libc io.ports io.pipes windows.types math +windows.kernel32 windows namespaces make io.launcher kernel +sequences windows.errors assocs splitting system strings +io.launcher.windows io.files.windows io.backend io.files +io.files.private combinators shuffle accessors locals ; +IN: io.launcher.windows.nt + +: duplicate-handle ( handle -- handle' ) + GetCurrentProcess ! source process + swap ! handle + GetCurrentProcess ! target process + f [ ! target handle + DUPLICATE_SAME_ACCESS ! desired access + TRUE ! inherit handle + DUPLICATE_CLOSE_SOURCE ! options + DuplicateHandle win32-error=0/f + ] keep *void* ; + +! /dev/null simulation +: null-input ( -- pipe ) + (pipe) [ in>> handle>> ] [ out>> dispose ] bi ; + +: null-output ( -- pipe ) + (pipe) [ in>> dispose ] [ out>> handle>> ] bi ; + +: null-pipe ( mode -- pipe ) + { + { GENERIC_READ [ null-input ] } + { GENERIC_WRITE [ null-output ] } + } case ; + +! The below code is based on the example given in +! http://msdn2.microsoft.com/en-us/library/ms682499.aspx + +: redirect-default ( obj access-mode create-mode -- handle ) + 3drop f ; + +: redirect-closed ( obj access-mode create-mode -- handle ) + drop nip null-pipe ; + +:: redirect-file ( path access-mode create-mode -- handle ) + path normalize-path + access-mode + share-mode + default-security-attributes + create-mode + FILE_ATTRIBUTE_NORMAL ! flags and attributes + f ! template file + CreateFile dup invalid-handle? &dispose handle>> ; + +: redirect-append ( path access-mode create-mode -- handle ) + [ path>> ] 2dip + drop OPEN_ALWAYS + redirect-file + dup 0 FILE_END set-file-pointer ; + +: redirect-handle ( handle access-mode create-mode -- handle ) + 2drop handle>> duplicate-handle ; + +: redirect-stream ( stream access-mode create-mode -- handle ) + [ underlying-handle handle>> ] 2dip redirect-handle ; + +: redirect ( obj access-mode create-mode -- handle ) + { + { [ pick not ] [ redirect-default ] } + { [ pick +closed+ eq? ] [ redirect-closed ] } + { [ pick string? ] [ redirect-file ] } + { [ pick appender? ] [ redirect-append ] } + { [ pick win32-file? ] [ redirect-handle ] } + [ redirect-stream ] + } cond + dup [ dup t set-inherit ] when ; + +: redirect-stdout ( process args -- handle ) + drop + stdout>> + GENERIC_WRITE + CREATE_ALWAYS + redirect + STD_OUTPUT_HANDLE GetStdHandle or ; + +: redirect-stderr ( process args -- handle ) + over stderr>> +stdout+ eq? [ + nip + lpStartupInfo>> STARTUPINFO-hStdOutput + ] [ + drop + stderr>> + GENERIC_WRITE + CREATE_ALWAYS + redirect + STD_ERROR_HANDLE GetStdHandle or + ] if ; + +: redirect-stdin ( process args -- handle ) + drop + stdin>> + GENERIC_READ + OPEN_EXISTING + redirect + STD_INPUT_HANDLE GetStdHandle or ; + +M: winnt fill-redirection ( process args -- ) + [ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput + [ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError + [ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput + 2drop ; diff --git a/basis/io/launcher/windows/nt/tags.txt b/basis/io/launcher/windows/nt/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/launcher/windows/nt/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/launcher/windows/nt/test/append.factor b/basis/io/launcher/windows/nt/test/append.factor new file mode 100644 index 0000000000..4c1de0c5f9 --- /dev/null +++ b/basis/io/launcher/windows/nt/test/append.factor @@ -0,0 +1,2 @@ +USE: io +"Hello appender" print diff --git a/basis/io/launcher/windows/nt/test/env.factor b/basis/io/launcher/windows/nt/test/env.factor new file mode 100644 index 0000000000..503ca7d018 --- /dev/null +++ b/basis/io/launcher/windows/nt/test/env.factor @@ -0,0 +1,4 @@ +USE: system +USE: prettyprint +USE: environment +os-envs . diff --git a/basis/io/launcher/windows/nt/test/stderr.factor b/basis/io/launcher/windows/nt/test/stderr.factor new file mode 100644 index 0000000000..f22f50e406 --- /dev/null +++ b/basis/io/launcher/windows/nt/test/stderr.factor @@ -0,0 +1,5 @@ +USE: io +USE: namespaces + +"output" write flush +"error" error-stream get stream-write error-stream get stream-flush diff --git a/basis/io/launcher/windows/tags.txt b/basis/io/launcher/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/launcher/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/launcher/windows/windows-tests.factor b/basis/io/launcher/windows/windows-tests.factor new file mode 100644 index 0000000000..1a3fe823a5 --- /dev/null +++ b/basis/io/launcher/windows/windows-tests.factor @@ -0,0 +1,10 @@ +IN: io.launcher.windows.tests +USING: tools.test io.launcher.windows ; + +[ "hello world" ] [ { "hello" "world" } join-arguments ] unit-test + +[ "bob \"mac arthur\"" ] [ { "bob" "mac arthur" } join-arguments ] unit-test + +[ "bob mac\\\\arthur" ] [ { "bob" "mac\\\\arthur" } join-arguments ] unit-test + +[ "bob \"mac arthur\\\\\"" ] [ { "bob" "mac arthur\\" } join-arguments ] unit-test diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor new file mode 100755 index 0000000000..0497754aa2 --- /dev/null +++ b/basis/io/launcher/windows/windows.factor @@ -0,0 +1,164 @@ +! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types arrays continuations io +io.backend.windows io.pipes.windows.nt io.pathnames libc io.ports +windows.types math windows.kernel32 +namespaces make io.launcher kernel sequences windows.errors +splitting system threads init strings combinators +io.backend accessors concurrency.flags io.files assocs +io.files.private windows destructors specialized-arrays.ushort +specialized-arrays.alien ; +IN: io.launcher.windows + +TUPLE: CreateProcess-args + lpApplicationName + lpCommandLine + lpProcessAttributes + lpThreadAttributes + bInheritHandles + dwCreateFlags + lpEnvironment + lpCurrentDirectory + lpStartupInfo + lpProcessInformation ; + +: default-CreateProcess-args ( -- obj ) + CreateProcess-args new + "STARTUPINFO" + "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo + "PROCESS_INFORMATION" >>lpProcessInformation + TRUE >>bInheritHandles + 0 >>dwCreateFlags ; + +: call-CreateProcess ( CreateProcess-args -- ) + { + [ lpApplicationName>> ] + [ lpCommandLine>> ] + [ lpProcessAttributes>> ] + [ lpThreadAttributes>> ] + [ bInheritHandles>> ] + [ dwCreateFlags>> ] + [ lpEnvironment>> ] + [ lpCurrentDirectory>> ] + [ lpStartupInfo>> ] + [ lpProcessInformation>> ] + } cleave + CreateProcess win32-error=0/f ; + +: count-trailing-backslashes ( str n -- str n ) + [ "\\" ?tail ] dip swap [ + 1+ count-trailing-backslashes + ] when ; + +: fix-trailing-backslashes ( str -- str' ) + 0 count-trailing-backslashes + 2 * CHAR: \\ append ; + +: escape-argument ( str -- newstr ) + CHAR: \s over member? [ + fix-trailing-backslashes "\"" dup surround + ] when ; + +: join-arguments ( args -- cmd-line ) + [ escape-argument ] map " " join ; + +: lookup-priority ( process -- n ) + priority>> { + { +lowest-priority+ [ IDLE_PRIORITY_CLASS ] } + { +low-priority+ [ BELOW_NORMAL_PRIORITY_CLASS ] } + { +normal-priority+ [ NORMAL_PRIORITY_CLASS ] } + { +high-priority+ [ ABOVE_NORMAL_PRIORITY_CLASS ] } + { +highest-priority+ [ HIGH_PRIORITY_CLASS ] } + { +realtime-priority+ [ REALTIME_PRIORITY_CLASS ] } + [ drop f ] + } case ; + +: app-name/cmd-line ( process -- app-name cmd-line ) + command>> dup string? [ + " " split1 + ] [ + unclip swap join-arguments + ] if ; + +: cmd-line ( process -- cmd-line ) + command>> dup string? [ join-arguments ] unless ; + +: fill-lpApplicationName ( process args -- process args ) + over app-name/cmd-line + [ >>lpApplicationName ] [ >>lpCommandLine ] bi* ; + +: fill-lpCommandLine ( process args -- process args ) + over cmd-line >>lpCommandLine ; + +: fill-dwCreateFlags ( process args -- process args ) + 0 + pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when + pick detached>> os winnt? and [ DETACHED_PROCESS bitor ] when + pick lookup-priority [ bitor ] when* + >>dwCreateFlags ; + +: fill-lpEnvironment ( process args -- process args ) + over pass-environment? [ + [ + over get-environment + [ swap % "=" % % "\0" % ] assoc-each + "\0" % + ] ushort-array{ } make underlying>> + >>lpEnvironment + ] when ; + +: fill-startup-info ( process args -- process args ) + STARTF_USESTDHANDLES over lpStartupInfo>> set-STARTUPINFO-dwFlags ; + +HOOK: fill-redirection io-backend ( process args -- ) + +M: wince fill-redirection 2drop ; + +: make-CreateProcess-args ( process -- args ) + default-CreateProcess-args + os wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if + fill-dwCreateFlags + fill-lpEnvironment + fill-startup-info + nip ; + +M: windows current-process-handle ( -- handle ) + GetCurrentProcessId ; + +M: windows run-process* ( process -- handle ) + [ + current-directory get (normalize-path) cd + + dup make-CreateProcess-args + tuck fill-redirection + dup call-CreateProcess + lpProcessInformation>> + ] with-destructors ; + +M: windows kill-process* ( handle -- ) + PROCESS_INFORMATION-hProcess + 255 TerminateProcess win32-error=0/f ; + +: dispose-process ( process-information -- ) + #! From MSDN: "Handles in PROCESS_INFORMATION must be closed + #! with CloseHandle when they are no longer needed." + dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when* + PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ; + +: exit-code ( process -- n ) + PROCESS_INFORMATION-hProcess + 0 [ GetExitCodeProcess ] keep *ulong + swap win32-error=0/f ; + +: process-exited ( process -- ) + dup handle>> exit-code + over handle>> dispose-process + notify-exit ; + +M: windows wait-for-processes ( -- ? ) + processes get keys dup + [ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as + [ length ] [ underlying>> ] bi 0 0 + WaitForMultipleObjects + dup HEX: ffffffff = [ win32-error ] when + dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ; diff --git a/basis/io/mmap/functor/functor.factor b/basis/io/mmap/functor/functor.factor index 4587a75fd9..954d8b43c7 100644 --- a/basis/io/mmap/functor/functor.factor +++ b/basis/io/mmap/functor/functor.factor @@ -20,9 +20,9 @@ with-mapped-A-file DEFINES with-mapped-${T}-file WHERE : ( mapped-file -- direct-array ) - T mapped-file>direct execute ; inline + T mapped-file>direct ; inline : with-mapped-A-file ( path length quot -- ) - '[ execute @ ] with-mapped-file ; inline + '[ @ ] with-mapped-file ; inline ;FUNCTOR diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor index bd971656d4..5ef3400a6d 100644 --- a/basis/io/mmap/mmap-docs.factor +++ b/basis/io/mmap/mmap-docs.factor @@ -19,6 +19,7 @@ HELP: HELP: with-mapped-file { $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } } { $contract "Opens a file and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." } +{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." } { $errors "Throws an error if a memory mapping could not be established." } ; HELP: close-mapped-file diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor index dc2f0b4687..166167a7e7 100644 --- a/basis/io/mmap/mmap-tests.factor +++ b/basis/io/mmap/mmap-tests.factor @@ -1,5 +1,6 @@ -USING: io io.mmap io.mmap.char io.files kernel tools.test -continuations sequences io.encodings.ascii accessors ; +USING: io io.mmap io.mmap.char io.files io.files.temp +io.directories kernel tools.test continuations sequences +io.encodings.ascii accessors ; IN: io.mmap.tests [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor index 3cf451bd03..6f2fabb709 100644 --- a/basis/io/mmap/mmap.factor +++ b/basis/io/mmap/mmap.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: continuations destructors io.files io.backend kernel -quotations system alien alien.accessors accessors system -vocabs.loader combinators alien.c-types ; +USING: continuations destructors io.files io.files.info +io.backend kernel quotations system alien alien.accessors +accessors system vocabs.loader combinators alien.c-types ; IN: io.mmap TUPLE: mapped-file address handle length disposed ; -HOOK: (mapped-file) io-backend ( path length -- address handle ) +HOOK: (mapped-file) os ( path length -- address handle ) : ( path -- mmap ) [ normalize-path ] [ file-info size>> ] bi [ (mapped-file) ] keep @@ -21,6 +21,6 @@ M: mapped-file dispose* ( mmap -- ) close-mapped-file ; [ ] dip with-disposal ; inline { - { [ os unix? ] [ "io.unix.mmap" require ] } - { [ os winnt? ] [ "io.windows.mmap" require ] } + { [ os unix? ] [ "io.mmap.unix" require ] } + { [ os winnt? ] [ "io.mmap.windows" require ] } } cond diff --git a/basis/io/mmap/unix/authors.txt b/basis/io/mmap/unix/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/mmap/unix/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/mmap/unix/tags.txt b/basis/io/mmap/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/mmap/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor new file mode 100644 index 0000000000..9325dcd632 --- /dev/null +++ b/basis/io/mmap/unix/unix.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2007 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien io io.files kernel math math.bitwise system unix +io.backend.unix io.ports io.mmap destructors locals accessors ; +IN: io.mmap.unix + +: open-r/w ( path -- fd ) O_RDWR file-mode open-file ; + +:: mmap-open ( path length prot flags -- alien fd ) + [ + f length prot flags + path open-r/w |dispose + [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep + ] with-destructors ; + +M: unix (mapped-file) + { PROT_READ PROT_WRITE } flags + { MAP_FILE MAP_SHARED } flags + mmap-open ; + +M: unix close-mapped-file ( mmap -- ) + [ [ address>> ] [ length>> ] bi munmap io-error ] + [ handle>> close-file ] + bi ; diff --git a/basis/io/mmap/windows/authors.txt b/basis/io/mmap/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/io/mmap/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/io/mmap/windows/tags.txt b/basis/io/mmap/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/mmap/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/mmap/windows/windows.factor b/basis/io/mmap/windows/windows.factor new file mode 100644 index 0000000000..fcdf416511 --- /dev/null +++ b/basis/io/mmap/windows/windows.factor @@ -0,0 +1,44 @@ +USING: alien alien.c-types arrays destructors generic io.mmap +io.ports io.backend.windows io.files.windows io.backend.windows.privileges +kernel libc math math.bitwise namespaces quotations sequences +windows windows.advapi32 windows.kernel32 io.backend system +accessors locals ; +IN: io.mmap.windows + +: create-file-mapping ( hFile lpAttributes flProtect dwMaximumSizeHigh dwMaximumSizeLow lpName -- HANDLE ) + CreateFileMapping [ win32-error=0/f ] keep ; + +: map-view-of-file ( hFileMappingObject dwDesiredAccess dwFileOffsetHigh dwFileOffsetLow dwNumberOfBytesToMap -- HANDLE ) + MapViewOfFile [ win32-error=0/f ] keep ; + +:: mmap-open ( path length access-mode create-mode protect access -- handle handle address ) + [let | lo [ length HEX: ffffffff bitand ] + hi [ length -32 shift HEX: ffffffff bitand ] | + { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [ + path access-mode create-mode 0 open-file |dispose + dup handle>> f protect hi lo f create-file-mapping |dispose + dup handle>> access 0 0 0 map-view-of-file + ] with-privileges + ] ; + +TUPLE: win32-mapped-file file mapping ; + +M: win32-mapped-file dispose + [ file>> dispose ] [ mapping>> dispose ] bi ; + +C: win32-mapped-file + +M: windows (mapped-file) + [ + { GENERIC_WRITE GENERIC_READ } flags + OPEN_ALWAYS + { PAGE_READWRITE SEC_COMMIT } flags + FILE_MAP_ALL_ACCESS mmap-open + -rot + ] with-destructors ; + +M: windows close-mapped-file ( mapped-file -- ) + [ + [ handle>> &dispose drop ] + [ address>> UnmapViewOfFile win32-error=0/f ] bi + ] with-destructors ; diff --git a/basis/io/monitors/linux/linux-tests.factor b/basis/io/monitors/linux/linux-tests.factor new file mode 100644 index 0000000000..2170bd73a4 --- /dev/null +++ b/basis/io/monitors/linux/linux-tests.factor @@ -0,0 +1,37 @@ +IN: io.monitors.linux.tests +USING: io.monitors tools.test io.files io.files.temp +io.directories system sequences continuations namespaces +concurrency.count-downs kernel io threads calendar prettyprint +destructors io.timeouts accessors ; + +! On Linux, a notification on the directory itself would report an invalid +! path name +[ + [ ] [ "monitor-test-self" temp-file make-directories ] unit-test + + ! Non-recursive + [ ] [ "monitor-test-self" temp-file f "m" set ] unit-test + [ ] [ 3 seconds "m" get set-timeout ] unit-test + + [ ] [ "monitor-test-self" temp-file touch-file ] unit-test + + [ t ] [ + "m" get next-change path>> + [ "" = ] [ "monitor-test-self" temp-file = ] bi or + ] unit-test + + [ ] [ "m" get dispose ] unit-test + + ! Recursive + [ ] [ "monitor-test-self" temp-file t "m" set ] unit-test + [ ] [ 3 seconds "m" get set-timeout ] unit-test + + [ ] [ "monitor-test-self" temp-file touch-file ] unit-test + + [ t ] [ + "m" get next-change path>> + [ "" = ] [ "monitor-test-self" temp-file = ] bi or + ] unit-test + + [ ] [ "m" get dispose ] unit-test +] with-monitors diff --git a/basis/io/monitors/linux/linux.factor b/basis/io/monitors/linux/linux.factor new file mode 100644 index 0000000000..e914f32a48 --- /dev/null +++ b/basis/io/monitors/linux/linux.factor @@ -0,0 +1,136 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel io.backend io.monitors io.monitors.recursive +io.files io.pathnames io.buffers io.monitors io.ports io.timeouts +io.backend.unix io.encodings.utf8 unix.linux.inotify assocs +namespaces make threads continuations init math math.bitwise +sets alien alien.strings alien.c-types vocabs.loader accessors +system hashtables destructors unix ; +IN: io.monitors.linux + +SYMBOL: watches + +SYMBOL: inotify + +TUPLE: linux-monitor < monitor wd inotify watches disposed ; + +: ( wd path mailbox -- monitor ) + linux-monitor new-monitor + inotify get >>inotify + watches get >>watches + swap >>wd ; + +: wd>monitor ( wd -- monitor ) watches get at ; + +: ( -- port/f ) + inotify_init dup 0 < [ drop f ] [ init-fd ] if ; + +: inotify-fd ( -- fd ) inotify get handle>> handle-fd ; + +: check-existing ( wd -- ) + watches get key? [ + "Cannot open multiple monitors for the same file" throw + ] when ; + +: (add-watch) ( path mask -- wd ) + inotify-fd -rot inotify_add_watch dup io-error dup check-existing ; + +: add-watch ( path mask mailbox -- monitor ) + [ [ (normalize-path) ] dip [ (add-watch) ] [ drop ] 2bi ] dip + [ ] [ ] [ wd>> ] tri watches get set-at ; + +: check-inotify ( -- ) + inotify get [ + "Calling outside with-monitors" throw + ] unless ; + +M: linux (monitor) ( path recursive? mailbox -- monitor ) + swap [ + + ] [ + check-inotify + IN_CHANGE_EVENTS swap add-watch + ] if ; + +M: linux-monitor dispose* ( monitor -- ) + [ [ wd>> ] [ watches>> ] bi delete-at ] + [ + dup inotify>> disposed>> [ drop ] [ + [ inotify>> handle>> handle-fd ] [ wd>> ] bi + inotify_rm_watch io-error + ] if + ] bi ; + +: ignore-flags? ( mask -- ? ) + { + IN_DELETE_SELF + IN_MOVE_SELF + IN_UNMOUNT + IN_Q_OVERFLOW + IN_IGNORED + } flags bitand 0 > ; + +: parse-action ( mask -- changed ) + [ + IN_CREATE +add-file+ ?flag + IN_DELETE +remove-file+ ?flag + IN_MODIFY +modify-file+ ?flag + IN_ATTRIB +modify-file+ ?flag + IN_MOVED_FROM +rename-file-old+ ?flag + IN_MOVED_TO +rename-file-new+ ?flag + drop + ] { } make prune ; + +: parse-event-name ( event -- name ) + dup inotify-event-len zero? + [ drop "" ] [ inotify-event-name utf8 alien>string ] if ; + +: parse-file-notify ( buffer -- path changed ) + dup inotify-event-mask ignore-flags? [ + drop f f + ] [ + [ parse-event-name ] [ inotify-event-mask parse-action ] bi + ] if ; + +: events-exhausted? ( i buffer -- ? ) + fill>> >= ; + +: inotify-event@ ( i buffer -- alien ) + ptr>> ; + +: next-event ( i buffer -- i buffer ) + 2dup inotify-event@ + inotify-event-len "inotify-event" heap-size + + swap [ + ] dip ; + +: parse-file-notifications ( i buffer -- ) + 2dup events-exhausted? [ 2drop ] [ + 2dup inotify-event@ dup inotify-event-wd wd>monitor + [ parse-file-notify ] dip queue-change + next-event parse-file-notifications + ] if ; + +: inotify-read-loop ( port -- ) + dup check-disposed + dup wait-to-read drop + 0 over buffer>> parse-file-notifications + 0 over buffer>> buffer-reset + inotify-read-loop ; + +: inotify-read-thread ( port -- ) + [ inotify-read-loop ] curry ignore-errors ; + +M: linux init-monitors + H{ } clone watches set + [ + [ inotify set ] + [ + [ inotify-read-thread ] curry + "Linux monitor thread" spawn drop + ] bi + ] [ + "Linux kernel version is too old" throw + ] if* ; + +M: linux dispose-monitors + inotify get dispose ; diff --git a/basis/io/monitors/linux/tags.txt b/basis/io/monitors/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/monitors/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/monitors/macosx/macosx.factor b/basis/io/monitors/macosx/macosx.factor new file mode 100644 index 0000000000..be1dcc64b6 --- /dev/null +++ b/basis/io/monitors/macosx/macosx.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.backend io.monitors +core-foundation.fsevents continuations kernel sequences +namespaces arrays system locals accessors destructors fry ; +IN: io.monitors.macosx + +TUPLE: macosx-monitor < monitor handle ; + +: enqueue-notifications ( triples monitor -- ) + '[ first { +modify-file+ } _ queue-change ] each ; + +M:: macosx (monitor) ( path recursive? mailbox -- monitor ) + [let | path [ path normalize-path ] | + path mailbox macosx-monitor new-monitor + dup [ enqueue-notifications ] curry + path 1array 0 0 >>handle + ] ; + +M: macosx-monitor dispose + handle>> dispose ; + +macosx set-io-backend diff --git a/basis/io/monitors/macosx/tags.txt b/basis/io/monitors/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/monitors/macosx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/monitors/monitors-docs.factor b/basis/io/monitors/monitors-docs.factor index 3242b276e6..f0278e300e 100644 --- a/basis/io/monitors/monitors-docs.factor +++ b/basis/io/monitors/monitors-docs.factor @@ -17,9 +17,12 @@ HELP: (monitor) { $contract "Opens a file system change monitor which listens for changes on " { $snippet "path" } " and posts notifications to " { $snippet "mailbox" } " as triples with shape " { $snippet "{ path changed monitor } " } ". The boolean indicates whether changes in subdirectories should be reported." } { $errors "Throws an error if the pathname does not exist, if a monitor could not be created or if the platform does not support monitors." } ; +HELP: file-change +{ $class-description "A change notification output by " { $link next-change } ". The " { $snippet "path" } " slot holds a pathname string. The " { $snippet "changed" } " slots holds a sequence of symbols documented in " { $link "io.monitors.descriptors" } "." } ; + HELP: next-change -{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changed" "a change descriptor" } } -{ $contract "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is a sequence of symbols documented in " { $link "io.monitors.descriptors" } "." } +{ $values { "monitor" "a monitor" } { "change" file-change } } +{ $contract "Waits for file system changes and outputs a change descriptor for the first changed file." } { $errors "Throws an error if the monitor is closed from another thread." } ; HELP: with-monitor @@ -46,7 +49,9 @@ HELP: +rename-file+ { $description "Indicates that a file has been renamed." } ; ARTICLE: "io.monitors.descriptors" "File system change descriptors" -"Change descriptors output by " { $link next-change } ":" +"The " { $link next-change } " word outputs instances of a class:" +{ $subsection file-change } +"The " { $slot "changed" } " slot holds a sequence which may contain any of the following symbols:" { $subsection +add-file+ } { $subsection +remove-file+ } { $subsection +modify-file+ } @@ -55,7 +60,7 @@ ARTICLE: "io.monitors.descriptors" "File system change descriptors" { $subsection +rename-file+ } ; ARTICLE: "io.monitors.platforms" "Monitors on different platforms" -"Whether the " { $snippet "path" } " output value of " { $link next-change } " contains an absolute path or a path relative to the path given to " { $link } " is unspecified, and may even vary on the same platform. User code should not assume either case." +"Whether the " { $slot "path" } " slot of a " { $link file-change } " contains an absolute path or a path relative to the path given to " { $link } " is unspecified, and may even vary on the same platform. User code should not assume either case." $nl "If the immediate path being monitored was changed, then " { $snippet "path" } " will equal " { $snippet "\"\"" } "; however this condition is not reported on all platforms. See below." { $heading "Mac OS X" } @@ -63,7 +68,7 @@ $nl $nl { $snippet "FSEventStream" } "s always monitor directory hierarchies recursively, and the " { $snippet "recursive?" } " parameter to " { $link } " has no effect." $nl -"The " { $snippet "changed" } " output value of the " { $link next-change } " word always outputs " { $link +modify-file+ } " and the " { $snippet "path" } " output value is always the directory containing the file that changed. Unlike other platforms, fine-grained information is not available." +"The " { $snippet "changed" } " slot of the " { $link file-change } " word tuple always contains " { $link +modify-file+ } " and the " { $snippet "path" } " slot is always the directory containing the file that changed. Unlike other platforms, fine-grained information is not available." $nl "Only directories may be monitored, not individual files. Changes to the directory itself (permissions, modification time, and so on) are not reported; only changes to children are reported." { $heading "Windows" } @@ -107,7 +112,7 @@ $nl { $code "USE: io.monitors" ": watch-loop ( monitor -- )" - " dup next-change . . nl nl flush watch-loop ;" + " dup next-change . nl nl flush watch-loop ;" "" ": watch-directory ( path -- )" " [ t [ watch-loop ] with-monitor ] with-monitors" diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor index 1cc97753b7..7c50a4e637 100644 --- a/basis/io/monitors/monitors-tests.factor +++ b/basis/io/monitors/monitors-tests.factor @@ -1,7 +1,9 @@ IN: io.monitors.tests USING: io.monitors tools.test io.files system sequences continuations namespaces concurrency.count-downs kernel io -threads calendar prettyprint destructors io.timeouts ; +threads calendar prettyprint destructors io.timeouts +io.files.temp io.directories io.directories.hierarchy +io.pathnames accessors ; os { winnt linux macosx } member? [ [ @@ -51,7 +53,7 @@ os { winnt linux macosx } member? [ "b" get count-down [ - "m" get next-change drop + "m" get next-change path>> dup print flush dup parent-directory [ trim-right-separators "xyz" tail? ] either? not @@ -60,7 +62,7 @@ os { winnt linux macosx } member? [ "c1" get count-down [ - "m" get next-change drop + "m" get next-change path>> dup print flush dup parent-directory [ trim-right-separators "yxy" tail? ] either? not @@ -99,13 +101,13 @@ os { winnt linux macosx } member? [ ! Non-recursive [ ] [ "monitor-timeout-test" temp-file f "m" set ] unit-test [ ] [ 3 seconds "m" get set-timeout ] unit-test - [ [ t ] [ "m" get next-change 2drop ] [ ] while ] must-fail + [ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail [ ] [ "m" get dispose ] unit-test ! Recursive [ ] [ "monitor-timeout-test" temp-file t "m" set ] unit-test [ ] [ 3 seconds "m" get set-timeout ] unit-test - [ [ t ] [ "m" get next-change 2drop ] [ ] while ] must-fail + [ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail [ ] [ "m" get dispose ] unit-test ] with-monitors ] when diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index 72f2bc80c5..7d40a1563a 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend kernel continuations destructors namespaces sequences assocs hashtables sorting arrays threads boxes -io.timeouts accessors concurrency.mailboxes +io.timeouts accessors concurrency.mailboxes fry system vocabs.loader combinators ; IN: io.monitors @@ -33,17 +33,19 @@ M: monitor set-timeout (>>timeout) ; swap >>queue swap >>path ; inline +TUPLE: file-change path changed monitor ; + : queue-change ( path changes monitor -- ) 3dup and and - [ [ 3array ] keep queue>> mailbox-put ] [ 3drop ] if ; + [ [ file-change boa ] keep queue>> mailbox-put ] [ 3drop ] if ; HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor ) : ( path recursive? -- monitor ) (monitor) ; -: next-change ( monitor -- path changed ) - [ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ; +: next-change ( monitor -- change ) + [ queue>> ] [ timeout ] bi mailbox-get-timeout ; SYMBOL: +add-file+ SYMBOL: +remove-file+ @@ -55,9 +57,15 @@ SYMBOL: +rename-file+ : with-monitor ( path recursive? quot -- ) [ ] dip with-disposal ; inline +: run-monitor ( path recursive? quot -- ) + '[ [ @ t ] loop ] with-monitor ; inline + +: spawn-monitor ( path recursive? quot -- ) + [ '[ _ _ _ run-monitor ] ] [ 2drop "Monitoring " prepend ] 3bi + spawn drop ; { - { [ os macosx? ] [ "io.unix.macosx.monitors" require ] } - { [ os linux? ] [ "io.unix.linux.monitors" require ] } - { [ os winnt? ] [ "io.windows.nt.monitors" require ] } - [ ] + { [ os macosx? ] [ "io.monitors.macosx" require ] } + { [ os linux? ] [ "io.monitors.linux" require ] } + { [ os winnt? ] [ "io.monitors.windows.nt" require ] } + { [ os bsd? ] [ ] } } cond diff --git a/basis/io/monitors/recursive/recursive-tests.factor b/basis/io/monitors/recursive/recursive-tests.factor index fba879a6d2..ace93ace44 100644 --- a/basis/io/monitors/recursive/recursive-tests.factor +++ b/basis/io/monitors/recursive/recursive-tests.factor @@ -1,6 +1,7 @@ USING: accessors math kernel namespaces continuations io.files io.monitors io.monitors.recursive io.backend -concurrency.mailboxes tools.test destructors ; +concurrency.mailboxes tools.test destructors io.files.info +io.pathnames io.files.temp io.directories.hierarchy ; IN: io.monitors.recursive.tests \ pump-thread must-infer diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor index a96c6f04f1..943345bf18 100644 --- a/basis/io/monitors/recursive/recursive.factor +++ b/basis/io/monitors/recursive/recursive.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors sequences assocs arrays continuations destructors combinators kernel threads concurrency.messaging -concurrency.mailboxes concurrency.promises io.files io.monitors -debugger fry ; +concurrency.mailboxes concurrency.promises io.files io.files.info +io.directories io.pathnames io.monitors debugger fry ; IN: io.monitors.recursive ! Simulate recursive monitors on platforms that don't have them @@ -45,12 +45,11 @@ M: recursive-monitor dispose* bi ; : stop-pump ( -- ) - monitor tget children>> [ nip dispose ] assoc-each ; + monitor tget children>> values dispose-each ; : pump-step ( msg -- ) - first3 path>> swap [ prepend-path ] dip monitor tget 3array - monitor tget queue>> - mailbox-put ; + [ [ monitor>> path>> ] [ path>> ] bi append-path ] [ changed>> ] bi + monitor tget queue-change ; : child-added ( path monitor -- ) path>> prepend-path add-child-monitor ; @@ -59,7 +58,7 @@ M: recursive-monitor dispose* path>> prepend-path remove-child-monitor ; : update-hierarchy ( msg -- ) - first3 swap [ + [ path>> ] [ monitor>> ] [ changed>> ] tri [ { { +add-file+ [ child-added ] } { +remove-file+ [ child-removed ] } diff --git a/basis/io/monitors/windows/nt/authors.txt b/basis/io/monitors/windows/nt/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/io/monitors/windows/nt/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/io/monitors/windows/nt/nt-tests.factor b/basis/io/monitors/windows/nt/nt-tests.factor new file mode 100644 index 0000000000..79cd7e9e9f --- /dev/null +++ b/basis/io/monitors/windows/nt/nt-tests.factor @@ -0,0 +1,4 @@ +IN: io.monitors.windows.nt.tests +USING: io.monitors.windows.nt tools.test ; + +\ fill-queue-thread must-infer diff --git a/basis/io/monitors/windows/nt/nt.factor b/basis/io/monitors/windows/nt/nt.factor new file mode 100755 index 0000000000..d2408a3dd1 --- /dev/null +++ b/basis/io/monitors/windows/nt/nt.factor @@ -0,0 +1,106 @@ +! Copyright (C) 2008 Doug Coleman, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types alien.strings libc destructors locals +kernel math assocs namespaces make continuations sequences +hashtables sorting arrays combinators math.bitwise strings +system accessors threads splitting io.backend io.backend.windows +io.backend.windows.nt io.files.windows.nt io.monitors io.ports +io.buffers io.files io.timeouts io.encodings.string +io.encodings.utf16n io windows windows.kernel32 windows.types +io.pathnames ; +IN: io.monitors.windows.nt + +: open-directory ( path -- handle ) + normalize-path + FILE_LIST_DIRECTORY + share-mode + f + OPEN_EXISTING + { FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } flags + f + CreateFile opened-file ; + +TUPLE: win32-monitor-port < input-port recursive ; + +TUPLE: win32-monitor < monitor port ; + +: begin-reading-changes ( port -- overlapped ) + { + [ handle>> handle>> ] + [ buffer>> ptr>> ] + [ buffer>> size>> ] + [ recursive>> 1 0 ? ] + } cleave + FILE_NOTIFY_CHANGE_ALL + 0 + (make-overlapped) + [ f ReadDirectoryChangesW win32-error=0/f ] keep ; + +: read-changes ( port -- bytes-transferred ) + [ + [ begin-reading-changes ] [ twiddle-thumbs ] bi + ] with-destructors ; + +: parse-action ( action -- changed ) + { + { FILE_ACTION_ADDED [ +add-file+ ] } + { FILE_ACTION_REMOVED [ +remove-file+ ] } + { FILE_ACTION_MODIFIED [ +modify-file+ ] } + { FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] } + { FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] } + [ drop +modify-file+ ] + } case 1array ; + +: memory>u16-string ( alien len -- string ) + memory>byte-array utf16n decode ; + +: parse-notify-record ( buffer -- path changed ) + [ + [ FILE_NOTIFY_INFORMATION-FileName ] + [ FILE_NOTIFY_INFORMATION-FileNameLength ] + bi memory>u16-string + ] + [ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ; + +: (file-notify-records) ( buffer -- buffer ) + dup , + dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [ + [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep + (file-notify-records) + ] unless ; + +: file-notify-records ( buffer -- seq ) + [ (file-notify-records) drop ] { } make ; + +:: parse-notify-records ( monitor buffer -- ) + buffer file-notify-records [ + parse-notify-record + [ monitor path>> prepend-path normalize-path ] dip + monitor queue-change + ] each ; + +: fill-queue ( monitor -- ) + dup port>> dup check-disposed + [ buffer>> ptr>> ] [ read-changes zero? ] bi + [ 2dup parse-notify-records ] unless + 2drop ; + +: (fill-queue-thread) ( monitor -- ) + dup fill-queue (fill-queue-thread) ; + +: fill-queue-thread ( monitor -- ) + [ dup fill-queue (fill-queue-thread) ] + [ dup already-disposed? [ 2drop ] [ rethrow ] if ] recover ; + +M:: winnt (monitor) ( path recursive? mailbox -- monitor ) + [ + path normalize-path mailbox win32-monitor new-monitor + path open-directory \ win32-monitor-port + recursive? >>recursive + >>port + dup [ fill-queue-thread ] curry + "Windows monitor thread" spawn drop + ] with-destructors ; + +M: win32-monitor dispose + port>> dispose ; diff --git a/basis/io/monitors/windows/nt/tags.txt b/basis/io/monitors/windows/nt/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/monitors/windows/nt/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/paths/authors.txt b/basis/io/paths/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/io/paths/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/io/paths/paths-tests.factor b/basis/io/paths/paths-tests.factor deleted file mode 100644 index 01763ce5c0..0000000000 --- a/basis/io/paths/paths-tests.factor +++ /dev/null @@ -1,11 +0,0 @@ -USING: io.paths kernel tools.test io.files.unique sequences -io.files namespaces sorting ; -IN: io.paths.tests - -[ t ] [ - [ - 10 [ "io.paths.test" "gogogo" make-unique-file* ] replicate - current-directory get t [ ] find-all-files - ] with-unique-directory - [ natural-sort ] bi@ = -] unit-test diff --git a/basis/io/paths/paths.factor b/basis/io/paths/paths.factor deleted file mode 100755 index 212ba9e396..0000000000 --- a/basis/io/paths/paths.factor +++ /dev/null @@ -1,58 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays deques dlists io.files -kernel sequences system vocabs.loader fry continuations ; -IN: io.paths - -TUPLE: directory-iterator path bfs queue ; - -> swap bfs>> - [ push-front ] [ push-back ] if - ] curry each ; - -: ( path bfs? -- iterator ) - directory-iterator boa - dup path>> over push-directory ; - -: next-file ( iter -- file/f ) - dup queue>> deque-empty? [ drop f ] [ - dup queue>> pop-back dup link-info directory? - [ over push-directory next-file ] [ nip ] if - ] if ; - -: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) - over next-file [ - over call - [ 2nip ] [ iterate-directory ] if* - ] [ - 2drop f - ] if* ; inline recursive - -PRIVATE> - -: find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) - [ ] dip - [ keep and ] curry iterate-directory ; inline - -: each-file ( path bfs? quot: ( obj -- ? ) -- ) - [ ] dip - [ f ] compose iterate-directory drop ; inline - -: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths ) - [ ] dip - pusher [ [ f ] compose iterate-directory drop ] dip ; inline - -: recursive-directory ( path bfs? -- paths ) - [ ] accumulator [ each-file ] dip ; - -: find-in-directories ( directories bfs? quot -- path' ) - '[ _ _ find-file ] attempt-all ; inline - -os windows? [ "io.paths.windows" require ] when diff --git a/basis/io/paths/windows/authors.txt b/basis/io/paths/windows/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/basis/io/paths/windows/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/io/paths/windows/tags.txt b/basis/io/paths/windows/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/paths/windows/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/paths/windows/windows.factor b/basis/io/paths/windows/windows.factor deleted file mode 100644 index b4858aaef8..0000000000 --- a/basis/io/paths/windows/windows.factor +++ /dev/null @@ -1,13 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: arrays continuations fry io.files io.paths -kernel windows.shell32 sequences ; -IN: io.paths.windows - -: program-files-directories ( -- array ) - program-files program-files-x86 2array ; inline - -: find-in-program-files ( base-directory bfs? quot -- path ) - [ - [ program-files-directories ] dip '[ _ append-path ] map - ] 2dip find-in-directories ; inline diff --git a/basis/io/pipes/pipes-docs.factor b/basis/io/pipes/pipes-docs.factor index 221cce1dbe..1ba3c05a6a 100644 --- a/basis/io/pipes/pipes-docs.factor +++ b/basis/io/pipes/pipes-docs.factor @@ -29,7 +29,7 @@ HELP: run-pipeline } } { $examples - "Print the lines of a log file which contain the string ``error'', sort them and filter out duplicates, using Unix shell commands only:" + "Print the lines of a log file which contain the string “error”, sort them and filter out duplicates, using Unix shell commands only:" { $code "{ \"cat log.txt\" \"grep error\" \"sort\" \"uniq\" } run-pipeline" } } ; diff --git a/basis/io/pipes/pipes.factor b/basis/io/pipes/pipes.factor index 3a7fa5a2e0..9cadb3f6cc 100644 --- a/basis/io/pipes/pipes.factor +++ b/basis/io/pipes/pipes.factor @@ -53,7 +53,7 @@ PRIVATE> ] 2parallel-map ; { - { [ os unix? ] [ "io.unix.pipes" require ] } - { [ os winnt? ] [ "io.windows.nt.pipes" require ] } + { [ os unix? ] [ "io.pipes.unix" require ] } + { [ os winnt? ] [ "io.pipes.windows.nt" require ] } [ ] } cond diff --git a/basis/io/pipes/unix/pipes-tests.factor b/basis/io/pipes/unix/pipes-tests.factor new file mode 100644 index 0000000000..ce3f1551b1 --- /dev/null +++ b/basis/io/pipes/unix/pipes-tests.factor @@ -0,0 +1,17 @@ +USING: tools.test io.pipes io.pipes.unix io.encodings.utf8 +io.encodings io namespaces sequences ; +IN: io.pipes.unix.tests + +[ { 0 0 } ] [ { "ls" "grep ." } run-pipeline ] unit-test + +[ { 0 f 0 } ] [ + { + "ls" + [ + input-stream [ utf8 ] change + output-stream [ utf8 ] change + input-stream get lines reverse [ print ] each f + ] + "grep ." + } run-pipeline +] unit-test diff --git a/basis/io/pipes/unix/tags.txt b/basis/io/pipes/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/pipes/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/pipes/unix/unix.factor b/basis/io/pipes/unix/unix.factor new file mode 100644 index 0000000000..6a0015084b --- /dev/null +++ b/basis/io/pipes/unix/unix.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: system kernel unix math sequences +io.backend.unix io.ports specialized-arrays.int accessors ; +IN: io.pipes.unix +QUALIFIED: io.pipes + +M: unix io.pipes:(pipe) ( -- pair ) + 2 + [ underlying>> pipe io-error ] + [ first2 [ init-fd ] bi@ io.pipes:pipe boa ] bi ; diff --git a/basis/io/pipes/windows/nt/authors.txt b/basis/io/pipes/windows/nt/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/pipes/windows/nt/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/pipes/windows/nt/nt.factor b/basis/io/pipes/windows/nt/nt.factor new file mode 100644 index 0000000000..cec03cf6d3 --- /dev/null +++ b/basis/io/pipes/windows/nt/nt.factor @@ -0,0 +1,46 @@ +! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types arrays destructors io io.backend.windows libc +windows.types math.bitwise windows.kernel32 windows namespaces +make kernel sequences windows.errors assocs math.parser system +random combinators accessors io.pipes io.ports ; +IN: io.pipes.windows.nt + +! This code is based on +! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py + +: create-named-pipe ( name -- handle ) + { PIPE_ACCESS_INBOUND FILE_FLAG_OVERLAPPED } flags + PIPE_TYPE_BYTE + 1 + 4096 + 4096 + 0 + default-security-attributes + CreateNamedPipe opened-file ; + +: open-other-end ( name -- handle ) + GENERIC_WRITE + { FILE_SHARE_READ FILE_SHARE_WRITE } flags + default-security-attributes + OPEN_EXISTING + FILE_FLAG_OVERLAPPED + f + CreateFile opened-file ; + +: unique-pipe-name ( -- string ) + [ + "\\\\.\\pipe\\factor-" % + pipe counter # + "-" % + 32 random-bits # + "-" % + micros # + ] "" make ; + +M: winnt (pipe) ( -- pipe ) + [ + unique-pipe-name + [ create-named-pipe ] [ open-other-end ] bi + pipe boa + ] with-destructors ; diff --git a/basis/io/pipes/windows/nt/tags.txt b/basis/io/pipes/windows/nt/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/pipes/windows/nt/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 6eb61a24a7..1fe717d5ee 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -99,7 +99,7 @@ TUPLE: output-port < buffered-port ; output-port ; : wait-to-write ( len port -- ) - tuck buffer>> buffer-capacity <= + [ nip ] [ buffer>> buffer-capacity <= ] 2bi [ drop ] [ stream-flush ] if ; inline M: output-port stream-write1 diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor index 60402c37ea..0326969e4f 100644 --- a/basis/io/sockets/secure/openssl/openssl.factor +++ b/basis/io/sockets/secure/openssl/openssl.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors byte-arrays kernel sequences -namespaces math math.order combinators init alien alien.c-types -alien.strings libc continuations destructors summary -splitting assocs random math.parser locals unicode.case openssl -openssl.libcrypto openssl.libssl io.backend io.ports io.files +USING: accessors byte-arrays kernel sequences namespaces math +math.order combinators init alien alien.c-types alien.strings +libc continuations destructors summary splitting assocs random +math.parser locals unicode.case openssl openssl.libcrypto +openssl.libssl io.backend io.ports io.pathnames io.encodings.8-bit io.timeouts io.sockets.secure ; IN: io.sockets.secure.openssl diff --git a/basis/io/sockets/secure/secure-docs.factor b/basis/io/sockets/secure/secure-docs.factor index 01f64dfccf..5dd4fe6b40 100644 --- a/basis/io/sockets/secure/secure-docs.factor +++ b/basis/io/sockets/secure/secure-docs.factor @@ -86,7 +86,7 @@ ARTICLE: "ssl-contexts" "Secure socket contexts" HELP: secure { $class-description "The class of secure socket addresses." } ; -HELP: ( addrspec -- secure ) +HELP: { $values { "addrspec" "an address specifier" } { "secure" secure } } { $description "Creates a new secure socket address, which can then be passed to " { $link } " or " { $link } "." } ; diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor index e752e7c328..c4a1475f48 100644 --- a/basis/io/sockets/secure/secure.factor +++ b/basis/io/sockets/secure/secure.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel symbols namespaces continuations +USING: accessors kernel namespaces continuations destructors io debugger io.sockets sequences summary calendar delegate system vocabs.loader combinators present ; IN: io.sockets.secure @@ -97,6 +97,6 @@ HOOK: send-secure-handshake secure-socket-backend ( -- ) HOOK: accept-secure-handshake secure-socket-backend ( -- ) { - { [ os unix? ] [ "io.unix.sockets.secure" require ] } + { [ os unix? ] [ "io.sockets.secure.unix" require ] } { [ os windows? ] [ "openssl" require ] } } cond diff --git a/basis/io/sockets/secure/unix/debug/debug.factor b/basis/io/sockets/secure/unix/debug/debug.factor new file mode 100644 index 0000000000..d32cdee2ed --- /dev/null +++ b/basis/io/sockets/secure/unix/debug/debug.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors io.sockets.secure kernel ; +IN: io.sockets.secure.unix.debug + +: with-test-context ( quot -- ) + + "resource:basis/openssl/test/server.pem" >>key-file + "resource:basis/openssl/test/dh1024.pem" >>dh-file + "password" >>password + swap with-secure-context ; inline diff --git a/basis/io/sockets/secure/unix/tags.txt b/basis/io/sockets/secure/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/sockets/secure/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/sockets/secure/unix/unix-tests.factor b/basis/io/sockets/secure/unix/unix-tests.factor new file mode 100644 index 0000000000..a3bfacc8a8 --- /dev/null +++ b/basis/io/sockets/secure/unix/unix-tests.factor @@ -0,0 +1,147 @@ +IN: io.sockets.secure.tests +USING: accessors kernel namespaces io io.sockets +io.sockets.secure io.encodings.ascii io.streams.duplex +io.backend.unix classes words destructors threads tools.test +concurrency.promises byte-arrays locals calendar io.timeouts +io.sockets.secure.unix.debug ; + +\ must-infer +{ 1 0 } [ [ ] with-secure-context ] must-infer-as + +[ ] [ "port" set ] unit-test + +:: server-test ( quot -- ) + [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept [ + quot call + ] curry with-stream + ] with-disposal + ] with-test-context + ] "SSL server test" spawn drop ; + +: client-test ( -- string ) + [ + "127.0.0.1" "port" get ?promise ascii drop contents + ] with-secure-context ; + +[ ] [ [ class name>> write ] server-test ] unit-test + +[ "secure" ] [ client-test ] unit-test + +! Now, see what happens if the server closes the connection prematurely +[ ] [ "port" set ] unit-test + +[ ] [ + [ + drop + "hello" write flush + input-stream get stream>> handle>> f >>connected drop + ] server-test +] unit-test + +[ client-test ] [ premature-close? ] must-fail-with + +! Now, try validating the certificate. This should fail because its +! actually an invalid certificate +[ ] [ "port" set ] unit-test + +[ ] [ [ drop "hi" write ] server-test ] unit-test + +[ + [ + "localhost" "port" get ?promise ascii + drop dispose + ] with-secure-context +] [ certificate-verify-error? ] must-fail-with + +! Client-side handshake timeout +[ ] [ "port" set ] unit-test + +[ ] [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> port>> "port" get fulfill + accept drop 1 minutes sleep dispose + ] with-disposal + ] "Silly server" spawn drop +] unit-test + +[ + 1 seconds secure-socket-timeout [ + client-test + ] with-variable +] [ io-timeout? ] must-fail-with + +! Server-side handshake timeout +[ ] [ "port" set ] unit-test + +[ ] [ + [ + "127.0.0.1" "port" get ?promise + ascii drop 1 minutes sleep dispose + ] "Silly client" spawn drop +] unit-test + +[ + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop dup stream-read1 drop dispose + ] with-disposal + ] with-test-context + ] with-variable +] [ io-timeout? ] must-fail-with + +! Client socket shutdown timeout + +! Until I sort out two-stage handshaking, I can't do much here +[ + [ ] [ "port" set ] unit-test + + [ ] [ + [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop 1 minutes sleep dispose + ] with-disposal + ] with-test-context + ] "Silly server" spawn drop + ] unit-test + + [ + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" "port" get ?promise + ascii drop dispose + ] with-secure-context + ] with-variable + ] [ io-timeout? ] must-fail-with + + ! Server socket shutdown timeout + [ ] [ "port" set ] unit-test + + [ ] [ + [ + [ + "127.0.0.1" "port" get ?promise + ascii drop 1 minutes sleep dispose + ] with-test-context + ] "Silly client" spawn drop + ] unit-test + + [ + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop dispose + ] with-disposal + ] with-test-context + ] with-variable + ] [ io-timeout? ] must-fail-with +] drop diff --git a/basis/io/sockets/secure/unix/unix.factor b/basis/io/sockets/secure/unix/unix.factor new file mode 100644 index 0000000000..8419246eb6 --- /dev/null +++ b/basis/io/sockets/secure/unix/unix.factor @@ -0,0 +1,200 @@ +! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors unix byte-arrays kernel sequences +namespaces math math.order combinators init alien alien.c-types +alien.strings libc continuations destructors openssl +openssl.libcrypto openssl.libssl io io.files io.ports +io.backend.unix io.sockets.unix io.encodings.ascii io.buffers +io.sockets io.sockets.secure io.sockets.secure.openssl +io.timeouts system summary fry ; +IN: io.sockets.secure.unix + +M: ssl-handle handle-fd file>> handle-fd ; + +: syscall-error ( r -- * ) + ERR_get_error dup zero? [ + drop + { + { -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] } + { 0 [ premature-close ] } + } case + ] [ nip (ssl-error) ] if ; + +: check-accept-response ( handle r -- event ) + over handle>> over SSL_get_error + { + { SSL_ERROR_NONE [ 2drop f ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_ACCEPT [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_ZERO_RETURN [ (ssl-error) ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ; + +: do-ssl-accept ( ssl-handle -- ) + dup dup handle>> SSL_accept check-accept-response dup + [ [ dup file>> ] dip wait-for-fd do-ssl-accept ] [ 2drop ] if ; + +: maybe-handshake ( ssl-handle -- ) + dup connected>> [ drop ] [ + t >>connected + [ do-ssl-accept ] with-timeout + ] if ; + +: check-response ( port r -- port r n ) + over handle>> handle>> over SSL_get_error ; inline + +! Input ports +: check-read-response ( port r -- event ) + check-response + { + { SSL_ERROR_NONE [ swap buffer>> n>buffer f ] } + { SSL_ERROR_ZERO_RETURN [ 2drop f ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ; + +M: ssl-handle refill + dup maybe-handshake + handle>> ! ssl + over buffer>> + [ buffer-end ] ! buf + [ buffer-capacity ] bi ! len + SSL_read + check-read-response ; + +! Output ports +: check-write-response ( port r -- event ) + check-response + { + { SSL_ERROR_NONE [ swap buffer>> buffer-consume f ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ; + +M: ssl-handle drain + dup maybe-handshake + handle>> ! ssl + over buffer>> + [ buffer@ ] ! buf + [ buffer-length ] bi ! len + SSL_write + check-write-response ; + +M: ssl-handle cancel-operation + file>> cancel-operation ; + +M: ssl-handle timeout + drop secure-socket-timeout get ; + +! Client sockets +: ( fd -- ssl ) + [ fd>> BIO_NOCLOSE BIO_new_socket dup ssl-error ] keep + [ handle>> swap dup SSL_set_bio ] keep ; + +M: secure ((client)) ( addrspec -- handle ) + addrspec>> ((client)) ; + +M: secure parse-sockaddr addrspec>> parse-sockaddr ; + +M: secure (get-local-address) addrspec>> (get-local-address) ; + +: check-connect-response ( ssl-handle r -- event ) + over handle>> over SSL_get_error + { + { SSL_ERROR_NONE [ 2drop f ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ; + +: do-ssl-connect ( ssl-handle -- ) + dup dup handle>> SSL_connect check-connect-response dup + [ dupd wait-for-fd do-ssl-connect ] [ 2drop ] if ; + +: resume-session ( ssl-handle ssl-session -- ) + [ [ handle>> ] dip SSL_set_session ssl-error ] + [ drop do-ssl-connect ] + 2bi ; + +: begin-session ( ssl-handle addrspec -- ) + [ drop do-ssl-connect ] + [ [ handle>> SSL_get1_session ] dip save-session ] + 2bi ; + +: secure-connection ( client-out addrspec -- ) + [ handle>> ] dip + [ + '[ + _ dup get-session + [ resume-session ] [ begin-session ] ?if + ] with-timeout + ] [ drop t >>connected drop ] 2bi ; + +M: secure establish-connection ( client-out remote -- ) + addrspec>> [ establish-connection ] [ secure-connection ] 2bi ; + +M: secure (server) addrspec>> (server) ; + +M: secure (accept) + [ + addrspec>> (accept) [ |dispose ] dip + ] with-destructors ; + +: check-shutdown-response ( handle r -- event ) + #! We don't do two-step shutdown here because I couldn't + #! figure out how to do it with non-blocking BIOs. Also, it + #! seems that SSL_shutdown always returns 0 -- this sounds + #! like a bug + over handle>> over SSL_get_error + { + { SSL_ERROR_NONE [ 2drop f ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ dup zero? [ 2drop f ] [ syscall-error ] if ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ; + +: (shutdown) ( handle -- ) + dup dup handle>> SSL_shutdown check-shutdown-response + dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ; + +M: ssl-handle shutdown + dup connected>> [ + f >>connected [ (shutdown) ] with-timeout + ] [ drop ] if ; + +: check-buffer ( port -- port ) + dup buffer>> buffer-empty? [ upgrade-buffers-full ] unless ; + +: input/output-ports ( -- input output ) + input-stream output-stream + [ get underlying-port check-buffer ] bi@ + 2dup [ handle>> ] bi@ eq? [ upgrade-on-non-socket ] unless ; + +: make-input/output-secure ( input output -- ) + dup handle>> fd? [ upgrade-on-non-socket ] unless + [ ] change-handle + handle>> >>handle drop ; + +: (send-secure-handshake) ( output -- ) + remote-address get [ upgrade-on-non-socket ] unless* + secure-connection ; + +M: openssl send-secure-handshake + input/output-ports + [ make-input/output-secure ] keep + [ (send-secure-handshake) ] keep + remote-address get dup inet? [ + host>> swap handle>> check-certificate + ] [ 2drop ] if ; + +M: openssl accept-secure-handshake + input/output-ports + make-input/output-secure ; diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor index cfc33a02f6..a66ed1d0c0 100644 --- a/basis/io/sockets/sockets-docs.factor +++ b/basis/io/sockets/sockets-docs.factor @@ -3,11 +3,20 @@ strings byte-arrays continuations destructors quotations ; IN: io.sockets ARTICLE: "network-addressing" "Address specifiers" -"The networking words are quite general and work with " { $emphasis "address specifiers" } " rather than concrete concepts such as host names. There are four types of address specifiers:" +"The networking words are quite general and work with " { $emphasis "address specifiers" } " rather than concrete concepts such as host names. There are four types of address specifiers." +$nl +"Unix domain sockets:" { $subsection local } +{ $subsection } +"Internet host name/port number pairs; the host name is resolved to an IPv4 or IPv6 address using the operating system's resolver:" { $subsection inet } +{ $subsection } +"IPv4 addresses, with no host name resolution:" { $subsection inet4 } +{ $subsection } +"IPv6 addresses, with no host name resolution:" { $subsection inet6 } +{ $subsection } "While the " { $link inet } " addressing specifier is capable of performing name lookups when passed to " { $link } ", sometimes it is necessary to look up a host name without making a connection:" { $subsection resolve-host } ; @@ -73,34 +82,42 @@ HELP: inet "This address specifier is only supported by " { $link } ", which calls " { $link resolve-host } " to obtain a list of IP addresses associated with the host name, and attempts a connection to each one in turn until one succeeds. Other network words do not accept this address specifier, and " { $link resolve-host } " must be called directly; it is then up to the application to pick the correct address from the (possibly several) addresses associated to the host name." } { $examples - { $code "\"www.apple.com\" \"http\" " } - { $code "\"localhost\" 8080 " } + { $code "\"www.apple.com\" 80 " } } ; +HELP: +{ $values { "host" "a host name" } { "port" "a port number" } { "inet" inet } } +{ $description "Creates a new " { $link inet } " address specifier." } ; + HELP: inet4 { $class-description "IPv4 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv4 address and port number, respectively. New instances are created by calling " { $link } "." } -{ $notes -"Most applications do not operate on IPv4 addresses directly, and instead should use " { $link resolve-host } " to look up the address associated to a host name. Also, try to support IPv6 where possible." -} +{ $notes "Most applications do not operate on IPv4 addresses directly, and instead should use the " { $link inet } " address specifier, or call " { $link resolve-host } "." } { $examples { $code "\"127.0.0.1\" 8080 " } } ; +HELP: +{ $values { "host" "an IPv4 address" } { "port" "a port number" } { "inet4" inet4 } } +{ $description "Creates a new " { $link inet4 } " address specifier." } ; + HELP: inet6 { $class-description "IPv6 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv6 address and port number, respectively. New instances are created by calling " { $link } "." } -{ $notes -"Most applications do not operate on IPv6 addresses directly, and instead should use " { $link resolve-host } " to look up the address associated to a host name." } +{ $notes "Most applications do not operate on IPv6 addresses directly, and instead should use the " { $link inet } " address specifier, or call " { $link resolve-host } "." } { $examples { $code "\"::1\" 8080 " } } ; +HELP: +{ $values { "host" "an IPv6 address" } { "port" "a port number" } { "inet6" inet6 } } +{ $description "Creates a new " { $link inet6 } " address specifier." } ; + HELP: { $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } { "local" "an address specifier" } } { $description "Opens a network connection and outputs a bidirectional stream using the given encoding, together with the local address the socket was bound to." } { $errors "Throws an error if the connection cannot be established." } { $notes "The " { $link with-client } " word is easier to use in most situations." } { $examples - { $code "\"www.apple.com\" \"http\" utf8 " } + { $code "\"www.apple.com\" 80 utf8 " } } ; HELP: with-client diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor index 4b95a31512..dc0c698699 100644 --- a/basis/io/sockets/sockets-tests.factor +++ b/basis/io/sockets/sockets-tests.factor @@ -33,6 +33,9 @@ concurrency.promises threads io.streams.string ; [ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } ] [ "::1" T{ inet6 } inet-pton ] unit-test +[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 } ] +[ "::100" T{ inet6 } inet-pton ] unit-test + [ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 2 } ] [ "1::2" T{ inet6 } inet-pton ] unit-test @@ -45,6 +48,9 @@ concurrency.promises threads io.streams.string ; [ "1:2:0:0:0:0:3:4" ] [ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test +[ "2001:6f8:37a:5:0:0:0:1" ] +[ "2001:6f8:37a:5::1" T{ inet6 } [ inet-pton ] [ inet-ntop ] bi ] unit-test + [ t ] [ "localhost" 80 resolve-host length 1 >= ] unit-test ! Smoke-test UDP diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 597aa61138..8dce527553 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -6,7 +6,7 @@ sequences arrays io.encodings io.ports io.streams.duplex io.encodings.ascii alien.strings io.binary accessors destructors classes byte-arrays system combinators parser alien.c-types math.parser splitting grouping math assocs summary -system vocabs.loader combinators present fry ; +system vocabs.loader combinators present fry vocabs.parser ; IN: io.sockets << { @@ -109,7 +109,7 @@ M: invalid-inet6 summary drop "Invalid IPv6 address" ; [ f ] [ ":" split [ hex> [ "Component not a number" throw ] unless* - ] B{ } map-as + ] { } map-as ] if-empty ; : pad-inet6 ( string1 string2 -- seq ) @@ -318,7 +318,6 @@ M: inet (server) invalid-inet-server ; { - { [ os unix? ] [ "io.unix.sockets" require ] } - { [ os winnt? ] [ "io.windows.nt.sockets" require ] } - { [ os wince? ] [ "io.windows.ce.sockets" require ] } + { [ os unix? ] [ "io.sockets.unix" require ] } + { [ os winnt? ] [ "io.sockets.windows.nt" require ] } } cond diff --git a/basis/io/sockets/unix/authors.txt b/basis/io/sockets/unix/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/sockets/unix/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/sockets/unix/summary.txt b/basis/io/sockets/unix/summary.txt new file mode 100644 index 0000000000..22342ec413 --- /dev/null +++ b/basis/io/sockets/unix/summary.txt @@ -0,0 +1 @@ +Implementation of TCP/IP and UDP/IP sockets on Unix-like systems diff --git a/basis/io/sockets/unix/tags.txt b/basis/io/sockets/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/sockets/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor new file mode 100644 index 0000000000..f209df5862 --- /dev/null +++ b/basis/io/sockets/unix/unix.factor @@ -0,0 +1,155 @@ +! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types alien.strings generic kernel math +namespaces threads sequences byte-arrays io.ports +io.binary io.backend.unix io.streams.duplex +io.backend io.ports io.pathnames io.files.private +io.encodings.utf8 math.parser continuations libc combinators +system accessors destructors unix locals init ; + +EXCLUDE: io => read write close ; +EXCLUDE: io.sockets => accept ; + +IN: io.sockets.unix + +: socket-fd ( domain type -- fd ) + 0 socket dup io-error init-fd |dispose ; + +: set-socket-option ( fd level opt -- ) + [ handle-fd ] 2dip 1 "int" heap-size setsockopt io-error ; + +M: unix addrinfo-error ( n -- ) + dup zero? [ drop ] [ gai_strerror throw ] if ; + +! Client sockets - TCP and Unix domain +M: object (get-local-address) ( handle remote -- sockaddr ) + [ handle-fd ] dip empty-sockaddr/size + [ getsockname io-error ] 2keep drop ; + +M: object (get-remote-address) ( handle local -- sockaddr ) + [ handle-fd ] dip empty-sockaddr/size + [ getpeername io-error ] 2keep drop ; + +: init-client-socket ( fd -- ) + SOL_SOCKET SO_OOBINLINE set-socket-option ; + +: wait-to-connect ( port -- ) + dup handle>> handle-fd f 0 write + { + { [ 0 = ] [ drop ] } + { [ err_no EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] } + { [ err_no EINTR = ] [ wait-to-connect ] } + [ (io-error) ] + } cond ; + +M: object establish-connection ( client-out remote -- ) + [ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi + { + { [ 0 = ] [ drop ] } + { [ err_no EINPROGRESS = ] [ + [ +output+ wait-for-port ] [ wait-to-connect ] bi + ] } + [ (io-error) ] + } cond ; + +M: object ((client)) ( addrspec -- fd ) + protocol-family SOCK_STREAM socket-fd dup init-client-socket ; + +! Server sockets - TCP and Unix domain +: init-server-socket ( fd -- ) + SOL_SOCKET SO_REUSEADDR set-socket-option ; + +: server-socket-fd ( addrspec type -- fd ) + [ dup protocol-family ] dip socket-fd + dup init-server-socket + dup handle-fd rot make-sockaddr/size bind io-error ; + +M: object (server) ( addrspec -- handle ) + [ + SOCK_STREAM server-socket-fd + dup handle-fd 128 listen io-error + ] with-destructors ; + +: do-accept ( server addrspec -- fd sockaddr ) + [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* + [ accept ] 2keep drop ; inline + +M: object (accept) ( server addrspec -- fd sockaddr ) + 2dup do-accept + { + { [ over 0 >= ] [ [ 2nip init-fd ] dip ] } + { [ err_no EINTR = ] [ 2drop (accept) ] } + { [ err_no EAGAIN = ] [ + 2drop + [ drop +input+ wait-for-port ] + [ (accept) ] + 2bi + ] } + [ (io-error) ] + } cond ; + +! Datagram sockets - UDP and Unix domain +M: unix (datagram) + [ SOCK_DGRAM server-socket-fd ] with-destructors ; + +SYMBOL: receive-buffer + +: packet-size 65536 ; inline + +[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook + +:: do-receive ( port -- packet sockaddr ) + port addr>> empty-sockaddr/size [| sockaddr len | + port handle>> handle-fd ! s + receive-buffer get-global ! buf + packet-size ! nbytes + 0 ! flags + sockaddr ! from + len ! fromlen + recvfrom dup 0 >= [ + receive-buffer get-global swap memory>byte-array sockaddr + ] [ + drop f f + ] if + ] call ; + +M: unix (receive) ( datagram -- packet sockaddr ) + dup do-receive dup [ [ drop ] 2dip ] [ + 2drop [ +input+ wait-for-port ] [ (receive) ] bi + ] if ; + +:: do-send ( packet sockaddr len socket datagram -- ) + socket handle-fd packet dup length 0 sockaddr len sendto + 0 < [ + err_no EINTR = [ + packet sockaddr len socket datagram do-send + ] [ + err_no EAGAIN = [ + datagram +output+ wait-for-port + packet sockaddr len socket datagram do-send + ] [ + (io-error) + ] if + ] if + ] when ; + +M: unix (send) ( packet addrspec datagram -- ) + [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ; + +! Unix domain sockets +M: local protocol-family drop PF_UNIX ; + +M: local sockaddr-size drop "sockaddr-un" heap-size ; + +M: local empty-sockaddr drop "sockaddr-un" ; + +M: local make-sockaddr + path>> (normalize-path) + dup length 1 + max-un-path > [ "Path too long" throw ] when + "sockaddr-un" + AF_UNIX over set-sockaddr-un-family + dup sockaddr-un-path rot utf8 string>alien dup length memcpy ; + +M: local parse-sockaddr + drop + sockaddr-un-path utf8 alien>string ; diff --git a/basis/io/sockets/windows/nt/authors.txt b/basis/io/sockets/windows/nt/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/basis/io/sockets/windows/nt/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor new file mode 100644 index 0000000000..49a1b2ae63 --- /dev/null +++ b/basis/io/sockets/windows/nt/nt.factor @@ -0,0 +1,216 @@ +USING: alien alien.accessors alien.c-types byte-arrays +continuations destructors io.ports io.timeouts io.sockets +io.sockets io namespaces io.streams.duplex io.backend.windows +io.sockets.windows io.backend.windows.nt windows.winsock kernel +libc math sequences threads system combinators accessors ; +IN: io.sockets.windows.nt + +: malloc-int ( object -- object ) + "int" heap-size malloc [ nip ] [ 0 set-alien-signed-4 ] 2bi ; inline + +M: winnt WSASocket-flags ( -- DWORD ) + WSA_FLAG_OVERLAPPED ; + +: get-ConnectEx-ptr ( socket -- void* ) + SIO_GET_EXTENSION_FUNCTION_POINTER + WSAID_CONNECTEX + "GUID" heap-size + "void*" + [ + "void*" heap-size + "DWORD" + f + f + WSAIoctl SOCKET_ERROR = [ + winsock-error-string throw + ] when + ] keep *void* ; + +TUPLE: ConnectEx-args port + s name namelen lpSendBuffer dwSendDataLength + lpdwBytesSent lpOverlapped ptr ; + +: wait-for-socket ( args -- n ) + [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline + +: ( sockaddr size -- ConnectEx ) + ConnectEx-args new + swap >>namelen + swap >>name + f >>lpSendBuffer + 0 >>dwSendDataLength + f >>lpdwBytesSent + (make-overlapped) >>lpOverlapped ; inline + +: call-ConnectEx ( ConnectEx -- ) + { + [ s>> ] + [ name>> ] + [ namelen>> ] + [ lpSendBuffer>> ] + [ dwSendDataLength>> ] + [ lpdwBytesSent>> ] + [ lpOverlapped>> ] + [ ptr>> ] + } cleave + "int" + { "SOCKET" "sockaddr_in*" "int" "PVOID" "DWORD" "LPDWORD" "void*" } + "stdcall" alien-indirect drop + winsock-error-string [ throw ] when* ; inline + +M: object establish-connection ( client-out remote -- ) + make-sockaddr/size + swap >>port + dup port>> handle>> handle>> >>s + dup s>> get-ConnectEx-ptr >>ptr + dup call-ConnectEx + wait-for-socket drop ; + +TUPLE: AcceptEx-args port + sListenSocket sAcceptSocket lpOutputBuffer dwReceiveDataLength + dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ; + +: init-accept-buffer ( addr AcceptEx -- ) + swap sockaddr-size 16 + + [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi + dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer + drop ; inline + +: ( server addr -- AcceptEx ) + AcceptEx-args new + 2dup init-accept-buffer + swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket + over handle>> handle>> >>sListenSocket + swap >>port + 0 >>dwReceiveDataLength + f >>lpdwBytesReceived + (make-overlapped) >>lpOverlapped ; inline + +: call-AcceptEx ( AcceptEx -- ) + { + [ sListenSocket>> ] + [ sAcceptSocket>> ] + [ lpOutputBuffer>> ] + [ dwReceiveDataLength>> ] + [ dwLocalAddressLength>> ] + [ dwRemoteAddressLength>> ] + [ lpdwBytesReceived>> ] + [ lpOverlapped>> ] + } cleave AcceptEx drop + winsock-error-string [ throw ] when* ; inline + +: extract-remote-address ( AcceptEx -- sockaddr ) + { + [ lpOutputBuffer>> ] + [ dwReceiveDataLength>> ] + [ dwLocalAddressLength>> ] + [ dwRemoteAddressLength>> ] + } cleave + f + 0 + f + [ 0 GetAcceptExSockaddrs ] keep *void* ; inline + +M: object (accept) ( server addr -- handle sockaddr ) + [ + + { + [ call-AcceptEx ] + [ wait-for-socket drop ] + [ sAcceptSocket>> ] + [ extract-remote-address ] + } cleave + ] with-destructors ; + +TUPLE: WSARecvFrom-args port + s lpBuffers dwBufferCount lpNumberOfBytesRecvd + lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ; + +: make-receive-buffer ( -- WSABUF ) + "WSABUF" malloc-object &free + default-buffer-size get over set-WSABUF-len + default-buffer-size get malloc &free over set-WSABUF-buf ; inline + +: ( datagram -- WSARecvFrom ) + WSARecvFrom-args new + swap >>port + dup port>> handle>> handle>> >>s + dup port>> addr>> sockaddr-size + [ malloc &free >>lpFrom ] + [ malloc-int &free >>lpFromLen ] bi + make-receive-buffer >>lpBuffers + 1 >>dwBufferCount + 0 malloc-int &free >>lpFlags + 0 malloc-int &free >>lpNumberOfBytesRecvd + (make-overlapped) >>lpOverlapped ; inline + +: call-WSARecvFrom ( WSARecvFrom -- ) + { + [ s>> ] + [ lpBuffers>> ] + [ dwBufferCount>> ] + [ lpNumberOfBytesRecvd>> ] + [ lpFlags>> ] + [ lpFrom>> ] + [ lpFromLen>> ] + [ lpOverlapped>> ] + [ lpCompletionRoutine>> ] + } cleave WSARecvFrom socket-error* ; inline + +: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr ) + [ lpBuffers>> WSABUF-buf swap memory>byte-array ] + [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline + +M: winnt (receive) ( datagram -- packet addrspec ) + [ + + [ call-WSARecvFrom ] + [ wait-for-socket ] + [ parse-WSARecvFrom ] + tri + ] with-destructors ; + +TUPLE: WSASendTo-args port + s lpBuffers dwBufferCount lpNumberOfBytesSent + dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ; + +: make-send-buffer ( packet -- WSABUF ) + "WSABUF" malloc-object &free + [ [ malloc-byte-array &free ] dip set-WSABUF-buf ] + [ [ length ] dip set-WSABUF-len ] + [ nip ] + 2tri ; inline + +: ( packet addrspec datagram -- WSASendTo ) + WSASendTo-args new + swap >>port + dup port>> handle>> handle>> >>s + swap make-sockaddr/size + [ malloc-byte-array &free ] dip + [ >>lpTo ] [ >>iToLen ] bi* + swap make-send-buffer >>lpBuffers + 1 >>dwBufferCount + 0 >>dwFlags + 0 >>lpNumberOfBytesSent + (make-overlapped) >>lpOverlapped ; inline + +: call-WSASendTo ( WSASendTo -- ) + { + [ s>> ] + [ lpBuffers>> ] + [ dwBufferCount>> ] + [ lpNumberOfBytesSent>> ] + [ dwFlags>> ] + [ lpTo>> ] + [ iToLen>> ] + [ lpOverlapped>> ] + [ lpCompletionRoutine>> ] + } cleave WSASendTo socket-error* ; inline + +M: winnt (send) ( packet addrspec datagram -- ) + [ + + [ call-WSASendTo ] + [ wait-for-socket drop ] + bi + ] with-destructors ; diff --git a/basis/io/sockets/windows/nt/tags.txt b/basis/io/sockets/windows/nt/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/sockets/windows/nt/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/sockets/windows/tags.txt b/basis/io/sockets/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/sockets/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor new file mode 100644 index 0000000000..29009403fc --- /dev/null +++ b/basis/io/sockets/windows/windows.factor @@ -0,0 +1,61 @@ +USING: kernel accessors io.sockets io.backend.windows io.backend +windows.winsock system destructors alien.c-types ; +IN: io.sockets.windows + +HOOK: WSASocket-flags io-backend ( -- DWORD ) + +TUPLE: win32-socket < win32-file ; + +: ( handle -- win32-socket ) + win32-socket new-win32-handle ; + +M: win32-socket dispose ( stream -- ) + handle>> closesocket drop ; + +: unspecific-sockaddr/size ( addrspec -- sockaddr len ) + [ empty-sockaddr/size ] [ protocol-family ] bi + pick set-sockaddr-in-family ; + +: opened-socket ( handle -- win32-socket ) + |dispose dup add-completion ; + +: open-socket ( addrspec type -- win32-socket ) + [ protocol-family ] dip + 0 f 0 WSASocket-flags WSASocket + dup socket-error + opened-socket ; + +M: object (get-local-address) ( socket addrspec -- sockaddr ) + [ handle>> ] dip empty-sockaddr/size + [ getsockname socket-error ] 2keep drop ; + +M: object (get-remote-address) ( socket addrspec -- sockaddr ) + [ handle>> ] dip empty-sockaddr/size + [ getpeername socket-error ] 2keep drop ; + +: bind-socket ( win32-socket sockaddr len -- ) + [ handle>> ] 2dip bind socket-error ; + +M: object ((client)) ( addrspec -- handle ) + [ SOCK_STREAM open-socket ] keep + [ unspecific-sockaddr/size bind-socket ] [ drop ] 2bi ; + +: server-socket ( addrspec type -- fd ) + [ open-socket ] [ drop ] 2bi + [ make-sockaddr/size bind-socket ] [ drop ] 2bi ; + +! http://support.microsoft.com/kb/127144 +! NOTE: Possibly tweak this because of SYN flood attacks +: listen-backlog ( -- n ) HEX: 7fffffff ; inline + +M: object (server) ( addrspec -- handle ) + [ + SOCK_STREAM server-socket + dup handle>> listen-backlog listen winsock-return-check + ] with-destructors ; + +M: windows (datagram) ( addrspec -- handle ) + [ SOCK_DGRAM server-socket ] with-destructors ; + +M: windows addrinfo-error ( n -- ) + winsock-return-check ; diff --git a/basis/io/streams/duplex/duplex-docs.factor b/basis/io/streams/duplex/duplex-docs.factor index ca4f424fb6..5bf33e9002 100644 --- a/basis/io/streams/duplex/duplex-docs.factor +++ b/basis/io/streams/duplex/duplex-docs.factor @@ -15,16 +15,16 @@ HELP: duplex-stream { $class-description "A bidirectional stream wrapping an input and output stream." } ; HELP: -{ $values { "in" "an input stream" } { "out" "an output stream" } { "stream" " a duplex stream" } } +{ $values { "in" "an input stream" } { "out" "an output stream" } { "duplex-stream" duplex-stream } } { $description "Creates a duplex stream. Writing to a duplex stream will write to " { $snippet "out" } ", and reading from a duplex stream will read from " { $snippet "in" } ". Closing a duplex stream closes both the input and output streams." } ; HELP: with-stream { $values { "stream" duplex-stream } { "quot" quotation } } -{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ; +{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ", which must be a duplex stream. The stream is closed if the quotation returns or throws an error." } ; HELP: with-stream* { $values { "stream" duplex-stream } { "quot" quotation } } -{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } "." } +{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ", which must be a duplex stream." } { $notes "This word does not close the stream. Compare with " { $link with-stream } "." } ; HELP: diff --git a/basis/io/streams/limited/limited-docs.factor b/basis/io/streams/limited/limited-docs.factor new file mode 100755 index 0000000000..fac1232cc0 --- /dev/null +++ b/basis/io/streams/limited/limited-docs.factor @@ -0,0 +1,90 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel math io ; +IN: io.streams.limited + +HELP: +{ $values + { "stream" "an input stream" } { "limit" integer } { "mode" "a " { $link limited-stream } " mode singleton" } + { "stream'" "an input stream" } +} +{ $description "Constructs a new " { $link limited-stream } " from an existing stream. User code should use " { $link limit } " or " { $link limit-input } "." } ; + +HELP: limit +{ $values + { "stream" "an input stream" } { "limit" integer } { "mode" "a " { $link limited-stream } " mode singleton" } + { "stream'" "a stream" } +} +{ $description "Changes a decoder's stream to be a limited stream, or wraps " { $snippet "stream" } " in a " { $link limited-stream } "." } +{ $examples "Throwing an exception:" + { $example + "USING: continuations io io.streams.limited io.streams.string" + "kernel prettyprint ;" + "[" + " \"123456\" 3 stream-throws limit" + " 100 swap stream-read ." + "] [ ] recover ." + "T{ limit-exceeded }" + } + "Returning " { $link f } " on exhaustion:" + { $example + "USING: accessors continuations io io.streams.limited" + "io.streams.string kernel prettyprint ;" + "\"123456\" 3 stream-eofs limit" + "100 swap stream-read ." + "\"123\"" + } +} ; + +HELP: unlimit +{ $values + { "stream" "an input stream" } + { "stream'" "a stream" } +} +{ $description "Returns the underlying stream of a limited stream." } ; + +HELP: limited-stream +{ $values + { "value" "a limited-stream class" } +} +{ $description "Limited streams wrap other streams, changing their behavior to throw an exception or return " { $link f } " upon exhaustion." } ; + +HELP: limit-input +{ $values + { "limit" integer } { "mode" "a " { $link limited-stream } " mode singleton" } +} +{ $description "Wraps the current " { $link input-stream } " in a " { $link limited-stream } "." } ; + +HELP: unlimit-input +{ $description "Returns the underlying stream of the limited-stream stored in " { $link input-stream } "." } ; + +HELP: stream-eofs +{ $values + { "value" "a " { $link limited-stream } " mode singleton" } +} +{ $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will return " { $link f } " upon exhaustion." } ; + +HELP: stream-throws +{ $values + { "value" "a " { $link limited-stream } " mode singleton" } +} +{ $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will throw " { $link limit-exceeded } " upon exhaustion." } ; + +{ stream-eofs stream-throws } related-words + +ARTICLE: "io.streams.limited" "Limited input streams" +"The " { $vocab-link "io.streams.limited" } " vocabulary wraps a stream to behave as if it had only a limited number of bytes, either throwing an error or returning " { $link f } " upon reaching the end." $nl +"Wrap a stream in a limited stream:" +{ $subsection limit } +"Wrap the current " { $link input-stream } " in a limited stream:" +{ $subsection limit-input } +"Unlimits a limited stream:" +{ $subsection unlimit } +"Unlimits the current " { $link input-stream } ":" +{ $subsection unlimit-input } +"Make a limited stream throw an exception on exhaustion:" +{ $subsection stream-throws } +"Make a limited stream return " { $link f } " on exhaustion:" +{ $subsection stream-eofs } ; + +ABOUT: "io.streams.limited" diff --git a/basis/io/streams/limited/limited-tests.factor b/basis/io/streams/limited/limited-tests.factor index eb5b921260..feddc130e9 100644 --- a/basis/io/streams/limited/limited-tests.factor +++ b/basis/io/streams/limited/limited-tests.factor @@ -1,14 +1,15 @@ -IN: io.streams.limited.tests USING: io io.streams.limited io.encodings io.encodings.string io.encodings.ascii io.encodings.binary io.streams.byte-array -namespaces tools.test strings kernel ; +namespaces tools.test strings kernel io.streams.string accessors +io.encodings.utf8 io.files destructors ; +IN: io.streams.limited.tests [ ] [ "hello world\nhow are you today\nthis is a very long line indeed" ascii encode binary "data" set ] unit-test -[ ] [ "data" get 24 "limited" set ] unit-test +[ ] [ "data" get 24 stream-throws "limited" set ] unit-test [ CHAR: h ] [ "limited" get stream-read1 ] unit-test @@ -25,7 +26,7 @@ namespaces tools.test strings kernel ; ascii encode binary "data" set ] unit-test -[ ] [ "data" get 7 "limited" set ] unit-test +[ ] [ "data" get 7 stream-throws "limited" set ] unit-test [ "abc" CHAR: \n ] [ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test @@ -34,7 +35,44 @@ namespaces tools.test strings kernel ; [ "he" CHAR: l ] [ B{ CHAR: h CHAR: e CHAR: l CHAR: l CHAR: o } ascii [ - 5 limit-input + 5 stream-throws limit-input "l" read-until ] with-input-stream ] unit-test + +[ CHAR: a ] +[ "a" 1 stream-eofs stream-read1 ] unit-test + +[ "abc" ] +[ + "abc" 3 stream-eofs + 4 swap stream-read +] unit-test + +[ f ] +[ + "abc" 3 stream-eofs + 4 over stream-read drop 10 swap stream-read +] unit-test + +[ t ] +[ + "abc" 3 stream-eofs limit unlimit + "abc" = +] unit-test + +[ t ] +[ + "abc" 3 stream-eofs limit unlimit + "abc" = +] unit-test + +[ t ] +[ + [ + "resource:license.txt" utf8 &dispose + 3 stream-eofs limit unlimit + "resource:license.txt" utf8 &dispose + [ decoder? ] both? + ] with-destructors +] unit-test diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor old mode 100644 new mode 100755 index ecc49923de..1237b3aba2 --- a/basis/io/streams/limited/limited.factor +++ b/basis/io/streams/limited/limited.factor @@ -1,45 +1,91 @@ -! Copyright (C) 2008 Slava Pestov +! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math io io.encodings destructors accessors -sequences namespaces byte-vectors ; +sequences namespaces byte-vectors fry combinators ; IN: io.streams.limited -TUPLE: limited-stream stream count limit ; +TUPLE: limited-stream stream count limit mode stack ; -: ( stream limit -- stream' ) +SINGLETONS: stream-throws stream-eofs ; + +: ( stream limit mode -- stream' ) limited-stream new + swap >>mode swap >>limit swap >>stream 0 >>count ; -GENERIC# limit 1 ( stream limit -- stream' ) +GENERIC# limit 2 ( stream limit mode -- stream' ) + +M: decoder limit ( stream limit mode -- stream' ) + [ clone ] 2dip '[ _ _ limit ] change-stream ; + +M: object limit ( stream limit mode -- stream' ) + ; + +GENERIC: unlimit ( stream -- stream' ) + +M: decoder unlimit ( stream -- stream' ) + [ stream>> ] change-stream ; + +M: object unlimit ( stream -- stream' ) + stream>> stream>> ; + +: limit-input ( limit mode -- ) input-stream [ -rot limit ] change ; -M: decoder limit [ clone ] dip [ limit ] curry change-stream ; +: unlimit-input ( -- ) input-stream [ unlimit ] change ; -M: object limit ; +: with-unlimited-stream ( stream quot -- ) + [ clone unlimit ] dip call ; inline -: limit-input ( limit -- ) input-stream [ swap limit ] change ; +: with-limited-stream ( stream limit mode quot -- ) + [ limit ] dip call ; inline ERROR: limit-exceeded ; -: check-limit ( n stream -- ) - [ + ] change-count - [ count>> ] [ limit>> ] bi >= - [ limit-exceeded ] when ; inline +ERROR: bad-stream-mode mode ; + +> ] [ limit>> ] bi > + [ + dup mode>> { + { stream-throws [ limit-exceeded ] } + { stream-eofs [ + dup [ count>> ] [ limit>> ] bi - + '[ _ - ] dip + ] } + [ bad-stream-mode ] + } case + ] when ; inline + +: maybe-read ( n limited-stream quot: ( n stream -- seq/f ) -- seq/f ) + [ adjust-limit ] dip + pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline + +PRIVATE> M: limited-stream stream-read1 - 1 over check-limit stream>> stream-read1 ; + 1 swap + [ nip stream-read1 ] maybe-read ; M: limited-stream stream-read - 2dup check-limit stream>> stream-read ; + [ stream-read ] maybe-read ; M: limited-stream stream-read-partial - 2dup check-limit stream>> stream-read-partial ; + [ stream-read-partial ] maybe-read ; + + + M: limited-stream stream-read-until swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ; diff --git a/basis/io/streams/null/authors.txt b/basis/io/streams/null/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/streams/null/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/streams/null/null.factor b/basis/io/streams/null/null.factor deleted file mode 100644 index 191c8dce91..0000000000 --- a/basis/io/streams/null/null.factor +++ /dev/null @@ -1,38 +0,0 @@ -! Copyright (C) 2007 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -IN: io.streams.null -USING: kernel io io.timeouts io.streams.duplex destructors ; - -TUPLE: null-stream ; - -M: null-stream dispose drop ; -M: null-stream set-timeout 2drop ; - -TUPLE: null-reader < null-stream ; - -M: null-reader stream-readln drop f ; -M: null-reader stream-read1 drop f ; -M: null-reader stream-read-until 2drop f f ; -M: null-reader stream-read 2drop f ; - -TUPLE: null-writer < null-stream ; - -M: null-writer stream-write1 2drop ; -M: null-writer stream-write 2drop ; -M: null-writer stream-nl drop ; -M: null-writer stream-flush drop ; -M: null-writer stream-format 3drop ; -M: null-writer make-span-stream nip ; -M: null-writer make-block-stream nip ; -M: null-writer make-cell-stream nip ; -M: null-writer stream-write-table 3drop ; - -: with-null-reader ( quot -- ) - T{ null-reader } swap with-input-stream* ; inline - -: with-null-writer ( quot -- ) - T{ null-writer } swap with-output-stream* ; inline - -: with-null-stream ( quot -- ) - T{ duplex-stream f T{ null-reader } T{ null-writer } } - swap with-stream* ; inline diff --git a/basis/io/styles/styles-docs.factor b/basis/io/styles/styles-docs.factor index febec6573a..82f5de3d70 100644 --- a/basis/io/styles/styles-docs.factor +++ b/basis/io/styles/styles-docs.factor @@ -1,7 +1,116 @@ USING: help.markup help.syntax io.streams.plain io strings -hashtables ; +hashtables kernel quotations ; IN: io.styles +HELP: stream-format +{ $values { "str" string } { "style" "a hashtable" } { "stream" "an output stream" } } +{ $contract "Writes formatted text to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." +$nl +"The " { $snippet "style" } " hashtable holds character style information. See " { $link "character-styles" } "." } +{ $notes "Most code only works on one stream at a time and should instead use " { $link format } "; see " { $link "stdio" } "." } +$io-error ; + +HELP: make-block-stream +{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } } +{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "." +$nl +"Unlike " { $link make-span-stream } ", this creates a new paragraph block in the output." +$nl +"The " { $snippet "style" } " hashtable holds paragraph style information. See " { $link "paragraph-styles" } "." } +{ $notes "Most code only works on one stream at a time and should instead use " { $link with-nesting } "; see " { $link "stdio" } "." } +$io-error ; + +HELP: stream-write-table +{ $values { "table-cells" "a sequence of sequences of table cells" } { "style" "a hashtable" } { "stream" "an output stream" } } +{ $contract "Prints a table of cells produced by " { $link with-cell } "." +$nl +"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." } +{ $notes "Most code only works on one stream at a time and should instead use " { $link tabular-output } "; see " { $link "stdio" } "." } +$io-error ; + +HELP: make-cell-stream +{ $values { "style" hashtable } { "stream" "an output stream" } { "stream'" object } } +{ $contract "Creates an output stream which writes to a table cell object." } +{ $notes "Most code only works on one stream at a time and should instead use " { $link with-cell } "; see " { $link "stdio" } "." } +$io-error ; + +HELP: make-span-stream +{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } } +{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "." +$nl +"Unlike " { $link make-block-stream } ", the stream output is inline, and not nested in a paragraph block." } +{ $notes "Most code only works on one stream at a time and should instead use " { $link with-style } "; see " { $link "stdio" } "." } +$io-error ; + +HELP: format +{ $values { "str" string } { "style" "a hashtable" } } +{ $description "Writes formatted text to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." } +{ $notes "Details are in the documentation for " { $link stream-format } "." } +$io-error ; + +HELP: with-nesting +{ $values { "style" "a hashtable" } { "quot" quotation } } +{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to a nested paragraph stream, with formatting information applied." } +{ $notes "Details are in the documentation for " { $link make-block-stream } "." } +$io-error ; + +HELP: tabular-output +{ $values { "style" "a hashtable" } { "quot" quotation } } +{ $description "Calls a quotation which emits a series of equal-length table rows using " { $link with-row } ". The results are laid out in a tabular fashion on " { $link output-stream } "." +$nl +"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." } +{ $examples + { $code + "{ { 1 2 } { 3 4 } }" + "H{ { table-gap { 10 10 } } } [" + " [ [ [ [ . ] with-cell ] each ] with-row ] each" + "] tabular-output" + } +} +$io-error ; + +HELP: with-row +{ $values { "quot" quotation } } +{ $description "Calls a quotation which emits a series of table cells using " { $link with-cell } ". This word can only be called inside the quotation given to " { $link tabular-output } "." } +$io-error ; + +HELP: with-cell +{ $values { "quot" quotation } } +{ $description "Calls a quotation in a new scope with " { $link output-stream } " rebound. Output performed by the quotation is displayed in a table cell. This word can only be called inside the quotation given to " { $link with-row } "." } +$io-error ; + +HELP: write-cell +{ $values { "str" string } } +{ $description "Outputs a table cell containing a single string. This word can only be called inside the quotation given to " { $link with-row } "." } +$io-error ; + +HELP: with-style +{ $values { "style" "a hashtable" } { "quot" quotation } } +{ $description "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "." } +{ $notes "Details are in the documentation for " { $link make-span-stream } "." } +$io-error ; + +ARTICLE: "formatted-stream-protocol" "Formatted stream protocol" +"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for output streams that support rich text." +{ $subsection stream-format } +{ $subsection make-span-stream } +{ $subsection make-block-stream } +{ $subsection make-cell-stream } +{ $subsection stream-write-table } ; + +ARTICLE: "formatted-stdout" "Formatted output on the default stream" +"The below words perform formatted output on " { $link output-stream } "." +$nl +"Formatted output:" +{ $subsection format } +{ $subsection with-style } +{ $subsection with-nesting } +"Tabular output:" +{ $subsection tabular-output } +{ $subsection with-row } +{ $subsection with-cell } +{ $subsection write-cell } ; + ARTICLE: "character-styles" "Character styles" "Character styles for " { $link stream-format } " and " { $link with-style } ":" { $subsection foreground } @@ -33,7 +142,7 @@ ARTICLE: "presentations" "Presentations" "The " { $link presented } " style can be used to emit clickable objects. A utility word for outputting this style:" { $subsection write-object } ; -ARTICLE: "styles" "Formatted output" +ARTICLE: "styles" "Styled text" "The " { $link stream-format } ", " { $link with-style } ", " { $link with-nesting } " and " { $link tabular-output } " words take a hashtable of style attributes. Output stream implementations are free to ignore style information." $nl "Style hashtables are keyed by symbols from the " { $vocab-link "io.styles" } " vocabulary." @@ -42,7 +151,13 @@ $nl { $subsection "table-styles" } { $subsection "presentations" } ; -ABOUT: "styles" +ARTICLE: "io.styles" "Formatted output" +"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for formatted output. This is used by the prettyprinter, help system, and various developer tools. Implementations include " { $vocab-link "ui.gadgets.panes" } ", " { $vocab-link "html.streams" } ", and " { $vocab-link "io.streams.plain" } "." +{ $subsection "formatted-stream-protocol" } +{ $subsection "formatted-stdout" } +{ $subsection "styles" } ; + +ABOUT: "io.styles" HELP: plain { $description "A value for the " { $link font-style } " character style denoting plain text." } ; @@ -150,10 +265,19 @@ HELP: input { $code "\"2 3 + .\" dup write-object nl" } } ; -HELP: ( string -- input ) +HELP: { $values { "string" string } { "input" input } } { $description "Creates a new " { $link input } "." } ; HELP: standard-table-style { $values { "style" hashtable } } { $description "Outputs a table style where cells are separated by 5-pixel gaps and framed by a light gray border. This style can be passed to " { $link tabular-output } "." } ; + +ARTICLE: "io.streams.plain" "Plain writer streams" +"Plain writer streams wrap an underlying stream and provide a default implementation of " +{ $link stream-nl } ", " +{ $link stream-format } ", " +{ $link make-span-stream } ", " +{ $link make-block-stream } " and " +{ $link make-cell-stream } "." +{ $subsection plain-writer } ; \ No newline at end of file diff --git a/basis/io/styles/styles-tests.factor b/basis/io/styles/styles-tests.factor new file mode 100644 index 0000000000..86c3681c2a --- /dev/null +++ b/basis/io/styles/styles-tests.factor @@ -0,0 +1,8 @@ +IN: io.styles.tests +USING: io.styles tools.test ; + +\ stream-format must-infer +\ stream-write-table must-infer +\ make-span-stream must-infer +\ make-block-stream must-infer +\ make-cell-stream must-infer \ No newline at end of file diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor index e07753c640..0e07c8bda9 100644 --- a/basis/io/styles/styles.factor +++ b/basis/io/styles/styles.factor @@ -1,9 +1,139 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: hashtables io colors summary make accessors splitting -kernel ; +USING: hashtables io io.streams.plain io.streams.string +colors summary make accessors splitting math.order +kernel namespaces assocs destructors strings sequences ; IN: io.styles +GENERIC: stream-format ( str style stream -- ) +GENERIC: make-span-stream ( style stream -- stream' ) +GENERIC: make-block-stream ( style stream -- stream' ) +GENERIC: make-cell-stream ( style stream -- stream' ) +GENERIC: stream-write-table ( table-cells style stream -- ) + +: format ( str style -- ) output-stream get stream-format ; + +: tabular-output ( style quot -- ) + swap [ { } make ] dip output-stream get stream-write-table ; inline + +: with-row ( quot -- ) + { } make , ; inline + +: with-cell ( quot -- ) + H{ } output-stream get make-cell-stream + [ swap with-output-stream ] keep , ; inline + +: write-cell ( str -- ) + [ write ] with-cell ; inline + +: with-style ( style quot -- ) + swap dup assoc-empty? [ + drop call + ] [ + output-stream get make-span-stream swap with-output-stream + ] if ; inline + +: with-nesting ( style quot -- ) + [ output-stream get make-block-stream ] dip + with-output-stream ; inline + +TUPLE: filter-writer stream ; + +M: filter-writer stream-format + stream>> stream-format ; + +M: filter-writer stream-write + stream>> stream-write ; + +M: filter-writer stream-write1 + stream>> stream-write1 ; + +M: filter-writer make-span-stream + stream>> make-span-stream ; + +M: filter-writer make-block-stream + stream>> make-block-stream ; + +M: filter-writer make-cell-stream + stream>> make-cell-stream ; + +M: filter-writer stream-flush + stream>> stream-flush ; + +M: filter-writer stream-nl + stream>> stream-nl ; + +M: filter-writer stream-write-table + stream>> stream-write-table ; + +M: filter-writer dispose + stream>> dispose ; + +TUPLE: ignore-close-stream < filter-writer ; + +M: ignore-close-stream dispose drop ; + +C: ignore-close-stream + +TUPLE: style-stream < filter-writer style ; + +: do-nested-style ( style style-stream -- style stream ) + [ style>> swap assoc-union ] [ stream>> ] bi ; inline + +C: style-stream + +M: style-stream stream-format + do-nested-style stream-format ; + +M: style-stream stream-write + [ style>> ] [ stream>> ] bi stream-format ; + +M: style-stream stream-write1 + [ 1string ] dip stream-write ; + +M: style-stream make-span-stream + do-nested-style make-span-stream ; + +M: style-stream make-block-stream + [ do-nested-style make-block-stream ] [ style>> ] bi + ; + +M: style-stream make-cell-stream + [ do-nested-style make-cell-stream ] [ style>> ] bi + ; + +M: style-stream stream-write-table + [ [ [ stream>> ] map ] map ] [ ] [ stream>> ] tri* + stream-write-table ; + +M: plain-writer stream-format + nip stream-write ; + +M: plain-writer make-span-stream + swap ; + +M: plain-writer make-block-stream + nip ; + +: format-column ( seq ? -- seq ) + [ + [ 0 [ length max ] reduce ] keep + swap [ CHAR: \s pad-right ] curry map + ] unless ; + +: map-last ( seq quot -- seq ) + [ dup length ] dip [ 0 = ] prepose 2map ; inline + +: format-table ( table -- seq ) + flip [ format-column ] map-last + flip [ " " join ] map ; + +M: plain-writer stream-write-table + [ drop format-table [ print ] each ] with-output-stream* ; + +M: plain-writer make-cell-stream 2drop ; + +! Font styles SYMBOL: plain SYMBOL: bold SYMBOL: italic diff --git a/basis/io/thread/thread.factor b/basis/io/thread/thread.factor index fe86ba9e3d..7589d4918e 100644 --- a/basis/io/thread/thread.factor +++ b/basis/io/thread/thread.factor @@ -1,14 +1,20 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USING: threads io.backend namespaces init math kernel ; IN: io.thread -USING: threads io.backend namespaces init math ; + +! The Cocoa UI backend stops the I/O thread and takes over +! completely. +SYMBOL: io-thread-running? : io-thread ( -- ) sleep-time io-multiplex yield ; : start-io-thread ( -- ) - [ io-thread t ] - "I/O wait" spawn-server - \ io-thread set-global ; + [ [ io-thread-running? get-global ] [ io-thread ] [ ] while ] + "I/O wait" spawn drop ; -[ start-io-thread ] "io.thread" add-init-hook +[ + t io-thread-running? set-global + start-io-thread +] "io.thread" add-init-hook diff --git a/basis/io/timeouts/timeouts.factor b/basis/io/timeouts/timeouts.factor old mode 100644 new mode 100755 index fd1b14de19..8e69983e9c --- a/basis/io/timeouts/timeouts.factor +++ b/basis/io/timeouts/timeouts.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov, Doug Coleman ! See http://factorcode.org/license.txt for BSD license. USING: kernel calendar alarms io io.encodings accessors -namespaces fry ; +namespaces fry io.streams.null ; IN: io.timeouts GENERIC: timeout ( obj -- dt/f ) @@ -27,3 +27,5 @@ GENERIC: cancel-operation ( obj -- ) : timeouts ( dt -- ) [ input-stream get set-timeout ] [ output-stream get set-timeout ] bi ; + +M: null-stream set-timeout 2drop ; diff --git a/basis/io/unix/authors.txt b/basis/io/unix/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/io/unix/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/backend/authors.txt b/basis/io/unix/backend/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/io/unix/backend/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/backend/backend.factor b/basis/io/unix/backend/backend.factor deleted file mode 100644 index 41bd03a58b..0000000000 --- a/basis/io/unix/backend/backend.factor +++ /dev/null @@ -1,185 +0,0 @@ -! Copyright (C) 2004, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.syntax generic assocs kernel -kernel.private math io.ports sequences strings sbufs threads -unix vectors io.buffers io.backend io.encodings math.parser -continuations system libc qualified namespaces make io.timeouts -io.encodings.utf8 destructors accessors summary combinators -locals unix.time fry io.unix.multiplexers ; -QUALIFIED: io -IN: io.unix.backend - -GENERIC: handle-fd ( handle -- fd ) - -TUPLE: fd fd disposed ; - -: init-fd ( fd -- fd ) - [ - |dispose - dup fd>> F_SETFL O_NONBLOCK fcntl io-error - dup fd>> F_SETFD FD_CLOEXEC fcntl io-error - ] with-destructors ; - -: ( n -- fd ) - #! We drop the error code rather than calling io-error, - #! since on OS X 10.3, this operation fails from init-io - #! when running the Factor.app (presumably because fd 0 and - #! 1 are closed). - f fd boa ; - -M: fd dispose - dup disposed>> [ drop ] [ - [ cancel-operation ] - [ t >>disposed drop ] - [ fd>> close-file ] - tri - ] if ; - -M: fd handle-fd dup check-disposed fd>> ; - -M: fd cancel-operation ( fd -- ) - dup disposed>> [ drop ] [ - fd>> - mx get-global - [ remove-input-callbacks [ t swap resume-with ] each ] - [ remove-output-callbacks [ t swap resume-with ] each ] - 2bi - ] if ; - -SYMBOL: +retry+ ! just try the operation again without blocking -SYMBOL: +input+ -SYMBOL: +output+ - -ERROR: io-timeout ; - -M: io-timeout summary drop "I/O operation timed out" ; - -: wait-for-fd ( handle event -- ) - dup +retry+ eq? [ 2drop ] [ - '[ - swap handle-fd mx get-global _ { - { +input+ [ add-input-callback ] } - { +output+ [ add-output-callback ] } - } case - ] "I/O" suspend nip [ io-timeout ] when - ] if ; - -: wait-for-port ( port event -- ) - '[ handle>> _ wait-for-fd ] with-timeout ; - -! Some general stuff -: file-mode OCT: 0666 ; - -! Readers -: (refill) ( port -- n ) - [ handle>> ] - [ buffer>> buffer-end ] - [ buffer>> buffer-capacity ] tri read ; - -! Returns an event to wait for which will ensure completion of -! this request -GENERIC: refill ( port handle -- event/f ) - -M: fd refill - fd>> over buffer>> [ buffer-end ] [ buffer-capacity ] bi read - { - { [ dup 0 >= ] [ swap buffer>> n>buffer f ] } - { [ err_no EINTR = ] [ 2drop +retry+ ] } - { [ err_no EAGAIN = ] [ 2drop +input+ ] } - [ (io-error) ] - } cond ; - -M: unix (wait-to-read) ( port -- ) - dup - dup handle>> dup check-disposed refill dup - [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ; - -! Writers -GENERIC: drain ( port handle -- event/f ) - -M: fd drain - fd>> over buffer>> [ buffer@ ] [ buffer-length ] bi write - { - { [ dup 0 >= ] [ - over buffer>> buffer-consume - buffer>> buffer-empty? f +output+ ? - ] } - { [ err_no EINTR = ] [ 2drop +retry+ ] } - { [ err_no EAGAIN = ] [ 2drop +output+ ] } - [ (io-error) ] - } cond ; - -M: unix (wait-to-write) ( port -- ) - dup - dup handle>> dup check-disposed drain - dup [ wait-for-port ] [ 2drop ] if ; - -M: unix io-multiplex ( ms/f -- ) - mx get-global wait-for-events ; - -! On Unix, you're not supposed to set stdin to non-blocking -! because the fd might be shared with another process (either -! parent or child). So what we do is have the VM start a thread -! which pumps data from the real stdin to a pipe. We set the -! pipe to non-blocking, and read from it instead of the real -! stdin. Very crufty, but it will suffice until we get native -! threading support at the language level. -TUPLE: stdin control size data disposed ; - -M: stdin dispose* - [ - [ control>> &dispose drop ] - [ size>> &dispose drop ] - [ data>> &dispose drop ] - tri - ] with-destructors ; - -: wait-for-stdin ( stdin -- n ) - [ control>> CHAR: X over io:stream-write1 io:stream-flush ] - [ size>> "ssize_t" heap-size swap io:stream-read *int ] - bi ; - -:: refill-stdin ( buffer stdin size -- ) - stdin data>> handle-fd buffer buffer-end size read - dup 0 < [ - drop - err_no EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if - ] [ - size = [ "Error reading stdin pipe" throw ] unless - size buffer n>buffer - ] if ; - -M: stdin refill - [ buffer>> ] [ dup wait-for-stdin ] bi* refill-stdin f ; - -: control-write-fd ( -- fd ) &: control_write *uint ; - -: size-read-fd ( -- fd ) &: size_read *uint ; - -: data-read-fd ( -- fd ) &: stdin_read *uint ; - -: ( -- stdin ) - stdin new - control-write-fd >>control - size-read-fd init-fd >>size - data-read-fd >>data ; - -M: unix (init-stdio) ( -- ) - - 1 - 2 ; - -! mx io-task for embedding an fd-based mx inside another mx -TUPLE: mx-port < port mx ; - -: ( mx -- port ) - dup fd>> mx-port swap >>mx ; - -: multiplexer-error ( n -- n ) - dup 0 < [ - err_no [ EAGAIN = ] [ EINTR = ] bi or - [ drop 0 ] [ (io-error) ] if - ] when ; - -: ?flag ( n mask symbol -- n ) - pick rot bitand 0 > [ , ] [ drop ] if ; diff --git a/basis/io/unix/backend/summary.txt b/basis/io/unix/backend/summary.txt deleted file mode 100644 index 8f66d889cc..0000000000 --- a/basis/io/unix/backend/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Non-blocking I/O and sockets on Unix-like systems diff --git a/basis/io/unix/backend/tags.txt b/basis/io/unix/backend/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/backend/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/bsd/authors.txt b/basis/io/unix/bsd/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/bsd/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/bsd/bsd.factor b/basis/io/unix/bsd/bsd.factor deleted file mode 100644 index 83f063d713..0000000000 --- a/basis/io/unix/bsd/bsd.factor +++ /dev/null @@ -1,13 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: namespaces system kernel accessors assocs continuations -unix io.backend io.unix.backend io.unix.multiplexers -io.unix.multiplexers.kqueue ; -IN: io.unix.bsd - -M: bsd init-io ( -- ) - mx set-global ; - -! M: bsd (monitor) ( path recursive? mailbox -- ) -! swap [ "Recursive kqueue monitors not supported" throw ] when -! ; diff --git a/basis/io/unix/bsd/tags.txt b/basis/io/unix/bsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/bsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/epoll/authors.txt b/basis/io/unix/epoll/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/epoll/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/epoll/epoll.factor b/basis/io/unix/epoll/epoll.factor deleted file mode 100644 index 93d0b4aa99..0000000000 --- a/basis/io/unix/epoll/epoll.factor +++ /dev/null @@ -1,63 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types kernel io.ports io.unix.backend -bit-arrays sequences assocs struct-arrays math namespaces locals -fry unix unix.linux.epoll unix.time ; -IN: io.unix.epoll - -TUPLE: epoll-mx < mx events ; - -: max-events ( -- n ) - #! We read up to 256 events at a time. This is an arbitrary - #! constant... - 256 ; inline - -: ( -- mx ) - epoll-mx new-mx - max-events epoll_create dup io-error >>fd - max-events "epoll-event" >>events ; - -: make-event ( fd events -- event ) - "epoll-event" - [ set-epoll-event-events ] keep - [ set-epoll-event-fd ] keep ; - -:: do-epoll-ctl ( fd mx what events -- ) - mx fd>> what fd fd events make-event epoll_ctl io-error ; - -: do-epoll-add ( fd mx events -- ) - EPOLL_CTL_ADD swap EPOLLONESHOT bitor do-epoll-ctl ; - -: do-epoll-del ( fd mx events -- ) - EPOLL_CTL_DEL swap do-epoll-ctl ; - -M: epoll-mx add-input-callback ( thread fd mx -- ) - [ EPOLLIN do-epoll-add ] [ call-next-method ] 2bi ; - -M: epoll-mx add-output-callback ( thread fd mx -- ) - [ EPOLLOUT do-epoll-add ] [ call-next-method ] 2bi ; - -M: epoll-mx remove-input-callbacks ( fd mx -- seq ) - 2dup reads>> key? [ - [ call-next-method ] [ EPOLLIN do-epoll-del ] 2bi - ] [ 2drop f ] if ; - -M: epoll-mx remove-output-callbacks ( fd mx -- seq ) - 2dup writes>> key? [ - [ EPOLLOUT do-epoll-del ] [ call-next-method ] 2bi - ] [ 2drop f ] if ; - -: wait-event ( mx us -- n ) - [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi* - epoll_wait multiplexer-error ; - -: handle-event ( event mx -- ) - [ epoll-event-fd ] dip - [ EPOLLIN EPOLLOUT bitor do-epoll-del ] - [ input-available ] [ output-available ] 2tri ; - -: handle-events ( mx n -- ) - [ dup events>> ] dip head-slice swap '[ _ handle-event ] each ; - -M: epoll-mx wait-for-events ( us mx -- ) - swap 60000000 or dupd wait-event handle-events ; diff --git a/basis/io/unix/epoll/tags.txt b/basis/io/unix/epoll/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/epoll/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/authors.txt b/basis/io/unix/files/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/io/unix/files/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/files/bsd/bsd.factor b/basis/io/unix/files/bsd/bsd.factor deleted file mode 100644 index 3c94baa39a..0000000000 --- a/basis/io/unix/files/bsd/bsd.factor +++ /dev/null @@ -1,20 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators calendar.unix ; -IN: io.unix.files.bsd - -TUPLE: bsd-file-info < unix-file-info birth-time flags gen ; - -M: bsd new-file-info ( -- class ) bsd-file-info new ; - -M: bsd stat>file-info ( stat -- file-info ) - [ call-next-method ] keep - { - [ stat-st_flags >>flags ] - [ stat-st_gen >>gen ] - [ - stat-st_birthtimespec timespec>unix-time - >>birth-time - ] - } cleave ; diff --git a/basis/io/unix/files/bsd/tags.txt b/basis/io/unix/files/bsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/bsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/files-docs.factor b/basis/io/unix/files/files-docs.factor deleted file mode 100644 index 3798380e0f..0000000000 --- a/basis/io/unix/files/files-docs.factor +++ /dev/null @@ -1,277 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: classes help.markup help.syntax io.streams.string -strings math calendar io.files ; -IN: io.unix.files - -HELP: file-group-id -{ $values - { "path" "a pathname string" } - { "gid" integer } } -{ $description "Returns the group id for a given file." } ; - -HELP: file-group-name -{ $values - { "path" "a pathname string" } - { "string" string } } -{ $description "Returns the group name for a given file." } ; - -HELP: file-permissions -{ $values - { "path" "a pathname string" } - { "n" integer } } -{ $description "Returns the Unix file permissions for a given file." } ; - -HELP: file-username -{ $values - { "path" "a pathname string" } - { "string" string } } -{ $description "Returns the username for a given file." } ; - -HELP: file-user-id -{ $values - { "path" "a pathname string" } - { "uid" integer } } -{ $description "Returns the user id for a given file." } ; - -HELP: group-execute? -{ $values - { "obj" "a pathname string or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: group-read? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: group-write? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: other-execute? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: other-read? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: other-write? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: set-file-access-time -{ $values - { "path" "a pathname string" } { "timestamp" timestamp } } -{ $description "Sets a file's last access timestamp." } ; - -HELP: set-file-group -{ $values - { "path" "a pathname string" } { "string/id" "a string or a group id" } } -{ $description "Sets a file's group id from the given group id or group name." } ; - -HELP: set-file-ids -{ $values - { "path" "a pathname string" } { "uid" integer } { "gid" integer } } -{ $description "Sets the user id and group id of a file with a single library call." } ; - -HELP: set-file-permissions -{ $values - { "path" "a pathname string" } { "n" "an integer, interepreted as a string of bits" } } -{ $description "Sets the file permissions for a given file with the supplied Unix permissions integer. Supplying an octal number with " { $link POSTPONE: OCT: } " is recommended." } -{ $examples "Using the tradidional octal value:" - { $unchecked-example "USING: io.unix.files kernel ;" - "\"resource:license.txt\" OCT: 755 set-file-permissions" - "" - } - "Higher-level, setting named bits:" - { $unchecked-example "USING: io.unix.files kernel math.bitwise ;" - "\"resource:license.txt\"" - "{ USER-ALL GROUP-READ GROUP-EXECUTE OTHER-READ OTHER-EXECUTE }" - "flags set-file-permissions" - "" } -} ; - -HELP: set-file-times -{ $values - { "path" "a pathname string" } { "timestamps" "an array of two timestamps" } } -{ $description "Sets the access and write timestamps for a file as provided in the input array. A value of " { $link f } " provided for either of the timestamps will not change that timestamp." } ; - -HELP: set-file-user -{ $values - { "path" "a pathname string" } { "string/id" "a string or a user id" } } -{ $description "Sets a file's user id from the given user id or username." } ; - -HELP: set-file-modified-time -{ $values - { "path" "a pathname string" } { "timestamp" timestamp } } -{ $description "Sets a file's last modified timestamp, or write timestamp." } ; - -HELP: set-gid -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "gid" } " bit of a file to true or false." } ; - -HELP: gid? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: set-group-execute -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "group execute" } " bit of a file to true or false." } ; - -HELP: set-group-read -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "group read" } " bit of a file to true or false." } ; - -HELP: set-group-write -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "group write" } " bit of a file to true or false." } ; - -HELP: set-other-execute -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ; - -HELP: set-other-read -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "other read" } " bit of a file to true or false." } ; - -HELP: set-other-write -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ; - -HELP: set-sticky -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "sticky" } " bit of a file to true or false." } ; - -HELP: sticky? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "sticky" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: set-uid -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "uid" } " bit of a file to true or false." } ; - -HELP: uid? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "uid" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: set-user-execute -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "user execute" } " bit of a file to true or false." } ; - -HELP: set-user-read -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "user read" } " bit of a file to true or false." } ; - -HELP: set-user-write -{ $values - { "path" "a pathname string" } { "?" "a boolean" } } -{ $description "Sets the " { $snippet "user write" } " bit of a file to true or false." } ; - -HELP: user-execute? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: user-read? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -HELP: user-write? -{ $values - { "obj" "a pathname string, file-info object, or an integer" } - { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file, " { $link file-info } ", or an integer." } ; - -ARTICLE: "unix-file-permissions" "Unix file permissions" -"Reading all file permissions:" -{ $subsection file-permissions } -"Reading individual file permissions:" -{ $subsection uid? } -{ $subsection gid? } -{ $subsection sticky? } -{ $subsection user-read? } -{ $subsection user-write? } -{ $subsection user-execute? } -{ $subsection group-read? } -{ $subsection group-write? } -{ $subsection group-execute? } -{ $subsection other-read? } -{ $subsection other-write? } -{ $subsection other-execute? } -"Writing all file permissions:" -{ $subsection set-file-permissions } -"Writing individual file permissions:" -{ $subsection set-uid } -{ $subsection set-gid } -{ $subsection set-sticky } -{ $subsection set-user-read } -{ $subsection set-user-write } -{ $subsection set-user-execute } -{ $subsection set-group-read } -{ $subsection set-group-write } -{ $subsection set-group-execute } -{ $subsection set-other-read } -{ $subsection set-other-write } -{ $subsection set-other-execute } ; - -ARTICLE: "unix-file-timestamps" "Unix file timestamps" -"To read file times, use the accessors on the object returned by the " { $link file-info } " word." $nl -"Setting multiple file times:" -{ $subsection set-file-times } -"Setting just the last access time:" -{ $subsection set-file-access-time } -"Setting just the last modified time:" -{ $subsection set-file-modified-time } ; - - -ARTICLE: "unix-file-ids" "Unix file user and group ids" -"Reading file user data:" -{ $subsection file-user-id } -{ $subsection file-username } -"Setting file user data:" -{ $subsection set-file-user } -"Reading file group data:" -{ $subsection file-group-id } -{ $subsection file-group-name } -"Setting file group data:" -{ $subsection set-file-group } ; - - -ARTICLE: "io.unix.files" "Unix file attributes" -"The " { $vocab-link "io.unix.files" } " vocabulary implements the Unix backend for opening files and provides a high-level way to set permissions, timestamps, and user and group ids for files." -{ $subsection "unix-file-permissions" } -{ $subsection "unix-file-timestamps" } -{ $subsection "unix-file-ids" } ; - -ABOUT: "io.unix.files" diff --git a/basis/io/unix/files/files-tests.factor b/basis/io/unix/files/files-tests.factor deleted file mode 100644 index 78a80ad969..0000000000 --- a/basis/io/unix/files/files-tests.factor +++ /dev/null @@ -1,163 +0,0 @@ -USING: tools.test io.files continuations kernel io.unix.files -math.bitwise calendar accessors math.functions math unix.users -unix.groups arrays sequences ; -IN: io.unix.files.tests - -[ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test -[ "/etc/" ] [ "/etc/passwd" parent-directory ] unit-test -[ "/" ] [ "/etc/" parent-directory ] unit-test -[ "/" ] [ "/etc" parent-directory ] unit-test -[ "/" ] [ "/" parent-directory ] unit-test - -[ f ] [ "" root-directory? ] unit-test -[ t ] [ "/" root-directory? ] unit-test -[ t ] [ "//" root-directory? ] unit-test -[ t ] [ "///////" root-directory? ] unit-test - -[ "/" ] [ "/" file-name ] unit-test -[ "///" ] [ "///" file-name ] unit-test - -[ "/" ] [ "/" "../.." append-path ] unit-test -[ "/" ] [ "/" "../../" append-path ] unit-test -[ "/lib" ] [ "/" "../lib" append-path ] unit-test -[ "/lib/" ] [ "/" "../lib/" append-path ] unit-test -[ "/lib" ] [ "/" "../../lib" append-path ] unit-test -[ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test - -[ "/lib" ] [ "/usr/" "/lib" append-path ] unit-test -[ "/lib/" ] [ "/usr/" "/lib/" append-path ] unit-test -[ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test -[ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test -[ t ] [ "/foo" absolute-path? ] unit-test - -: test-file ( -- path ) - "permissions" temp-file ; - -: prepare-test-file ( -- ) - [ test-file delete-file ] ignore-errors - test-file touch-file ; - -: perms ( -- n ) - test-file file-permissions OCT: 7777 mask ; - -prepare-test-file - -[ t ] -[ test-file { USER-ALL GROUP-ALL OTHER-ALL } flags set-file-permissions perms OCT: 777 = ] unit-test - -[ t ] [ test-file user-read? ] unit-test -[ t ] [ test-file user-write? ] unit-test -[ t ] [ test-file user-execute? ] unit-test -[ t ] [ test-file group-read? ] unit-test -[ t ] [ test-file group-write? ] unit-test -[ t ] [ test-file group-execute? ] unit-test -[ t ] [ test-file other-read? ] unit-test -[ t ] [ test-file other-write? ] unit-test -[ t ] [ test-file other-execute? ] unit-test - -[ t ] [ test-file f set-other-execute perms OCT: 776 = ] unit-test -[ f ] [ test-file file-info other-execute? ] unit-test - -[ t ] [ test-file f set-other-write perms OCT: 774 = ] unit-test -[ f ] [ test-file file-info other-write? ] unit-test - -[ t ] [ test-file f set-other-read perms OCT: 770 = ] unit-test -[ f ] [ test-file file-info other-read? ] unit-test - -[ t ] [ test-file f set-group-execute perms OCT: 760 = ] unit-test -[ f ] [ test-file file-info group-execute? ] unit-test - -[ t ] [ test-file f set-group-write perms OCT: 740 = ] unit-test -[ f ] [ test-file file-info group-write? ] unit-test - -[ t ] [ test-file f set-group-read perms OCT: 700 = ] unit-test -[ f ] [ test-file file-info group-read? ] unit-test - -[ t ] [ test-file f set-user-execute perms OCT: 600 = ] unit-test -[ f ] [ test-file file-info other-execute? ] unit-test - -[ t ] [ test-file f set-user-write perms OCT: 400 = ] unit-test -[ f ] [ test-file file-info other-write? ] unit-test - -[ t ] [ test-file f set-user-read perms OCT: 000 = ] unit-test -[ f ] [ test-file file-info other-read? ] unit-test - -[ t ] -[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test - -prepare-test-file - -[ t ] -[ - test-file now - [ set-file-access-time ] 2keep - [ file-info accessed>> ] - [ [ [ truncate >integer ] change-second ] bi@ ] bi* = -] unit-test - -[ t ] -[ - test-file now - [ set-file-modified-time ] 2keep - [ file-info modified>> ] - [ [ [ truncate >integer ] change-second ] bi@ ] bi* = -] unit-test - -[ t ] -[ - test-file now [ dup 2array set-file-times ] 2keep - [ file-info [ modified>> ] [ accessed>> ] bi ] dip - 3array - [ [ truncate >integer ] change-second ] map all-equal? -] unit-test - -[ ] [ test-file f now 2array set-file-times ] unit-test -[ ] [ test-file now f 2array set-file-times ] unit-test -[ ] [ test-file f f 2array set-file-times ] unit-test - - -[ ] [ test-file real-username set-file-user ] unit-test -[ ] [ test-file real-user-id set-file-user ] unit-test -[ ] [ test-file real-group-name set-file-group ] unit-test -[ ] [ test-file real-group-id set-file-group ] unit-test - -[ t ] [ test-file file-username real-username = ] unit-test -[ t ] [ test-file file-group-name real-group-name = ] unit-test - -[ ] -[ test-file real-user-id real-group-id set-file-ids ] unit-test - -[ ] -[ test-file f real-group-id set-file-ids ] unit-test - -[ ] -[ test-file real-user-id f set-file-ids ] unit-test - -[ ] -[ test-file f f set-file-ids ] unit-test - -[ t ] [ OCT: 4000 uid? ] unit-test -[ t ] [ OCT: 2000 gid? ] unit-test -[ t ] [ OCT: 1000 sticky? ] unit-test -[ t ] [ OCT: 400 user-read? ] unit-test -[ t ] [ OCT: 200 user-write? ] unit-test -[ t ] [ OCT: 100 user-execute? ] unit-test -[ t ] [ OCT: 040 group-read? ] unit-test -[ t ] [ OCT: 020 group-write? ] unit-test -[ t ] [ OCT: 010 group-execute? ] unit-test -[ t ] [ OCT: 004 other-read? ] unit-test -[ t ] [ OCT: 002 other-write? ] unit-test -[ t ] [ OCT: 001 other-execute? ] unit-test - -[ f ] [ 0 uid? ] unit-test -[ f ] [ 0 gid? ] unit-test -[ f ] [ 0 sticky? ] unit-test -[ f ] [ 0 user-read? ] unit-test -[ f ] [ 0 user-write? ] unit-test -[ f ] [ 0 user-execute? ] unit-test -[ f ] [ 0 group-read? ] unit-test -[ f ] [ 0 group-write? ] unit-test -[ f ] [ 0 group-execute? ] unit-test -[ f ] [ 0 other-read? ] unit-test -[ f ] [ 0 other-write? ] unit-test -[ f ] [ 0 other-execute? ] unit-test diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor deleted file mode 100644 index 1fc5fe9226..0000000000 --- a/basis/io/unix/files/files.factor +++ /dev/null @@ -1,371 +0,0 @@ -! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: io.backend io.ports io.unix.backend io.files io -unix unix.stat unix.time kernel math continuations -math.bitwise byte-arrays alien combinators calendar -io.encodings.binary accessors sequences strings system -io.files.private destructors vocabs.loader calendar.unix -unix.stat alien.c-types arrays unix.users unix.groups -environment fry io.encodings.utf8 alien.strings -combinators.short-circuit ; -IN: io.unix.files - -M: unix cwd ( -- path ) - MAXPATHLEN [ ] keep getcwd - [ (io-error) ] unless* ; - -M: unix cd ( path -- ) [ chdir ] unix-system-call drop ; - -: read-flags O_RDONLY ; inline - -: open-read ( path -- fd ) O_RDONLY file-mode open-file ; - -M: unix (file-reader) ( path -- stream ) - open-read init-fd ; - -: write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline - -: open-write ( path -- fd ) - write-flags file-mode open-file ; - -M: unix (file-writer) ( path -- stream ) - open-write init-fd ; - -: append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline - -: open-append ( path -- fd ) - [ - append-flags file-mode open-file |dispose - dup 0 SEEK_END lseek io-error - ] with-destructors ; - -M: unix (file-appender) ( path -- stream ) - open-append init-fd ; - -: touch-mode ( -- n ) - { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable - -M: unix touch-file ( path -- ) - normalize-path - dup exists? [ touch ] [ - touch-mode file-mode open-file close-file - ] if ; - -M: unix move-file ( from to -- ) - [ normalize-path ] bi@ rename io-error ; - -M: unix delete-file ( path -- ) normalize-path unlink-file ; - -M: unix make-directory ( path -- ) - normalize-path OCT: 777 mkdir io-error ; - -M: unix delete-directory ( path -- ) - normalize-path rmdir io-error ; - -: (copy-file) ( from to -- ) - dup parent-directory make-directories - binary [ - swap binary [ - swap stream-copy - ] with-disposal - ] with-disposal ; - -M: unix copy-file ( from to -- ) - [ normalize-path ] bi@ - [ (copy-file) ] - [ swap file-info permissions>> chmod io-error ] - 2bi ; - -TUPLE: unix-file-system-info < file-system-info -block-size preferred-block-size -blocks blocks-free blocks-available -files files-free files-available -name-max flags id ; - -HOOK: new-file-system-info os ( -- file-system-info ) - -M: unix new-file-system-info ( -- ) unix-file-system-info new ; - -HOOK: file-system-statfs os ( path -- statfs ) - -M: unix file-system-statfs drop f ; - -HOOK: file-system-statvfs os ( path -- statvfs ) - -M: unix file-system-statvfs drop f ; - -HOOK: statfs>file-system-info os ( file-system-info statfs -- file-system-info' ) - -M: unix statfs>file-system-info drop ; - -HOOK: statvfs>file-system-info os ( file-system-info statvfs -- file-system-info' ) - -M: unix statvfs>file-system-info drop ; - -: file-system-calculations ( file-system-info -- file-system-info' ) - { - [ dup [ blocks-available>> ] [ block-size>> ] bi * >>available-space drop ] - [ dup [ blocks-free>> ] [ block-size>> ] bi * >>free-space drop ] - [ dup [ blocks>> ] [ block-size>> ] bi * >>total-space drop ] - [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] - [ ] - } cleave ; - -M: unix file-system-info - normalize-path - [ new-file-system-info ] dip - [ file-system-statfs statfs>file-system-info ] - [ file-system-statvfs statvfs>file-system-info ] bi - file-system-calculations ; - -os { - { linux [ "io.unix.files.linux" require ] } - { macosx [ "io.unix.files.macosx" require ] } - { freebsd [ "io.unix.files.freebsd" require ] } - { netbsd [ "io.unix.files.netbsd" require ] } - { openbsd [ "io.unix.files.openbsd" require ] } -} case - -TUPLE: unix-file-info < file-info uid gid dev ino -nlink rdev blocks blocksize ; - -HOOK: new-file-info os ( -- file-info ) - -HOOK: stat>file-info os ( stat -- file-info ) - -HOOK: stat>type os ( stat -- file-info ) - -M: unix file-info ( path -- info ) - normalize-path file-status stat>file-info ; - -M: unix link-info ( path -- info ) - normalize-path link-status stat>file-info ; - -M: unix make-link ( path1 path2 -- ) - normalize-path symlink io-error ; - -M: unix read-link ( path -- path' ) - normalize-path read-symbolic-link ; - -M: unix new-file-info ( -- class ) unix-file-info new ; - -M: unix stat>file-info ( stat -- file-info ) - [ new-file-info ] dip - { - [ stat>type >>type ] - [ stat-st_size >>size ] - [ stat-st_mode >>permissions ] - [ stat-st_ctimespec timespec>unix-time >>created ] - [ stat-st_mtimespec timespec>unix-time >>modified ] - [ stat-st_atimespec timespec>unix-time >>accessed ] - [ stat-st_uid >>uid ] - [ stat-st_gid >>gid ] - [ stat-st_dev >>dev ] - [ stat-st_ino >>ino ] - [ stat-st_nlink >>nlink ] - [ stat-st_rdev >>rdev ] - [ stat-st_blocks >>blocks ] - [ stat-st_blksize >>blocksize ] - } cleave ; - -: n>file-type ( n -- type ) - S_IFMT bitand { - { S_IFREG [ +regular-file+ ] } - { S_IFDIR [ +directory+ ] } - { S_IFCHR [ +character-device+ ] } - { S_IFBLK [ +block-device+ ] } - { S_IFIFO [ +fifo+ ] } - { S_IFLNK [ +symbolic-link+ ] } - { S_IFSOCK [ +socket+ ] } - [ drop +unknown+ ] - } case ; - -M: unix stat>type ( stat -- type ) - stat-st_mode n>file-type ; - -! Linux has no extra fields in its stat struct -os { - { macosx [ "io.unix.files.bsd" require ] } - { netbsd [ "io.unix.files.bsd" require ] } - { openbsd [ "io.unix.files.bsd" require ] } - { freebsd [ "io.unix.files.bsd" require ] } - { linux [ ] } -} case - -: with-unix-directory ( path quot -- ) - [ opendir dup [ (io-error) ] unless ] dip - dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline - -: find-next-file ( DIR* -- byte-array ) - "dirent" - f - [ readdir_r 0 = [ (io-error) ] unless ] 2keep - *void* [ drop f ] unless ; - -M: unix >directory-entry ( byte-array -- directory-entry ) - [ dirent-d_name utf8 alien>string ] - [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ; - -M: unix (directory-entries) ( path -- seq ) - [ - '[ _ find-next-file dup ] - [ >directory-entry ] - [ drop ] produce - ] with-unix-directory ; - -> ] dip mask? ; - -PRIVATE> - -: ch>file-type ( ch -- type ) - { - { CHAR: b [ +block-device+ ] } - { CHAR: c [ +character-device+ ] } - { CHAR: d [ +directory+ ] } - { CHAR: l [ +symbolic-link+ ] } - { CHAR: s [ +socket+ ] } - { CHAR: p [ +fifo+ ] } - { CHAR: - [ +regular-file+ ] } - [ drop +unknown+ ] - } case ; - -: file-type>ch ( type -- string ) - { - { +block-device+ [ CHAR: b ] } - { +character-device+ [ CHAR: c ] } - { +directory+ [ CHAR: d ] } - { +symbolic-link+ [ CHAR: l ] } - { +socket+ [ CHAR: s ] } - { +fifo+ [ CHAR: p ] } - { +regular-file+ [ CHAR: - ] } - [ drop CHAR: - ] - } case ; - -: UID OCT: 0004000 ; inline -: GID OCT: 0002000 ; inline -: STICKY OCT: 0001000 ; inline -: USER-ALL OCT: 0000700 ; inline -: USER-READ OCT: 0000400 ; inline -: USER-WRITE OCT: 0000200 ; inline -: USER-EXECUTE OCT: 0000100 ; inline -: GROUP-ALL OCT: 0000070 ; inline -: GROUP-READ OCT: 0000040 ; inline -: GROUP-WRITE OCT: 0000020 ; inline -: GROUP-EXECUTE OCT: 0000010 ; inline -: OTHER-ALL OCT: 0000007 ; inline -: OTHER-READ OCT: 0000004 ; inline -: OTHER-WRITE OCT: 0000002 ; inline -: OTHER-EXECUTE OCT: 0000001 ; inline - -: uid? ( obj -- ? ) UID file-mode? ; -: gid? ( obj -- ? ) GID file-mode? ; -: sticky? ( obj -- ? ) STICKY file-mode? ; -: user-read? ( obj -- ? ) USER-READ file-mode? ; -: user-write? ( obj -- ? ) USER-WRITE file-mode? ; -: user-execute? ( obj -- ? ) USER-EXECUTE file-mode? ; -: group-read? ( obj -- ? ) GROUP-READ file-mode? ; -: group-write? ( obj -- ? ) GROUP-WRITE file-mode? ; -: group-execute? ( obj -- ? ) GROUP-EXECUTE file-mode? ; -: other-read? ( obj -- ? ) OTHER-READ file-mode? ; -: other-write? ( obj -- ? ) OTHER-WRITE file-mode? ; -: other-execute? ( obj -- ? ) OTHER-EXECUTE file-mode? ; - -: any-read? ( obj -- ? ) - { [ user-read? ] [ group-read? ] [ other-read? ] } 1|| ; - -: any-write? ( obj -- ? ) - { [ user-write? ] [ group-write? ] [ other-write? ] } 1|| ; - -: any-execute? ( obj -- ? ) - { [ user-execute? ] [ group-execute? ] [ other-execute? ] } 1|| ; - -: set-uid ( path ? -- ) UID swap chmod-set-bit ; -: set-gid ( path ? -- ) GID swap chmod-set-bit ; -: set-sticky ( path ? -- ) STICKY swap chmod-set-bit ; -: set-user-read ( path ? -- ) USER-READ swap chmod-set-bit ; -: set-user-write ( path ? -- ) USER-WRITE swap chmod-set-bit ; -: set-user-execute ( path ? -- ) USER-EXECUTE swap chmod-set-bit ; -: set-group-read ( path ? -- ) GROUP-READ swap chmod-set-bit ; -: set-group-write ( path ? -- ) GROUP-WRITE swap chmod-set-bit ; -: set-group-execute ( path ? -- ) GROUP-EXECUTE swap chmod-set-bit ; -: set-other-read ( path ? -- ) OTHER-READ swap chmod-set-bit ; -: set-other-write ( path ? -- ) OTHER-WRITE swap chmod-set-bit ; -: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ; - -: set-file-permissions ( path n -- ) - [ normalize-path ] dip chmod io-error ; - -: file-permissions ( path -- n ) - normalize-path file-info permissions>> ; - - ] unless* ] map concat ; - -: timestamp>timeval ( timestamp -- timeval ) - unix-1970 time- duration>microseconds make-timeval ; - -: timestamps>byte-array ( timestamps -- byte-array ) - [ dup [ timestamp>timeval ] when ] map make-timeval-array ; - -PRIVATE> - -: set-file-times ( path timestamps -- ) - #! set access, write - [ normalize-path ] dip - timestamps>byte-array utimes io-error ; - -: set-file-access-time ( path timestamp -- ) - f 2array set-file-times ; - -: set-file-modified-time ( path timestamp -- ) - f swap 2array set-file-times ; - -: set-file-ids ( path uid gid -- ) - [ normalize-path ] 2dip - [ [ -1 ] unless* ] bi@ chown io-error ; - -GENERIC: set-file-user ( path string/id -- ) - -GENERIC: set-file-group ( path string/id -- ) - -M: integer set-file-user ( path uid -- ) - f set-file-ids ; - -M: string set-file-user ( path string -- ) - user-id f set-file-ids ; - -M: integer set-file-group ( path gid -- ) - f swap set-file-ids ; - -M: string set-file-group ( path string -- ) - group-id - f swap set-file-ids ; - -: file-user-id ( path -- uid ) - normalize-path file-info uid>> ; - -: file-username ( path -- string ) - file-user-id username ; - -: file-group-id ( path -- gid ) - normalize-path file-info gid>> ; - -: file-group-name ( path -- string ) - file-group-id group-name ; - -M: unix home "HOME" os-env ; diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor deleted file mode 100644 index eaf217af62..0000000000 --- a/basis/io/unix/files/freebsd/freebsd.factor +++ /dev/null @@ -1,55 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.syntax combinators -io.backend io.files io.unix.files kernel math system unix -unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd -sequences grouping alien.strings io.encodings.utf8 -specialized-arrays.direct.uint arrays ; -IN: io.unix.files.freebsd - -TUPLE: freebsd-file-system-info < unix-file-system-info -version io-size owner syncreads syncwrites asyncreads asyncwrites ; - -M: freebsd new-file-system-info freebsd-file-system-info new ; - -M: freebsd file-system-statfs ( path -- byte-array ) - "statfs" tuck statfs io-error ; - -M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-info ) - { - [ statfs-f_version >>version ] - [ statfs-f_type >>type ] - [ statfs-f_flags >>flags ] - [ statfs-f_bsize >>block-size ] - [ statfs-f_iosize >>io-size ] - [ statfs-f_blocks >>blocks ] - [ statfs-f_bfree >>blocks-free ] - [ statfs-f_bavail >>blocks-available ] - [ statfs-f_files >>files ] - [ statfs-f_ffree >>files-free ] - [ statfs-f_syncwrites >>syncwrites ] - [ statfs-f_asyncwrites >>asyncwrites ] - [ statfs-f_syncreads >>syncreads ] - [ statfs-f_asyncreads >>asyncreads ] - [ statfs-f_namemax >>name-max ] - [ statfs-f_owner >>owner ] - [ statfs-f_fsid 2 >array >>id ] - [ statfs-f_fstypename utf8 alien>string >>type ] - [ statfs-f_mntfromname utf8 alien>string >>device-name ] - [ statfs-f_mntonname utf8 alien>string >>mount-point ] - } cleave ; - -M: freebsd file-system-statvfs ( path -- byte-array ) - "statvfs" tuck statvfs io-error ; - -M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info ) - { - [ statvfs-f_favail >>files-available ] - [ statvfs-f_frsize >>preferred-block-size ] - } cleave ; - -M: freebsd file-systems ( -- array ) - f 0 0 getfsstat dup io-error - "statfs" dup dup length 0 getfsstat io-error - "statfs" heap-size group - [ statfs-f_mntonname alien>native-string file-system-info ] map ; diff --git a/basis/io/unix/files/freebsd/tags.txt b/basis/io/unix/files/freebsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/freebsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/linux/linux.factor b/basis/io/unix/files/linux/linux.factor deleted file mode 100644 index c30855c3ee..0000000000 --- a/basis/io/unix/files/linux/linux.factor +++ /dev/null @@ -1,90 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.syntax combinators csv -io.backend io.encodings.utf8 io.files io.streams.string -io.unix.files kernel math.order namespaces sequences sorting -system unix unix.statfs.linux unix.statvfs.linux -specialized-arrays.direct.uint arrays ; -IN: io.unix.files.linux - -TUPLE: linux-file-system-info < unix-file-system-info -namelen ; - -M: linux new-file-system-info linux-file-system-info new ; - -M: linux file-system-statfs ( path -- byte-array ) - "statfs64" tuck statfs64 io-error ; - -M: linux statfs>file-system-info ( struct -- statfs ) - { - [ statfs64-f_type >>type ] - [ statfs64-f_bsize >>block-size ] - [ statfs64-f_blocks >>blocks ] - [ statfs64-f_bfree >>blocks-free ] - [ statfs64-f_bavail >>blocks-available ] - [ statfs64-f_files >>files ] - [ statfs64-f_ffree >>files-free ] - [ statfs64-f_fsid 2 >array >>id ] - [ statfs64-f_namelen >>namelen ] - [ statfs64-f_frsize >>preferred-block-size ] - ! [ statfs64-f_spare >>spare ] - } cleave ; - -M: linux file-system-statvfs ( path -- byte-array ) - "statvfs64" tuck statvfs64 io-error ; - -M: linux statvfs>file-system-info ( struct -- statfs ) - { - [ statvfs64-f_flag >>flags ] - [ statvfs64-f_namemax >>name-max ] - } cleave ; - -TUPLE: mtab-entry file-system-name mount-point type options -frequency pass-number ; - -: mtab-csv>mtab-entry ( csv -- mtab-entry ) - [ mtab-entry new ] dip - { - [ first >>file-system-name ] - [ second >>mount-point ] - [ third >>type ] - [ fourth csv first >>options ] - [ 4 swap nth >>frequency ] - [ 5 swap nth >>pass-number ] - } cleave ; - -: parse-mtab ( -- array ) - [ - "/etc/mtab" utf8 - CHAR: \s delimiter set csv - ] with-scope - [ mtab-csv>mtab-entry ] map ; - -M: linux file-systems - parse-mtab [ - [ mount-point>> file-system-info ] keep - { - [ file-system-name>> >>device-name ] - [ mount-point>> >>mount-point ] - [ type>> >>type ] - } cleave - ] map ; - -ERROR: file-system-not-found ; - -M: linux file-system-info ( path -- ) - normalize-path - [ - [ new-file-system-info ] dip - [ file-system-statfs statfs>file-system-info ] - [ file-system-statvfs statvfs>file-system-info ] bi - file-system-calculations - ] keep - - parse-mtab [ [ mount-point>> ] bi@ <=> invert-comparison ] sort - [ mount-point>> head? ] with find nip [ file-system-not-found ] unless* - { - [ file-system-name>> >>device-name drop ] - [ mount-point>> >>mount-point drop ] - [ type>> >>type ] - } 2cleave ; diff --git a/basis/io/unix/files/linux/tags.txt b/basis/io/unix/files/linux/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/linux/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/macosx/macosx.factor b/basis/io/unix/files/macosx/macosx.factor deleted file mode 100644 index 397145c9ae..0000000000 --- a/basis/io/unix/files/macosx/macosx.factor +++ /dev/null @@ -1,51 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.strings combinators -grouping io.encodings.utf8 io.files kernel math sequences -system unix io.unix.files specialized-arrays.direct.uint arrays -unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx ; -IN: io.unix.files.macosx - -TUPLE: macosx-file-system-info < unix-file-system-info -io-size owner type-id filesystem-subtype ; - -M: macosx file-systems ( -- array ) - f dup 0 getmntinfo64 dup io-error - [ *void* ] dip - "statfs64" heap-size [ * memory>byte-array ] keep group - [ statfs64-f_mntonname utf8 alien>string file-system-info ] map ; - ! [ [ new-file-system-info ] dip statfs>file-system-info ] map ; - -M: macosx new-file-system-info macosx-file-system-info new ; - -M: macosx file-system-statfs ( normalized-path -- statfs ) - "statfs64" tuck statfs64 io-error ; - -M: macosx file-system-statvfs ( normalized-path -- statvfs ) - "statvfs" tuck statvfs io-error ; - -M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' ) - { - [ statfs64-f_bsize >>block-size ] - [ statfs64-f_iosize >>io-size ] - [ statfs64-f_blocks >>blocks ] - [ statfs64-f_bfree >>blocks-free ] - [ statfs64-f_bavail >>blocks-available ] - [ statfs64-f_files >>files ] - [ statfs64-f_ffree >>files-free ] - [ statfs64-f_fsid 2 >array >>id ] - [ statfs64-f_owner >>owner ] - [ statfs64-f_type >>type-id ] - [ statfs64-f_flags >>flags ] - [ statfs64-f_fssubtype >>filesystem-subtype ] - [ statfs64-f_fstypename utf8 alien>string >>type ] - [ statfs64-f_mntonname utf8 alien>string >>mount-point ] - [ statfs64-f_mntfromname utf8 alien>string >>device-name ] - } cleave ; - -M: macosx statvfs>file-system-info ( file-system-info byte-array -- file-system-info' ) - { - [ statvfs-f_frsize >>preferred-block-size ] - [ statvfs-f_favail >>files-available ] - [ statvfs-f_namemax >>name-max ] - } cleave ; diff --git a/basis/io/unix/files/macosx/tags.txt b/basis/io/unix/files/macosx/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/macosx/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor deleted file mode 100644 index 82ac3dc70d..0000000000 --- a/basis/io/unix/files/netbsd/netbsd.factor +++ /dev/null @@ -1,52 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel unix.stat math unix -combinators system io.backend accessors alien.c-types -io.encodings.utf8 alien.strings unix.types io.unix.files -io.files unix.statvfs.netbsd unix.getfsstat.netbsd arrays -grouping sequences io.encodings.utf8 specialized-arrays.direct.uint ; -IN: io.unix.files.netbsd - -TUPLE: netbsd-file-system-info < unix-file-system-info -blocks-reserved files-reserved -owner io-size sync-reads sync-writes async-reads async-writes -idx mount-from ; - -M: netbsd new-file-system-info netbsd-file-system-info new ; - -M: netbsd file-system-statvfs - "statvfs" tuck statvfs io-error ; - -M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) - { - [ statvfs-f_flag >>flags ] - [ statvfs-f_bsize >>block-size ] - [ statvfs-f_frsize >>preferred-block-size ] - [ statvfs-f_iosize >>io-size ] - [ statvfs-f_blocks >>blocks ] - [ statvfs-f_bfree >>blocks-free ] - [ statvfs-f_bavail >>blocks-available ] - [ statvfs-f_bresvd >>blocks-reserved ] - [ statvfs-f_files >>files ] - [ statvfs-f_ffree >>files-free ] - [ statvfs-f_favail >>files-available ] - [ statvfs-f_fresvd >>files-reserved ] - [ statvfs-f_syncreads >>sync-reads ] - [ statvfs-f_syncwrites >>sync-writes ] - [ statvfs-f_asyncreads >>async-reads ] - [ statvfs-f_asyncwrites >>async-writes ] - [ statvfs-f_fsidx 2 >array >>idx ] - [ statvfs-f_fsid >>id ] - [ statvfs-f_namemax >>name-max ] - [ statvfs-f_owner >>owner ] - ! [ statvfs-f_spare >>spare ] - [ statvfs-f_fstypename utf8 alien>string >>type ] - [ statvfs-f_mntonname utf8 alien>string >>mount-point ] - [ statvfs-f_mntfromname utf8 alien>string >>device-name ] - } cleave ; - -M: netbsd file-systems ( -- array ) - f 0 0 getvfsstat dup io-error - "statvfs" dup dup length 0 getvfsstat io-error - "statvfs" heap-size group - [ statvfs-f_mntonname utf8 alien>string file-system-info ] map ; diff --git a/basis/io/unix/files/netbsd/tags.txt b/basis/io/unix/files/netbsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/netbsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor deleted file mode 100644 index e5e18b29ea..0000000000 --- a/basis/io/unix/files/openbsd/openbsd.factor +++ /dev/null @@ -1,55 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.strings alien.syntax -combinators io.backend io.files io.unix.files kernel math -sequences system unix unix.getfsstat.openbsd grouping -unix.statfs.openbsd unix.statvfs.openbsd unix.types -specialized-arrays.direct.uint arrays ; -IN: io.unix.files.openbsd - -TUPLE: freebsd-file-system-info < unix-file-system-info -io-size sync-writes sync-reads async-writes async-reads -owner ; - -M: openbsd new-file-system-info freebsd-file-system-info new ; - -M: openbsd file-system-statfs - "statfs" tuck statfs io-error ; - -M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info' ) - { - [ statfs-f_flags >>flags ] - [ statfs-f_bsize >>block-size ] - [ statfs-f_iosize >>io-size ] - [ statfs-f_blocks >>blocks ] - [ statfs-f_bfree >>blocks-free ] - [ statfs-f_bavail >>blocks-available ] - [ statfs-f_files >>files ] - [ statfs-f_ffree >>files-free ] - [ statfs-f_favail >>files-available ] - [ statfs-f_syncwrites >>sync-writes ] - [ statfs-f_syncreads >>sync-reads ] - [ statfs-f_asyncwrites >>async-writes ] - [ statfs-f_asyncreads >>async-reads ] - [ statfs-f_fsid 2 >array >>id ] - [ statfs-f_namemax >>name-max ] - [ statfs-f_owner >>owner ] - ! [ statfs-f_spare >>spare ] - [ statfs-f_fstypename alien>native-string >>type ] - [ statfs-f_mntonname alien>native-string >>mount-point ] - [ statfs-f_mntfromname alien>native-string >>device-name ] - } cleave ; - -M: openbsd file-system-statvfs ( normalized-path -- statvfs ) - "statvfs" tuck statvfs io-error ; - -M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) - { - [ statvfs-f_frsize >>preferred-block-size ] - } cleave ; - -M: openbsd file-systems ( -- seq ) - f 0 0 getfsstat dup io-error - "statfs" dup dup length 0 getfsstat io-error - "statfs" heap-size group - [ statfs-f_mntonname alien>native-string file-system-info ] map ; diff --git a/basis/io/unix/files/openbsd/tags.txt b/basis/io/unix/files/openbsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/openbsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/summary.txt b/basis/io/unix/files/summary.txt deleted file mode 100644 index 57527bef70..0000000000 --- a/basis/io/unix/files/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Implementation of reading and writing files on Unix-like systems diff --git a/basis/io/unix/files/tags.txt b/basis/io/unix/files/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/unique/tags.txt b/basis/io/unix/files/unique/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/unique/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/unique/unique.factor b/basis/io/unix/files/unique/unique.factor deleted file mode 100644 index 24dcdcb65a..0000000000 --- a/basis/io/unix/files/unique/unique.factor +++ /dev/null @@ -1,13 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel io.ports io.unix.backend math.bitwise -unix system io.files.unique ; -IN: io.unix.files.unique - -: open-unique-flags ( -- flags ) - { O_RDWR O_CREAT O_EXCL } flags ; - -M: unix touch-unique-file ( path -- ) - open-unique-flags file-mode open-file close-file ; - -M: unix temporary-path ( -- path ) "/tmp" ; diff --git a/basis/io/unix/freebsd/freebsd.factor b/basis/io/unix/freebsd/freebsd.factor deleted file mode 100644 index 49fbc9af7e..0000000000 --- a/basis/io/unix/freebsd/freebsd.factor +++ /dev/null @@ -1,3 +0,0 @@ -USING: io.unix.bsd io.backend system ; - -freebsd set-io-backend diff --git a/basis/io/unix/freebsd/tags.txt b/basis/io/unix/freebsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/freebsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/kqueue/authors.txt b/basis/io/unix/kqueue/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/kqueue/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/kqueue/kqueue.factor b/basis/io/unix/kqueue/kqueue.factor deleted file mode 100644 index be99d17572..0000000000 --- a/basis/io/unix/kqueue/kqueue.factor +++ /dev/null @@ -1,74 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types combinators io.unix.backend -kernel math.bitwise sequences struct-arrays unix unix.kqueue -unix.time assocs ; -IN: io.unix.kqueue - -TUPLE: kqueue-mx < mx events ; - -: max-events ( -- n ) - #! We read up to 256 events at a time. This is an arbitrary - #! constant... - 256 ; inline - -: ( -- mx ) - kqueue-mx new-mx - kqueue dup io-error >>fd - max-events "kevent" >>events ; - -: make-kevent ( fd filter flags -- event ) - "kevent" - [ set-kevent-flags ] keep - [ set-kevent-filter ] keep - [ set-kevent-ident ] keep ; - -: register-kevent ( kevent mx -- ) - fd>> swap 1 f 0 f kevent io-error ; - -M: kqueue-mx add-input-callback ( thread fd mx -- ) - [ call-next-method ] [ - [ EVFILT_READ { EV_ADD EV_ONESHOT } flags make-kevent ] dip - register-kevent - ] 2bi ; - -M: kqueue-mx add-output-callback ( thread fd mx -- ) - [ call-next-method ] [ - [ EVFILT_WRITE { EV_ADD EV_ONESHOT } flags make-kevent ] dip - register-kevent - ] 2bi ; - -M: kqueue-mx remove-input-callbacks ( fd mx -- seq ) - 2dup reads>> key? [ - [ call-next-method ] [ - [ EVFILT_READ EV_DELETE make-kevent ] dip - register-kevent - ] 2bi - ] [ 2drop f ] if ; - -M: kqueue-mx remove-output-callbacks ( fd mx -- seq ) - 2dup writes>> key? [ - [ - [ EVFILT_WRITE EV_DELETE make-kevent ] dip - register-kevent - ] [ call-next-method ] 2bi - ] [ 2drop f ] if ; - -: wait-kevent ( mx timespec -- n ) - [ - [ fd>> f 0 ] - [ events>> [ underlying>> ] [ length ] bi ] bi - ] dip kevent multiplexer-error ; - -: handle-kevent ( mx kevent -- ) - [ kevent-ident swap ] [ kevent-filter ] bi { - { EVFILT_READ [ input-available ] } - { EVFILT_WRITE [ output-available ] } - } case ; - -: handle-kevents ( mx n -- ) - [ dup events>> ] dip head-slice [ handle-kevent ] with each ; - -M: kqueue-mx wait-for-events ( us mx -- ) - swap dup [ make-timespec ] when - dupd wait-kevent handle-kevents ; diff --git a/basis/io/unix/kqueue/tags.txt b/basis/io/unix/kqueue/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/kqueue/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/launcher/authors.txt b/basis/io/unix/launcher/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/launcher/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/launcher/launcher-tests.factor b/basis/io/unix/launcher/launcher-tests.factor deleted file mode 100644 index 68ca821ed4..0000000000 --- a/basis/io/unix/launcher/launcher-tests.factor +++ /dev/null @@ -1,138 +0,0 @@ -IN: io.unix.launcher.tests -USING: io.files tools.test io.launcher arrays io namespaces -continuations math io.encodings.binary io.encodings.ascii -accessors kernel sequences io.encodings.utf8 destructors -io.streams.duplex locals concurrency.promises threads -unix.process ; - -[ ] [ - [ "launcher-test-1" temp-file delete-file ] ignore-errors -] unit-test - -[ ] [ - "touch" - "launcher-test-1" temp-file - 2array - try-process -] unit-test - -[ t ] [ "launcher-test-1" temp-file exists? ] unit-test - -[ ] [ - [ "launcher-test-1" temp-file delete-file ] ignore-errors -] unit-test - -[ ] [ - - "echo Hello" >>command - "launcher-test-1" temp-file >>stdout - try-process -] unit-test - -[ "Hello\n" ] [ - "cat" - "launcher-test-1" temp-file - 2array - ascii contents -] unit-test - -[ ] [ - [ "launcher-test-1" temp-file delete-file ] ignore-errors -] unit-test - -[ ] [ - - "cat" >>command - +closed+ >>stdin - "launcher-test-1" temp-file >>stdout - try-process -] unit-test - -[ f ] [ - "cat" - "launcher-test-1" temp-file - 2array - ascii contents -] unit-test - -[ ] [ - 2 [ - "launcher-test-1" temp-file binary [ - - swap >>stdout - "echo Hello" >>command - try-process - ] with-disposal - ] times -] unit-test - -[ "Hello\nHello\n" ] [ - "cat" - "launcher-test-1" temp-file - 2array - ascii contents -] unit-test - -[ t ] [ - - "env" >>command - { { "A" "B" } } >>environment - ascii lines - "A=B" swap member? -] unit-test - -[ { "A=B" } ] [ - - "env" >>command - { { "A" "B" } } >>environment - +replace-environment+ >>environment-mode - ascii lines -] unit-test - -[ "hi\n" ] [ - temp-directory [ - [ "aloha" delete-file ] ignore-errors - - { "echo" "hi" } >>command - "aloha" >>stdout - try-process - ] with-directory - temp-directory "aloha" append-path - utf8 file-contents -] unit-test - -[ "append-test" temp-file delete-file ] ignore-errors - -[ "hi\nhi\n" ] [ - 2 [ - - "echo hi" >>command - "append-test" temp-file >>stdout - try-process - ] times - "append-test" temp-file utf8 file-contents -] unit-test - -[ t ] [ "ls" utf8 contents >boolean ] unit-test - -[ "Hello world.\n" ] [ - "cat" utf8 [ - "Hello world.\n" write - output-stream get dispose - input-stream get contents - ] with-stream -] unit-test - -! Killed processes were exiting with code 0 on FreeBSD -[ f ] [ - [let | p [ ] - s [ ] | - [ - "sleep 1000" run-detached - [ p fulfill ] [ wait-for-process s fulfill ] bi - ] in-thread - - p ?promise handle>> 9 kill drop - s ?promise 0 = - ] -] unit-test diff --git a/basis/io/unix/launcher/launcher.factor b/basis/io/unix/launcher/launcher.factor deleted file mode 100644 index 729c1545d8..0000000000 --- a/basis/io/unix/launcher/launcher.factor +++ /dev/null @@ -1,107 +0,0 @@ -! Copyright (C) 2007, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces math system sequences -continuations arrays assocs combinators alien.c-types strings -threads accessors environment -io io.backend io.launcher io.ports io.files -io.files.private io.unix.files io.unix.backend -io.unix.launcher.parser -unix unix.process ; -IN: io.unix.launcher - -! Search unix first -USE: unix - -: get-arguments ( process -- seq ) - command>> dup string? [ tokenize-command ] when ; - -: assoc>env ( assoc -- env ) - [ "=" glue ] { } assoc>map ; - -: setup-priority ( process -- process ) - dup priority>> [ - H{ - { +lowest-priority+ 20 } - { +low-priority+ 10 } - { +normal-priority+ 0 } - { +high-priority+ -10 } - { +highest-priority+ -20 } - { +realtime-priority+ -20 } - } at set-priority - ] when* ; - -: reset-fd ( fd -- ) - [ F_SETFL 0 fcntl io-error ] [ F_SETFD 0 fcntl io-error ] bi ; - -: redirect-fd ( oldfd fd -- ) - 2dup = [ 2drop ] [ dup2 io-error ] if ; - -: redirect-file ( obj mode fd -- ) - [ [ normalize-path ] dip file-mode open-file ] dip redirect-fd ; - -: redirect-file-append ( obj mode fd -- ) - [ drop path>> normalize-path open-append ] dip redirect-fd ; - -: redirect-closed ( obj mode fd -- ) - [ drop "/dev/null" ] 2dip redirect-file ; - -: redirect ( obj mode fd -- ) - { - { [ pick not ] [ 3drop ] } - { [ pick string? ] [ redirect-file ] } - { [ pick appender? ] [ redirect-file-append ] } - { [ pick +closed+ eq? ] [ redirect-closed ] } - { [ pick fd? ] [ [ drop fd>> dup reset-fd ] dip redirect-fd ] } - [ [ underlying-handle ] 2dip redirect ] - } cond ; - -: ?closed ( obj -- obj' ) - dup +closed+ eq? [ drop "/dev/null" ] when ; - -: setup-redirection ( process -- process ) - dup stdin>> ?closed read-flags 0 redirect - dup stdout>> ?closed write-flags 1 redirect - dup stderr>> dup +stdout+ eq? [ - drop 1 2 dup2 io-error - ] [ - ?closed write-flags 2 redirect - ] if ; - -: setup-environment ( process -- process ) - dup pass-environment? [ - dup get-environment set-os-envs - ] when ; - -: spawn-process ( process -- * ) - [ setup-priority ] [ 250 _exit ] recover - [ setup-redirection ] [ 251 _exit ] recover - [ current-directory get (normalize-path) cd ] [ 252 _exit ] recover - [ setup-environment ] [ 253 _exit ] recover - [ get-arguments exec-args-with-path ] [ 254 _exit ] recover - 255 _exit ; - -M: unix current-process-handle ( -- handle ) getpid ; - -M: unix run-process* ( process -- pid ) - [ spawn-process ] curry [ ] with-fork ; - -M: unix kill-process* ( pid -- ) - SIGTERM kill io-error ; - -: find-process ( handle -- process ) - processes get swap [ nip swap handle>> = ] curry - assoc-find 2drop ; - -TUPLE: signal n ; - -: code>status ( code -- obj ) - dup WIFEXITED [ WEXITSTATUS ] [ WTERMSIG signal boa ] if ; - -M: unix wait-for-processes ( -- ? ) - -1 0 tuck WNOHANG waitpid - dup 0 <= [ - 2drop t - ] [ - find-process dup - [ swap *int code>status notify-exit f ] [ 2drop f ] if - ] if ; diff --git a/basis/io/unix/launcher/parser/parser-tests.factor b/basis/io/unix/launcher/parser/parser-tests.factor deleted file mode 100644 index 63aadcabbe..0000000000 --- a/basis/io/unix/launcher/parser/parser-tests.factor +++ /dev/null @@ -1,33 +0,0 @@ -IN: io.unix.launcher.parser.tests -USING: io.unix.launcher.parser tools.test ; - -[ "" tokenize-command ] must-fail -[ " " tokenize-command ] must-fail -[ V{ "a" } ] [ "a" tokenize-command ] unit-test -[ V{ "abc" } ] [ "abc" tokenize-command ] unit-test -[ V{ "abc" } ] [ "abc " tokenize-command ] unit-test -[ V{ "abc" } ] [ " abc" tokenize-command ] unit-test -[ V{ "abc" "def" } ] [ "abc def" tokenize-command ] unit-test -[ V{ "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test -[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test -[ V{ "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test -[ V{ "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test -[ V{ "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test -[ V{ "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test -[ "'abc def' \"hey" tokenize-command ] must-fail -[ "'abc def" tokenize-command ] must-fail -[ V{ "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\" " tokenize-command ] unit-test - -[ - V{ - "Hello world.app/Contents/MacOS/hello-ui" - "-i=boot.macosx-ppc.image" - "-include= math compiler ui" - "-deploy-vocab=hello-ui" - "-output-image=Hello world.app/Contents/Resources/hello-ui.image" - "-no-stack-traces" - "-no-user-init" - } -] [ - "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize-command -] unit-test diff --git a/basis/io/unix/launcher/parser/parser.factor b/basis/io/unix/launcher/parser/parser.factor deleted file mode 100644 index 276ed45f27..0000000000 --- a/basis/io/unix/launcher/parser/parser.factor +++ /dev/null @@ -1,33 +0,0 @@ -! Copyright (C) 2008 Slava Pestov -! See http://factorcode.org/license.txt for BSD license. -USING: peg peg.parsers kernel sequences strings words ; -IN: io.unix.launcher.parser - -! Our command line parser. Supported syntax: -! foo bar baz -- simple tokens -! foo\ bar -- escaping the space -! 'foo bar' -- quotation -! "foo bar" -- quotation -: 'escaped-char' ( -- parser ) - "\\" token any-char 2seq [ second ] action ; - -: 'quoted-char' ( delimiter -- parser' ) - 'escaped-char' - swap [ member? not ] curry satisfy - 2choice ; inline - -: 'quoted' ( delimiter -- parser ) - dup 'quoted-char' repeat0 swap dup surrounded-by ; - -: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ; - -: 'argument' ( -- parser ) - "\"" 'quoted' - "'" 'quoted' - 'unquoted' 3choice - [ >string ] action ; - -PEG: tokenize-command ( command -- ast/f ) - 'argument' " " token repeat1 list-of - " " token repeat0 tuck pack - just ; diff --git a/basis/io/unix/launcher/parser/tags.txt b/basis/io/unix/launcher/parser/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/launcher/parser/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/launcher/tags.txt b/basis/io/unix/launcher/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/launcher/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/linux/authors.txt b/basis/io/unix/linux/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/linux/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/linux/linux.factor b/basis/io/unix/linux/linux.factor deleted file mode 100644 index fd24e0ac02..0000000000 --- a/basis/io/unix/linux/linux.factor +++ /dev/null @@ -1,10 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel system namespaces io.backend io.unix.backend -io.unix.multiplexers io.unix.multiplexers.epoll ; -IN: io.unix.linux - -M: linux init-io ( -- ) - mx set-global ; - -linux set-io-backend diff --git a/basis/io/unix/linux/monitors/monitors-tests.factor b/basis/io/unix/linux/monitors/monitors-tests.factor deleted file mode 100644 index 42c5009ccb..0000000000 --- a/basis/io/unix/linux/monitors/monitors-tests.factor +++ /dev/null @@ -1,36 +0,0 @@ -IN: io.unix.linux.monitors.tests -USING: io.monitors tools.test io.files system sequences -continuations namespaces concurrency.count-downs kernel io -threads calendar prettyprint destructors io.timeouts ; - -! On Linux, a notification on the directory itself would report an invalid -! path name -[ - [ ] [ "monitor-test-self" temp-file make-directories ] unit-test - - ! Non-recursive - [ ] [ "monitor-test-self" temp-file f "m" set ] unit-test - [ ] [ 3 seconds "m" get set-timeout ] unit-test - - [ ] [ "monitor-test-self" temp-file touch-file ] unit-test - - [ t ] [ - "m" get next-change drop - [ "" = ] [ "monitor-test-self" temp-file = ] bi or - ] unit-test - - [ ] [ "m" get dispose ] unit-test - - ! Recursive - [ ] [ "monitor-test-self" temp-file t "m" set ] unit-test - [ ] [ 3 seconds "m" get set-timeout ] unit-test - - [ ] [ "monitor-test-self" temp-file touch-file ] unit-test - - [ t ] [ - "m" get next-change drop - [ "" = ] [ "monitor-test-self" temp-file = ] bi or - ] unit-test - - [ ] [ "m" get dispose ] unit-test -] with-monitors diff --git a/basis/io/unix/linux/monitors/monitors.factor b/basis/io/unix/linux/monitors/monitors.factor deleted file mode 100644 index 3964a25a04..0000000000 --- a/basis/io/unix/linux/monitors/monitors.factor +++ /dev/null @@ -1,136 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel io.backend io.monitors io.monitors.recursive -io.files io.buffers io.monitors io.ports io.timeouts -io.unix.backend io.encodings.utf8 unix.linux.inotify assocs -namespaces make threads continuations init math math.bitwise -sets alien alien.strings alien.c-types vocabs.loader accessors -system hashtables destructors unix ; -IN: io.unix.linux.monitors - -SYMBOL: watches - -SYMBOL: inotify - -TUPLE: linux-monitor < monitor wd inotify watches disposed ; - -: ( wd path mailbox -- monitor ) - linux-monitor new-monitor - inotify get >>inotify - watches get >>watches - swap >>wd ; - -: wd>monitor ( wd -- monitor ) watches get at ; - -: ( -- port/f ) - inotify_init dup 0 < [ drop f ] [ init-fd ] if ; - -: inotify-fd ( -- fd ) inotify get handle>> handle-fd ; - -: check-existing ( wd -- ) - watches get key? [ - "Cannot open multiple monitors for the same file" throw - ] when ; - -: (add-watch) ( path mask -- wd ) - inotify-fd -rot inotify_add_watch dup io-error dup check-existing ; - -: add-watch ( path mask mailbox -- monitor ) - [ [ (normalize-path) ] dip [ (add-watch) ] [ drop ] 2bi ] dip - [ ] [ ] [ wd>> ] tri watches get set-at ; - -: check-inotify ( -- ) - inotify get [ - "Calling outside with-monitors" throw - ] unless ; - -M: linux (monitor) ( path recursive? mailbox -- monitor ) - swap [ - - ] [ - check-inotify - IN_CHANGE_EVENTS swap add-watch - ] if ; - -M: linux-monitor dispose* ( monitor -- ) - [ [ wd>> ] [ watches>> ] bi delete-at ] - [ - dup inotify>> disposed>> [ drop ] [ - [ inotify>> handle>> handle-fd ] [ wd>> ] bi - inotify_rm_watch io-error - ] if - ] bi ; - -: ignore-flags? ( mask -- ? ) - { - IN_DELETE_SELF - IN_MOVE_SELF - IN_UNMOUNT - IN_Q_OVERFLOW - IN_IGNORED - } flags bitand 0 > ; - -: parse-action ( mask -- changed ) - [ - IN_CREATE +add-file+ ?flag - IN_DELETE +remove-file+ ?flag - IN_MODIFY +modify-file+ ?flag - IN_ATTRIB +modify-file+ ?flag - IN_MOVED_FROM +rename-file-old+ ?flag - IN_MOVED_TO +rename-file-new+ ?flag - drop - ] { } make prune ; - -: parse-event-name ( event -- name ) - dup inotify-event-len zero? - [ drop "" ] [ inotify-event-name utf8 alien>string ] if ; - -: parse-file-notify ( buffer -- path changed ) - dup inotify-event-mask ignore-flags? [ - drop f f - ] [ - [ parse-event-name ] [ inotify-event-mask parse-action ] bi - ] if ; - -: events-exhausted? ( i buffer -- ? ) - fill>> >= ; - -: inotify-event@ ( i buffer -- alien ) - ptr>> ; - -: next-event ( i buffer -- i buffer ) - 2dup inotify-event@ - inotify-event-len "inotify-event" heap-size + - swap [ + ] dip ; - -: parse-file-notifications ( i buffer -- ) - 2dup events-exhausted? [ 2drop ] [ - 2dup inotify-event@ dup inotify-event-wd wd>monitor - [ parse-file-notify ] dip queue-change - next-event parse-file-notifications - ] if ; - -: inotify-read-loop ( port -- ) - dup check-disposed - dup wait-to-read drop - 0 over buffer>> parse-file-notifications - 0 over buffer>> buffer-reset - inotify-read-loop ; - -: inotify-read-thread ( port -- ) - [ inotify-read-loop ] curry ignore-errors ; - -M: linux init-monitors - H{ } clone watches set - [ - [ inotify set ] - [ - [ inotify-read-thread ] curry - "Linux monitor thread" spawn drop - ] bi - ] [ - "Linux kernel version is too old" throw - ] if* ; - -M: linux dispose-monitors - inotify get dispose ; diff --git a/basis/io/unix/linux/monitors/tags.txt b/basis/io/unix/linux/monitors/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/linux/monitors/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/linux/tags.txt b/basis/io/unix/linux/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/linux/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/macosx/macosx.factor b/basis/io/unix/macosx/macosx.factor deleted file mode 100644 index 75f42b7394..0000000000 --- a/basis/io/unix/macosx/macosx.factor +++ /dev/null @@ -1,10 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: io.backend system namespaces io.unix.multiplexers -io.unix.multiplexers.run-loop ; -IN: io.unix.macosx - -M: macosx init-io ( -- ) - mx set-global ; - -macosx set-io-backend diff --git a/basis/io/unix/macosx/monitors/monitors.factor b/basis/io/unix/macosx/monitors/monitors.factor deleted file mode 100644 index cde1d6339a..0000000000 --- a/basis/io/unix/macosx/monitors/monitors.factor +++ /dev/null @@ -1,23 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: io.backend io.monitors -core-foundation.fsevents continuations kernel sequences -namespaces arrays system locals accessors destructors fry ; -IN: io.unix.macosx.monitors - -TUPLE: macosx-monitor < monitor handle ; - -: enqueue-notifications ( triples monitor -- ) - '[ first { +modify-file+ } _ queue-change ] each ; - -M:: macosx (monitor) ( path recursive? mailbox -- monitor ) - [let | path [ path normalize-path ] | - path mailbox macosx-monitor new-monitor - dup [ enqueue-notifications ] curry - path 1array 0 0 >>handle - ] ; - -M: macosx-monitor dispose - handle>> dispose ; - -macosx set-io-backend diff --git a/basis/io/unix/macosx/monitors/tags.txt b/basis/io/unix/macosx/monitors/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/macosx/monitors/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/macosx/tags.txt b/basis/io/unix/macosx/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/macosx/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/mmap/authors.txt b/basis/io/unix/mmap/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/mmap/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/mmap/mmap.factor b/basis/io/unix/mmap/mmap.factor deleted file mode 100644 index d5dcda9436..0000000000 --- a/basis/io/unix/mmap/mmap.factor +++ /dev/null @@ -1,24 +0,0 @@ -! Copyright (C) 2007 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien io io.files kernel math math.bitwise system unix -io.unix.backend io.ports io.mmap destructors locals accessors ; -IN: io.unix.mmap - -: open-r/w ( path -- fd ) O_RDWR file-mode open-file ; - -:: mmap-open ( path length prot flags -- alien fd ) - [ - f length prot flags - path open-r/w |dispose - [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep - ] with-destructors ; - -M: unix (mapped-file) - { PROT_READ PROT_WRITE } flags - { MAP_FILE MAP_SHARED } flags - mmap-open ; - -M: unix close-mapped-file ( mmap -- ) - [ [ address>> ] [ length>> ] bi munmap io-error ] - [ handle>> close-file ] - bi ; diff --git a/basis/io/unix/mmap/tags.txt b/basis/io/unix/mmap/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/mmap/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/multiplexers/epoll/authors.txt b/basis/io/unix/multiplexers/epoll/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/multiplexers/epoll/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/multiplexers/epoll/epoll.factor b/basis/io/unix/multiplexers/epoll/epoll.factor deleted file mode 100644 index 08e20d4b95..0000000000 --- a/basis/io/unix/multiplexers/epoll/epoll.factor +++ /dev/null @@ -1,66 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types kernel destructors bit-arrays -sequences assocs struct-arrays math namespaces locals fry unix -unix.linux.epoll unix.time io.ports io.unix.backend -io.unix.multiplexers ; -IN: io.unix.multiplexers.epoll - -TUPLE: epoll-mx < mx events ; - -: max-events ( -- n ) - #! We read up to 256 events at a time. This is an arbitrary - #! constant... - 256 ; inline - -: ( -- mx ) - epoll-mx new-mx - max-events epoll_create dup io-error >>fd - max-events "epoll-event" >>events ; - -M: epoll-mx dispose fd>> close-file ; - -: make-event ( fd events -- event ) - "epoll-event" - [ set-epoll-event-events ] keep - [ set-epoll-event-fd ] keep ; - -:: do-epoll-ctl ( fd mx what events -- ) - mx fd>> what fd fd events make-event epoll_ctl io-error ; - -: do-epoll-add ( fd mx events -- ) - EPOLL_CTL_ADD swap EPOLLONESHOT bitor do-epoll-ctl ; - -: do-epoll-del ( fd mx events -- ) - EPOLL_CTL_DEL swap do-epoll-ctl ; - -M: epoll-mx add-input-callback ( thread fd mx -- ) - [ EPOLLIN do-epoll-add ] [ call-next-method ] 2bi ; - -M: epoll-mx add-output-callback ( thread fd mx -- ) - [ EPOLLOUT do-epoll-add ] [ call-next-method ] 2bi ; - -M: epoll-mx remove-input-callbacks ( fd mx -- seq ) - 2dup reads>> key? [ - [ call-next-method ] [ EPOLLIN do-epoll-del ] 2bi - ] [ 2drop f ] if ; - -M: epoll-mx remove-output-callbacks ( fd mx -- seq ) - 2dup writes>> key? [ - [ EPOLLOUT do-epoll-del ] [ call-next-method ] 2bi - ] [ 2drop f ] if ; - -: wait-event ( mx us -- n ) - [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi* - epoll_wait multiplexer-error ; - -: handle-event ( event mx -- ) - [ epoll-event-fd ] dip - [ EPOLLIN EPOLLOUT bitor do-epoll-del ] - [ input-available ] [ output-available ] 2tri ; - -: handle-events ( mx n -- ) - [ dup events>> ] dip head-slice swap '[ _ handle-event ] each ; - -M: epoll-mx wait-for-events ( us mx -- ) - swap 60000000 or dupd wait-event handle-events ; diff --git a/basis/io/unix/multiplexers/epoll/tags.txt b/basis/io/unix/multiplexers/epoll/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/multiplexers/epoll/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/multiplexers/kqueue/authors.txt b/basis/io/unix/multiplexers/kqueue/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/multiplexers/kqueue/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/multiplexers/kqueue/kqueue.factor b/basis/io/unix/multiplexers/kqueue/kqueue.factor deleted file mode 100644 index a66e86a6a7..0000000000 --- a/basis/io/unix/multiplexers/kqueue/kqueue.factor +++ /dev/null @@ -1,76 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types combinators destructors -io.unix.backend kernel math.bitwise sequences struct-arrays unix -unix.kqueue unix.time assocs io.unix.multiplexers ; -IN: io.unix.multiplexers.kqueue - -TUPLE: kqueue-mx < mx events ; - -: max-events ( -- n ) - #! We read up to 256 events at a time. This is an arbitrary - #! constant... - 256 ; inline - -: ( -- mx ) - kqueue-mx new-mx - kqueue dup io-error >>fd - max-events "kevent" >>events ; - -M: kqueue-mx dispose fd>> close-file ; - -: make-kevent ( fd filter flags -- event ) - "kevent" - [ set-kevent-flags ] keep - [ set-kevent-filter ] keep - [ set-kevent-ident ] keep ; - -: register-kevent ( kevent mx -- ) - fd>> swap 1 f 0 f kevent io-error ; - -M: kqueue-mx add-input-callback ( thread fd mx -- ) - [ call-next-method ] [ - [ EVFILT_READ { EV_ADD EV_ONESHOT } flags make-kevent ] dip - register-kevent - ] 2bi ; - -M: kqueue-mx add-output-callback ( thread fd mx -- ) - [ call-next-method ] [ - [ EVFILT_WRITE { EV_ADD EV_ONESHOT } flags make-kevent ] dip - register-kevent - ] 2bi ; - -M: kqueue-mx remove-input-callbacks ( fd mx -- seq ) - 2dup reads>> key? [ - [ call-next-method ] [ - [ EVFILT_READ EV_DELETE make-kevent ] dip - register-kevent - ] 2bi - ] [ 2drop f ] if ; - -M: kqueue-mx remove-output-callbacks ( fd mx -- seq ) - 2dup writes>> key? [ - [ - [ EVFILT_WRITE EV_DELETE make-kevent ] dip - register-kevent - ] [ call-next-method ] 2bi - ] [ 2drop f ] if ; - -: wait-kevent ( mx timespec -- n ) - [ - [ fd>> f 0 ] - [ events>> [ underlying>> ] [ length ] bi ] bi - ] dip kevent multiplexer-error ; - -: handle-kevent ( mx kevent -- ) - [ kevent-ident swap ] [ kevent-filter ] bi { - { EVFILT_READ [ input-available ] } - { EVFILT_WRITE [ output-available ] } - } case ; - -: handle-kevents ( mx n -- ) - [ dup events>> ] dip head-slice [ handle-kevent ] with each ; - -M: kqueue-mx wait-for-events ( us mx -- ) - swap dup [ make-timespec ] when - dupd wait-kevent handle-kevents ; diff --git a/basis/io/unix/multiplexers/kqueue/tags.txt b/basis/io/unix/multiplexers/kqueue/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/multiplexers/kqueue/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/multiplexers/multiplexers.factor b/basis/io/unix/multiplexers/multiplexers.factor deleted file mode 100644 index 1c9fb134e7..0000000000 --- a/basis/io/unix/multiplexers/multiplexers.factor +++ /dev/null @@ -1,35 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors assocs sequences threads ; -IN: io.unix.multiplexers - -TUPLE: mx fd reads writes ; - -: new-mx ( class -- obj ) - new - H{ } clone >>reads - H{ } clone >>writes ; inline - -GENERIC: add-input-callback ( thread fd mx -- ) - -M: mx add-input-callback reads>> push-at ; - -GENERIC: add-output-callback ( thread fd mx -- ) - -M: mx add-output-callback writes>> push-at ; - -GENERIC: remove-input-callbacks ( fd mx -- callbacks ) - -M: mx remove-input-callbacks reads>> delete-at* drop ; - -GENERIC: remove-output-callbacks ( fd mx -- callbacks ) - -M: mx remove-output-callbacks writes>> delete-at* drop ; - -GENERIC: wait-for-events ( ms mx -- ) - -: input-available ( fd mx -- ) - reads>> delete-at* drop [ resume ] each ; - -: output-available ( fd mx -- ) - writes>> delete-at* drop [ resume ] each ; diff --git a/basis/io/unix/multiplexers/run-loop/run-loop-tests.factor b/basis/io/unix/multiplexers/run-loop/run-loop-tests.factor deleted file mode 100644 index 5f249c6881..0000000000 --- a/basis/io/unix/multiplexers/run-loop/run-loop-tests.factor +++ /dev/null @@ -1,5 +0,0 @@ -USING: io.unix.multiplexers.run-loop tools.test -destructors ; -IN: io.unix.multiplexers.run-loop.tests - -[ ] [ dispose ] unit-test diff --git a/basis/io/unix/multiplexers/run-loop/run-loop.factor b/basis/io/unix/multiplexers/run-loop/run-loop.factor deleted file mode 100644 index 7b80e461dc..0000000000 --- a/basis/io/unix/multiplexers/run-loop/run-loop.factor +++ /dev/null @@ -1,58 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces math accessors threads alien locals -destructors combinators io.unix.multiplexers -io.unix.multiplexers.kqueue core-foundation -core-foundation.run-loop core-foundation.file-descriptors ; -IN: io.unix.multiplexers.run-loop - -TUPLE: run-loop-mx kqueue-mx fd source ; - -: kqueue-callback ( -- callback ) - "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" } - "cdecl" [ - 3drop - 0 mx get kqueue-mx>> wait-for-events - mx get fd>> enable-all-callbacks - yield - ] - alien-callback ; - -SYMBOL: kqueue-run-loop-source - -: create-kqueue-source ( fd -- source ) - f swap 0 CFFileDescriptorCreateRunLoopSource ; - -: add-kqueue-to-run-loop ( mx -- ) - CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopAddSource ; - -: remove-kqueue-from-run-loop ( source -- ) - CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopRemoveSource ; - -: ( -- mx ) - [ - |dispose - dup fd>> kqueue-callback |dispose - dup create-kqueue-source run-loop-mx boa - dup add-kqueue-to-run-loop - ] with-destructors ; - -M: run-loop-mx dispose - [ - { - [ fd>> &CFRelease drop ] - [ source>> &CFRelease drop ] - [ remove-kqueue-from-run-loop ] - [ kqueue-mx>> &dispose drop ] - } cleave - ] with-destructors ; - -M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ; -M: run-loop-mx add-output-callback kqueue-mx>> add-output-callback ; -M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ; -M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ; - -M:: run-loop-mx wait-for-events ( us mx -- ) - mx fd>> enable-all-callbacks - CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode - kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ; diff --git a/basis/io/unix/multiplexers/run-loop/tags.txt b/basis/io/unix/multiplexers/run-loop/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/multiplexers/run-loop/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/multiplexers/select/authors.txt b/basis/io/unix/multiplexers/select/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/multiplexers/select/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/multiplexers/select/select.factor b/basis/io/unix/multiplexers/select/select.factor deleted file mode 100644 index 915daac2d3..0000000000 --- a/basis/io/unix/multiplexers/select/select.factor +++ /dev/null @@ -1,56 +0,0 @@ -! Copyright (C) 2004, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel bit-arrays sequences assocs unix -math namespaces accessors math.order locals unix.time fry -io.ports io.unix.backend io.unix.multiplexers ; -IN: io.unix.multiplexers.select - -TUPLE: select-mx < mx read-fdset write-fdset ; - -! Factor's bit-arrays are an array of bytes, OS X expects -! FD_SET to be an array of cells, so we have to account for -! byte order differences on big endian platforms -: munge ( i -- i' ) - little-endian? [ BIN: 11000 bitxor ] unless ; inline - -: ( -- mx ) - select-mx new-mx - FD_SETSIZE 8 * >>read-fdset - FD_SETSIZE 8 * >>write-fdset ; - -: clear-nth ( n seq -- ? ) - [ nth ] [ [ f ] 2dip set-nth ] 2bi ; - -:: check-fd ( fd fdset mx quot -- ) - fd munge fdset clear-nth [ fd mx quot call ] when ; inline - -: check-fdset ( fds fdset mx quot -- ) - [ check-fd ] 3curry each ; inline - -: init-fdset ( fds fdset -- ) - '[ t swap munge _ set-nth ] each ; - -: read-fdset/tasks ( mx -- seq fdset ) - [ reads>> keys ] [ read-fdset>> ] bi ; - -: write-fdset/tasks ( mx -- seq fdset ) - [ writes>> keys ] [ write-fdset>> ] bi ; - -: max-fd ( assoc -- n ) - dup assoc-empty? [ drop 0 ] [ keys supremum ] if ; - -: num-fds ( mx -- n ) - [ reads>> max-fd ] [ writes>> max-fd ] bi max 1+ ; - -: init-fdsets ( mx -- nfds read write except ) - [ num-fds ] - [ read-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] - [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri - f ; - -M:: select-mx wait-for-events ( us mx -- ) - mx - [ init-fdsets us dup [ make-timeval ] when select multiplexer-error drop ] - [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ] - [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ] - tri ; diff --git a/basis/io/unix/multiplexers/select/tags.txt b/basis/io/unix/multiplexers/select/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/multiplexers/select/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/netbsd/netbsd.factor b/basis/io/unix/netbsd/netbsd.factor deleted file mode 100644 index ed134788b6..0000000000 --- a/basis/io/unix/netbsd/netbsd.factor +++ /dev/null @@ -1,3 +0,0 @@ -USING: io.unix.bsd io.backend system ; - -netbsd set-io-backend diff --git a/basis/io/unix/netbsd/tags.txt b/basis/io/unix/netbsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/netbsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/openbsd/openbsd.factor b/basis/io/unix/openbsd/openbsd.factor deleted file mode 100644 index dfc466f94b..0000000000 --- a/basis/io/unix/openbsd/openbsd.factor +++ /dev/null @@ -1,3 +0,0 @@ -USING: io.unix.bsd io.backend system ; - -openbsd set-io-backend diff --git a/basis/io/unix/openbsd/tags.txt b/basis/io/unix/openbsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/openbsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/pipes/pipes-tests.factor b/basis/io/unix/pipes/pipes-tests.factor deleted file mode 100644 index 6ea74043ca..0000000000 --- a/basis/io/unix/pipes/pipes-tests.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: tools.test io.pipes io.unix.pipes io.encodings.utf8 -io.encodings io namespaces sequences ; -IN: io.unix.pipes.tests - -[ { 0 0 } ] [ { "ls" "grep ." } run-pipeline ] unit-test - -[ { 0 f 0 } ] [ - { - "ls" - [ - input-stream [ utf8 ] change - output-stream [ utf8 ] change - input-stream get lines reverse [ print ] each f - ] - "grep ." - } run-pipeline -] unit-test diff --git a/basis/io/unix/pipes/pipes.factor b/basis/io/unix/pipes/pipes.factor deleted file mode 100644 index a28738e147..0000000000 --- a/basis/io/unix/pipes/pipes.factor +++ /dev/null @@ -1,11 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: system kernel unix math sequences qualified -io.unix.backend io.ports specialized-arrays.int accessors ; -IN: io.unix.pipes -QUALIFIED: io.pipes - -M: unix io.pipes:(pipe) ( -- pair ) - 2 - [ underlying>> pipe io-error ] - [ first2 [ init-fd ] bi@ io.pipes:pipe boa ] bi ; diff --git a/basis/io/unix/pipes/tags.txt b/basis/io/unix/pipes/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/pipes/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/select/authors.txt b/basis/io/unix/select/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/unix/select/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor deleted file mode 100644 index a6b61001a6..0000000000 --- a/basis/io/unix/select/select.factor +++ /dev/null @@ -1,56 +0,0 @@ -! Copyright (C) 2004, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel io.ports io.unix.backend -bit-arrays sequences assocs unix math namespaces -accessors math.order locals unix.time fry ; -IN: io.unix.select - -TUPLE: select-mx < mx read-fdset write-fdset ; - -! Factor's bit-arrays are an array of bytes, OS X expects -! FD_SET to be an array of cells, so we have to account for -! byte order differences on big endian platforms -: munge ( i -- i' ) - little-endian? [ BIN: 11000 bitxor ] unless ; inline - -: ( -- mx ) - select-mx new-mx - FD_SETSIZE 8 * >>read-fdset - FD_SETSIZE 8 * >>write-fdset ; - -: clear-nth ( n seq -- ? ) - [ nth ] [ [ f ] 2dip set-nth ] 2bi ; - -:: check-fd ( fd fdset mx quot -- ) - fd munge fdset clear-nth [ fd mx quot call ] when ; inline - -: check-fdset ( fds fdset mx quot -- ) - [ check-fd ] 3curry each ; inline - -: init-fdset ( fds fdset -- ) - '[ t swap munge _ set-nth ] each ; - -: read-fdset/tasks ( mx -- seq fdset ) - [ reads>> keys ] [ read-fdset>> ] bi ; - -: write-fdset/tasks ( mx -- seq fdset ) - [ writes>> keys ] [ write-fdset>> ] bi ; - -: max-fd ( assoc -- n ) - dup assoc-empty? [ drop 0 ] [ keys supremum ] if ; - -: num-fds ( mx -- n ) - [ reads>> max-fd ] [ writes>> max-fd ] bi max 1+ ; - -: init-fdsets ( mx -- nfds read write except ) - [ num-fds ] - [ read-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] - [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri - f ; - -M:: select-mx wait-for-events ( us mx -- ) - mx - [ init-fdsets us dup [ make-timeval ] when select multiplexer-error drop ] - [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ] - [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ] - tri ; diff --git a/basis/io/unix/select/tags.txt b/basis/io/unix/select/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/select/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/sockets/authors.txt b/basis/io/unix/sockets/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/io/unix/sockets/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/unix/sockets/secure/debug/debug.factor b/basis/io/unix/sockets/secure/debug/debug.factor deleted file mode 100644 index cd5353ea7b..0000000000 --- a/basis/io/unix/sockets/secure/debug/debug.factor +++ /dev/null @@ -1,11 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors io.sockets.secure kernel ; -IN: io.unix.sockets.secure.debug - -: with-test-context ( quot -- ) - - "resource:basis/openssl/test/server.pem" >>key-file - "resource:basis/openssl/test/dh1024.pem" >>dh-file - "password" >>password - swap with-secure-context ; inline diff --git a/basis/io/unix/sockets/secure/secure-tests.factor b/basis/io/unix/sockets/secure/secure-tests.factor deleted file mode 100644 index 0816dd270b..0000000000 --- a/basis/io/unix/sockets/secure/secure-tests.factor +++ /dev/null @@ -1,147 +0,0 @@ -IN: io.sockets.secure.tests -USING: accessors kernel namespaces io io.sockets -io.sockets.secure io.encodings.ascii io.streams.duplex -io.unix.backend classes words destructors threads tools.test -concurrency.promises byte-arrays locals calendar io.timeouts -io.unix.sockets.secure.debug ; - -\ must-infer -{ 1 0 } [ [ ] with-secure-context ] must-infer-as - -[ ] [ "port" set ] unit-test - -:: server-test ( quot -- ) - [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept [ - quot call - ] curry with-stream - ] with-disposal - ] with-test-context - ] "SSL server test" spawn drop ; - -: client-test ( -- string ) - [ - "127.0.0.1" "port" get ?promise ascii drop contents - ] with-secure-context ; - -[ ] [ [ class name>> write ] server-test ] unit-test - -[ "secure" ] [ client-test ] unit-test - -! Now, see what happens if the server closes the connection prematurely -[ ] [ "port" set ] unit-test - -[ ] [ - [ - drop - "hello" write flush - input-stream get stream>> handle>> f >>connected drop - ] server-test -] unit-test - -[ client-test ] [ premature-close? ] must-fail-with - -! Now, try validating the certificate. This should fail because its -! actually an invalid certificate -[ ] [ "port" set ] unit-test - -[ ] [ [ drop "hi" write ] server-test ] unit-test - -[ - [ - "localhost" "port" get ?promise ascii - drop dispose - ] with-secure-context -] [ certificate-verify-error? ] must-fail-with - -! Client-side handshake timeout -[ ] [ "port" set ] unit-test - -[ ] [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> port>> "port" get fulfill - accept drop 1 minutes sleep dispose - ] with-disposal - ] "Silly server" spawn drop -] unit-test - -[ - 1 seconds secure-socket-timeout [ - client-test - ] with-variable -] [ io-timeout? ] must-fail-with - -! Server-side handshake timeout -[ ] [ "port" set ] unit-test - -[ ] [ - [ - "127.0.0.1" "port" get ?promise - ascii drop 1 minutes sleep dispose - ] "Silly client" spawn drop -] unit-test - -[ - 1 seconds secure-socket-timeout [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop dup stream-read1 drop dispose - ] with-disposal - ] with-test-context - ] with-variable -] [ io-timeout? ] must-fail-with - -! Client socket shutdown timeout - -! Until I sort out two-stage handshaking, I can't do much here -[ - [ ] [ "port" set ] unit-test - - [ ] [ - [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop 1 minutes sleep dispose - ] with-disposal - ] with-test-context - ] "Silly server" spawn drop - ] unit-test - - [ - 1 seconds secure-socket-timeout [ - [ - "127.0.0.1" "port" get ?promise - ascii drop dispose - ] with-secure-context - ] with-variable - ] [ io-timeout? ] must-fail-with - - ! Server socket shutdown timeout - [ ] [ "port" set ] unit-test - - [ ] [ - [ - [ - "127.0.0.1" "port" get ?promise - ascii drop 1 minutes sleep dispose - ] with-test-context - ] "Silly client" spawn drop - ] unit-test - - [ - 1 seconds secure-socket-timeout [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop dispose - ] with-disposal - ] with-test-context - ] with-variable - ] [ io-timeout? ] must-fail-with -] drop diff --git a/basis/io/unix/sockets/secure/secure.factor b/basis/io/unix/sockets/secure/secure.factor deleted file mode 100644 index 106b6569ed..0000000000 --- a/basis/io/unix/sockets/secure/secure.factor +++ /dev/null @@ -1,200 +0,0 @@ -! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors unix byte-arrays kernel sequences -namespaces math math.order combinators init alien alien.c-types -alien.strings libc continuations destructors openssl -openssl.libcrypto openssl.libssl io io.files io.ports -io.unix.backend io.unix.sockets io.encodings.ascii io.buffers -io.sockets io.sockets.secure io.sockets.secure.openssl -io.timeouts system summary fry ; -IN: io.unix.sockets.secure - -M: ssl-handle handle-fd file>> handle-fd ; - -: syscall-error ( r -- * ) - ERR_get_error dup zero? [ - drop - { - { -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] } - { 0 [ premature-close ] } - } case - ] [ nip (ssl-error) ] if ; - -: check-accept-response ( handle r -- event ) - over handle>> over SSL_get_error - { - { SSL_ERROR_NONE [ 2drop f ] } - { SSL_ERROR_WANT_READ [ 2drop +input+ ] } - { SSL_ERROR_WANT_ACCEPT [ 2drop +input+ ] } - { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } - { SSL_ERROR_SYSCALL [ syscall-error ] } - { SSL_ERROR_ZERO_RETURN [ (ssl-error) ] } - { SSL_ERROR_SSL [ (ssl-error) ] } - } case ; - -: do-ssl-accept ( ssl-handle -- ) - dup dup handle>> SSL_accept check-accept-response dup - [ [ dup file>> ] dip wait-for-fd do-ssl-accept ] [ 2drop ] if ; - -: maybe-handshake ( ssl-handle -- ) - dup connected>> [ drop ] [ - t >>connected - [ do-ssl-accept ] with-timeout - ] if ; - -: check-response ( port r -- port r n ) - over handle>> handle>> over SSL_get_error ; inline - -! Input ports -: check-read-response ( port r -- event ) - check-response - { - { SSL_ERROR_NONE [ swap buffer>> n>buffer f ] } - { SSL_ERROR_ZERO_RETURN [ 2drop f ] } - { SSL_ERROR_WANT_READ [ 2drop +input+ ] } - { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } - { SSL_ERROR_SYSCALL [ syscall-error ] } - { SSL_ERROR_SSL [ (ssl-error) ] } - } case ; - -M: ssl-handle refill - dup maybe-handshake - handle>> ! ssl - over buffer>> - [ buffer-end ] ! buf - [ buffer-capacity ] bi ! len - SSL_read - check-read-response ; - -! Output ports -: check-write-response ( port r -- event ) - check-response - { - { SSL_ERROR_NONE [ swap buffer>> buffer-consume f ] } - { SSL_ERROR_WANT_READ [ 2drop +input+ ] } - { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } - { SSL_ERROR_SYSCALL [ syscall-error ] } - { SSL_ERROR_SSL [ (ssl-error) ] } - } case ; - -M: ssl-handle drain - dup maybe-handshake - handle>> ! ssl - over buffer>> - [ buffer@ ] ! buf - [ buffer-length ] bi ! len - SSL_write - check-write-response ; - -M: ssl-handle cancel-operation - file>> cancel-operation ; - -M: ssl-handle timeout - drop secure-socket-timeout get ; - -! Client sockets -: ( fd -- ssl ) - [ fd>> BIO_NOCLOSE BIO_new_socket dup ssl-error ] keep - [ handle>> swap dup SSL_set_bio ] keep ; - -M: secure ((client)) ( addrspec -- handle ) - addrspec>> ((client)) ; - -M: secure parse-sockaddr addrspec>> parse-sockaddr ; - -M: secure (get-local-address) addrspec>> (get-local-address) ; - -: check-connect-response ( ssl-handle r -- event ) - over handle>> over SSL_get_error - { - { SSL_ERROR_NONE [ 2drop f ] } - { SSL_ERROR_WANT_READ [ 2drop +input+ ] } - { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } - { SSL_ERROR_SYSCALL [ syscall-error ] } - { SSL_ERROR_SSL [ (ssl-error) ] } - } case ; - -: do-ssl-connect ( ssl-handle -- ) - dup dup handle>> SSL_connect check-connect-response dup - [ dupd wait-for-fd do-ssl-connect ] [ 2drop ] if ; - -: resume-session ( ssl-handle ssl-session -- ) - [ [ handle>> ] dip SSL_set_session ssl-error ] - [ drop do-ssl-connect ] - 2bi ; - -: begin-session ( ssl-handle addrspec -- ) - [ drop do-ssl-connect ] - [ [ handle>> SSL_get1_session ] dip save-session ] - 2bi ; - -: secure-connection ( client-out addrspec -- ) - [ handle>> ] dip - [ - '[ - _ dup get-session - [ resume-session ] [ begin-session ] ?if - ] with-timeout - ] [ drop t >>connected drop ] 2bi ; - -M: secure establish-connection ( client-out remote -- ) - addrspec>> [ establish-connection ] [ secure-connection ] 2bi ; - -M: secure (server) addrspec>> (server) ; - -M: secure (accept) - [ - addrspec>> (accept) [ |dispose ] dip - ] with-destructors ; - -: check-shutdown-response ( handle r -- event ) - #! We don't do two-step shutdown here because I couldn't - #! figure out how to do it with non-blocking BIOs. Also, it - #! seems that SSL_shutdown always returns 0 -- this sounds - #! like a bug - over handle>> over SSL_get_error - { - { SSL_ERROR_NONE [ 2drop f ] } - { SSL_ERROR_WANT_READ [ 2drop +input+ ] } - { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } - { SSL_ERROR_SYSCALL [ dup zero? [ 2drop f ] [ syscall-error ] if ] } - { SSL_ERROR_SSL [ (ssl-error) ] } - } case ; - -: (shutdown) ( handle -- ) - dup dup handle>> SSL_shutdown check-shutdown-response - dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ; - -M: ssl-handle shutdown - dup connected>> [ - f >>connected [ (shutdown) ] with-timeout - ] [ drop ] if ; - -: check-buffer ( port -- port ) - dup buffer>> buffer-empty? [ upgrade-buffers-full ] unless ; - -: input/output-ports ( -- input output ) - input-stream output-stream - [ get underlying-port check-buffer ] bi@ - 2dup [ handle>> ] bi@ eq? [ upgrade-on-non-socket ] unless ; - -: make-input/output-secure ( input output -- ) - dup handle>> fd? [ upgrade-on-non-socket ] unless - [ ] change-handle - handle>> >>handle drop ; - -: (send-secure-handshake) ( output -- ) - remote-address get [ upgrade-on-non-socket ] unless* - secure-connection ; - -M: openssl send-secure-handshake - input/output-ports - [ make-input/output-secure ] keep - [ (send-secure-handshake) ] keep - remote-address get dup inet? [ - host>> swap handle>> check-certificate - ] [ 2drop ] if ; - -M: openssl accept-secure-handshake - input/output-ports - make-input/output-secure ; diff --git a/basis/io/unix/sockets/secure/tags.txt b/basis/io/unix/sockets/secure/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/sockets/secure/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/sockets/sockets.factor b/basis/io/unix/sockets/sockets.factor deleted file mode 100644 index 5fba7badb0..0000000000 --- a/basis/io/unix/sockets/sockets.factor +++ /dev/null @@ -1,155 +0,0 @@ -! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings generic kernel math -namespaces threads sequences byte-arrays io.ports -io.binary io.unix.backend io.streams.duplex -io.backend io.ports io.files io.files.private -io.encodings.utf8 math.parser continuations libc combinators -system accessors qualified destructors unix locals init ; - -EXCLUDE: io => read write close ; -EXCLUDE: io.sockets => accept ; - -IN: io.unix.sockets - -: socket-fd ( domain type -- fd ) - 0 socket dup io-error init-fd |dispose ; - -: set-socket-option ( fd level opt -- ) - [ handle-fd ] 2dip 1 "int" heap-size setsockopt io-error ; - -M: unix addrinfo-error ( n -- ) - dup zero? [ drop ] [ gai_strerror throw ] if ; - -! Client sockets - TCP and Unix domain -M: object (get-local-address) ( handle remote -- sockaddr ) - [ handle-fd ] dip empty-sockaddr/size - [ getsockname io-error ] 2keep drop ; - -M: object (get-remote-address) ( handle local -- sockaddr ) - [ handle-fd ] dip empty-sockaddr/size - [ getpeername io-error ] 2keep drop ; - -: init-client-socket ( fd -- ) - SOL_SOCKET SO_OOBINLINE set-socket-option ; - -: wait-to-connect ( port -- ) - dup handle>> handle-fd f 0 write - { - { [ 0 = ] [ drop ] } - { [ err_no EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] } - { [ err_no EINTR = ] [ wait-to-connect ] } - [ (io-error) ] - } cond ; - -M: object establish-connection ( client-out remote -- ) - [ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi - { - { [ 0 = ] [ drop ] } - { [ err_no EINPROGRESS = ] [ - [ +output+ wait-for-port ] [ wait-to-connect ] bi - ] } - [ (io-error) ] - } cond ; - -M: object ((client)) ( addrspec -- fd ) - protocol-family SOCK_STREAM socket-fd dup init-client-socket ; - -! Server sockets - TCP and Unix domain -: init-server-socket ( fd -- ) - SOL_SOCKET SO_REUSEADDR set-socket-option ; - -: server-socket-fd ( addrspec type -- fd ) - [ dup protocol-family ] dip socket-fd - dup init-server-socket - dup handle-fd rot make-sockaddr/size bind io-error ; - -M: object (server) ( addrspec -- handle ) - [ - SOCK_STREAM server-socket-fd - dup handle-fd 128 listen io-error - ] with-destructors ; - -: do-accept ( server addrspec -- fd sockaddr ) - [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* - [ accept ] 2keep drop ; inline - -M: object (accept) ( server addrspec -- fd sockaddr ) - 2dup do-accept - { - { [ over 0 >= ] [ [ 2nip init-fd ] dip ] } - { [ err_no EINTR = ] [ 2drop (accept) ] } - { [ err_no EAGAIN = ] [ - 2drop - [ drop +input+ wait-for-port ] - [ (accept) ] - 2bi - ] } - [ (io-error) ] - } cond ; - -! Datagram sockets - UDP and Unix domain -M: unix (datagram) - [ SOCK_DGRAM server-socket-fd ] with-destructors ; - -SYMBOL: receive-buffer - -: packet-size 65536 ; inline - -[ packet-size malloc receive-buffer set-global ] "io.unix.sockets" add-init-hook - -:: do-receive ( port -- packet sockaddr ) - port addr>> empty-sockaddr/size [| sockaddr len | - port handle>> handle-fd ! s - receive-buffer get-global ! buf - packet-size ! nbytes - 0 ! flags - sockaddr ! from - len ! fromlen - recvfrom dup 0 >= [ - receive-buffer get-global swap memory>byte-array sockaddr - ] [ - drop f f - ] if - ] call ; - -M: unix (receive) ( datagram -- packet sockaddr ) - dup do-receive dup [ [ drop ] 2dip ] [ - 2drop [ +input+ wait-for-port ] [ (receive) ] bi - ] if ; - -:: do-send ( packet sockaddr len socket datagram -- ) - socket handle-fd packet dup length 0 sockaddr len sendto - 0 < [ - err_no EINTR = [ - packet sockaddr len socket datagram do-send - ] [ - err_no EAGAIN = [ - datagram +output+ wait-for-port - packet sockaddr len socket datagram do-send - ] [ - (io-error) - ] if - ] if - ] when ; - -M: unix (send) ( packet addrspec datagram -- ) - [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ; - -! Unix domain sockets -M: local protocol-family drop PF_UNIX ; - -M: local sockaddr-size drop "sockaddr-un" heap-size ; - -M: local empty-sockaddr drop "sockaddr-un" ; - -M: local make-sockaddr - path>> (normalize-path) - dup length 1 + max-un-path > [ "Path too long" throw ] when - "sockaddr-un" - AF_UNIX over set-sockaddr-un-family - dup sockaddr-un-path rot utf8 string>alien dup length memcpy ; - -M: local parse-sockaddr - drop - sockaddr-un-path utf8 alien>string ; diff --git a/basis/io/unix/sockets/summary.txt b/basis/io/unix/sockets/summary.txt deleted file mode 100644 index 22342ec413..0000000000 --- a/basis/io/unix/sockets/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Implementation of TCP/IP and UDP/IP sockets on Unix-like systems diff --git a/basis/io/unix/sockets/tags.txt b/basis/io/unix/sockets/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/sockets/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/summary.txt b/basis/io/unix/summary.txt deleted file mode 100644 index 8f66d889cc..0000000000 --- a/basis/io/unix/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Non-blocking I/O and sockets on Unix-like systems diff --git a/basis/io/unix/tags.txt b/basis/io/unix/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/unix-tests.factor b/basis/io/unix/unix-tests.factor deleted file mode 100644 index df61420c77..0000000000 --- a/basis/io/unix/unix-tests.factor +++ /dev/null @@ -1,140 +0,0 @@ -USING: io.files io.sockets io kernel threads -namespaces tools.test continuations strings byte-arrays -sequences prettyprint system io.encodings.binary io.encodings.ascii -io.streams.duplex destructors make ; -IN: io.unix.tests - -! Unix domain stream sockets -: socket-server "unix-domain-socket-test" temp-file ; - -[ - [ socket-server delete-file ] ignore-errors - - socket-server - ascii [ - accept drop [ - "Hello world" print flush - readln "XYZ" = "FOO" "BAR" ? print flush - ] with-stream - ] with-disposal - - socket-server delete-file -] "Test" spawn drop - -yield - -[ { "Hello world" "FOO" } ] [ - [ - socket-server ascii [ - readln , - "XYZ" print flush - readln , - ] with-client - ] { } make -] unit-test - -: datagram-server "unix-domain-datagram-test" temp-file ; -: datagram-client "unix-domain-datagram-test-2" temp-file ; - -! Unix domain datagram sockets -[ datagram-server delete-file ] ignore-errors -[ datagram-client delete-file ] ignore-errors - -[ - [ - datagram-server "d" set - - "Receive 1" print - - "d" get receive [ reverse ] dip - - "Send 1" print - dup . - - "d" get send - - "Receive 2" print - - "d" get receive [ " world" append ] dip - - "Send 1" print - dup . - - "d" get send - - "d" get dispose - - "Done" print - - datagram-server delete-file - ] with-scope -] "Test" spawn drop - -yield - -[ datagram-client delete-file ] ignore-errors - -datagram-client -"d" set - -[ ] [ - "hello" >byte-array - datagram-server - "d" get send -] unit-test - -[ "olleh" t ] [ - "d" get receive - datagram-server = - [ >string ] dip -] unit-test - -[ ] [ - "hello" >byte-array - datagram-server - "d" get send -] unit-test - -[ "hello world" t ] [ - "d" get receive - datagram-server = - [ >string ] dip -] unit-test - -[ ] [ "d" get dispose ] unit-test - -! Test error behavior -: another-datagram "unix-domain-datagram-test-3" temp-file ; - -[ another-datagram delete-file ] ignore-errors - -datagram-client delete-file - -[ ] [ datagram-client "d" set ] unit-test - -[ B{ 1 2 3 } another-datagram "d" get send ] must-fail - -[ ] [ "d" get dispose ] unit-test - -! See what happens on send/receive after close - -[ "d" get receive ] must-fail - -[ B{ 1 2 } datagram-server "d" get send ] must-fail - -! Invalid parameter tests - -[ - image binary [ input-stream get accept ] with-file-reader -] must-fail - -[ - image binary [ input-stream get receive ] with-file-reader -] must-fail - -[ - image binary [ - B{ 1 2 } datagram-server - input-stream get send - ] with-file-reader -] must-fail diff --git a/basis/io/unix/unix.factor b/basis/io/unix/unix.factor deleted file mode 100644 index 93b5fa620e..0000000000 --- a/basis/io/unix/unix.factor +++ /dev/null @@ -1,4 +0,0 @@ -USING: accessors system words sequences vocabs.loader -io.unix.backend io.unix.files ; - -"io.unix." os name>> append require diff --git a/basis/io/windows/authors.txt b/basis/io/windows/authors.txt deleted file mode 100644 index 781acc2b62..0000000000 --- a/basis/io/windows/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Doug Coleman -Mackenzie Straight diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor deleted file mode 100755 index 664727dbdb..0000000000 --- a/basis/io/windows/files/files.factor +++ /dev/null @@ -1,378 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types io.binary io.backend io.files io.buffers -io.encodings.utf16n io.ports io.windows kernel math splitting -fry alien.strings windows windows.kernel32 windows.time calendar -combinators math.functions sequences namespaces make words -symbols system destructors accessors math.bitwise continuations -windows.errors arrays byte-arrays generalizations ; -IN: io.windows.files - -: open-file ( path access-mode create-mode flags -- handle ) - [ - [ share-mode default-security-attributes ] 2dip - CreateFile-flags f CreateFile opened-file - ] with-destructors ; - -: open-pipe-r/w ( path -- win32-file ) - { GENERIC_READ GENERIC_WRITE } flags - OPEN_EXISTING 0 open-file ; - -: open-read ( path -- win32-file ) - GENERIC_READ OPEN_EXISTING 0 open-file 0 >>ptr ; - -: open-write ( path -- win32-file ) - GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 >>ptr ; - -: (open-append) ( path -- win32-file ) - GENERIC_WRITE OPEN_ALWAYS 0 open-file ; - -: open-existing ( path -- win32-file ) - { GENERIC_READ GENERIC_WRITE } flags - share-mode - f - OPEN_EXISTING - FILE_FLAG_BACKUP_SEMANTICS - f CreateFileW dup win32-error=0/f ; - -: maybe-create-file ( path -- win32-file ? ) - #! return true if file was just created - { GENERIC_READ GENERIC_WRITE } flags - share-mode - f - OPEN_ALWAYS - 0 CreateFile-flags - f CreateFileW dup win32-error=0/f - GetLastError ERROR_ALREADY_EXISTS = not ; - -: set-file-pointer ( handle length method -- ) - [ dupd d>w/w ] dip SetFilePointer - INVALID_SET_FILE_POINTER = [ - CloseHandle "SetFilePointer failed" throw - ] when drop ; - -HOOK: open-append os ( path -- win32-file ) - -TUPLE: FileArgs - hFile lpBuffer nNumberOfBytesToRead - lpNumberOfBytesRet lpOverlapped ; - -C: FileArgs - -: make-FileArgs ( port -- ) - { - [ handle>> check-disposed ] - [ handle>> handle>> ] - [ buffer>> ] - [ buffer>> buffer-length ] - [ drop "DWORD" ] - [ FileArgs-overlapped ] - } cleave ; - -: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) - { - [ hFile>> ] - [ lpBuffer>> buffer-end ] - [ lpBuffer>> buffer-capacity ] - [ lpNumberOfBytesRet>> ] - [ lpOverlapped>> ] - } cleave ; - -: setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) - { - [ hFile>> ] - [ lpBuffer>> buffer@ ] - [ lpBuffer>> buffer-length ] - [ lpNumberOfBytesRet>> ] - [ lpOverlapped>> ] - } cleave ; - -M: windows (file-reader) ( path -- stream ) - open-read ; - -M: windows (file-writer) ( path -- stream ) - open-write ; - -M: windows (file-appender) ( path -- stream ) - open-append ; - -M: windows move-file ( from to -- ) - [ normalize-path ] bi@ MoveFile win32-error=0/f ; - -M: windows delete-file ( path -- ) - normalize-path DeleteFile win32-error=0/f ; - -M: windows copy-file ( from to -- ) - dup parent-directory make-directories - [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ; - -M: windows make-directory ( path -- ) - normalize-path - f CreateDirectory win32-error=0/f ; - -M: windows delete-directory ( path -- ) - normalize-path - RemoveDirectory win32-error=0/f ; - -: find-first-file ( path -- WIN32_FIND_DATA handle ) - "WIN32_FIND_DATA" tuck - FindFirstFile - [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; - -: find-next-file ( path -- WIN32_FIND_DATA/f ) - "WIN32_FIND_DATA" tuck - FindNextFile 0 = [ - GetLastError ERROR_NO_MORE_FILES = [ - win32-error - ] unless drop f - ] when ; - -M: windows (directory-entries) ( path -- seq ) - "\\" ?tail drop "\\*" append - find-first-file [ >directory-entry ] dip - [ - '[ - [ _ find-next-file dup ] - [ >directory-entry ] - [ drop ] produce - over name>> "." = [ nip ] [ swap prefix ] if - ] - ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ; - -SYMBOLS: +read-only+ +hidden+ +system+ -+archive+ +device+ +normal+ +temporary+ -+sparse-file+ +reparse-point+ +compressed+ +offline+ -+not-content-indexed+ +encrypted+ ; - -TUPLE: windows-file-info < file-info attributes ; - -: win32-file-attribute ( n attr symbol -- ) - rot mask? [ , ] [ drop ] if ; - -: win32-file-attributes ( n -- seq ) - [ - { - [ +read-only+ FILE_ATTRIBUTE_READONLY win32-file-attribute ] - [ +hidden+ FILE_ATTRIBUTE_HIDDEN win32-file-attribute ] - [ +system+ FILE_ATTRIBUTE_SYSTEM win32-file-attribute ] - [ +directory+ FILE_ATTRIBUTE_DIRECTORY win32-file-attribute ] - [ +archive+ FILE_ATTRIBUTE_ARCHIVE win32-file-attribute ] - [ +device+ FILE_ATTRIBUTE_DEVICE win32-file-attribute ] - [ +normal+ FILE_ATTRIBUTE_NORMAL win32-file-attribute ] - [ +temporary+ FILE_ATTRIBUTE_TEMPORARY win32-file-attribute ] - [ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE win32-file-attribute ] - [ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT win32-file-attribute ] - [ +compressed+ FILE_ATTRIBUTE_COMPRESSED win32-file-attribute ] - [ +offline+ FILE_ATTRIBUTE_OFFLINE win32-file-attribute ] - [ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED win32-file-attribute ] - [ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED win32-file-attribute ] - } cleave - ] { } make ; - -: win32-file-type ( n -- symbol ) - FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; - -TUPLE: windows-directory-entry < directory-entry attributes ; - -M: windows >directory-entry ( byte-array -- directory-entry ) - [ WIN32_FIND_DATA-cFileName utf16n alien>string ] - [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ] - [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ] - tri - dupd remove windows-directory-entry boa ; - -: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) - [ \ windows-file-info new ] dip - { - [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ] - [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ] - [ - [ WIN32_FIND_DATA-nFileSizeLow ] - [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size - ] - [ WIN32_FIND_DATA-dwFileAttributes >>permissions ] - [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ] - [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ] - [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ] - } cleave ; - -: find-first-file-stat ( path -- WIN32_FIND_DATA ) - "WIN32_FIND_DATA" [ - FindFirstFile - [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep - FindClose win32-error=0/f - ] keep ; - -: BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info ) - [ \ windows-file-info new ] dip - { - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ] - [ - [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] - [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size - ] - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ] - [ - BY_HANDLE_FILE_INFORMATION-ftCreationTime - FILETIME>timestamp >>created - ] - [ - BY_HANDLE_FILE_INFORMATION-ftLastWriteTime - FILETIME>timestamp >>modified - ] - [ - BY_HANDLE_FILE_INFORMATION-ftLastAccessTime - FILETIME>timestamp >>accessed - ] - ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ] - ! [ - ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ] - ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit - ! ] - } cleave ; - -: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION ) - [ - "BY_HANDLE_FILE_INFORMATION" - [ GetFileInformationByHandle win32-error=0/f ] keep - ] keep CloseHandle win32-error=0/f ; - -: get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION ) - dup - GENERIC_READ FILE_SHARE_READ f - OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f - CreateFileW dup INVALID_HANDLE_VALUE = [ - drop find-first-file-stat WIN32_FIND_DATA>file-info - ] [ - nip - get-file-information BY_HANDLE_FILE_INFORMATION>file-info - ] if ; - -M: winnt file-info ( path -- info ) - normalize-path get-file-information-stat ; - -M: winnt link-info ( path -- info ) - file-info ; - -HOOK: root-directory os ( string -- string' ) - -: volume-information ( normalized-path -- volume-name volume-serial max-component flags type ) - MAX_PATH 1+ [ ] keep - "DWORD" - "DWORD" - "DWORD" - MAX_PATH 1+ [ ] keep - [ GetVolumeInformation win32-error=0/f ] 7 nkeep - drop 5 nrot drop - [ utf16n alien>string ] 4 ndip - utf16n alien>string ; - -: file-system-space ( normalized-path -- available-space total-space free-space ) - "ULARGE_INTEGER" - "ULARGE_INTEGER" - "ULARGE_INTEGER" - [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; - -: calculate-file-system-info ( file-system-info -- file-system-info' ) - { - [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] - [ ] - } cleave ; - -TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ; - -M: winnt file-system-info ( path -- file-system-info ) - normalize-path root-directory - dup [ volume-information ] [ file-system-space ] bi - \ win32-file-system-info new - swap *ulonglong >>free-space - swap *ulonglong >>total-space - swap *ulonglong >>available-space - swap >>type - swap *uint >>flags - swap *uint >>max-component - swap *uint >>device-serial - swap >>device-name - swap >>mount-point - calculate-file-system-info ; - -: volume>paths ( string -- array ) - 16384 "ushort" tuck dup length - 0 dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [ - win32-error-string throw - ] [ - *uint "ushort" heap-size * head - utf16n alien>string CHAR: \0 split - ] if ; - -: find-first-volume ( -- string handle ) - MAX_PATH 1+ [ ] keep - dupd - FindFirstVolume dup win32-error=0/f - [ utf16n alien>string ] dip ; - -: find-next-volume ( handle -- string/f ) - MAX_PATH 1+ [ tuck ] keep - FindNextVolume 0 = [ - GetLastError ERROR_NO_MORE_FILES = - [ drop f ] [ win32-error-string throw ] if - ] [ - utf16n alien>string - ] if ; - -: find-volumes ( -- array ) - find-first-volume - [ - '[ - [ _ find-next-volume dup ] - [ ] - [ drop ] produce - swap prefix - ] - ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; - -M: winnt file-systems ( -- array ) - find-volumes [ volume>paths ] map - concat [ - [ file-system-info ] - [ drop \ file-system-info new swap >>mount-point ] recover - ] map ; - -: file-times ( path -- timestamp timestamp timestamp ) - [ - normalize-path open-existing &dispose handle>> - "FILETIME" - "FILETIME" - "FILETIME" - [ GetFileTime win32-error=0/f ] 3keep - [ FILETIME>timestamp >local-time ] tri@ - ] with-destructors ; - -: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- ) - [ timestamp>FILETIME ] tri@ - SetFileTime win32-error=0/f ; - -: set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) - #! timestamp order: creation access write - [ - [ - normalize-path open-existing &dispose handle>> - ] 3dip (set-file-times) - ] with-destructors ; - -: set-file-create-time ( path timestamp -- ) - f f set-file-times ; - -: set-file-access-time ( path timestamp -- ) - [ f ] dip f set-file-times ; - -: set-file-write-time ( path timestamp -- ) - [ f f ] dip set-file-times ; - -M: winnt touch-file ( path -- ) - [ - normalize-path - maybe-create-file [ &dispose ] dip - [ drop ] [ handle>> f now dup (set-file-times) ] if - ] with-destructors ; diff --git a/basis/io/windows/files/tags.txt b/basis/io/windows/files/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/files/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/files/unique/tags.txt b/basis/io/windows/files/unique/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/files/unique/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/files/unique/unique.factor b/basis/io/windows/files/unique/unique.factor deleted file mode 100644 index ab99bf2cac..0000000000 --- a/basis/io/windows/files/unique/unique.factor +++ /dev/null @@ -1,10 +0,0 @@ -USING: kernel system windows.kernel32 io.windows -io.windows.files io.ports windows destructors environment -io.files.unique ; -IN: io.windows.files.unique - -M: windows touch-unique-file ( path -- ) - GENERIC_WRITE CREATE_NEW 0 open-file dispose ; - -M: windows temporary-path ( -- path ) - "TEMP" os-env ; diff --git a/basis/io/windows/launcher/authors.txt b/basis/io/windows/launcher/authors.txt deleted file mode 100755 index 5674120196..0000000000 --- a/basis/io/windows/launcher/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Doug Coleman -Slava Pestov diff --git a/basis/io/windows/launcher/launcher-tests.factor b/basis/io/windows/launcher/launcher-tests.factor deleted file mode 100644 index 1dba8bd0ec..0000000000 --- a/basis/io/windows/launcher/launcher-tests.factor +++ /dev/null @@ -1,10 +0,0 @@ -IN: io.windows.launcher.tests -USING: tools.test io.windows.launcher ; - -[ "hello world" ] [ { "hello" "world" } join-arguments ] unit-test - -[ "bob \"mac arthur\"" ] [ { "bob" "mac arthur" } join-arguments ] unit-test - -[ "bob mac\\\\arthur" ] [ { "bob" "mac\\\\arthur" } join-arguments ] unit-test - -[ "bob \"mac arthur\\\\\"" ] [ { "bob" "mac arthur\\" } join-arguments ] unit-test diff --git a/basis/io/windows/launcher/launcher.factor b/basis/io/windows/launcher/launcher.factor deleted file mode 100644 index fd31ca999f..0000000000 --- a/basis/io/windows/launcher/launcher.factor +++ /dev/null @@ -1,164 +0,0 @@ -! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays continuations io -io.windows io.windows.nt.pipes libc io.ports -windows.types math windows.kernel32 -namespaces make io.launcher kernel sequences windows.errors -splitting system threads init strings combinators -io.backend accessors concurrency.flags io.files assocs -io.files.private windows destructors specialized-arrays.ushort -specialized-arrays.alien ; -IN: io.windows.launcher - -TUPLE: CreateProcess-args - lpApplicationName - lpCommandLine - lpProcessAttributes - lpThreadAttributes - bInheritHandles - dwCreateFlags - lpEnvironment - lpCurrentDirectory - lpStartupInfo - lpProcessInformation ; - -: default-CreateProcess-args ( -- obj ) - CreateProcess-args new - "STARTUPINFO" - "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo - "PROCESS_INFORMATION" >>lpProcessInformation - TRUE >>bInheritHandles - 0 >>dwCreateFlags ; - -: call-CreateProcess ( CreateProcess-args -- ) - { - [ lpApplicationName>> ] - [ lpCommandLine>> ] - [ lpProcessAttributes>> ] - [ lpThreadAttributes>> ] - [ bInheritHandles>> ] - [ dwCreateFlags>> ] - [ lpEnvironment>> ] - [ lpCurrentDirectory>> ] - [ lpStartupInfo>> ] - [ lpProcessInformation>> ] - } cleave - CreateProcess win32-error=0/f ; - -: count-trailing-backslashes ( str n -- str n ) - [ "\\" ?tail ] dip swap [ - 1+ count-trailing-backslashes - ] when ; - -: fix-trailing-backslashes ( str -- str' ) - 0 count-trailing-backslashes - 2 * CHAR: \\ append ; - -: escape-argument ( str -- newstr ) - CHAR: \s over member? [ - fix-trailing-backslashes "\"" dup surround - ] when ; - -: join-arguments ( args -- cmd-line ) - [ escape-argument ] map " " join ; - -: lookup-priority ( process -- n ) - priority>> { - { +lowest-priority+ [ IDLE_PRIORITY_CLASS ] } - { +low-priority+ [ BELOW_NORMAL_PRIORITY_CLASS ] } - { +normal-priority+ [ NORMAL_PRIORITY_CLASS ] } - { +high-priority+ [ ABOVE_NORMAL_PRIORITY_CLASS ] } - { +highest-priority+ [ HIGH_PRIORITY_CLASS ] } - { +realtime-priority+ [ REALTIME_PRIORITY_CLASS ] } - [ drop f ] - } case ; - -: app-name/cmd-line ( process -- app-name cmd-line ) - command>> dup string? [ - " " split1 - ] [ - unclip swap join-arguments - ] if ; - -: cmd-line ( process -- cmd-line ) - command>> dup string? [ join-arguments ] unless ; - -: fill-lpApplicationName ( process args -- process args ) - over app-name/cmd-line - [ >>lpApplicationName ] [ >>lpCommandLine ] bi* ; - -: fill-lpCommandLine ( process args -- process args ) - over cmd-line >>lpCommandLine ; - -: fill-dwCreateFlags ( process args -- process args ) - 0 - pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when - pick detached>> os winnt? and [ DETACHED_PROCESS bitor ] when - pick lookup-priority [ bitor ] when* - >>dwCreateFlags ; - -: fill-lpEnvironment ( process args -- process args ) - over pass-environment? [ - [ - over get-environment - [ swap % "=" % % "\0" % ] assoc-each - "\0" % - ] ushort-array{ } make underlying>> - >>lpEnvironment - ] when ; - -: fill-startup-info ( process args -- process args ) - STARTF_USESTDHANDLES over lpStartupInfo>> set-STARTUPINFO-dwFlags ; - -HOOK: fill-redirection io-backend ( process args -- ) - -M: wince fill-redirection 2drop ; - -: make-CreateProcess-args ( process -- args ) - default-CreateProcess-args - os wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if - fill-dwCreateFlags - fill-lpEnvironment - fill-startup-info - nip ; - -M: windows current-process-handle ( -- handle ) - GetCurrentProcessId ; - -M: windows run-process* ( process -- handle ) - [ - current-directory get (normalize-path) cd - - dup make-CreateProcess-args - tuck fill-redirection - dup call-CreateProcess - lpProcessInformation>> - ] with-destructors ; - -M: windows kill-process* ( handle -- ) - PROCESS_INFORMATION-hProcess - 255 TerminateProcess win32-error=0/f ; - -: dispose-process ( process-information -- ) - #! From MSDN: "Handles in PROCESS_INFORMATION must be closed - #! with CloseHandle when they are no longer needed." - dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when* - PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ; - -: exit-code ( process -- n ) - PROCESS_INFORMATION-hProcess - 0 [ GetExitCodeProcess ] keep *ulong - swap win32-error=0/f ; - -: process-exited ( process -- ) - dup handle>> exit-code - over handle>> dispose-process - notify-exit ; - -M: windows wait-for-processes ( -- ? ) - processes get keys dup - [ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as - [ length ] [ underlying>> ] bi 0 0 - WaitForMultipleObjects - dup HEX: ffffffff = [ win32-error ] when - dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ; diff --git a/basis/io/windows/launcher/tags.txt b/basis/io/windows/launcher/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/launcher/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/mmap/authors.txt b/basis/io/windows/mmap/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/io/windows/mmap/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/io/windows/mmap/mmap.factor b/basis/io/windows/mmap/mmap.factor deleted file mode 100644 index e5b0d10f2f..0000000000 --- a/basis/io/windows/mmap/mmap.factor +++ /dev/null @@ -1,44 +0,0 @@ -USING: alien alien.c-types arrays destructors generic io.mmap -io.ports io.windows io.windows.files io.windows.privileges -kernel libc math math.bitwise namespaces quotations sequences -windows windows.advapi32 windows.kernel32 io.backend system -accessors locals ; -IN: io.windows.mmap - -: create-file-mapping ( hFile lpAttributes flProtect dwMaximumSizeHigh dwMaximumSizeLow lpName -- HANDLE ) - CreateFileMapping [ win32-error=0/f ] keep ; - -: map-view-of-file ( hFileMappingObject dwDesiredAccess dwFileOffsetHigh dwFileOffsetLow dwNumberOfBytesToMap -- HANDLE ) - MapViewOfFile [ win32-error=0/f ] keep ; - -:: mmap-open ( path length access-mode create-mode protect access -- handle handle address ) - [let | lo [ length HEX: ffffffff bitand ] - hi [ length -32 shift HEX: ffffffff bitand ] | - { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [ - path access-mode create-mode 0 open-file |dispose - dup handle>> f protect hi lo f create-file-mapping |dispose - dup handle>> access 0 0 0 map-view-of-file - ] with-privileges - ] ; - -TUPLE: win32-mapped-file file mapping ; - -M: win32-mapped-file dispose - [ file>> dispose ] [ mapping>> dispose ] bi ; - -C: win32-mapped-file - -M: windows (mapped-file) - [ - { GENERIC_WRITE GENERIC_READ } flags - OPEN_ALWAYS - { PAGE_READWRITE SEC_COMMIT } flags - FILE_MAP_ALL_ACCESS mmap-open - -rot - ] with-destructors ; - -M: windows close-mapped-file ( mapped-file -- ) - [ - [ handle>> &dispose drop ] - [ address>> UnmapViewOfFile win32-error=0/f ] bi - ] with-destructors ; diff --git a/basis/io/windows/mmap/tags.txt b/basis/io/windows/mmap/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/mmap/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/authors.txt b/basis/io/windows/nt/authors.txt deleted file mode 100644 index 781acc2b62..0000000000 --- a/basis/io/windows/nt/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Doug Coleman -Mackenzie Straight diff --git a/basis/io/windows/nt/backend/authors.txt b/basis/io/windows/nt/backend/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/basis/io/windows/nt/backend/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/basis/io/windows/nt/backend/backend.factor b/basis/io/windows/nt/backend/backend.factor deleted file mode 100644 index 8035bd66e9..0000000000 --- a/basis/io/windows/nt/backend/backend.factor +++ /dev/null @@ -1,120 +0,0 @@ -USING: alien alien.c-types arrays assocs combinators -continuations destructors io io.backend io.ports io.timeouts -io.windows io.windows.files io.files io.buffers io.streams.c -libc kernel math namespaces sequences threads windows -windows.errors windows.kernel32 strings splitting qualified -ascii system accessors locals ; -QUALIFIED: windows.winsock -IN: io.windows.nt.backend - -! Global variable with assoc mapping overlapped to threads -SYMBOL: pending-overlapped - -TUPLE: io-callback port thread ; - -C: io-callback - -: (make-overlapped) ( -- overlapped-ext ) - "OVERLAPPED" malloc-object &free ; - -: make-overlapped ( port -- overlapped-ext ) - [ (make-overlapped) ] dip - handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ; - -: ( handle existing -- handle ) - f 1 CreateIoCompletionPort dup win32-error=0/f ; - -SYMBOL: master-completion-port - -: ( -- handle ) - INVALID_HANDLE_VALUE f ; - -M: winnt add-completion ( win32-handle -- ) - handle>> master-completion-port get-global drop ; - -: eof? ( error -- ? ) - [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] bi or ; - -: twiddle-thumbs ( overlapped port -- bytes-transferred ) - [ - drop - [ pending-overlapped get-global set-at ] curry "I/O" suspend - { - { [ dup integer? ] [ ] } - { [ dup array? ] [ - first dup eof? - [ drop 0 ] [ (win32-error-string) throw ] if - ] } - } cond - ] with-timeout ; - -:: wait-for-overlapped ( us -- bytes-transferred overlapped error? ) - master-completion-port get-global - 0 [ ! bytes - f ! key - f [ ! overlapped - us [ 1000 /i ] [ INFINITE ] if* ! timeout - GetQueuedCompletionStatus zero? - ] keep *void* - ] keep *int spin ; - -: resume-callback ( result overlapped -- ) - pending-overlapped get-global delete-at* drop resume-with ; - -: handle-overlapped ( us -- ? ) - wait-for-overlapped [ - dup [ - [ drop GetLastError 1array ] dip resume-callback t - ] [ 2drop f ] if - ] [ resume-callback t ] if ; - -M: win32-handle cancel-operation - [ check-disposed ] [ handle>> CancelIo drop ] bi ; - -M: winnt io-multiplex ( us -- ) - handle-overlapped [ 0 io-multiplex ] when ; - -M: winnt init-io ( -- ) - master-completion-port set-global - H{ } clone pending-overlapped set-global - windows.winsock:init-winsock ; - -: file-error? ( n -- eof? ) - zero? [ - GetLastError { - { [ dup expected-io-error? ] [ drop f ] } - { [ dup eof? ] [ drop t ] } - [ (win32-error-string) throw ] - } cond - ] [ f ] if ; - -: wait-for-file ( FileArgs n port -- n ) - swap file-error? - [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ; - -: update-file-ptr ( n port -- ) - handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ; - -: finish-write ( n port -- ) - [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ; - -M: winnt (wait-to-write) - [ - [ make-FileArgs dup setup-write WriteFile ] - [ wait-for-file ] - [ finish-write ] - tri - ] with-destructors ; - -: finish-read ( n port -- ) - [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ; - -M: winnt (wait-to-read) ( port -- ) - [ - [ make-FileArgs dup setup-read ReadFile ] - [ wait-for-file ] - [ finish-read ] - tri - ] with-destructors ; - -M: winnt (init-stdio) init-c-stdio ; diff --git a/basis/io/windows/nt/backend/tags.txt b/basis/io/windows/nt/backend/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/backend/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/files/authors.txt b/basis/io/windows/nt/files/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/basis/io/windows/nt/files/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/basis/io/windows/nt/files/files-tests.factor b/basis/io/windows/nt/files/files-tests.factor deleted file mode 100644 index 6620dd691e..0000000000 --- a/basis/io/windows/nt/files/files-tests.factor +++ /dev/null @@ -1,55 +0,0 @@ -USING: io.files kernel tools.test io.backend -io.windows.nt.files splitting sequences ; -IN: io.windows.nt.files.tests - -[ f ] [ "\\foo" absolute-path? ] unit-test -[ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test -[ t ] [ "\\\\?\\c:\\" absolute-path? ] unit-test -[ t ] [ "\\\\?\\c:" absolute-path? ] unit-test -[ t ] [ "c:\\foo" absolute-path? ] unit-test -[ t ] [ "c:" absolute-path? ] unit-test -[ t ] [ "c:\\" absolute-path? ] unit-test -[ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test - -[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test -[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test -[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test -! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing -[ "c:\\" ] [ "c:\\" parent-directory ] unit-test -[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test -[ "c:" ] [ "c:" parent-directory ] unit-test -[ "Z:" ] [ "Z:" parent-directory ] unit-test - -[ f ] [ "" root-directory? ] unit-test -[ t ] [ "\\" root-directory? ] unit-test -[ t ] [ "\\\\" root-directory? ] unit-test -[ t ] [ "/" root-directory? ] unit-test -[ t ] [ "//" root-directory? ] unit-test -[ t ] [ "c:\\" trim-right-separators root-directory? ] unit-test -[ t ] [ "Z:\\" trim-right-separators root-directory? ] unit-test -[ f ] [ "c:\\foo" root-directory? ] unit-test -[ f ] [ "." root-directory? ] unit-test -[ f ] [ ".." root-directory? ] unit-test -[ t ] [ "\\\\?\\c:\\" root-directory? ] unit-test -[ t ] [ "\\\\?\\c:" root-directory? ] unit-test -[ f ] [ "\\\\?\\c:\\bar" root-directory? ] unit-test - -[ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test - -[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [ - "C:\\builds\\factor\\12345\\" - "..\\log.txt" append-path normalize-path -] unit-test - -[ "\\\\?\\C:\\builds\\" ] [ - "C:\\builds\\factor\\12345\\" - "..\\.." append-path normalize-path -] unit-test - -[ "\\\\?\\C:\\builds\\" ] [ - "C:\\builds\\factor\\12345\\" - "..\\.." append-path normalize-path -] unit-test - -[ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test -[ t ] [ "" resource-path 2 tail exists? ] unit-test diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor deleted file mode 100755 index 892a5c4d31..0000000000 --- a/basis/io/windows/nt/files/files.factor +++ /dev/null @@ -1,64 +0,0 @@ -USING: continuations destructors io.buffers io.files io.backend -io.timeouts io.ports io.files.private io.windows -io.windows.files io.windows.nt.backend io.encodings.utf16n -windows windows.kernel32 kernel libc math threads system -environment alien.c-types alien.arrays alien.strings sequences -combinators combinators.short-circuit ascii splitting alien -strings assocs namespaces make accessors tr ; -IN: io.windows.nt.files - -M: winnt cwd - MAX_UNICODE_PATH dup "ushort" - [ GetCurrentDirectory win32-error=0/f ] keep - utf16n alien>string ; - -M: winnt cd - SetCurrentDirectory win32-error=0/f ; - -: unicode-prefix ( -- seq ) - "\\\\?\\" ; inline - -M: winnt root-directory? ( path -- ? ) - { - { [ dup empty? ] [ drop f ] } - { [ dup [ path-separator? ] all? ] [ drop t ] } - { [ dup trim-right-separators { [ length 2 = ] - [ second CHAR: : = ] } 1&& ] [ drop t ] } - { [ dup unicode-prefix head? ] - [ trim-right-separators length unicode-prefix length 2 + = ] } - [ drop f ] - } cond ; - -ERROR: not-absolute-path ; - -M: winnt root-directory ( string -- string' ) - unicode-prefix ?head drop - dup { - [ length 2 >= ] - [ second CHAR: : = ] - [ first Letter? ] - } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; - -: prepend-prefix ( string -- string' ) - dup unicode-prefix head? [ - unicode-prefix prepend - ] unless ; - -TR: normalize-separators "/" "\\" ; - -M: winnt normalize-path ( string -- string' ) - (normalize-path) - normalize-separators - prepend-prefix ; - -M: winnt CreateFile-flags ( DWORD -- DWORD ) - FILE_FLAG_OVERLAPPED bitor ; - -M: winnt FileArgs-overlapped ( port -- overlapped ) - make-overlapped ; - -M: winnt open-append - [ dup file-info size>> ] [ drop 0 ] recover - [ (open-append) ] dip >>ptr ; - -M: winnt home "USERPROFILE" os-env ; diff --git a/basis/io/windows/nt/files/tags.txt b/basis/io/windows/nt/files/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/files/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/launcher/authors.txt b/basis/io/windows/nt/launcher/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/basis/io/windows/nt/launcher/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor deleted file mode 100644 index cbae2f5eca..0000000000 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ /dev/null @@ -1,157 +0,0 @@ -USING: io.launcher tools.test calendar accessors environment -namespaces kernel system arrays io io.files io.encodings.ascii -sequences parser assocs hashtables math continuations eval ; -IN: io.windows.launcher.nt.tests - -[ ] [ - - "notepad" >>command - 1/2 seconds >>timeout - "notepad" set -] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ f ] [ "notepad" get process-started? ] unit-test - -[ ] [ "notepad" [ run-detached ] change ] unit-test - -[ "notepad" get wait-for-process ] must-fail - -[ t ] [ "notepad" get killed>> ] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ ] [ - - vm "-quiet" "-run=hello-world" 3array >>command - "out.txt" temp-file >>stdout - try-process -] unit-test - -[ "Hello world" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - - vm "-run=listener" 2array >>command - +closed+ >>stdin - try-process -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - "err.txt" temp-file >>stderr - try-process - ] with-directory -] unit-test - -[ "output" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "error" ] [ - "err.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - +stdout+ >>stderr - try-process - ] with-directory -] unit-test - -[ "outputerror" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "output" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "err2.txt" temp-file >>stderr - ascii lines first - ] with-directory -] unit-test - -[ "error" ] [ - "err2.txt" temp-file ascii file-lines first -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - +replace-environment+ >>environment-mode - os-envs >>environment - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ "B" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "A" "B" } } >>environment - ascii contents - ] with-directory eval - - "A" swap at -] unit-test - -[ f ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "USERPROFILE" "XXX" } } >>environment - +prepend-environment+ >>environment-mode - ascii contents - ] with-directory eval - - "USERPROFILE" swap at "XXX" = -] unit-test - -2 [ - [ ] [ - - "cmd.exe /c dir" >>command - "dir.txt" temp-file >>stdout - try-process - ] unit-test - - [ ] [ "dir.txt" temp-file delete-file ] unit-test -] times - -[ "append-test" temp-file delete-file ] ignore-errors - -[ "Hello appender\r\nHello appender\r\n" ] [ - 2 [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "append.factor" 3array >>command - "append-test" temp-file >>stdout - try-process - ] with-directory - ] times - - "append-test" temp-file ascii file-contents -] unit-test diff --git a/basis/io/windows/nt/launcher/launcher.factor b/basis/io/windows/nt/launcher/launcher.factor deleted file mode 100644 index de4fb99c64..0000000000 --- a/basis/io/windows/nt/launcher/launcher.factor +++ /dev/null @@ -1,110 +0,0 @@ -! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays continuations destructors io -io.windows libc io.ports io.pipes windows.types math -windows.kernel32 windows namespaces make io.launcher kernel -sequences windows.errors assocs splitting system strings -io.windows.launcher io.windows.files io.backend io.files -io.files.private combinators shuffle accessors locals ; -IN: io.windows.nt.launcher - -: duplicate-handle ( handle -- handle' ) - GetCurrentProcess ! source process - swap ! handle - GetCurrentProcess ! target process - f [ ! target handle - DUPLICATE_SAME_ACCESS ! desired access - TRUE ! inherit handle - DUPLICATE_CLOSE_SOURCE ! options - DuplicateHandle win32-error=0/f - ] keep *void* ; - -! /dev/null simulation -: null-input ( -- pipe ) - (pipe) [ in>> handle>> ] [ out>> dispose ] bi ; - -: null-output ( -- pipe ) - (pipe) [ in>> dispose ] [ out>> handle>> ] bi ; - -: null-pipe ( mode -- pipe ) - { - { GENERIC_READ [ null-input ] } - { GENERIC_WRITE [ null-output ] } - } case ; - -! The below code is based on the example given in -! http://msdn2.microsoft.com/en-us/library/ms682499.aspx - -: redirect-default ( obj access-mode create-mode -- handle ) - 3drop f ; - -: redirect-closed ( obj access-mode create-mode -- handle ) - drop nip null-pipe ; - -:: redirect-file ( path access-mode create-mode -- handle ) - path normalize-path - access-mode - share-mode - default-security-attributes - create-mode - FILE_ATTRIBUTE_NORMAL ! flags and attributes - f ! template file - CreateFile dup invalid-handle? &dispose handle>> ; - -: redirect-append ( path access-mode create-mode -- handle ) - [ path>> ] 2dip - drop OPEN_ALWAYS - redirect-file - dup 0 FILE_END set-file-pointer ; - -: redirect-handle ( handle access-mode create-mode -- handle ) - 2drop handle>> duplicate-handle ; - -: redirect-stream ( stream access-mode create-mode -- handle ) - [ underlying-handle handle>> ] 2dip redirect-handle ; - -: redirect ( obj access-mode create-mode -- handle ) - { - { [ pick not ] [ redirect-default ] } - { [ pick +closed+ eq? ] [ redirect-closed ] } - { [ pick string? ] [ redirect-file ] } - { [ pick appender? ] [ redirect-append ] } - { [ pick win32-file? ] [ redirect-handle ] } - [ redirect-stream ] - } cond - dup [ dup t set-inherit ] when ; - -: redirect-stdout ( process args -- handle ) - drop - stdout>> - GENERIC_WRITE - CREATE_ALWAYS - redirect - STD_OUTPUT_HANDLE GetStdHandle or ; - -: redirect-stderr ( process args -- handle ) - over stderr>> +stdout+ eq? [ - nip - lpStartupInfo>> STARTUPINFO-hStdOutput - ] [ - drop - stderr>> - GENERIC_WRITE - CREATE_ALWAYS - redirect - STD_ERROR_HANDLE GetStdHandle or - ] if ; - -: redirect-stdin ( process args -- handle ) - drop - stdin>> - GENERIC_READ - OPEN_EXISTING - redirect - STD_INPUT_HANDLE GetStdHandle or ; - -M: winnt fill-redirection ( process args -- ) - [ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput - [ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError - [ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput - 2drop ; diff --git a/basis/io/windows/nt/launcher/tags.txt b/basis/io/windows/nt/launcher/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/launcher/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/launcher/test/append.factor b/basis/io/windows/nt/launcher/test/append.factor deleted file mode 100644 index 4c1de0c5f9..0000000000 --- a/basis/io/windows/nt/launcher/test/append.factor +++ /dev/null @@ -1,2 +0,0 @@ -USE: io -"Hello appender" print diff --git a/basis/io/windows/nt/launcher/test/env.factor b/basis/io/windows/nt/launcher/test/env.factor deleted file mode 100644 index 503ca7d018..0000000000 --- a/basis/io/windows/nt/launcher/test/env.factor +++ /dev/null @@ -1,4 +0,0 @@ -USE: system -USE: prettyprint -USE: environment -os-envs . diff --git a/basis/io/windows/nt/launcher/test/stderr.factor b/basis/io/windows/nt/launcher/test/stderr.factor deleted file mode 100644 index f22f50e406..0000000000 --- a/basis/io/windows/nt/launcher/test/stderr.factor +++ /dev/null @@ -1,5 +0,0 @@ -USE: io -USE: namespaces - -"output" write flush -"error" error-stream get stream-write error-stream get stream-flush diff --git a/basis/io/windows/nt/monitors/authors.txt b/basis/io/windows/nt/monitors/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/io/windows/nt/monitors/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/io/windows/nt/monitors/monitors-tests.factor b/basis/io/windows/nt/monitors/monitors-tests.factor deleted file mode 100644 index ef36baedc5..0000000000 --- a/basis/io/windows/nt/monitors/monitors-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -IN: io.windows.nt.monitors.tests -USING: io.windows.nt.monitors tools.test ; - -\ fill-queue-thread must-infer diff --git a/basis/io/windows/nt/monitors/monitors.factor b/basis/io/windows/nt/monitors/monitors.factor deleted file mode 100755 index a2b7c4fa2d..0000000000 --- a/basis/io/windows/nt/monitors/monitors.factor +++ /dev/null @@ -1,105 +0,0 @@ -! Copyright (C) 2008 Doug Coleman, Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings libc destructors locals -kernel math assocs namespaces make continuations sequences -hashtables sorting arrays combinators math.bitwise strings -system accessors threads splitting io.backend io.windows -io.windows.nt.backend io.windows.nt.files io.monitors io.ports -io.buffers io.files io.timeouts io.encodings.string -io.encodings.utf16n io windows windows.kernel32 windows.types ; -IN: io.windows.nt.monitors - -: open-directory ( path -- handle ) - normalize-path - FILE_LIST_DIRECTORY - share-mode - f - OPEN_EXISTING - { FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } flags - f - CreateFile opened-file ; - -TUPLE: win32-monitor-port < input-port recursive ; - -TUPLE: win32-monitor < monitor port ; - -: begin-reading-changes ( port -- overlapped ) - { - [ handle>> handle>> ] - [ buffer>> ptr>> ] - [ buffer>> size>> ] - [ recursive>> 1 0 ? ] - } cleave - FILE_NOTIFY_CHANGE_ALL - 0 - (make-overlapped) - [ f ReadDirectoryChangesW win32-error=0/f ] keep ; - -: read-changes ( port -- bytes-transferred ) - [ - [ begin-reading-changes ] [ twiddle-thumbs ] bi - ] with-destructors ; - -: parse-action ( action -- changed ) - { - { FILE_ACTION_ADDED [ +add-file+ ] } - { FILE_ACTION_REMOVED [ +remove-file+ ] } - { FILE_ACTION_MODIFIED [ +modify-file+ ] } - { FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] } - { FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] } - [ drop +modify-file+ ] - } case 1array ; - -: memory>u16-string ( alien len -- string ) - memory>byte-array utf16n decode ; - -: parse-notify-record ( buffer -- path changed ) - [ - [ FILE_NOTIFY_INFORMATION-FileName ] - [ FILE_NOTIFY_INFORMATION-FileNameLength ] - bi memory>u16-string - ] - [ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ; - -: (file-notify-records) ( buffer -- buffer ) - dup , - dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [ - [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep - (file-notify-records) - ] unless ; - -: file-notify-records ( buffer -- seq ) - [ (file-notify-records) drop ] { } make ; - -:: parse-notify-records ( monitor buffer -- ) - buffer file-notify-records [ - parse-notify-record - [ monitor path>> prepend-path normalize-path ] dip - monitor queue-change - ] each ; - -: fill-queue ( monitor -- ) - dup port>> dup check-disposed - [ buffer>> ptr>> ] [ read-changes zero? ] bi - [ 2dup parse-notify-records ] unless - 2drop ; - -: (fill-queue-thread) ( monitor -- ) - dup fill-queue (fill-queue-thread) ; - -: fill-queue-thread ( monitor -- ) - [ dup fill-queue (fill-queue-thread) ] - [ dup already-disposed? [ 2drop ] [ rethrow ] if ] recover ; - -M:: winnt (monitor) ( path recursive? mailbox -- monitor ) - [ - path normalize-path mailbox win32-monitor new-monitor - path open-directory \ win32-monitor-port - recursive? >>recursive - >>port - dup [ fill-queue-thread ] curry - "Windows monitor thread" spawn drop - ] with-destructors ; - -M: win32-monitor dispose - port>> dispose ; diff --git a/basis/io/windows/nt/monitors/tags.txt b/basis/io/windows/nt/monitors/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/monitors/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/nt.factor b/basis/io/windows/nt/nt.factor deleted file mode 100644 index efde4f4035..0000000000 --- a/basis/io/windows/nt/nt.factor +++ /dev/null @@ -1,7 +0,0 @@ -! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman, -! Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: vocabs.loader io.windows io.windows.nt.backend -io.windows.nt.files io.windows.files io.backend system ; - -winnt set-io-backend diff --git a/basis/io/windows/nt/pipes/authors.txt b/basis/io/windows/nt/pipes/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/basis/io/windows/nt/pipes/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/io/windows/nt/pipes/pipes.factor b/basis/io/windows/nt/pipes/pipes.factor deleted file mode 100644 index d498875c87..0000000000 --- a/basis/io/windows/nt/pipes/pipes.factor +++ /dev/null @@ -1,46 +0,0 @@ -! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays destructors io io.windows libc -windows.types math.bitwise windows.kernel32 windows namespaces -make kernel sequences windows.errors assocs math.parser system -random combinators accessors io.pipes io.ports ; -IN: io.windows.nt.pipes - -! This code is based on -! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py - -: create-named-pipe ( name -- handle ) - { PIPE_ACCESS_INBOUND FILE_FLAG_OVERLAPPED } flags - PIPE_TYPE_BYTE - 1 - 4096 - 4096 - 0 - default-security-attributes - CreateNamedPipe opened-file ; - -: open-other-end ( name -- handle ) - GENERIC_WRITE - { FILE_SHARE_READ FILE_SHARE_WRITE } flags - default-security-attributes - OPEN_EXISTING - FILE_FLAG_OVERLAPPED - f - CreateFile opened-file ; - -: unique-pipe-name ( -- string ) - [ - "\\\\.\\pipe\\factor-" % - pipe counter # - "-" % - 32 random-bits # - "-" % - micros # - ] "" make ; - -M: winnt (pipe) ( -- pipe ) - [ - unique-pipe-name - [ create-named-pipe ] [ open-other-end ] bi - pipe boa - ] with-destructors ; diff --git a/basis/io/windows/nt/pipes/tags.txt b/basis/io/windows/nt/pipes/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/pipes/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/privileges/privileges.factor b/basis/io/windows/nt/privileges/privileges.factor deleted file mode 100755 index 264f337eaf..0000000000 --- a/basis/io/windows/nt/privileges/privileges.factor +++ /dev/null @@ -1,52 +0,0 @@ -USING: alien alien.c-types alien.syntax arrays continuations -destructors generic io.mmap io.ports io.windows io.windows.files -kernel libc math math.bitwise namespaces quotations sequences windows -windows.advapi32 windows.kernel32 io.backend system accessors -io.windows.privileges ; -IN: io.windows.nt.privileges - -TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES - -! Security tokens -! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/ - -: (open-process-token) ( handle -- handle ) - { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags "PHANDLE" - [ OpenProcessToken win32-error=0/f ] keep *void* ; - -: open-process-token ( -- handle ) - #! remember to CloseHandle - GetCurrentProcess (open-process-token) ; - -: with-process-token ( quot -- ) - #! quot: ( token-handle -- token-handle ) - [ open-process-token ] dip - [ keep ] curry - [ CloseHandle drop ] [ ] cleanup ; inline - -: lookup-privilege ( string -- luid ) - [ f ] dip "LUID" - [ LookupPrivilegeValue win32-error=0/f ] keep ; - -: make-token-privileges ( name ? -- obj ) - "TOKEN_PRIVILEGES" - 1 [ over set-TOKEN_PRIVILEGES-PrivilegeCount ] keep - "LUID_AND_ATTRIBUTES" malloc-array &free - over set-TOKEN_PRIVILEGES-Privileges - - swap [ - SE_PRIVILEGE_ENABLED over TOKEN_PRIVILEGES-Privileges - set-LUID_AND_ATTRIBUTES-Attributes - ] when - - [ lookup-privilege ] dip - [ - TOKEN_PRIVILEGES-Privileges - set-LUID_AND_ATTRIBUTES-Luid - ] keep ; - -M: winnt set-privilege ( name ? -- ) - [ - -rot 0 -rot make-token-privileges - dup length f f AdjustTokenPrivileges win32-error=0/f - ] with-process-token ; diff --git a/basis/io/windows/nt/privileges/tags.txt b/basis/io/windows/nt/privileges/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/privileges/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/sockets/authors.txt b/basis/io/windows/nt/sockets/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/basis/io/windows/nt/sockets/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/basis/io/windows/nt/sockets/sockets.factor b/basis/io/windows/nt/sockets/sockets.factor deleted file mode 100644 index ecd9ea9d9b..0000000000 --- a/basis/io/windows/nt/sockets/sockets.factor +++ /dev/null @@ -1,216 +0,0 @@ -USING: alien alien.accessors alien.c-types byte-arrays -continuations destructors io.ports io.timeouts io.sockets -io.sockets io namespaces io.streams.duplex io.windows -io.windows.sockets io.windows.nt.backend windows.winsock kernel -libc math sequences threads system combinators accessors ; -IN: io.windows.nt.sockets - -: malloc-int ( object -- object ) - "int" heap-size malloc tuck 0 set-alien-signed-4 ; inline - -M: winnt WSASocket-flags ( -- DWORD ) - WSA_FLAG_OVERLAPPED ; - -: get-ConnectEx-ptr ( socket -- void* ) - SIO_GET_EXTENSION_FUNCTION_POINTER - WSAID_CONNECTEX - "GUID" heap-size - "void*" - [ - "void*" heap-size - "DWORD" - f - f - WSAIoctl SOCKET_ERROR = [ - winsock-error-string throw - ] when - ] keep *void* ; - -TUPLE: ConnectEx-args port - s name namelen lpSendBuffer dwSendDataLength - lpdwBytesSent lpOverlapped ptr ; - -: wait-for-socket ( args -- n ) - [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline - -: ( sockaddr size -- ConnectEx ) - ConnectEx-args new - swap >>namelen - swap >>name - f >>lpSendBuffer - 0 >>dwSendDataLength - f >>lpdwBytesSent - (make-overlapped) >>lpOverlapped ; inline - -: call-ConnectEx ( ConnectEx -- ) - { - [ s>> ] - [ name>> ] - [ namelen>> ] - [ lpSendBuffer>> ] - [ dwSendDataLength>> ] - [ lpdwBytesSent>> ] - [ lpOverlapped>> ] - [ ptr>> ] - } cleave - "int" - { "SOCKET" "sockaddr_in*" "int" "PVOID" "DWORD" "LPDWORD" "void*" } - "stdcall" alien-indirect drop - winsock-error-string [ throw ] when* ; inline - -M: object establish-connection ( client-out remote -- ) - make-sockaddr/size - swap >>port - dup port>> handle>> handle>> >>s - dup s>> get-ConnectEx-ptr >>ptr - dup call-ConnectEx - wait-for-socket drop ; - -TUPLE: AcceptEx-args port - sListenSocket sAcceptSocket lpOutputBuffer dwReceiveDataLength - dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ; - -: init-accept-buffer ( addr AcceptEx -- ) - swap sockaddr-size 16 + - [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi - dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer - drop ; inline - -: ( server addr -- AcceptEx ) - AcceptEx-args new - 2dup init-accept-buffer - swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket - over handle>> handle>> >>sListenSocket - swap >>port - 0 >>dwReceiveDataLength - f >>lpdwBytesReceived - (make-overlapped) >>lpOverlapped ; inline - -: call-AcceptEx ( AcceptEx -- ) - { - [ sListenSocket>> ] - [ sAcceptSocket>> ] - [ lpOutputBuffer>> ] - [ dwReceiveDataLength>> ] - [ dwLocalAddressLength>> ] - [ dwRemoteAddressLength>> ] - [ lpdwBytesReceived>> ] - [ lpOverlapped>> ] - } cleave AcceptEx drop - winsock-error-string [ throw ] when* ; inline - -: extract-remote-address ( AcceptEx -- sockaddr ) - { - [ lpOutputBuffer>> ] - [ dwReceiveDataLength>> ] - [ dwLocalAddressLength>> ] - [ dwRemoteAddressLength>> ] - } cleave - f - 0 - f - [ 0 GetAcceptExSockaddrs ] keep *void* ; inline - -M: object (accept) ( server addr -- handle sockaddr ) - [ - - { - [ call-AcceptEx ] - [ wait-for-socket drop ] - [ sAcceptSocket>> ] - [ extract-remote-address ] - } cleave - ] with-destructors ; - -TUPLE: WSARecvFrom-args port - s lpBuffers dwBufferCount lpNumberOfBytesRecvd - lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ; - -: make-receive-buffer ( -- WSABUF ) - "WSABUF" malloc-object &free - default-buffer-size get over set-WSABUF-len - default-buffer-size get malloc &free over set-WSABUF-buf ; inline - -: ( datagram -- WSARecvFrom ) - WSARecvFrom-args new - swap >>port - dup port>> handle>> handle>> >>s - dup port>> addr>> sockaddr-size - [ malloc &free >>lpFrom ] - [ malloc-int &free >>lpFromLen ] bi - make-receive-buffer >>lpBuffers - 1 >>dwBufferCount - 0 malloc-int &free >>lpFlags - 0 malloc-int &free >>lpNumberOfBytesRecvd - (make-overlapped) >>lpOverlapped ; inline - -: call-WSARecvFrom ( WSARecvFrom -- ) - { - [ s>> ] - [ lpBuffers>> ] - [ dwBufferCount>> ] - [ lpNumberOfBytesRecvd>> ] - [ lpFlags>> ] - [ lpFrom>> ] - [ lpFromLen>> ] - [ lpOverlapped>> ] - [ lpCompletionRoutine>> ] - } cleave WSARecvFrom socket-error* ; inline - -: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr ) - [ lpBuffers>> WSABUF-buf swap memory>byte-array ] - [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline - -M: winnt (receive) ( datagram -- packet addrspec ) - [ - - [ call-WSARecvFrom ] - [ wait-for-socket ] - [ parse-WSARecvFrom ] - tri - ] with-destructors ; - -TUPLE: WSASendTo-args port - s lpBuffers dwBufferCount lpNumberOfBytesSent - dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ; - -: make-send-buffer ( packet -- WSABUF ) - "WSABUF" malloc-object &free - [ [ malloc-byte-array &free ] dip set-WSABUF-buf ] - [ [ length ] dip set-WSABUF-len ] - [ nip ] - 2tri ; inline - -: ( packet addrspec datagram -- WSASendTo ) - WSASendTo-args new - swap >>port - dup port>> handle>> handle>> >>s - swap make-sockaddr/size - [ malloc-byte-array &free ] dip - [ >>lpTo ] [ >>iToLen ] bi* - swap make-send-buffer >>lpBuffers - 1 >>dwBufferCount - 0 >>dwFlags - 0 >>lpNumberOfBytesSent - (make-overlapped) >>lpOverlapped ; inline - -: call-WSASendTo ( WSASendTo -- ) - { - [ s>> ] - [ lpBuffers>> ] - [ dwBufferCount>> ] - [ lpNumberOfBytesSent>> ] - [ dwFlags>> ] - [ lpTo>> ] - [ iToLen>> ] - [ lpOverlapped>> ] - [ lpCompletionRoutine>> ] - } cleave WSASendTo socket-error* ; inline - -M: winnt (send) ( packet addrspec datagram -- ) - [ - - [ call-WSASendTo ] - [ wait-for-socket drop ] - bi - ] with-destructors ; diff --git a/basis/io/windows/nt/sockets/tags.txt b/basis/io/windows/nt/sockets/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/sockets/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/nt/summary.txt b/basis/io/windows/nt/summary.txt deleted file mode 100644 index 0e1b3e244f..0000000000 --- a/basis/io/windows/nt/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Microsoft Windows XP/Vista native I/O implementation diff --git a/basis/io/windows/nt/tags.txt b/basis/io/windows/nt/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/nt/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/privileges/privileges.factor b/basis/io/windows/privileges/privileges.factor deleted file mode 100644 index e169bdf12f..0000000000 --- a/basis/io/windows/privileges/privileges.factor +++ /dev/null @@ -1,14 +0,0 @@ -USING: io.backend kernel continuations sequences -system vocabs.loader combinators ; -IN: io.windows.privileges - -HOOK: set-privilege io-backend ( name ? -- ) inline - -: with-privileges ( seq quot -- ) - over [ [ t set-privilege ] each ] curry compose - swap [ [ f set-privilege ] each ] curry [ ] cleanup ; inline - -{ - { [ os winnt? ] [ "io.windows.nt.privileges" require ] } - { [ os wince? ] [ "io.windows.ce.privileges" require ] } -} cond diff --git a/basis/io/windows/privileges/tags.txt b/basis/io/windows/privileges/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/privileges/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/sockets/sockets.factor b/basis/io/windows/sockets/sockets.factor deleted file mode 100644 index 809af605e0..0000000000 --- a/basis/io/windows/sockets/sockets.factor +++ /dev/null @@ -1,61 +0,0 @@ -USING: kernel accessors io.sockets io.windows io.backend -windows.winsock system destructors alien.c-types ; -IN: io.windows.sockets - -HOOK: WSASocket-flags io-backend ( -- DWORD ) - -TUPLE: win32-socket < win32-file ; - -: ( handle -- win32-socket ) - win32-socket new-win32-handle ; - -M: win32-socket dispose ( stream -- ) - handle>> closesocket drop ; - -: unspecific-sockaddr/size ( addrspec -- sockaddr len ) - [ empty-sockaddr/size ] [ protocol-family ] bi - pick set-sockaddr-in-family ; - -: opened-socket ( handle -- win32-socket ) - |dispose dup add-completion ; - -: open-socket ( addrspec type -- win32-socket ) - [ protocol-family ] dip - 0 f 0 WSASocket-flags WSASocket - dup socket-error - opened-socket ; - -M: object (get-local-address) ( socket addrspec -- sockaddr ) - [ handle>> ] dip empty-sockaddr/size - [ getsockname socket-error ] 2keep drop ; - -M: object (get-remote-address) ( socket addrspec -- sockaddr ) - [ handle>> ] dip empty-sockaddr/size - [ getpeername socket-error ] 2keep drop ; - -: bind-socket ( win32-socket sockaddr len -- ) - [ handle>> ] 2dip bind socket-error ; - -M: object ((client)) ( addrspec -- handle ) - [ SOCK_STREAM open-socket ] keep - [ unspecific-sockaddr/size bind-socket ] [ drop ] 2bi ; - -: server-socket ( addrspec type -- fd ) - [ open-socket ] [ drop ] 2bi - [ make-sockaddr/size bind-socket ] [ drop ] 2bi ; - -! http://support.microsoft.com/kb/127144 -! NOTE: Possibly tweak this because of SYN flood attacks -: listen-backlog ( -- n ) HEX: 7fffffff ; inline - -M: object (server) ( addrspec -- handle ) - [ - SOCK_STREAM server-socket - dup handle>> listen-backlog listen winsock-return-check - ] with-destructors ; - -M: windows (datagram) ( addrspec -- handle ) - [ SOCK_DGRAM server-socket ] with-destructors ; - -M: windows addrinfo-error ( n -- ) - winsock-return-check ; diff --git a/basis/io/windows/sockets/tags.txt b/basis/io/windows/sockets/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/windows/sockets/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/summary.txt b/basis/io/windows/summary.txt deleted file mode 100644 index 2a2d5443b2..0000000000 --- a/basis/io/windows/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Microsoft Windows native I/O implementation diff --git a/basis/io/windows/tags.txt b/basis/io/windows/tags.txt deleted file mode 100755 index 6bf68304bb..0000000000 --- a/basis/io/windows/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/windows/windows.factor b/basis/io/windows/windows.factor deleted file mode 100755 index 94304edc05..0000000000 --- a/basis/io/windows/windows.factor +++ /dev/null @@ -1,54 +0,0 @@ -! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays destructors io io.backend -io.buffers io.files io.ports io.binary io.timeouts -windows.errors strings kernel math namespaces sequences windows -windows.kernel32 windows.shell32 windows.types windows.winsock -splitting continuations math.bitwise system accessors ; -IN: io.windows - -: set-inherit ( handle ? -- ) - [ HANDLE_FLAG_INHERIT ] dip - >BOOLEAN SetHandleInformation win32-error=0/f ; - -TUPLE: win32-handle handle disposed ; - -: new-win32-handle ( handle class -- win32-handle ) - new swap [ >>handle ] [ f set-inherit ] bi ; - -: ( handle -- win32-handle ) - win32-handle new-win32-handle ; - -M: win32-handle dispose* ( handle -- ) - handle>> CloseHandle drop ; - -TUPLE: win32-file < win32-handle ptr ; - -: ( handle -- win32-file ) - win32-file new-win32-handle ; - -M: win32-file dispose - dup disposed>> [ drop ] [ - [ cancel-operation ] [ call-next-method ] bi - ] if ; - -HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) -HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) -HOOK: add-completion io-backend ( port -- ) - -: opened-file ( handle -- win32-file ) - dup invalid-handle? - |dispose - dup add-completion ; - -: share-mode ( -- fixnum ) - { - FILE_SHARE_READ - FILE_SHARE_WRITE - FILE_SHARE_DELETE - } flags ; foldable - -: default-security-attributes ( -- obj ) - "SECURITY_ATTRIBUTES" - "SECURITY_ATTRIBUTES" heap-size - over set-SECURITY_ATTRIBUTES-nLength ; diff --git a/basis/lcs/diff2html/diff2html-tests.factor b/basis/lcs/diff2html/diff2html-tests.factor new file mode 100644 index 0000000000..0c2ed34f45 --- /dev/null +++ b/basis/lcs/diff2html/diff2html-tests.factor @@ -0,0 +1,6 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: lcs.diff2html lcs kernel tools.test strings sequences xml.writer ; +IN: lcs.diff2html.tests + +[ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml>string drop ] unit-test diff --git a/basis/lcs/diff2html/diff2html.factor b/basis/lcs/diff2html/diff2html.factor index b92eeb1250..ee303cc5a5 100644 --- a/basis/lcs/diff2html/diff2html.factor +++ b/basis/lcs/diff2html/diff2html.factor @@ -1,44 +1,42 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: lcs html.elements kernel qualified ; +USING: lcs xml.interpolate xml.writer kernel strings ; FROM: accessors => item>> ; FROM: io => write ; -FROM: sequences => each if-empty ; -FROM: xml.entities => escape-string ; +FROM: sequences => each if-empty when-empty map ; IN: lcs.diff2html -GENERIC: diff-line ( obj -- ) +GENERIC: diff-line ( obj -- xml ) -: write-item ( item -- ) - item>> [ " " ] [ escape-string ] if-empty write ; +: item-string ( item -- string ) + item>> [ CHAR: no-break-space 1string ] when-empty ; M: retain diff-line - - dup [ - - write-item - - ] bi@ - ; + item-string + [XML <-> XML] + dup [XML <-><-> XML] ; M: insert diff-line - - - - write-item - - ; + item-string [XML + + + <-> + + XML] ; M: delete diff-line - - - write-item - - - ; + item-string [XML + + <-> + + + XML] ; -: htmlize-diff ( diff -- ) - - - [ diff-line ] each -
"Old" write "New" write
; +: htmlize-diff ( diff -- xml ) + [ diff-line ] map + [XML + + + <-> +
OldNew
+ XML] ; diff --git a/basis/lcs/lcs.factor b/basis/lcs/lcs.factor index 759e923a34..8c67590697 100644 --- a/basis/lcs/lcs.factor +++ b/basis/lcs/lcs.factor @@ -5,7 +5,7 @@ IN: lcs r [ 1+ ] bi@ r> min min ; + 0 1 ? + [ [ 1+ ] bi@ ] dip min min ; : lcs-step ( insert delete change same? -- next ) 1 -1./0. ? + max max ; ! -1./0. is -inf (float) diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor index e681bac314..61aa323924 100644 --- a/basis/listener/listener-tests.factor +++ b/basis/listener/listener-tests.factor @@ -1,6 +1,6 @@ USING: io io.streams.string io.streams.duplex listener tools.test parser math namespaces continuations vocabs kernel -compiler.units eval ; +compiler.units eval vocabs.parser ; IN: listener.tests : hello "Hi" print ; parsing diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index f60403055e..88a90b72e2 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory namespaces parser lexer sequences strings io.styles vectors words generic system combinators continuations debugger definitions compiler.units accessors colors prettyprint fry -sets ; +sets vocabs.parser ; IN: listener GENERIC: stream-read-quot ( stream -- quot/f ) diff --git a/basis/locals/backend/backend.factor b/basis/locals/backend/backend.factor index ece5c1d200..1c1f288797 100644 --- a/basis/locals/backend/backend.factor +++ b/basis/locals/backend/backend.factor @@ -3,6 +3,6 @@ USING: slots.private ; IN: locals.backend -: local-value 2 slot ; inline +: local-value ( box -- value ) 2 slot ; inline -: set-local-value 2 set-slot ; inline +: set-local-value ( value box -- ) 2 set-slot ; inline diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 77b87d1b49..a4a9ca448b 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -113,7 +113,7 @@ HELP: MEMO:: { POSTPONE: MEMO: POSTPONE: MEMO:: } related-words -ARTICLE: "locals-literals" "Locals in array and hashtable literals" +ARTICLE: "locals-literals" "Locals in literals" "Certain data type literals are permitted to contain free variables. Any such literals are written into code which constructs an instance of the type with the free variable values spliced in. Conceptually, this is similar to the transformation applied to quotations containing free variables." $nl "The data types which receive this special handling are the following:" @@ -122,7 +122,9 @@ $nl { $link "hashtables" } { $link "vectors" } { $link "tuples" } + { $link "wrappers" } } +{ $heading "Object identity" } "This feature changes the semantics of literal object identity. An ordinary word containing a literal pushes the same literal on the stack every time it is invoked:" { $example "IN: scratchpad" @@ -134,6 +136,7 @@ $nl } "In a word with locals, literals expand into code which constructs the literal, and so every invocation pushes a new object:" { $example + "USE: locals" "IN: scratchpad" "TUPLE: person first-name last-name ;" ":: ordinary-word-test ( -- tuple )" @@ -142,7 +145,7 @@ $nl "f" } "One exception to the above rule is that array instances containing no free variables do retain identity. This allows macros such as " { $link cond } " to recognize that the array is constant and expand at compile-time." -$nl +{ $heading "Example" } "For example, here is an implementation of the " { $link 3array } " word which uses this feature:" { $code ":: 3array ( x y z -- array ) { x y z } ;" } ; @@ -166,7 +169,7 @@ $nl "Recall that the following two code snippets are equivalent:" { $code "'[ sq _ + ]" } { $code "[ [ sq ] dip + ] curry" } -"The semantics of " { $link dip } " and " { $link curry } " are such that the first example behaves as if the top of the stack as ``inserted'' in the ``hole'' in the quotation's second element." +"The semantics of " { $link dip } " and " { $link curry } " are such that the first example behaves as if the top of the stack as “inserted” in the “hole” in the quotation's second element." $nl "Conceptually, " { $link curry } " is defined so that the following two code snippets are equivalent:" { $code "3 [ - ] curry" } @@ -179,7 +182,7 @@ $nl { $code "'[ [| a | a - ] curry ] call" } "Instead, the first line above expands into something like the following:" { $code "[ [ swap [| a | a - ] ] curry call ]" } -"This ensures that the fried value appears ``underneath'' the local variable " { $snippet "a" } " when the quotation calls." +"This ensures that the fried value appears “underneath” the local variable " { $snippet "a" } " when the quotation calls." $nl "The precise behavior is the following. When frying a lambda, a stack shuffle (" { $link mnswap } ") is prepended to the lambda so that the " { $snippet "m" } " curried values, which start off at the top of the stack, are transposed with the " { $snippet "n" } " inputs to the lambda." ; diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index b5c201a5d9..bd9e7cf103 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel namespaces arrays strings prettyprint io.streams.string parser accessors generic eval combinators combinators.short-circuit combinators.short-circuit.smart math.order math.functions -definitions compiler.units fry lexer ; +definitions compiler.units fry lexer words.symbol ; IN: locals.tests :: foo ( a b -- a a ) a a ; @@ -490,4 +490,14 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ 10 ] [ [| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call -] unit-test \ No newline at end of file +] unit-test + +! Discovered by littledan +[ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test +[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test + +[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test + +[ { \ + 3 } ] [ [let | a [ 3 ] | { \ + a } ] ] unit-test + +[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] unit-test \ No newline at end of file diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index e6ab6c003c..f6baaf9ba7 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. +! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators effects.parser -generic.parser kernel lexer locals.errors +generic.parser kernel lexer locals.errors fry locals.rewrite.closures locals.types make namespaces parser -quotations sequences splitting words ; +quotations sequences splitting words vocabs.parser ; IN: locals.parser : make-local ( name -- word ) @@ -56,19 +56,21 @@ SYMBOL: in-lambda? (parse-bindings) ] [ 2drop ] if ; +: with-bindings ( quot -- words assoc ) + '[ + in-lambda? on + _ H{ } make-assoc + ] { } make swap ; inline + : parse-bindings ( end -- bindings vars ) - [ - [ (parse-bindings) ] H{ } make-assoc - ] { } make swap ; + [ (parse-bindings) ] with-bindings ; : parse-bindings* ( end -- words assoc ) [ - [ - namespace push-locals - (parse-bindings) - namespace pop-locals - ] { } make-assoc - ] { } make swap ; + namespace push-locals + (parse-bindings) + namespace pop-locals + ] with-bindings ; : (parse-wbindings) ( end -- ) dup parse-binding dup [ @@ -77,9 +79,7 @@ SYMBOL: in-lambda? ] [ 2drop ] if ; : parse-wbindings ( end -- bindings vars ) - [ - [ (parse-wbindings) ] H{ } make-assoc - ] { } make swap ; + [ (parse-wbindings) ] with-bindings ; : parse-locals ( -- vars assoc ) "(" expect ")" parse-effect @@ -88,8 +88,8 @@ SYMBOL: in-lambda? : parse-locals-definition ( word -- word quot ) parse-locals \ ; (parse-lambda) - 2dup "lambda" set-word-prop - rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ; + [ "lambda" set-word-prop ] + [ rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ] 2bi ; : (::) ( -- word def ) CREATE-WORD parse-locals-definition ; diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor index bd322bfff3..33e0f4d3b3 100644 --- a/basis/locals/rewrite/point-free/point-free.factor +++ b/basis/locals/rewrite/point-free/point-free.factor @@ -30,7 +30,10 @@ M: local-writer localize read-local-quot [ set-local-value ] append ; M: def localize - local>> [ prefix ] [ local-reader? [ 1array >r ] [ >r ] ? ] bi ; + local>> + [ prefix ] + [ local-reader? [ 1array load-local ] [ load-local ] ? ] + bi ; M: object localize 1quotation ; diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor index 05b1e2345e..515473c467 100644 --- a/basis/locals/rewrite/sugar/sugar.factor +++ b/basis/locals/rewrite/sugar/sugar.factor @@ -37,7 +37,7 @@ M: array rewrite-literal? [ rewrite-literal? ] contains? ; M: quotation rewrite-literal? [ rewrite-literal? ] contains? ; -M: wrapper rewrite-literal? drop t ; +M: wrapper rewrite-literal? wrapped>> rewrite-literal? ; M: hashtable rewrite-literal? drop t ; @@ -53,7 +53,7 @@ GENERIC: rewrite-element ( obj -- ) [ rewrite-element ] each ; : rewrite-sequence ( seq -- ) - [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ; + [ rewrite-elements ] [ length ] [ 0 head ] tri '[ _ _ nsequence ] % ; M: array rewrite-element dup rewrite-literal? [ rewrite-sequence ] [ , ] if ; @@ -63,7 +63,7 @@ M: vector rewrite-element rewrite-sequence ; M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ; M: tuple rewrite-element - [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ; + [ tuple-slots rewrite-elements ] [ class ] bi '[ _ boa ] % ; M: quotation rewrite-element rewrite-sugar* ; @@ -81,10 +81,14 @@ M: local-writer rewrite-element M: local-word rewrite-element local-word-in-literal-error ; -M: word rewrite-element literalize , ; +M: word rewrite-element , ; + +: rewrite-wrapper ( wrapper -- ) + dup rewrite-literal? + [ wrapped>> rewrite-element ] [ , ] if ; M: wrapper rewrite-element - dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ; + rewrite-wrapper \ , ; M: object rewrite-element , ; @@ -98,10 +102,11 @@ M: def rewrite-sugar* , ; M: hashtable rewrite-sugar* rewrite-element ; -M: wrapper rewrite-sugar* rewrite-element ; +M: wrapper rewrite-sugar* + rewrite-wrapper ; M: word rewrite-sugar* - dup { >r r> load-locals get-local drop-locals } memq? + dup { load-locals get-local drop-locals } memq? [ >r/r>-in-lambda-error ] [ call-next-method ] if ; M: object rewrite-sugar* , ; diff --git a/basis/locals/types/types.factor b/basis/locals/types/types.factor index 7a8dac1947..3ed753e094 100644 --- a/basis/locals/types/types.factor +++ b/basis/locals/types/types.factor @@ -1,6 +1,7 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. +! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators kernel sequences words ; +USING: accessors combinators kernel sequences words +quotations ; IN: locals.types TUPLE: lambda vars body ; @@ -38,6 +39,8 @@ PREDICATE: local < word "local?" word-prop ; f dup t "local?" set-word-prop ; +M: local literalize ; + PREDICATE: local-word < word "local-word?" word-prop ; : ( name -- word ) @@ -49,6 +52,8 @@ PREDICATE: local-reader < word "local-reader?" word-prop ; f dup t "local-reader?" set-word-prop ; +M: local-reader literalize ; + PREDICATE: local-writer < word "local-writer?" word-prop ; : ( reader -- word ) diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor index 7c1db5b7c0..91baae631f 100644 --- a/basis/logging/insomniac/insomniac.factor +++ b/basis/logging/insomniac/insomniac.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: logging.analysis logging.server logging smtp kernel io.files io.streams.string namespaces make alarms assocs -io.encodings.utf8 accessors calendar sequences qualified ; +io.encodings.utf8 accessors calendar sequences ; QUALIFIED: io.sockets IN: logging.insomniac diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 47de880559..6769932c88 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -4,7 +4,7 @@ USING: logging.server sequences namespaces concurrency.messaging words kernel arrays shuffle tools.annotations prettyprint.config prettyprint debugger io.streams.string splitting continuations effects generalizations parser strings -quotations fry symbols accessors ; +quotations fry accessors ; IN: logging SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ; @@ -61,7 +61,7 @@ PRIVATE> [ dup ] 2dip 2curry annotate ; : call-logging-quot ( quot word level -- quot' ) - "called" -rot [ log-message ] 3curry prepose ; + [ "called" ] 2dip [ log-message ] 3curry prepose ; : add-logging ( word level -- ) [ call-logging-quot ] (define-logging) ; diff --git a/basis/logging/parser/parser-docs.factor b/basis/logging/parser/parser-docs.factor index 76c7ab6c90..7ab1ad3883 100644 --- a/basis/logging/parser/parser-docs.factor +++ b/basis/logging/parser/parser-docs.factor @@ -13,7 +13,7 @@ HELP: parse-log } ; ARTICLE: "logging.parser" "Log file parser" -"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $link "logging.insomniac" } " to analyze logs." +"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $vocab-link "logging.insomniac" } " to analyze logs." $nl "There is only one primary entry point:" { $subsection parse-log } ; diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor index 1872bb0af2..618dba544c 100644 --- a/basis/logging/server/server.factor +++ b/basis/logging/server/server.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: namespaces kernel io calendar sequences io.files -io.sockets continuations destructors prettyprint assocs -math.parser words debugger math combinators -concurrency.messaging threads arrays init math.ranges strings -calendar.format io.encodings.utf8 ; +USING: namespaces kernel io io.files io.pathnames io.directories +io.sockets io.encodings.utf8 +calendar calendar.format sequences continuations destructors +prettyprint assocs math.parser words debugger math combinators +concurrency.messaging threads arrays init math.ranges strings ; IN: logging.server : log-root ( -- string ) @@ -28,7 +28,7 @@ SYMBOL: log-files : multiline-header ( -- string ) 20 CHAR: - ; foldable -: (write-message) ( msg name>> level multi? -- ) +: (write-message) ( msg word-name level multi? -- ) [ "[" write multiline-header write "] " write ] [ @@ -36,18 +36,19 @@ SYMBOL: log-files ] if write bl write ": " write print ; -: write-message ( msg name>> level -- ) - rot harvest { - { [ dup empty? ] [ 3drop ] } - { [ dup length 1 = ] [ first -rot f (write-message) ] } +: write-message ( msg word-name level -- ) + [ harvest ] 2dip { + { [ pick empty? ] [ 3drop ] } + { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] } [ - [ first -rot f (write-message) ] 3keep - rest -rot [ t (write-message) ] 2curry each + [ [ first ] 2dip f (write-message) ] + [ [ rest ] 2dip [ t (write-message) ] 2curry each ] + 3bi ] } cond ; : (log-message) ( msg -- ) - #! msg: { msg name>> level service } + #! msg: { msg word-name level service } first4 log-stream [ write-message flush ] with-output-stream* ; : try-dispose ( stream -- ) diff --git a/basis/match/match.factor b/basis/match/match.factor index 7d393dadc9..3846dea3be 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -47,7 +47,7 @@ MACRO: match-cond ( assoc -- ) [ "Fall-through in match-cond" throw ] [ first2 - >r [ dupd match ] curry r> + [ [ dupd match ] curry ] dip [ bind ] curry rot [ ?if ] 2curry append ] reduce ; @@ -80,7 +80,7 @@ MACRO: match-cond ( assoc -- ) (match-first) drop ; : (match-all) ( seq pattern-seq -- ) - tuck (match-first) swap + [ nip ] [ (match-first) swap ] 2bi [ , [ swap (match-all) ] [ drop ] if* ] [ 2drop ] if* ; diff --git a/basis/math/bitwise/bitwise-tests.factor b/basis/math/bitwise/bitwise-tests.factor index 979c62dcfb..40eb20642c 100644 --- a/basis/math/bitwise/bitwise-tests.factor +++ b/basis/math/bitwise/bitwise-tests.factor @@ -32,3 +32,7 @@ IN: math.bitwise.tests [ 8 ] [ 0 3 toggle-bit ] unit-test [ 0 ] [ 8 3 toggle-bit ] unit-test + +[ 4 ] [ BIN: 1010101 bit-count ] unit-test +[ 0 ] [ BIN: 0 bit-count ] unit-test +[ 1 ] [ BIN: 1 bit-count ] unit-test diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor old mode 100644 new mode 100755 index 89a21b65ab..e60815bf60 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.functions sequences sequences.private words namespaces macros hints -combinators fry io.binary ; +combinators fry io.binary combinators.smart ; IN: math.bitwise ! utilities @@ -66,19 +66,24 @@ DEFER: byte-bit-count \ byte-bit-count 256 [ 0 swap [ [ 1+ ] when ] each-bit -] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] define-inline +] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] +(( byte -- table )) define-declared + +\ byte-bit-count make-inline >> GENERIC: (bit-count) ( x -- n ) M: fixnum (bit-count) - { - [ byte-bit-count ] - [ -8 shift byte-bit-count ] - [ -16 shift byte-bit-count ] - [ -24 shift byte-bit-count ] - } cleave + + + ; + [ + { + [ byte-bit-count ] + [ -8 shift byte-bit-count ] + [ -16 shift byte-bit-count ] + [ -24 shift byte-bit-count ] + } cleave + ] sum-outputs ; M: bignum (bit-count) dup 0 = [ drop 0 ] [ diff --git a/basis/math/blas/cblas/authors.txt b/basis/math/blas/cblas/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/math/blas/cblas/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/math/blas/cblas/cblas.factor b/basis/math/blas/cblas/cblas.factor new file mode 100644 index 0000000000..4c0a88f929 --- /dev/null +++ b/basis/math/blas/cblas/cblas.factor @@ -0,0 +1,559 @@ +USING: alien alien.c-types alien.syntax kernel system combinators ; +IN: math.blas.cblas + +<< "cblas" { + { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] } + { [ os windows? ] [ "blas.dll" "cdecl" add-library ] } + { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] } + { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library ] } + [ "libblas.so" "cdecl" add-library ] +} cond >> + +LIBRARY: cblas + +TYPEDEF: int CBLAS_ORDER +: CblasRowMajor 101 ; inline +: CblasColMajor 102 ; inline + +TYPEDEF: int CBLAS_TRANSPOSE +: CblasNoTrans 111 ; inline +: CblasTrans 112 ; inline +: CblasConjTrans 113 ; inline + +TYPEDEF: int CBLAS_UPLO +: CblasUpper 121 ; inline +: CblasLower 122 ; inline + +TYPEDEF: int CBLAS_DIAG +: CblasNonUnit 131 ; inline +: CblasUnit 132 ; inline + +TYPEDEF: int CBLAS_SIDE +: CblasLeft 141 ; inline +: CblasRight 142 ; inline + +TYPEDEF: int CBLAS_INDEX + +C-STRUCT: float-complex + { "float" "real" } + { "float" "imag" } ; +C-STRUCT: double-complex + { "double" "real" } + { "double" "imag" } ; + +! Level 1 BLAS (scalar-vector and vector-vector) + +FUNCTION: float cblas_sdsdot + ( int N, float alpha, float* X, int incX, float* Y, int incY ) ; +FUNCTION: double cblas_dsdot + ( int N, float* X, int incX, float* Y, int incY ) ; +FUNCTION: float cblas_sdot + ( int N, float* X, int incX, float* Y, int incY ) ; +FUNCTION: double cblas_ddot + ( int N, double* X, int incX, double* Y, int incY ) ; + +FUNCTION: void cblas_cdotu_sub + ( int N, void* X, int incX, void* Y, int incY, void* dotu ) ; +FUNCTION: void cblas_cdotc_sub + ( int N, void* X, int incX, void* Y, int incY, void* dotc ) ; + +FUNCTION: void cblas_zdotu_sub + ( int N, void* X, int incX, void* Y, int incY, void* dotu ) ; +FUNCTION: void cblas_zdotc_sub + ( int N, void* X, int incX, void* Y, int incY, void* dotc ) ; + +FUNCTION: float cblas_snrm2 + ( int N, float* X, int incX ) ; +FUNCTION: float cblas_sasum + ( int N, float* X, int incX ) ; + +FUNCTION: double cblas_dnrm2 + ( int N, double* X, int incX ) ; +FUNCTION: double cblas_dasum + ( int N, double* X, int incX ) ; + +FUNCTION: float cblas_scnrm2 + ( int N, void* X, int incX ) ; +FUNCTION: float cblas_scasum + ( int N, void* X, int incX ) ; + +FUNCTION: double cblas_dznrm2 + ( int N, void* X, int incX ) ; +FUNCTION: double cblas_dzasum + ( int N, void* X, int incX ) ; + +FUNCTION: CBLAS_INDEX cblas_isamax + ( int N, float* X, int incX ) ; +FUNCTION: CBLAS_INDEX cblas_idamax + ( int N, double* X, int incX ) ; +FUNCTION: CBLAS_INDEX cblas_icamax + ( int N, void* X, int incX ) ; +FUNCTION: CBLAS_INDEX cblas_izamax + ( int N, void* X, int incX ) ; + +FUNCTION: void cblas_sswap + ( int N, float* X, int incX, float* Y, int incY ) ; +FUNCTION: void cblas_scopy + ( int N, float* X, int incX, float* Y, int incY ) ; +FUNCTION: void cblas_saxpy + ( int N, float alpha, float* X, int incX, float* Y, int incY ) ; + +FUNCTION: void cblas_dswap + ( int N, double* X, int incX, double* Y, int incY ) ; +FUNCTION: void cblas_dcopy + ( int N, double* X, int incX, double* Y, int incY ) ; +FUNCTION: void cblas_daxpy + ( int N, double alpha, double* X, int incX, double* Y, int incY ) ; + +FUNCTION: void cblas_cswap + ( int N, void* X, int incX, void* Y, int incY ) ; +FUNCTION: void cblas_ccopy + ( int N, void* X, int incX, void* Y, int incY ) ; +FUNCTION: void cblas_caxpy + ( int N, void* alpha, void* X, int incX, void* Y, int incY ) ; + +FUNCTION: void cblas_zswap + ( int N, void* X, int incX, void* Y, int incY ) ; +FUNCTION: void cblas_zcopy + ( int N, void* X, int incX, void* Y, int incY ) ; +FUNCTION: void cblas_zaxpy + ( int N, void* alpha, void* X, int incX, void* Y, int incY ) ; + +FUNCTION: void cblas_sscal + ( int N, float alpha, float* X, int incX ) ; +FUNCTION: void cblas_dscal + ( int N, double alpha, double* X, int incX ) ; +FUNCTION: void cblas_cscal + ( int N, void* alpha, void* X, int incX ) ; +FUNCTION: void cblas_zscal + ( int N, void* alpha, void* X, int incX ) ; +FUNCTION: void cblas_csscal + ( int N, float alpha, void* X, int incX ) ; +FUNCTION: void cblas_zdscal + ( int N, double alpha, void* X, int incX ) ; + +FUNCTION: void cblas_srotg + ( float* a, float* b, float* c, float* s ) ; +FUNCTION: void cblas_srotmg + ( float* d1, float* d2, float* b1, float b2, float* P ) ; +FUNCTION: void cblas_srot + ( int N, float* X, int incX, float* Y, int incY, float c, float s ) ; +FUNCTION: void cblas_srotm + ( int N, float* X, int incX, float* Y, int incY, float* P ) ; + +FUNCTION: void cblas_drotg + ( double* a, double* b, double* c, double* s ) ; +FUNCTION: void cblas_drotmg + ( double* d1, double* d2, double* b1, double b2, double* P ) ; +FUNCTION: void cblas_drot + ( int N, double* X, int incX, double* Y, int incY, double c, double s ) ; +FUNCTION: void cblas_drotm + ( int N, double* X, int incX, double* Y, int incY, double* P ) ; + +! Level 2 BLAS (matrix-vector) + +FUNCTION: void cblas_sgemv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + float alpha, float* A, int lda, + float* X, int incX, float beta, + float* Y, int incY ) ; +FUNCTION: void cblas_sgbmv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + int KL, int KU, float alpha, + float* A, int lda, float* X, + int incX, float beta, float* Y, int incY ) ; +FUNCTION: void cblas_strmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, float* A, int lda, + float* X, int incX ) ; +FUNCTION: void cblas_stbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, float* A, int lda, + float* X, int incX ) ; +FUNCTION: void cblas_stpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, float* Ap, float* X, int incX ) ; +FUNCTION: void cblas_strsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, float* A, int lda, float* X, + int incX ) ; +FUNCTION: void cblas_stbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, float* A, int lda, + float* X, int incX ) ; +FUNCTION: void cblas_stpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, float* Ap, float* X, int incX ) ; + +FUNCTION: void cblas_dgemv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + double alpha, double* A, int lda, + double* X, int incX, double beta, + double* Y, int incY ) ; +FUNCTION: void cblas_dgbmv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + int KL, int KU, double alpha, + double* A, int lda, double* X, + int incX, double beta, double* Y, int incY ) ; +FUNCTION: void cblas_dtrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, double* A, int lda, + double* X, int incX ) ; +FUNCTION: void cblas_dtbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, double* A, int lda, + double* X, int incX ) ; +FUNCTION: void cblas_dtpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, double* Ap, double* X, int incX ) ; +FUNCTION: void cblas_dtrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, double* A, int lda, double* X, + int incX ) ; +FUNCTION: void cblas_dtbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, double* A, int lda, + double* X, int incX ) ; +FUNCTION: void cblas_dtpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, double* Ap, double* X, int incX ) ; + +FUNCTION: void cblas_cgemv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + void* alpha, void* A, int lda, + void* X, int incX, void* beta, + void* Y, int incY ) ; +FUNCTION: void cblas_cgbmv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + int KL, int KU, void* alpha, + void* A, int lda, void* X, + int incX, void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_ctrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* A, int lda, + void* X, int incX ) ; +FUNCTION: void cblas_ctbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, void* A, int lda, + void* X, int incX ) ; +FUNCTION: void cblas_ctpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* Ap, void* X, int incX ) ; +FUNCTION: void cblas_ctrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* A, int lda, void* X, + int incX ) ; +FUNCTION: void cblas_ctbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, void* A, int lda, + void* X, int incX ) ; +FUNCTION: void cblas_ctpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* Ap, void* X, int incX ) ; + +FUNCTION: void cblas_zgemv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + void* alpha, void* A, int lda, + void* X, int incX, void* beta, + void* Y, int incY ) ; +FUNCTION: void cblas_zgbmv ( CBLAS_ORDER Order, + CBLAS_TRANSPOSE TransA, int M, int N, + int KL, int KU, void* alpha, + void* A, int lda, void* X, + int incX, void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_ztrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* A, int lda, + void* X, int incX ) ; +FUNCTION: void cblas_ztbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, void* A, int lda, + void* X, int incX ) ; +FUNCTION: void cblas_ztpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* Ap, void* X, int incX ) ; +FUNCTION: void cblas_ztrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* A, int lda, void* X, + int incX ) ; +FUNCTION: void cblas_ztbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, int K, void* A, int lda, + void* X, int incX ) ; +FUNCTION: void cblas_ztpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + int N, void* Ap, void* X, int incX ) ; + + +FUNCTION: void cblas_ssymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, float* A, + int lda, float* X, int incX, + float beta, float* Y, int incY ) ; +FUNCTION: void cblas_ssbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, int K, float alpha, float* A, + int lda, float* X, int incX, + float beta, float* Y, int incY ) ; +FUNCTION: void cblas_sspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, float* Ap, + float* X, int incX, + float beta, float* Y, int incY ) ; +FUNCTION: void cblas_sger ( CBLAS_ORDER Order, int M, int N, + float alpha, float* X, int incX, + float* Y, int incY, float* A, int lda ) ; +FUNCTION: void cblas_ssyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, float* X, + int incX, float* A, int lda ) ; +FUNCTION: void cblas_sspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, float* X, + int incX, float* Ap ) ; +FUNCTION: void cblas_ssyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, float* X, + int incX, float* Y, int incY, float* A, + int lda ) ; +FUNCTION: void cblas_sspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, float* X, + int incX, float* Y, int incY, float* A ) ; + +FUNCTION: void cblas_dsymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, double* A, + int lda, double* X, int incX, + double beta, double* Y, int incY ) ; +FUNCTION: void cblas_dsbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, int K, double alpha, double* A, + int lda, double* X, int incX, + double beta, double* Y, int incY ) ; +FUNCTION: void cblas_dspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, double* Ap, + double* X, int incX, + double beta, double* Y, int incY ) ; +FUNCTION: void cblas_dger ( CBLAS_ORDER Order, int M, int N, + double alpha, double* X, int incX, + double* Y, int incY, double* A, int lda ) ; +FUNCTION: void cblas_dsyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, double* X, + int incX, double* A, int lda ) ; +FUNCTION: void cblas_dspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, double* X, + int incX, double* Ap ) ; +FUNCTION: void cblas_dsyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, double* X, + int incX, double* Y, int incY, double* A, + int lda ) ; +FUNCTION: void cblas_dspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, double* X, + int incX, double* Y, int incY, double* A ) ; + + +FUNCTION: void cblas_chemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, void* alpha, void* A, + int lda, void* X, int incX, + void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_chbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, int K, void* alpha, void* A, + int lda, void* X, int incX, + void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_chpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, void* alpha, void* Ap, + void* X, int incX, + void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_cgeru ( CBLAS_ORDER Order, int M, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* A, int lda ) ; +FUNCTION: void cblas_cgerc ( CBLAS_ORDER Order, int M, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* A, int lda ) ; +FUNCTION: void cblas_cher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, void* X, int incX, + void* A, int lda ) ; +FUNCTION: void cblas_chpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, float alpha, void* X, + int incX, void* A ) ; +FUNCTION: void cblas_cher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* A, int lda ) ; +FUNCTION: void cblas_chpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* Ap ) ; + +FUNCTION: void cblas_zhemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, void* alpha, void* A, + int lda, void* X, int incX, + void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_zhbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, int K, void* alpha, void* A, + int lda, void* X, int incX, + void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_zhpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, void* alpha, void* Ap, + void* X, int incX, + void* beta, void* Y, int incY ) ; +FUNCTION: void cblas_zgeru ( CBLAS_ORDER Order, int M, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* A, int lda ) ; +FUNCTION: void cblas_zgerc ( CBLAS_ORDER Order, int M, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* A, int lda ) ; +FUNCTION: void cblas_zher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, void* X, int incX, + void* A, int lda ) ; +FUNCTION: void cblas_zhpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + int N, double alpha, void* X, + int incX, void* A ) ; +FUNCTION: void cblas_zher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* A, int lda ) ; +FUNCTION: void cblas_zhpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N, + void* alpha, void* X, int incX, + void* Y, int incY, void* Ap ) ; + +! Level 3 BLAS (matrix-matrix) + +FUNCTION: void cblas_sgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, int M, int N, + int K, float alpha, float* A, + int lda, float* B, int ldb, + float beta, float* C, int ldc ) ; +FUNCTION: void cblas_ssymm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, int M, int N, + float alpha, float* A, int lda, + float* B, int ldb, float beta, + float* C, int ldc ) ; +FUNCTION: void cblas_ssyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + float alpha, float* A, int lda, + float beta, float* C, int ldc ) ; +FUNCTION: void cblas_ssyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + float alpha, float* A, int lda, + float* B, int ldb, float beta, + float* C, int ldc ) ; +FUNCTION: void cblas_strmm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + float alpha, float* A, int lda, + float* B, int ldb ) ; +FUNCTION: void cblas_strsm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + float alpha, float* A, int lda, + float* B, int ldb ) ; + +FUNCTION: void cblas_dgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, int M, int N, + int K, double alpha, double* A, + int lda, double* B, int ldb, + double beta, double* C, int ldc ) ; +FUNCTION: void cblas_dsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, int M, int N, + double alpha, double* A, int lda, + double* B, int ldb, double beta, + double* C, int ldc ) ; +FUNCTION: void cblas_dsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + double alpha, double* A, int lda, + double beta, double* C, int ldc ) ; +FUNCTION: void cblas_dsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + double alpha, double* A, int lda, + double* B, int ldb, double beta, + double* C, int ldc ) ; +FUNCTION: void cblas_dtrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + double alpha, double* A, int lda, + double* B, int ldb ) ; +FUNCTION: void cblas_dtrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + double alpha, double* A, int lda, + double* B, int ldb ) ; + +FUNCTION: void cblas_cgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, int M, int N, + int K, void* alpha, void* A, + int lda, void* B, int ldb, + void* beta, void* C, int ldc ) ; +FUNCTION: void cblas_csymm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb, void* beta, + void* C, int ldc ) ; +FUNCTION: void cblas_csyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + void* alpha, void* A, int lda, + void* beta, void* C, int ldc ) ; +FUNCTION: void cblas_csyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + void* alpha, void* A, int lda, + void* B, int ldb, void* beta, + void* C, int ldc ) ; +FUNCTION: void cblas_ctrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb ) ; +FUNCTION: void cblas_ctrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb ) ; + +FUNCTION: void cblas_zgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, int M, int N, + int K, void* alpha, void* A, + int lda, void* B, int ldb, + void* beta, void* C, int ldc ) ; +FUNCTION: void cblas_zsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb, void* beta, + void* C, int ldc ) ; +FUNCTION: void cblas_zsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + void* alpha, void* A, int lda, + void* beta, void* C, int ldc ) ; +FUNCTION: void cblas_zsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + void* alpha, void* A, int lda, + void* B, int ldb, void* beta, + void* C, int ldc ) ; +FUNCTION: void cblas_ztrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb ) ; +FUNCTION: void cblas_ztrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb ) ; + +FUNCTION: void cblas_chemm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb, void* beta, + void* C, int ldc ) ; +FUNCTION: void cblas_cherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + float alpha, void* A, int lda, + float beta, void* C, int ldc ) ; +FUNCTION: void cblas_cher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + void* alpha, void* A, int lda, + void* B, int ldb, float beta, + void* C, int ldc ) ; +FUNCTION: void cblas_zhemm ( CBLAS_ORDER Order, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, int M, int N, + void* alpha, void* A, int lda, + void* B, int ldb, void* beta, + void* C, int ldc ) ; +FUNCTION: void cblas_zherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + double alpha, void* A, int lda, + double beta, void* C, int ldc ) ; +FUNCTION: void cblas_zher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, int N, int K, + void* alpha, void* A, int lda, + void* B, int ldb, double beta, + void* C, int ldc ) ; + diff --git a/basis/math/blas/cblas/summary.txt b/basis/math/blas/cblas/summary.txt new file mode 100644 index 0000000000..c72e78eb0d --- /dev/null +++ b/basis/math/blas/cblas/summary.txt @@ -0,0 +1 @@ +Low-level bindings to the C Basic Linear Algebra Subroutines (BLAS) library diff --git a/basis/math/blas/cblas/tags.txt b/basis/math/blas/cblas/tags.txt new file mode 100644 index 0000000000..241ec1ecda --- /dev/null +++ b/basis/math/blas/cblas/tags.txt @@ -0,0 +1,2 @@ +math +bindings diff --git a/basis/math/blas/matrices/authors.txt b/basis/math/blas/matrices/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/math/blas/matrices/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/math/blas/matrices/matrices-docs.factor b/basis/math/blas/matrices/matrices-docs.factor new file mode 100644 index 0000000000..01e0997405 --- /dev/null +++ b/basis/math/blas/matrices/matrices-docs.factor @@ -0,0 +1,245 @@ +USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings ; +IN: math.blas.matrices + +ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface" +"Factor provides an interface to high-performance vector and matrix math routines available in the system's BLAS library. A set of specialized types are provided for handling packed, unboxed vector data:" +{ $subsection "math.blas-types" } +"Scalar-vector and vector-vector operations are available in the " { $vocab-link "math.blas.vectors" } " vocabulary:" +{ $subsection "math.blas.vectors" } +"Vector-matrix and matrix-matrix operations are available in the " { $vocab-link "math.blas.matrices" } " vocabulary:" +{ $subsection "math.blas.matrices" } +"The low-level BLAS C interface can be accessed directly through the " { $vocab-link "math.blas.cblas" } " vocabulary." ; + +ARTICLE: "math.blas-types" "BLAS interface types" +"BLAS vectors come in single- and double-precision, real and complex flavors:" +{ $subsection float-blas-vector } +{ $subsection double-blas-vector } +{ $subsection float-complex-blas-vector } +{ $subsection double-complex-blas-vector } +"These vector types all follow the " { $link sequence } " protocol. In addition, there are corresponding types for matrix data:" +{ $subsection float-blas-matrix } +{ $subsection double-blas-matrix } +{ $subsection float-complex-blas-matrix } +{ $subsection double-complex-blas-matrix } +"Syntax words are provided for constructing literal vectors and matrices in the " { $vocab-link "math.blas.syntax" } " vocabulary:" +{ $subsection "math.blas.syntax" } +"There are BOA constructors for all vector and matrix types, which provide the most flexibility in specifying memory layout:" +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +"For the simple case of creating a dense, zero-filled vector or matrix, simple empty object constructors are provided:" +{ $subsection } +{ $subsection } +"BLAS vectors and matrices can also be constructed from other Factor sequences:" +{ $subsection >float-blas-vector } +{ $subsection >double-blas-vector } +{ $subsection >float-complex-blas-vector } +{ $subsection >double-complex-blas-vector } +{ $subsection >float-blas-matrix } +{ $subsection >double-blas-matrix } +{ $subsection >float-complex-blas-matrix } +{ $subsection >double-complex-blas-matrix } ; + +ARTICLE: "math.blas.matrices" "BLAS interface matrix operations" +"Transposing and slicing matrices:" +{ $subsection Mtranspose } +{ $subsection Mrows } +{ $subsection Mcols } +{ $subsection Msub } +"Matrix-vector products:" +{ $subsection n*M.V+n*V! } +{ $subsection n*M.V+n*V } +{ $subsection n*M.V } +{ $subsection M.V } +"Vector outer products:" +{ $subsection n*V(*)V+M! } +{ $subsection n*V(*)Vconj+M! } +{ $subsection n*V(*)V+M } +{ $subsection n*V(*)Vconj+M } +{ $subsection n*V(*)V } +{ $subsection n*V(*)Vconj } +{ $subsection V(*) } +{ $subsection V(*)conj } +"Matrix products:" +{ $subsection n*M.M+n*M! } +{ $subsection n*M.M+n*M } +{ $subsection n*M.M } +{ $subsection M. } +"Scalar-matrix products:" +{ $subsection n*M! } +{ $subsection n*M } +{ $subsection M*n } +{ $subsection M/n } ; + +ABOUT: "math.blas.matrices" + +HELP: blas-matrix-base +{ $class-description "The base class for all BLAS matrix types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:" +{ $list + { { $link float-blas-matrix } } + { { $link double-blas-matrix } } + { { $link float-complex-blas-matrix } } + { { $link double-complex-blas-matrix } } +} +"All of these subclasses share the same tuple layout:" +{ $list + { { $snippet "underlying" } " contains an alien pointer referencing or byte-array containing a packed, column-major array of float, double, float complex, or double complex values;" } + { { $snippet "ld" } " indicates the distance, in elements, between matrix columns;" } + { { $snippet "rows" } " and " { $snippet "cols" } " indicate the number of significant rows and columns in the matrix;" } + { "and " { $snippet "transpose" } ", if set to a true value, indicates that the matrix should be treated as transposed relative to its in-memory representation." } +} } ; + +{ blas-vector-base blas-matrix-base } related-words + +HELP: float-blas-matrix +{ $class-description "A matrix of single-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ; +HELP: double-blas-matrix +{ $class-description "A matrix of double-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ; +HELP: float-complex-blas-matrix +{ $class-description "A matrix of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ; +HELP: double-complex-blas-matrix +{ $class-description "A matrix of double-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ; + +{ + float-blas-matrix double-blas-matrix float-complex-blas-matrix double-complex-blas-matrix + float-blas-vector double-blas-vector float-complex-blas-vector double-complex-blas-vector +} related-words + +HELP: Mwidth +{ $values { "matrix" blas-matrix-base } { "width" integer } } +{ $description "Returns the number of columns in " { $snippet "matrix" } "." } ; + +HELP: Mheight +{ $values { "matrix" blas-matrix-base } { "height" integer } } +{ $description "Returns the number of rows in " { $snippet "matrix" } "." } ; + +{ Mwidth Mheight } related-words + +HELP: n*M.V+n*V! +{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "y=alpha*A.x+b*y" blas-vector-base } } +{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } ", and overwrite the current contents of " { $snippet "y" } " with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." } +{ $side-effects "y" } ; + +HELP: n*V(*)V+M! +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)y+A" blas-matrix-base } } +{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGER and xGERU routines in BLAS." } +{ $side-effects "A" } ; + +HELP: n*V(*)Vconj+M! +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)yconj+A" blas-matrix-base } } +{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGERC routines in BLAS." } +{ $side-effects "A" } ; + +HELP: n*M.M+n*M! +{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "C=alpha*A.B+beta*C" blas-matrix-base } } +{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } +{ $side-effects "C" } ; + +HELP: +{ $values { "rows" integer } { "cols" integer } { "exemplar" blas-vector-base blas-matrix-base } { "matrix" blas-matrix-base } } +{ $description "Create a matrix of all zeros with the given dimensions and the same element type as " { $snippet "exemplar" } "." } ; + +{ } related-words + +HELP: n*M.V+n*V +{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "alpha*A.x+b*y" blas-vector-base } } +{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". The returned vector will have the same length as " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." } ; + +HELP: n*V(*)V+M +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)y+A" blas-matrix-base } } +{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGER and xGERU routines in BLAS." } ; + +HELP: n*V(*)Vconj+M +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)yconj+A" blas-matrix-base } } +{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGERC routines in BLAS." } ; + +HELP: n*M.M+n*M +{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "alpha*A.B+beta*C" blas-matrix-base } } +{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } ; + +HELP: n*M.V +{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "alpha*A.x" blas-vector-base } } +{ $description "Calculate the matrix-vector product " { $snippet "αAx" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ; + +HELP: M.V +{ $values { "A" blas-matrix-base } { "x" blas-vector-base } { "A.x" blas-vector-base } } +{ $description "Calculate the matrix-vector product " { $snippet "Ax" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ; + +{ n*M.V+n*V! n*M.V+n*V n*M.V M.V } related-words + +HELP: n*V(*)V +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)y" blas-matrix-base } } +{ $description "Calculate the outer product " { $snippet "αx⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ; + +HELP: n*V(*)Vconj +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)yconj" blas-matrix-base } } +{ $description "Calculate the outer product " { $snippet "αx⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ; + +HELP: V(*) +{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)y" blas-matrix-base } } +{ $description "Calculate the outer product " { $snippet "x⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ; + +HELP: V(*)conj +{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)yconj" blas-matrix-base } } +{ $description "Calculate the conjugate outer product " { $snippet "x⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ; + +{ n*V(*)V+M! n*V(*)Vconj+M! n*V(*)V+M n*V(*)Vconj+M n*V(*)V n*V(*)Vconj V(*) V(*)conj V. V.conj } related-words + +HELP: n*M.M +{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "alpha*A.B" blas-matrix-base } } +{ $description "Calculate the matrix product " { $snippet "αAB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ; + +HELP: M. +{ $values { "A" blas-matrix-base } { "B" blas-matrix-base } { "A.B" blas-matrix-base } } +{ $description "Calculate the matrix product " { $snippet "AB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ; + +{ n*M.M+n*M! n*M.M+n*M n*M.M M. } related-words + +HELP: Msub +{ $values { "matrix" blas-matrix-base } { "row" integer } { "col" integer } { "height" integer } { "width" integer } { "sub" blas-matrix-base } } +{ $description "Select a rectangular submatrix of " { $snippet "matrix" } " with the given dimensions. The returned submatrix will share the parent matrix's storage." } ; + +HELP: Mrows +{ $values { "A" blas-matrix-base } { "rows" sequence } } +{ $description "Return a sequence of BLAS vectors representing the rows of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ; + +HELP: Mcols +{ $values { "A" blas-matrix-base } { "cols" sequence } } +{ $description "Return a sequence of BLAS vectors representing the columns of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ; + +HELP: n*M! +{ $values { "n" number } { "A" blas-matrix-base } { "A=n*A" blas-matrix-base } } +{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and overwrite the current contents of A with the result." } +{ $side-effects "A" } ; + +HELP: n*M +{ $values { "n" number } { "A" blas-matrix-base } { "n*A" blas-matrix-base } } +{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ; + +HELP: M*n +{ $values { "A" blas-matrix-base } { "n" number } { "A*n" blas-matrix-base } } +{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ; + +HELP: M/n +{ $values { "A" blas-matrix-base } { "n" number } { "A/n" blas-matrix-base } } +{ $description "Calculate the scalar-matrix product " { $snippet "(1/n)A" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ; + +{ n*M! n*M M*n M/n } related-words + +HELP: Mtranspose +{ $values { "matrix" blas-matrix-base } { "matrix^T" blas-matrix-base } } +{ $description "Returns the transpose of " { $snippet "matrix" } ". The returned matrix shares storage with the original matrix." } ; + +HELP: element-type +{ $values { "v" blas-vector-base blas-matrix-base } { "type" string } } +{ $description "Return the C type of the elements in the given BLAS vector or matrix." } ; + +HELP: +{ $values { "length" "The length of the new vector" } { "exemplar" blas-vector-base blas-matrix-base } { "vector" blas-vector-base } } +{ $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ; + diff --git a/basis/math/blas/matrices/matrices-tests.factor b/basis/math/blas/matrices/matrices-tests.factor new file mode 100644 index 0000000000..dabf3c3ee9 --- /dev/null +++ b/basis/math/blas/matrices/matrices-tests.factor @@ -0,0 +1,710 @@ +USING: kernel math.blas.matrices math.blas.vectors math.blas.syntax +sequences tools.test ; +IN: math.blas.matrices.tests + +! clone + +[ smatrix{ + { 1.0 2.0 3.0 } + { 4.0 5.0 6.0 } + { 7.0 8.0 9.0 } +} ] [ + smatrix{ + { 1.0 2.0 3.0 } + { 4.0 5.0 6.0 } + { 7.0 8.0 9.0 } + } clone +] unit-test +[ f ] [ + smatrix{ + { 1.0 2.0 3.0 } + { 4.0 5.0 6.0 } + { 7.0 8.0 9.0 } + } dup clone eq? +] unit-test + +[ dmatrix{ + { 1.0 2.0 3.0 } + { 4.0 5.0 6.0 } + { 7.0 8.0 9.0 } +} ] [ + dmatrix{ + { 1.0 2.0 3.0 } + { 4.0 5.0 6.0 } + { 7.0 8.0 9.0 } + } clone +] unit-test +[ f ] [ + dmatrix{ + { 1.0 2.0 3.0 } + { 4.0 5.0 6.0 } + { 7.0 8.0 9.0 } + } dup clone eq? +] unit-test + +[ cmatrix{ + { C{ 1.0 1.0 } 2.0 3.0 } + { 4.0 C{ 5.0 2.0 } 6.0 } + { 7.0 8.0 C{ 9.0 3.0 } } +} ] [ + cmatrix{ + { C{ 1.0 1.0 } 2.0 3.0 } + { 4.0 C{ 5.0 2.0 } 6.0 } + { 7.0 8.0 C{ 9.0 3.0 } } + } clone +] unit-test +[ f ] [ + cmatrix{ + { C{ 1.0 1.0 } 2.0 3.0 } + { 4.0 C{ 5.0 2.0 } 6.0 } + { 7.0 8.0 C{ 9.0 3.0 } } + } dup clone eq? +] unit-test + +[ zmatrix{ + { C{ 1.0 1.0 } 2.0 3.0 } + { 4.0 C{ 5.0 2.0 } 6.0 } + { 7.0 8.0 C{ 9.0 3.0 } } +} ] [ + zmatrix{ + { C{ 1.0 1.0 } 2.0 3.0 } + { 4.0 C{ 5.0 2.0 } 6.0 } + { 7.0 8.0 C{ 9.0 3.0 } } + } clone +] unit-test +[ f ] [ + zmatrix{ + { C{ 1.0 1.0 } 2.0 3.0 } + { 4.0 C{ 5.0 2.0 } 6.0 } + { 7.0 8.0 C{ 9.0 3.0 } } + } dup clone eq? +] unit-test + +! M.V + +[ svector{ 3.0 1.0 6.0 } ] [ + smatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 0.0 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } + svector{ 1.0 2.0 3.0 1.0 } + M.V +] unit-test +[ svector{ -2.0 1.0 3.0 14.0 } ] [ + smatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 0.0 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } Mtranspose + svector{ 1.0 2.0 3.0 } + M.V +] unit-test + +[ dvector{ 3.0 1.0 6.0 } ] [ + dmatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 0.0 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } + dvector{ 1.0 2.0 3.0 1.0 } + M.V +] unit-test +[ dvector{ -2.0 1.0 3.0 14.0 } ] [ + dmatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 0.0 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } Mtranspose + dvector{ 1.0 2.0 3.0 } + M.V +] unit-test + +[ cvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [ + cmatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 C{ 0.0 1.0 } 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } + cvector{ 1.0 2.0 3.0 1.0 } + M.V +] unit-test +[ cvector{ -2.0 C{ 1.0 2.0 } 3.0 14.0 } ] [ + cmatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 C{ 0.0 1.0 } 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } Mtranspose + cvector{ 1.0 2.0 3.0 } + M.V +] unit-test + +[ zvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [ + zmatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 C{ 0.0 1.0 } 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } + zvector{ 1.0 2.0 3.0 1.0 } + M.V +] unit-test +[ zvector{ -2.0 C{ 1.0 2.0 } 3.0 14.0 } ] [ + zmatrix{ + { 0.0 1.0 0.0 1.0 } + { -1.0 C{ 0.0 1.0 } 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + } Mtranspose + zvector{ 1.0 2.0 3.0 } + M.V +] unit-test + +! V(*) + +[ smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 4.0 6.0 8.0 } + { 3.0 6.0 9.0 12.0 } +} ] [ + svector{ 1.0 2.0 3.0 } svector{ 1.0 2.0 3.0 4.0 } V(*) +] unit-test + +[ dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 4.0 6.0 8.0 } + { 3.0 6.0 9.0 12.0 } +} ] [ + dvector{ 1.0 2.0 3.0 } dvector{ 1.0 2.0 3.0 4.0 } V(*) +] unit-test + +[ cmatrix{ + { 1.0 2.0 C{ 3.0 -3.0 } 4.0 } + { 2.0 4.0 C{ 6.0 -6.0 } 8.0 } + { C{ 3.0 3.0 } C{ 6.0 6.0 } 18.0 C{ 12.0 12.0 } } +} ] [ + cvector{ 1.0 2.0 C{ 3.0 3.0 } } cvector{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 } V(*) +] unit-test + +[ zmatrix{ + { 1.0 2.0 C{ 3.0 -3.0 } 4.0 } + { 2.0 4.0 C{ 6.0 -6.0 } 8.0 } + { C{ 3.0 3.0 } C{ 6.0 6.0 } 18.0 C{ 12.0 12.0 } } +} ] [ + zvector{ 1.0 2.0 C{ 3.0 3.0 } } zvector{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 } V(*) +] unit-test + +! M. + +[ smatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 0.0 -3.0 0.0 0.0 } + { 0.0 4.0 0.0 0.0 10.0 } + { 0.0 0.0 0.0 0.0 0.0 } +} ] [ + smatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } smatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 2.0 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } M. +] unit-test + +[ smatrix{ + { 1.0 0.0 0.0 0.0 } + { 0.0 0.0 4.0 0.0 } + { 0.0 -3.0 0.0 0.0 } + { 4.0 0.0 0.0 0.0 } + { 0.0 0.0 10.0 0.0 } +} ] [ + smatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 2.0 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } Mtranspose smatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } Mtranspose M. +] unit-test + +[ dmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 0.0 -3.0 0.0 0.0 } + { 0.0 4.0 0.0 0.0 10.0 } + { 0.0 0.0 0.0 0.0 0.0 } +} ] [ + dmatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } dmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 2.0 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } M. +] unit-test + +[ dmatrix{ + { 1.0 0.0 0.0 0.0 } + { 0.0 0.0 4.0 0.0 } + { 0.0 -3.0 0.0 0.0 } + { 4.0 0.0 0.0 0.0 } + { 0.0 0.0 10.0 0.0 } +} ] [ + dmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 2.0 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } Mtranspose dmatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } Mtranspose M. +] unit-test + +[ cmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 0.0 -3.0 0.0 0.0 } + { 0.0 C{ 4.0 -4.0 } 0.0 0.0 10.0 } + { 0.0 0.0 0.0 0.0 0.0 } +} ] [ + cmatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } cmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } M. +] unit-test + +[ cmatrix{ + { 1.0 0.0 0.0 0.0 } + { 0.0 0.0 C{ 4.0 -4.0 } 0.0 } + { 0.0 -3.0 0.0 0.0 } + { 4.0 0.0 0.0 0.0 } + { 0.0 0.0 10.0 0.0 } +} ] [ + cmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } Mtranspose cmatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } Mtranspose M. +] unit-test + +[ zmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 0.0 -3.0 0.0 0.0 } + { 0.0 C{ 4.0 -4.0 } 0.0 0.0 10.0 } + { 0.0 0.0 0.0 0.0 0.0 } +} ] [ + zmatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } zmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } M. +] unit-test + +[ zmatrix{ + { 1.0 0.0 0.0 0.0 } + { 0.0 0.0 C{ 4.0 -4.0 } 0.0 } + { 0.0 -3.0 0.0 0.0 } + { 4.0 0.0 0.0 0.0 } + { 0.0 0.0 10.0 0.0 } +} ] [ + zmatrix{ + { 1.0 0.0 0.0 4.0 0.0 } + { 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 } + { 0.0 0.0 3.0 0.0 0.0 } + } Mtranspose zmatrix{ + { 1.0 0.0 0.0 } + { 0.0 0.0 -1.0 } + { 0.0 2.0 0.0 } + { 0.0 0.0 0.0 } + } Mtranspose M. +] unit-test + +! n*M + +[ smatrix{ + { 2.0 0.0 } + { 0.0 2.0 } +} ] [ + 2.0 smatrix{ + { 1.0 0.0 } + { 0.0 1.0 } + } n*M +] unit-test + +[ dmatrix{ + { 2.0 0.0 } + { 0.0 2.0 } +} ] [ + 2.0 dmatrix{ + { 1.0 0.0 } + { 0.0 1.0 } + } n*M +] unit-test + +[ cmatrix{ + { C{ 2.0 1.0 } 0.0 } + { 0.0 C{ -1.0 2.0 } } +} ] [ + C{ 2.0 1.0 } cmatrix{ + { 1.0 0.0 } + { 0.0 C{ 0.0 1.0 } } + } n*M +] unit-test + +[ zmatrix{ + { C{ 2.0 1.0 } 0.0 } + { 0.0 C{ -1.0 2.0 } } +} ] [ + C{ 2.0 1.0 } zmatrix{ + { 1.0 0.0 } + { 0.0 C{ 0.0 1.0 } } + } n*M +] unit-test + +! Mrows, Mcols + +[ svector{ 3.0 3.0 3.0 } ] [ + 2 smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mcols nth +] unit-test +[ svector{ 3.0 2.0 3.0 4.0 } ] [ + 2 smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mrows nth +] unit-test +[ 3 ] [ + smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mrows length +] unit-test +[ 4 ] [ + smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mcols length +] unit-test +[ svector{ 3.0 3.0 3.0 } ] [ + 2 smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mrows nth +] unit-test +[ svector{ 3.0 2.0 3.0 4.0 } ] [ + 2 smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mcols nth +] unit-test +[ 3 ] [ + smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mcols length +] unit-test +[ 4 ] [ + smatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mrows length +] unit-test + +[ dvector{ 3.0 3.0 3.0 } ] [ + 2 dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mcols nth +] unit-test +[ dvector{ 3.0 2.0 3.0 4.0 } ] [ + 2 dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mrows nth +] unit-test +[ 3 ] [ + dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mrows length +] unit-test +[ 4 ] [ + dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mcols length +] unit-test +[ dvector{ 3.0 3.0 3.0 } ] [ + 2 dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mrows nth +] unit-test +[ dvector{ 3.0 2.0 3.0 4.0 } ] [ + 2 dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mcols nth +] unit-test +[ 3 ] [ + dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mcols length +] unit-test +[ 4 ] [ + dmatrix{ + { 1.0 2.0 3.0 4.0 } + { 2.0 2.0 3.0 4.0 } + { 3.0 2.0 3.0 4.0 } + } Mtranspose Mrows length +] unit-test + +[ cvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [ + 2 cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mcols nth +] unit-test +[ cvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [ + 2 cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mrows nth +] unit-test +[ 3 ] [ + cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mrows length +] unit-test +[ 4 ] [ + cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mcols length +] unit-test +[ cvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [ + 2 cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mrows nth +] unit-test +[ cvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [ + 2 cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mcols nth +] unit-test +[ 3 ] [ + cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mcols length +] unit-test +[ 4 ] [ + cmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mrows length +] unit-test + +[ zvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [ + 2 zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mcols nth +] unit-test +[ zvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [ + 2 zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mrows nth +] unit-test +[ 3 ] [ + zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mrows length +] unit-test +[ 4 ] [ + zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mcols length +] unit-test +[ zvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [ + 2 zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mrows nth +] unit-test +[ zvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [ + 2 zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mcols nth +] unit-test +[ 3 ] [ + zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mcols length +] unit-test +[ 4 ] [ + zmatrix{ + { C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } } + { C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } } + { C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } + } Mtranspose Mrows length +] unit-test + +! Msub + +[ smatrix{ + { 3.0 2.0 1.0 } + { 0.0 1.0 0.0 } +} ] [ + smatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 3.0 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } 1 2 2 3 Msub +] unit-test + +[ smatrix{ + { 3.0 0.0 } + { 2.0 1.0 } + { 1.0 0.0 } +} ] [ + smatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 3.0 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } Mtranspose 2 1 3 2 Msub +] unit-test + +[ dmatrix{ + { 3.0 2.0 1.0 } + { 0.0 1.0 0.0 } +} ] [ + dmatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 3.0 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } 1 2 2 3 Msub +] unit-test + +[ dmatrix{ + { 3.0 0.0 } + { 2.0 1.0 } + { 1.0 0.0 } +} ] [ + dmatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 3.0 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } Mtranspose 2 1 3 2 Msub +] unit-test + +[ cmatrix{ + { C{ 3.0 3.0 } 2.0 1.0 } + { 0.0 1.0 0.0 } +} ] [ + cmatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } 1 2 2 3 Msub +] unit-test + +[ cmatrix{ + { C{ 3.0 3.0 } 0.0 } + { 2.0 1.0 } + { 1.0 0.0 } +} ] [ + cmatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } Mtranspose 2 1 3 2 Msub +] unit-test + +[ zmatrix{ + { C{ 3.0 3.0 } 2.0 1.0 } + { 0.0 1.0 0.0 } +} ] [ + zmatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } 1 2 2 3 Msub +] unit-test + +[ zmatrix{ + { C{ 3.0 3.0 } 0.0 } + { 2.0 1.0 } + { 1.0 0.0 } +} ] [ + zmatrix{ + { 0.0 1.0 2.0 3.0 2.0 } + { 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 } + { 2.0 3.0 0.0 1.0 0.0 } + } Mtranspose 2 1 3 2 Msub +] unit-test + diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor new file mode 100755 index 0000000000..f6b98e3ae2 --- /dev/null +++ b/basis/math/blas/matrices/matrices.factor @@ -0,0 +1,307 @@ +USING: accessors alien alien.c-types arrays byte-arrays combinators +combinators.short-circuit fry kernel locals macros +math math.blas.cblas math.blas.vectors math.blas.vectors.private +math.complex math.functions math.order functors words +sequences sequences.merged sequences.private shuffle +specialized-arrays.direct.float specialized-arrays.direct.double +specialized-arrays.float specialized-arrays.double ; +IN: math.blas.matrices + +TUPLE: blas-matrix-base underlying ld rows cols transpose ; + +: Mtransposed? ( matrix -- ? ) + transpose>> ; inline +: Mwidth ( matrix -- width ) + dup Mtransposed? [ rows>> ] [ cols>> ] if ; inline +: Mheight ( matrix -- height ) + dup Mtransposed? [ cols>> ] [ rows>> ] if ; inline + +GENERIC: n*M.V+n*V! ( alpha A x beta y -- y=alpha*A.x+b*y ) +GENERIC: n*V(*)V+M! ( alpha x y A -- A=alpha*x(*)y+A ) +GENERIC: n*V(*)Vconj+M! ( alpha x y A -- A=alpha*x(*)yconj+A ) +GENERIC: n*M.M+n*M! ( alpha A B beta C -- C=alpha*A.B+beta*C ) + +> [ CblasTrans ] [ CblasNoTrans ] if ; + +GENERIC: (blas-matrix-like) ( data ld rows cols transpose exemplar -- matrix ) + +: (validate-gemv) ( A x y -- ) + { + [ drop [ Mwidth ] [ length>> ] bi* = ] + [ nip [ Mheight ] [ length>> ] bi* = ] + } 3&& + [ "Mismatched matrix and vectors in matrix-vector multiplication" throw ] + unless ; + +:: (prepare-gemv) + ( alpha A x beta y >c-arg -- order A-trans m n alpha A-data A-ld x-data x-inc beta y-data y-inc + y ) + A x y (validate-gemv) + CblasColMajor + A (blas-transpose) + A rows>> + A cols>> + alpha >c-arg call + A underlying>> + A ld>> + x underlying>> + x inc>> + beta >c-arg call + y underlying>> + y inc>> + y ; inline + +: (validate-ger) ( x y A -- ) + { + [ nip [ length>> ] [ Mheight ] bi* = ] + [ nipd [ length>> ] [ Mwidth ] bi* = ] + } 3&& + [ "Mismatched vertices and matrix in vector outer product" throw ] + unless ; + +:: (prepare-ger) + ( alpha x y A >c-arg -- order m n alpha x-data x-inc y-data y-inc A-data A-ld + A ) + x y A (validate-ger) + CblasColMajor + A rows>> + A cols>> + alpha >c-arg call + x underlying>> + x inc>> + y underlying>> + y inc>> + A underlying>> + A ld>> + A f >>transpose ; inline + +: (validate-gemm) ( A B C -- ) + { + [ drop [ Mwidth ] [ Mheight ] bi* = ] + [ nip [ Mheight ] bi@ = ] + [ nipd [ Mwidth ] bi@ = ] + } 3&& + [ "Mismatched matrices in matrix multiplication" throw ] + unless ; + +:: (prepare-gemm) + ( alpha A B beta C >c-arg -- order A-trans B-trans m n k alpha A-data A-ld B-data B-ld beta C-data C-ld + C ) + A B C (validate-gemm) + CblasColMajor + A (blas-transpose) + B (blas-transpose) + C rows>> + C cols>> + A Mwidth + alpha >c-arg call + A underlying>> + A ld>> + B underlying>> + B ld>> + beta >c-arg call + C underlying>> + C ld>> + C f >>transpose ; inline + +: (>matrix) ( arrays >c-array -- c-array ld rows cols transpose ) + '[ @ ] [ length dup ] [ first length ] tri f ; inline + +PRIVATE> + +! XXX should do a dense clone +M: blas-matrix-base clone + [ + [ { + [ underlying>> ] + [ ld>> ] + [ cols>> ] + [ element-type heap-size ] + } cleave * * memory>byte-array ] + [ { + [ ld>> ] + [ rows>> ] + [ cols>> ] + [ transpose>> ] + } cleave ] + bi + ] keep (blas-matrix-like) ; + +! XXX try rounding stride to next 128 bit bound for better vectorizin' +: ( rows cols exemplar -- matrix ) + [ element-type [ * ] dip ] + [ 2drop ] + [ f swap (blas-matrix-like) ] 3tri ; + +: n*M.V+n*V ( alpha A x beta y -- alpha*A.x+b*y ) + clone n*M.V+n*V! ; +: n*V(*)V+M ( alpha x y A -- alpha*x(*)y+A ) + clone n*V(*)V+M! ; +: n*V(*)Vconj+M ( alpha x y A -- alpha*x(*)yconj+A ) + clone n*V(*)Vconj+M! ; +: n*M.M+n*M ( alpha A B beta C -- alpha*A.B+beta*C ) + clone n*M.M+n*M! ; + +: n*M.V ( alpha A x -- alpha*A.x ) + 1.0 2over [ Mheight ] dip + n*M.V+n*V! ; inline + +: M.V ( A x -- A.x ) + 1.0 -rot n*M.V ; inline + +: n*V(*)V ( alpha x y -- alpha*x(*)y ) + 2dup [ length>> ] bi@ pick + n*V(*)V+M! ; +: n*V(*)Vconj ( alpha x y -- alpha*x(*)yconj ) + 2dup [ length>> ] bi@ pick + n*V(*)Vconj+M! ; + +: V(*) ( x y -- x(*)y ) + 1.0 -rot n*V(*)V ; inline +: V(*)conj ( x y -- x(*)yconj ) + 1.0 -rot n*V(*)Vconj ; inline + +: n*M.M ( alpha A B -- alpha*A.B ) + 2dup [ Mheight ] [ Mwidth ] bi* pick + 1.0 swap n*M.M+n*M! ; + +: M. ( A B -- A.B ) + 1.0 -rot n*M.M ; inline + +:: (Msub) ( matrix row col height width -- data ld rows cols ) + matrix ld>> col * row + matrix element-type heap-size * + matrix underlying>> + matrix ld>> + height + width ; + +:: Msub ( matrix row col height width -- sub ) + matrix dup transpose>> + [ col row width height ] + [ row col height width ] if (Msub) + matrix transpose>> matrix (blas-matrix-like) ; + +TUPLE: blas-matrix-rowcol-sequence + parent inc rowcol-length rowcol-jump length ; +C: blas-matrix-rowcol-sequence + +INSTANCE: blas-matrix-rowcol-sequence sequence + +M: blas-matrix-rowcol-sequence length + length>> ; +M: blas-matrix-rowcol-sequence nth-unsafe + { + [ + [ rowcol-jump>> ] + [ parent>> element-type heap-size ] + [ parent>> underlying>> ] tri + [ * * ] dip + ] + [ rowcol-length>> ] + [ inc>> ] + [ parent>> ] + } cleave (blas-vector-like) ; + +: (Mcols) ( A -- columns ) + { [ ] [ drop 1 ] [ rows>> ] [ ld>> ] [ cols>> ] } + cleave ; +: (Mrows) ( A -- rows ) + { [ ] [ ld>> ] [ cols>> ] [ drop 1 ] [ rows>> ] } + cleave ; + +: Mrows ( A -- rows ) + dup transpose>> [ (Mcols) ] [ (Mrows) ] if ; +: Mcols ( A -- cols ) + dup transpose>> [ (Mrows) ] [ (Mcols) ] if ; + +: n*M! ( n A -- A=n*A ) + [ (Mcols) [ n*V! drop ] with each ] keep ; + +: n*M ( n A -- n*A ) + clone n*M! ; inline + +: M*n ( A n -- A*n ) + swap n*M ; inline +: M/n ( A n -- A/n ) + recip swap n*M ; inline + +: Mtranspose ( matrix -- matrix^T ) + [ { + [ underlying>> ] + [ ld>> ] [ rows>> ] + [ cols>> ] + [ transpose>> not ] + } cleave ] keep (blas-matrix-like) ; + +M: blas-matrix-base equal? + { + [ [ Mwidth ] bi@ = ] + [ [ Mcols ] bi@ [ = ] 2all? ] + } 2&& ; + +<< + +FUNCTOR: (define-blas-matrix) ( TYPE T U C -- ) + +VECTOR IS ${TYPE}-blas-vector + IS <${TYPE}-blas-vector> +>ARRAY IS >${TYPE}-array +TYPE>ARG IS ${TYPE}>arg +XGEMV IS cblas_${T}gemv +XGEMM IS cblas_${T}gemm +XGERU IS cblas_${T}ger${U} +XGERC IS cblas_${T}ger${C} + +MATRIX DEFINES ${TYPE}-blas-matrix + DEFINES <${TYPE}-blas-matrix> +>MATRIX DEFINES >${TYPE}-blas-matrix + +WHERE + +TUPLE: MATRIX < blas-matrix-base ; +: ( underlying ld rows cols transpose -- matrix ) + MATRIX boa ; inline + +M: MATRIX element-type + drop TYPE ; +M: MATRIX (blas-matrix-like) + drop ; +M: VECTOR (blas-matrix-like) + drop ; +M: MATRIX (blas-vector-like) + drop ; + +: >MATRIX ( arrays -- matrix ) + [ >ARRAY underlying>> ] (>matrix) + ; + +M: VECTOR n*M.V+n*V! + [ TYPE>ARG ] (prepare-gemv) + [ XGEMV ] dip ; +M: MATRIX n*M.M+n*M! + [ TYPE>ARG ] (prepare-gemm) + [ XGEMM ] dip ; +M: MATRIX n*V(*)V+M! + [ TYPE>ARG ] (prepare-ger) + [ XGERU ] dip ; +M: MATRIX n*V(*)Vconj+M! + [ TYPE>ARG ] (prepare-ger) + [ XGERC ] dip ; + +;FUNCTOR + + +: define-real-blas-matrix ( TYPE T -- ) + "" "" (define-blas-matrix) ; +: define-complex-blas-matrix ( TYPE T -- ) + "u" "c" (define-blas-matrix) ; + +"float" "s" define-real-blas-matrix +"double" "d" define-real-blas-matrix +"float-complex" "c" define-complex-blas-matrix +"double-complex" "z" define-complex-blas-matrix + +>> diff --git a/basis/math/blas/matrices/summary.txt b/basis/math/blas/matrices/summary.txt new file mode 100644 index 0000000000..4cc5684789 --- /dev/null +++ b/basis/math/blas/matrices/summary.txt @@ -0,0 +1 @@ +BLAS level 2 and 3 matrix-vector and matrix-matrix operations diff --git a/basis/math/blas/matrices/tags.txt b/basis/math/blas/matrices/tags.txt new file mode 100644 index 0000000000..241ec1ecda --- /dev/null +++ b/basis/math/blas/matrices/tags.txt @@ -0,0 +1,2 @@ +math +bindings diff --git a/basis/math/blas/syntax/authors.txt b/basis/math/blas/syntax/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/math/blas/syntax/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/math/blas/syntax/summary.txt b/basis/math/blas/syntax/summary.txt new file mode 100644 index 0000000000..a71bebb50f --- /dev/null +++ b/basis/math/blas/syntax/summary.txt @@ -0,0 +1 @@ +Literal syntax for BLAS vectors and matrices diff --git a/basis/math/blas/syntax/syntax-docs.factor b/basis/math/blas/syntax/syntax-docs.factor new file mode 100644 index 0000000000..6b58df738a --- /dev/null +++ b/basis/math/blas/syntax/syntax-docs.factor @@ -0,0 +1,78 @@ +USING: help.markup help.syntax math.blas.matrices math.blas.vectors multiline ; +IN: math.blas.syntax + +ARTICLE: "math.blas.syntax" "BLAS interface literal syntax" +"Vectors:" +{ $subsection POSTPONE: svector{ } +{ $subsection POSTPONE: dvector{ } +{ $subsection POSTPONE: cvector{ } +{ $subsection POSTPONE: zvector{ } +"Matrices:" +{ $subsection POSTPONE: smatrix{ } +{ $subsection POSTPONE: dmatrix{ } +{ $subsection POSTPONE: cmatrix{ } +{ $subsection POSTPONE: zmatrix{ } ; + +ABOUT: "math.blas.syntax" + +HELP: svector{ +{ $syntax "svector{ 1.0 -2.0 3.0 }" } +{ $description "Construct a literal " { $link float-blas-vector } "." } ; + +HELP: dvector{ +{ $syntax "dvector{ 1.0 -2.0 3.0 }" } +{ $description "Construct a literal " { $link double-blas-vector } "." } ; + +HELP: cvector{ +{ $syntax "cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" } +{ $description "Construct a literal " { $link float-complex-blas-vector } "." } ; + +HELP: zvector{ +{ $syntax "dvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" } +{ $description "Construct a literal " { $link double-complex-blas-vector } "." } ; + +{ + POSTPONE: svector{ POSTPONE: dvector{ + POSTPONE: cvector{ POSTPONE: zvector{ +} related-words + +HELP: smatrix{ +{ $syntax <" smatrix{ + { 1.0 0.0 0.0 1.0 } + { 0.0 1.0 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + { 0.0 0.0 0.0 1.0 } +} "> } +{ $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; + +HELP: dmatrix{ +{ $syntax <" dmatrix{ + { 1.0 0.0 0.0 1.0 } + { 0.0 1.0 0.0 2.0 } + { 0.0 0.0 1.0 3.0 } + { 0.0 0.0 0.0 1.0 } +} "> } +{ $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; + +HELP: cmatrix{ +{ $syntax <" cmatrix{ + { 1.0 0.0 0.0 1.0 } + { 0.0 C{ 0.0 1.0 } 0.0 2.0 } + { 0.0 0.0 -1.0 3.0 } + { 0.0 0.0 0.0 C{ 0.0 -1.0 } } +} "> } +{ $description "Construct a literal " { $link float-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; + +HELP: zmatrix{ +{ $syntax <" zmatrix{ + { 1.0 0.0 0.0 1.0 } + { 0.0 C{ 0.0 1.0 } 0.0 2.0 } + { 0.0 0.0 -1.0 3.0 } + { 0.0 0.0 0.0 C{ 0.0 -1.0 } } +} "> } +{ $description "Construct a literal " { $link double-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; + +{ + POSTPONE: smatrix{ POSTPONE: dmatrix{ + POSTPONE: cmatrix{ POSTPONE: zmatrix{ +} related-words diff --git a/basis/math/blas/syntax/syntax.factor b/basis/math/blas/syntax/syntax.factor new file mode 100644 index 0000000000..2d171a801b --- /dev/null +++ b/basis/math/blas/syntax/syntax.factor @@ -0,0 +1,44 @@ +USING: kernel math.blas.vectors math.blas.matrices parser +arrays prettyprint.backend prettyprint.custom sequences ; +IN: math.blas.syntax + +: svector{ + \ } [ >float-blas-vector ] parse-literal ; parsing +: dvector{ + \ } [ >double-blas-vector ] parse-literal ; parsing +: cvector{ + \ } [ >float-complex-blas-vector ] parse-literal ; parsing +: zvector{ + \ } [ >double-complex-blas-vector ] parse-literal ; parsing + +: smatrix{ + \ } [ >float-blas-matrix ] parse-literal ; parsing +: dmatrix{ + \ } [ >double-blas-matrix ] parse-literal ; parsing +: cmatrix{ + \ } [ >float-complex-blas-matrix ] parse-literal ; parsing +: zmatrix{ + \ } [ >double-complex-blas-matrix ] parse-literal ; parsing + +M: float-blas-vector pprint-delims + drop \ svector{ \ } ; +M: double-blas-vector pprint-delims + drop \ dvector{ \ } ; +M: float-complex-blas-vector pprint-delims + drop \ cvector{ \ } ; +M: double-complex-blas-vector pprint-delims + drop \ zvector{ \ } ; + +M: float-blas-matrix pprint-delims + drop \ smatrix{ \ } ; +M: double-blas-matrix pprint-delims + drop \ dmatrix{ \ } ; +M: float-complex-blas-matrix pprint-delims + drop \ cmatrix{ \ } ; +M: double-complex-blas-matrix pprint-delims + drop \ zmatrix{ \ } ; + +M: blas-vector-base >pprint-sequence ; +M: blas-vector-base pprint* pprint-object ; +M: blas-matrix-base >pprint-sequence Mrows ; +M: blas-matrix-base pprint* pprint-object ; diff --git a/basis/math/blas/syntax/tags.txt b/basis/math/blas/syntax/tags.txt new file mode 100644 index 0000000000..ede10ab61b --- /dev/null +++ b/basis/math/blas/syntax/tags.txt @@ -0,0 +1 @@ +math diff --git a/basis/math/blas/vectors/authors.txt b/basis/math/blas/vectors/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/math/blas/vectors/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/math/blas/vectors/summary.txt b/basis/math/blas/vectors/summary.txt new file mode 100644 index 0000000000..f983e855a4 --- /dev/null +++ b/basis/math/blas/vectors/summary.txt @@ -0,0 +1 @@ +BLAS level 1 vector operations diff --git a/basis/math/blas/vectors/tags.txt b/basis/math/blas/vectors/tags.txt new file mode 100644 index 0000000000..ede10ab61b --- /dev/null +++ b/basis/math/blas/vectors/tags.txt @@ -0,0 +1 @@ +math diff --git a/basis/math/blas/vectors/vectors-docs.factor b/basis/math/blas/vectors/vectors-docs.factor new file mode 100644 index 0000000000..cb26d67334 --- /dev/null +++ b/basis/math/blas/vectors/vectors-docs.factor @@ -0,0 +1,131 @@ +USING: alien byte-arrays help.markup help.syntax math sequences ; +IN: math.blas.vectors + +ARTICLE: "math.blas.vectors" "BLAS interface vector operations" +"Slicing vectors:" +{ $subsection Vsub } +"Taking the norm (magnitude) of a vector:" +{ $subsection Vnorm } +"Summing and taking the maximum of elements:" +{ $subsection Vasum } +{ $subsection Viamax } +{ $subsection Vamax } +"Scalar-vector products:" +{ $subsection n*V! } +{ $subsection n*V } +{ $subsection V*n } +{ $subsection V/n } +{ $subsection Vneg } +"Vector addition:" +{ $subsection n*V+V! } +{ $subsection n*V+V } +{ $subsection V+ } +{ $subsection V- } +"Vector inner products:" +{ $subsection V. } +{ $subsection V.conj } ; + +ABOUT: "math.blas.vectors" + +HELP: blas-vector-base +{ $class-description "The base class for all BLAS vector types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:" +{ $list + { { $link float-blas-vector } } + { { $link double-blas-vector } } + { { $link float-complex-blas-vector } } + { { $link double-complex-blas-vector } } +} +"All of these subclasses share the same tuple layout:" +{ $list + { { $snippet "underlying" } " contains an alien pointer referencing or byte-array containing a packed array of float, double, float complex, or double complex values;" } + { { $snippet "length" } " indicates the length of the vector;" } + { "and " { $snippet "inc" } " indicates the distance, in elements, between elements." } +} } ; + +HELP: float-blas-vector +{ $class-description "A vector of single-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ; +HELP: double-blas-vector +{ $class-description "A vector of double-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ; +HELP: float-complex-blas-vector +{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ; +HELP: double-complex-blas-vector +{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ; + +HELP: n*V+V! +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "y=alpha*x+y" blas-vector-base } } +{ $description "Calculate the vector sum " { $snippet "αx + y" } " and replace the existing contents of y with the result. Corresponds to the xAXPY routines in BLAS." } +{ $side-effects "y" } ; + +HELP: n*V! +{ $values { "alpha" number } { "x" blas-vector-base } { "x=alpha*x" blas-vector-base } } +{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and replace the existing contents of x with the result. Corresponds to the xSCAL routines in BLAS." } +{ $side-effects "x" } ; + +HELP: V. +{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x.y" number } } +{ $description "Calculate the inner product " { $snippet "x⋅y" } ". Corresponds to the xDOT and xDOTU routines in BLAS." } ; + +HELP: V.conj +{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "xconj.y" number } } +{ $description "Calculate the conjugate inner product " { $snippet "x̅⋅y" } ". Corresponds to the xDOTC routines in BLAS." } ; + +HELP: Vnorm +{ $values { "x" blas-vector-base } { "norm" number } } +{ $description "Calculate the norm-2, i.e., the magnitude or absolute value, of " { $snippet "x" } " (" { $snippet "‖x‖₂" } "). Corresponds to the xNRM2 routines in BLAS." } ; + +HELP: Vasum +{ $values { "x" blas-vector-base } { "sum" number } } +{ $description "Calculate the sum of the norm-1s of the elements of " { $snippet "x" } " (" { $snippet "Σ ‖xᵢ‖₁" } "). Corresponds to the xASUM routines in BLAS." } ; + +HELP: Vswap +{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x=y" blas-vector-base } { "y=x" blas-vector-base } } +{ $description "Swap the contents of " { $snippet "x" } " and " { $snippet "y" } " in place. Corresponds to the xSWAP routines in BLAS." } +{ $side-effects "x" "y" } ; + +HELP: Viamax +{ $values { "x" blas-vector-base } { "max-i" integer } } +{ $description "Return the index of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the smallest index. Corresponds to the IxAMAX routines in BLAS." } ; + +HELP: Vamax +{ $values { "x" blas-vector-base } { "max" number } } +{ $description "Return the value of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the first element. Corresponds to the IxAMAX routines in BLAS." } ; + +{ Viamax Vamax } related-words + +HELP: +{ $values { "exemplar" blas-vector-base } { "zero" blas-vector-base } } +{ $description "Return a vector of zeros with the same length and element type as " { $snippet "v" } ". The vector is constructed with an " { $snippet "inc" } " of zero, so it is not suitable for receiving results from BLAS functions; it is intended to be used as a term in other vector calculations. To construct an empty vector that can be used to receive results, see " { $link } "." } ; + +HELP: n*V+V +{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x+y" blas-vector-base } } +{ $description "Calculate the vector sum " { $snippet "αx + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ; + +HELP: n*V +{ $values { "alpha" "a number" } { "x" blas-vector-base } { "alpha*x" blas-vector-base } } +{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ; + +HELP: V+ +{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x+y" blas-vector-base } } +{ $description "Calculate the vector sum " { $snippet "x + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ; + +HELP: V- +{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x-y" blas-vector-base } } +{ $description "Calculate the vector difference " { $snippet "x – y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ; + +HELP: Vneg +{ $values { "x" blas-vector-base } { "-x" blas-vector-base } } +{ $description "Negate the elements of " { $snippet "x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result." } ; + +HELP: V*n +{ $values { "x" blas-vector-base } { "alpha" number } { "x*alpha" blas-vector-base } } +{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ; + +HELP: V/n +{ $values { "x" blas-vector-base } { "alpha" number } { "x/alpha" blas-vector-base } } +{ $description "Calculate the scalar-vector product " { $snippet "(1/α)x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ; + +{ n*V+V! n*V! n*V+V n*V V+ V- Vneg V*n V/n } related-words + +HELP: Vsub +{ $values { "v" blas-vector-base } { "start" integer } { "length" integer } { "sub" blas-vector-base } } +{ $description "Slice a subvector out of " { $snippet "v" } " starting at " { $snippet "start" } " with the given " { $snippet "length" } ". The subvector will share storage with the parent vector." } ; diff --git a/basis/math/blas/vectors/vectors-tests.factor b/basis/math/blas/vectors/vectors-tests.factor new file mode 100644 index 0000000000..5f9e8fdc42 --- /dev/null +++ b/basis/math/blas/vectors/vectors-tests.factor @@ -0,0 +1,180 @@ +USING: kernel math.blas.vectors math.blas.syntax sequences tools.test ; +IN: math.blas.vectors.tests + +! clone + +[ svector{ 1.0 2.0 3.0 } ] [ svector{ 1.0 2.0 3.0 } clone ] unit-test +[ f ] [ svector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test +[ dvector{ 1.0 2.0 3.0 } ] [ dvector{ 1.0 2.0 3.0 } clone ] unit-test +[ f ] [ dvector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test +[ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } ] [ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test +[ f ] [ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test +[ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } ] [ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test +[ f ] [ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test + +! nth + +[ 1.0 ] [ 2 svector{ 3.0 2.0 1.0 } nth ] unit-test +[ 1.0 ] [ 2 dvector{ 3.0 2.0 1.0 } nth ] unit-test + +[ C{ 1.0 2.0 } ] +[ 2 cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test + +[ C{ 1.0 2.0 } ] +[ 2 zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test + +! set-nth + +[ svector{ 3.0 2.0 0.0 } ] [ 0.0 2 svector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test +[ dvector{ 3.0 2.0 0.0 } ] [ 0.0 2 dvector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test + +[ cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } ] [ + C{ 3.0 4.0 } 2 + cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } + [ set-nth ] keep +] unit-test +[ zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } ] [ + C{ 3.0 4.0 } 2 + zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } + [ set-nth ] keep +] unit-test + +! V+ + +[ svector{ 11.0 22.0 } ] [ svector{ 1.0 2.0 } svector{ 10.0 20.0 } V+ ] unit-test +[ dvector{ 11.0 22.0 } ] [ dvector{ 1.0 2.0 } dvector{ 10.0 20.0 } V+ ] unit-test + +[ cvector{ 11.0 C{ 22.0 33.0 } } ] +[ cvector{ 1.0 C{ 2.0 3.0 } } cvector{ 10.0 C{ 20.0 30.0 } } V+ ] +unit-test + +[ zvector{ 11.0 C{ 22.0 33.0 } } ] +[ zvector{ 1.0 C{ 2.0 3.0 } } zvector{ 10.0 C{ 20.0 30.0 } } V+ ] +unit-test + +! V- + +[ svector{ 9.0 18.0 } ] [ svector{ 10.0 20.0 } svector{ 1.0 2.0 } V- ] unit-test +[ dvector{ 9.0 18.0 } ] [ dvector{ 10.0 20.0 } dvector{ 1.0 2.0 } V- ] unit-test + +[ cvector{ 9.0 C{ 18.0 27.0 } } ] +[ cvector{ 10.0 C{ 20.0 30.0 } } cvector{ 1.0 C{ 2.0 3.0 } } V- ] +unit-test + +[ zvector{ 9.0 C{ 18.0 27.0 } } ] +[ zvector{ 10.0 C{ 20.0 30.0 } } zvector{ 1.0 C{ 2.0 3.0 } } V- ] +unit-test + +! Vneg + +[ svector{ 1.0 -2.0 } ] [ svector{ -1.0 2.0 } Vneg ] unit-test +[ dvector{ 1.0 -2.0 } ] [ dvector{ -1.0 2.0 } Vneg ] unit-test + +[ cvector{ 1.0 C{ -2.0 3.0 } } ] [ cvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test +[ zvector{ 1.0 C{ -2.0 3.0 } } ] [ zvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test + +! n*V + +[ svector{ 100.0 200.0 } ] [ 10.0 svector{ 10.0 20.0 } n*V ] unit-test +[ dvector{ 100.0 200.0 } ] [ 10.0 dvector{ 10.0 20.0 } n*V ] unit-test + +[ cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ] +[ C{ 10.0 2.0 } cvector{ 2.0 C{ 1.0 1.0 } } n*V ] +unit-test + +[ zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ] +[ C{ 10.0 2.0 } zvector{ 2.0 C{ 1.0 1.0 } } n*V ] +unit-test + +! V*n + +[ svector{ 100.0 200.0 } ] [ svector{ 10.0 20.0 } 10.0 V*n ] unit-test +[ dvector{ 100.0 200.0 } ] [ dvector{ 10.0 20.0 } 10.0 V*n ] unit-test + +[ cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ] +[ cvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ] +unit-test + +[ zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ] +[ zvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ] +unit-test + +! V/n + +[ svector{ 1.0 2.0 } ] [ svector{ 4.0 8.0 } 4.0 V/n ] unit-test +[ dvector{ 1.0 2.0 } ] [ dvector{ 4.0 8.0 } 4.0 V/n ] unit-test + +[ cvector{ C{ 0.0 -4.0 } 1.0 } ] +[ cvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ] +unit-test + +[ zvector{ C{ 0.0 -4.0 } 1.0 } ] +[ zvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ] +unit-test + +! V. + +[ 7.0 ] [ svector{ 1.0 2.5 } svector{ 2.0 2.0 } V. ] unit-test +[ 7.0 ] [ dvector{ 1.0 2.5 } dvector{ 2.0 2.0 } V. ] unit-test +[ C{ 7.0 7.0 } ] [ cvector{ C{ 1.0 1.0 } 2.5 } cvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test +[ C{ 7.0 7.0 } ] [ zvector{ C{ 1.0 1.0 } 2.5 } zvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test + +! V.conj + +[ C{ 7.0 3.0 } ] [ cvector{ C{ 1.0 1.0 } 2.5 } cvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test +[ C{ 7.0 3.0 } ] [ zvector{ C{ 1.0 1.0 } 2.5 } zvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test + +! Vnorm + +[ 5.0 ] [ svector{ 3.0 4.0 } Vnorm ] unit-test +[ 5.0 ] [ dvector{ 3.0 4.0 } Vnorm ] unit-test + +[ 13.0 ] [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test +[ 13.0 ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test + +! Vasum + +[ 6.0 ] [ svector{ 1.0 2.0 -3.0 } Vasum ] unit-test +[ 6.0 ] [ dvector{ 1.0 2.0 -3.0 } Vasum ] unit-test + +[ 15.0 ] [ cvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test +[ 15.0 ] [ zvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test + +! Vswap + +[ svector{ 2.0 2.0 } svector{ 1.0 1.0 } ] +[ svector{ 1.0 1.0 } svector{ 2.0 2.0 } Vswap ] +unit-test + +[ dvector{ 2.0 2.0 } dvector{ 1.0 1.0 } ] +[ dvector{ 1.0 1.0 } dvector{ 2.0 2.0 } Vswap ] +unit-test + +[ cvector{ 2.0 C{ 2.0 2.0 } } cvector{ C{ 1.0 1.0 } 1.0 } ] +[ cvector{ C{ 1.0 1.0 } 1.0 } cvector{ 2.0 C{ 2.0 2.0 } } Vswap ] +unit-test + +[ zvector{ 2.0 C{ 2.0 2.0 } } zvector{ C{ 1.0 1.0 } 1.0 } ] +[ zvector{ C{ 1.0 1.0 } 1.0 } zvector{ 2.0 C{ 2.0 2.0 } } Vswap ] +unit-test + +! Viamax + +[ 3 ] [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test +[ 3 ] [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test +[ 0 ] [ cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test +[ 0 ] [ zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test + +! Vamax + +[ -6.0 ] [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test +[ -6.0 ] [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test +[ C{ 2.0 -5.0 } ] [ cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test +[ C{ 2.0 -5.0 } ] [ zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test + +! Vsub + +[ svector{ -5.0 4.0 -6.0 } ] [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test +[ dvector{ -5.0 4.0 -6.0 } ] [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test +[ cvector{ -5.0 C{ 4.0 3.0 } -6.0 } ] [ cvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test +[ zvector{ -5.0 C{ 4.0 3.0 } -6.0 } ] [ zvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor new file mode 100755 index 0000000000..c86fa30115 --- /dev/null +++ b/basis/math/blas/vectors/vectors.factor @@ -0,0 +1,272 @@ +USING: accessors alien alien.c-types arrays byte-arrays combinators +combinators.short-circuit fry kernel math math.blas.cblas +math.complex math.functions math.order sequences.complex +sequences.complex-components sequences sequences.private +functors words locals +specialized-arrays.float specialized-arrays.double +specialized-arrays.direct.float specialized-arrays.direct.double ; +IN: math.blas.vectors + +TUPLE: blas-vector-base underlying length inc ; + +INSTANCE: blas-vector-base virtual-sequence + +GENERIC: element-type ( v -- type ) + +GENERIC: n*V+V! ( alpha x y -- y=alpha*x+y ) +GENERIC: n*V! ( alpha x -- x=alpha*x ) +GENERIC: V. ( x y -- x.y ) +GENERIC: V.conj ( x y -- xconj.y ) +GENERIC: Vnorm ( x -- norm ) +GENERIC: Vasum ( x -- sum ) +GENERIC: Vswap ( x y -- x=y y=x ) +GENERIC: Viamax ( x -- max-i ) + +> ] bi@ min ; inline +: data-and-inc ( v -- data inc ) + [ underlying>> ] [ inc>> ] bi ; inline +: datas-and-incs ( v1 v2 -- v1-data v1-inc v2-data v2-inc ) + [ data-and-inc ] bi@ ; inline + +:: (prepare-copy) + ( v element-size -- length v-data v-inc v-dest-data v-dest-inc + copy-data copy-length copy-inc ) + v [ length>> ] [ data-and-inc ] bi + v length>> element-size * + 1 + over v length>> 1 ; + +: (prepare-swap) + ( v1 v2 -- length v1-data v1-inc v2-data v2-inc + v1 v2 ) + [ shorter-length ] [ datas-and-incs ] [ ] 2tri ; + +:: (prepare-axpy) + ( n v1 v2 -- length n v1-data v1-inc v2-data v2-inc + v2 ) + v1 v2 shorter-length + n + v1 v2 datas-and-incs + v2 ; + +:: (prepare-scal) + ( n v -- length n v-data v-inc + v ) + v length>> + n + v data-and-inc + v ; + +: (prepare-dot) ( v1 v2 -- length v1-data v1-inc v2-data v2-inc ) + [ shorter-length ] [ datas-and-incs ] 2bi ; + +: (prepare-nrm2) ( v -- length data inc ) + [ length>> ] [ data-and-inc ] bi ; + +PRIVATE> + +: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V! ; inline +: n*V ( alpha x -- alpha*x ) clone n*V! ; inline + +: V+ ( x y -- x+y ) + 1.0 -rot n*V+V ; inline +: V- ( x y -- x-y ) + -1.0 spin n*V+V ; inline + +: Vneg ( x -- -x ) + -1.0 swap n*V ; inline + +: V*n ( x alpha -- x*alpha ) + swap n*V ; inline +: V/n ( x alpha -- x/alpha ) + recip swap n*V ; inline + +: Vamax ( x -- max ) + [ Viamax ] keep nth ; inline + +:: Vsub ( v start length -- sub ) + v inc>> start * v element-type heap-size * + v underlying>> + length v inc>> v (blas-vector-like) ; + +: ( exemplar -- zero ) + [ element-type ] + [ length>> 0 ] + [ (blas-vector-like) ] tri ; + +: ( length exemplar -- vector ) + [ element-type ] + [ 1 swap ] 2bi + (blas-vector-like) ; + +M: blas-vector-base equal? + { + [ [ length ] bi@ = ] + [ [ = ] 2all? ] + } 2&& ; + +M: blas-vector-base length + length>> ; +M: blas-vector-base virtual-seq + (blas-direct-array) ; +M: blas-vector-base virtual@ + [ inc>> * ] [ nip (blas-direct-array) ] 2bi ; + +: float>arg ( f -- f ) ; inline +: double>arg ( f -- f ) ; inline +: arg>float ( f -- f ) ; inline +: arg>double ( f -- f ) ; inline + +<< + +FUNCTOR: (define-blas-vector) ( TYPE T -- ) + + IS +>ARRAY IS >${TYPE}-array +XCOPY IS cblas_${T}copy +XSWAP IS cblas_${T}swap +IXAMAX IS cblas_i${T}amax + +VECTOR DEFINES ${TYPE}-blas-vector + DEFINES <${TYPE}-blas-vector> +>VECTOR DEFINES >${TYPE}-blas-vector + +WHERE + +TUPLE: VECTOR < blas-vector-base ; +: ( underlying length inc -- vector ) VECTOR boa ; inline + +: >VECTOR ( seq -- v ) + [ >ARRAY underlying>> ] [ length ] bi 1 ; + +M: VECTOR clone + TYPE heap-size (prepare-copy) + [ XCOPY ] 3dip ; + +M: VECTOR element-type + drop TYPE ; +M: VECTOR Vswap + (prepare-swap) [ XSWAP ] 2dip ; +M: VECTOR Viamax + (prepare-nrm2) IXAMAX ; + +M: VECTOR (blas-vector-like) + drop ; + +M: VECTOR (blas-direct-array) + [ underlying>> ] + [ [ length>> ] [ inc>> ] bi * ] bi + ; + +;FUNCTOR + + +FUNCTOR: (define-real-blas-vector) ( TYPE T -- ) + +VECTOR IS ${TYPE}-blas-vector +XDOT IS cblas_${T}dot +XNRM2 IS cblas_${T}nrm2 +XASUM IS cblas_${T}asum +XAXPY IS cblas_${T}axpy +XSCAL IS cblas_${T}scal + +WHERE + +M: VECTOR V. + (prepare-dot) XDOT ; +M: VECTOR V.conj + (prepare-dot) XDOT ; +M: VECTOR Vnorm + (prepare-nrm2) XNRM2 ; +M: VECTOR Vasum + (prepare-nrm2) XASUM ; +M: VECTOR n*V+V! + (prepare-axpy) [ XAXPY ] dip ; +M: VECTOR n*V! + (prepare-scal) [ XSCAL ] dip ; + +;FUNCTOR + + +FUNCTOR: (define-complex-helpers) ( TYPE -- ) + + DEFINES +>COMPLEX-ARRAY DEFINES >${TYPE}-complex-array +ARG>COMPLEX DEFINES arg>${TYPE}-complex +COMPLEX>ARG DEFINES ${TYPE}-complex>arg + IS +>ARRAY IS >${TYPE}-array + +WHERE + +: ( alien len -- sequence ) + 1 shift ; +: >COMPLEX-ARRAY ( sequence -- sequence ) + >ARRAY ; +: COMPLEX>ARG ( complex -- alien ) + >rect 2array >ARRAY underlying>> ; +: ARG>COMPLEX ( alien -- complex ) + 2 first2 rect> ; + +;FUNCTOR + + +FUNCTOR: (define-complex-blas-vector) ( TYPE C S -- ) + +VECTOR IS ${TYPE}-blas-vector +XDOTU_SUB IS cblas_${C}dotu_sub +XDOTC_SUB IS cblas_${C}dotc_sub +XXNRM2 IS cblas_${S}${C}nrm2 +XXASUM IS cblas_${S}${C}asum +XAXPY IS cblas_${C}axpy +XSCAL IS cblas_${C}scal +TYPE>ARG IS ${TYPE}>arg +ARG>TYPE IS arg>${TYPE} + +WHERE + +M: VECTOR V. + (prepare-dot) TYPE + [ XDOTU_SUB ] keep + ARG>TYPE ; +M: VECTOR V.conj + (prepare-dot) TYPE + [ XDOTC_SUB ] keep + ARG>TYPE ; +M: VECTOR Vnorm + (prepare-nrm2) XXNRM2 ; +M: VECTOR Vasum + (prepare-nrm2) XXASUM ; +M: VECTOR n*V+V! + [ TYPE>ARG ] 2dip + (prepare-axpy) [ XAXPY ] dip ; +M: VECTOR n*V! + [ TYPE>ARG ] dip + (prepare-scal) [ XSCAL ] dip ; + +;FUNCTOR + + +: define-real-blas-vector ( TYPE T -- ) + [ (define-blas-vector) ] + [ (define-real-blas-vector) ] 2bi ; +:: define-complex-blas-vector ( TYPE C S -- ) + TYPE (define-complex-helpers) + TYPE "-complex" append + [ C (define-blas-vector) ] + [ C S (define-complex-blas-vector) ] bi ; + +"float" "s" define-real-blas-vector +"double" "d" define-real-blas-vector +"float" "c" "s" define-complex-blas-vector +"double" "z" "d" define-complex-blas-vector + +>> + diff --git a/basis/math/complex/complex-docs.factor b/basis/math/complex/complex-docs.factor index bed3a655b1..1fcc1ead13 100644 --- a/basis/math/complex/complex-docs.factor +++ b/basis/math/complex/complex-docs.factor @@ -6,7 +6,7 @@ ARTICLE: "complex-numbers-zero" "Embedding of real numbers in complex numbers" "Constructing a complex number with an imaginary component equal to an integer zero simply returns the real number corresponding to the real component:" { $example "USING: math prettyprint ;" "C{ 1 2 } C{ 3 -2 } + ." "4" } "Constructing a complex number with an imaginary component equal to floating point zero will still output a new complex number, however:" -{ $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ 2.0 0.0 }" } +{ $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ -2.0 0.0 }" } "Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero." ; ARTICLE: "complex-numbers" "Complex numbers" diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor index 90713cd40f..620a6c3bab 100644 --- a/basis/math/complex/complex.factor +++ b/basis/math/complex/complex.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel kernel.private math math.private math.libm math.functions arrays math.functions.private sequences @@ -47,3 +47,9 @@ M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ; IN: syntax : C{ \ } [ first2 rect> ] parse-literal ; parsing + +USE: prettyprint.custom + +M: complex pprint* pprint-object ; +M: complex pprint-delims drop \ C{ \ } ; +M: complex >pprint-sequence >rect 2array ; \ No newline at end of file diff --git a/basis/math/complex/prettyprint/prettyprint.factor b/basis/math/complex/prettyprint/prettyprint.factor deleted file mode 100644 index 09eeb8045c..0000000000 --- a/basis/math/complex/prettyprint/prettyprint.factor +++ /dev/null @@ -1,8 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: math math.functions arrays prettyprint.custom kernel ; -IN: math.complex.prettyprint - -M: complex pprint* pprint-object ; -M: complex pprint-delims drop \ C{ \ } ; -M: complex >pprint-sequence >rect 2array ; diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index a06a67e4a1..cf0ce5f0bb 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -97,7 +97,7 @@ IN: math.functions.tests : verify-gcd ( a b -- ? ) 2dup gcd - >r rot * swap rem r> = ; + [ rot * swap rem ] dip = ; [ t ] [ 123 124 verify-gcd ] unit-test [ t ] [ 50 120 verify-gcd ] unit-test diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 8411baf94c..85b4d711ac 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -46,7 +46,8 @@ M: real sqrt GENERIC# ^n 1 ( z w -- z^w ) -: (^n) 1 swap [ [ dupd * ] when [ sq ] dip ] each-bit nip ; inline +: (^n) ( z w -- z^w ) + 1 swap [ [ dupd * ] when [ sq ] dip ] each-bit nip ; inline M: integer ^n [ factor-2s ] dip [ (^n) ] keep rot * shift ; @@ -121,11 +122,9 @@ PRIVATE> [ * ] 2keep gcd nip /i ; foldable : mod-inv ( x n -- y ) - tuck gcd 1 = [ - dup 0 < [ + ] [ nip ] if - ] [ - "Non-trivial divisor found" throw - ] if ; foldable + [ nip ] [ gcd 1 = ] 2bi + [ dup 0 < [ + ] [ nip ] if ] + [ "Non-trivial divisor found" throw ] if ; foldable : ^mod ( x y n -- z ) over 0 < [ diff --git a/basis/math/geometry/rect/rect-docs.factor b/basis/math/geometry/rect/rect-docs.factor index 31c9e44b1d..2077d82b70 100644 --- a/basis/math/geometry/rect/rect-docs.factor +++ b/basis/math/geometry/rect/rect-docs.factor @@ -11,7 +11,7 @@ HELP: rect "Rectangles are constructed by calling " { $link } " and " { $link } "." } ; -HELP: ( loc dim -- rect ) +HELP: { $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } { "rect" "a new " { $link rect } } } { $description "Creates a new rectangle with the specified top-left location and dimensions." } ; @@ -23,7 +23,7 @@ HELP: rect-bounds { rect-bounds rect-extent } related-words -HELP: ( loc ext -- rect ) +HELP: { $values { "loc" "a pair of integers" } { "ext" "a pair of integers" } { "rect" "a new " { $link rect } } } { $description "Creates a new rectangle with the specified top-left and bottom-right corner locations." } ; diff --git a/basis/math/intervals/intervals-docs.factor b/basis/math/intervals/intervals-docs.factor index d8a80340ba..4be8dcc9a7 100644 --- a/basis/math/intervals/intervals-docs.factor +++ b/basis/math/intervals/intervals-docs.factor @@ -93,7 +93,7 @@ $nl $nl "Intervals are created by calling " { $link [a,b] } ", " { $link (a,b) } ", " { $link [a,b) } ", " { $link (a,b] } " or " { $link [a,a] } "." } ; -HELP: ( from to -- interval ) +HELP: { $values { "from" "a " { $snippet "{ point included? }" } " pair" } { "to" "a " { $snippet "{ point included? }" } " pair" } { "interval" interval } } { $description "Creates a new interval. Usually it is more convenient to create intervals using one of the following words instead:" { $list diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index 8c29171a57..378ca2fb4b 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -255,8 +255,7 @@ IN: math.intervals.tests 0 pick interval-contains? over first \ recip eq? and [ 2drop t ] [ - [ >r random-element ! dup . - r> first execute ] 2keep + [ [ random-element ] dip first execute ] 2keep second execute interval-contains? ] if ; @@ -287,8 +286,7 @@ IN: math.intervals.tests 0 pick interval-contains? over first { / /i mod rem } member? and [ 3drop t ] [ - [ >r [ random-element ] bi@ ! 2dup . . - r> first execute ] 3keep + [ [ [ random-element ] bi@ ] dip first execute ] 3keep second execute interval-contains? ] if ; @@ -304,7 +302,7 @@ IN: math.intervals.tests : comparison-test ( -- ? ) random-interval random-interval random-comparison - [ >r [ random-element ] bi@ r> first execute ] 3keep + [ [ [ random-element ] bi@ ] dip first execute ] 3keep second execute dup incomparable eq? [ 2drop t ] [ = ] if ; [ t ] [ 40000 [ drop comparison-test ] all? ] unit-test diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index ed76ccaedd..86c3b0de0b 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -11,7 +11,7 @@ SYMBOL: full-interval TUPLE: interval { from read-only } { to read-only } ; -: ( from to -- int ) +: ( from to -- interval ) 2dup [ first ] bi@ { { [ 2dup > ] [ 2drop 2drop empty-interval ] } { [ 2dup = ] [ diff --git a/basis/math/libm/libm-docs.factor b/basis/math/libm/libm-docs.factor index 1fe565ee00..72c114487b 100644 --- a/basis/math/libm/libm-docs.factor +++ b/basis/math/libm/libm-docs.factor @@ -5,8 +5,8 @@ ARTICLE: "math.libm" "C standard library math functions" "The words in the " { $vocab-link "math.libm" } " vocabulary call C standard library math functions. They are used to implement words in the " { $vocab-link "math.functions" } " vocabulary." $nl "They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:" -{ $example "2 acos ." "C{ 0.0 1.316957896924817 }" } -{ $example "2 facos ." "0.0/0.0" } +{ $example "USE: math.functions" "2 acos ." "C{ 0.0 1.316957896924817 }" } +{ $example "USE: math.libm" "2 facos ." "0.0/0.0" } "Trigonometric functions:" { $subsection fcos } { $subsection fsin } diff --git a/basis/math/miller-rabin/authors.txt b/basis/math/miller-rabin/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/math/miller-rabin/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/math/miller-rabin/miller-rabin-tests.factor b/basis/math/miller-rabin/miller-rabin-tests.factor new file mode 100644 index 0000000000..9ca85ea72c --- /dev/null +++ b/basis/math/miller-rabin/miller-rabin-tests.factor @@ -0,0 +1,10 @@ +USING: math.miller-rabin tools.test ; +IN: math.miller-rabin.tests + +[ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test +[ t ] [ 2 miller-rabin ] unit-test +[ t ] [ 3 miller-rabin ] unit-test +[ f ] [ 36 miller-rabin ] unit-test +[ t ] [ 37 miller-rabin ] unit-test +[ 101 ] [ 100 next-prime ] unit-test +[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test diff --git a/basis/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor new file mode 100755 index 0000000000..8c237d0dc3 --- /dev/null +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators kernel locals math math.functions math.ranges +random sequences sets ; +IN: math.miller-rabin + +odd ( n -- int ) dup even? [ 1+ ] when ; foldable + +TUPLE: positive-even-expected n ; + +:: (miller-rabin) ( n trials -- ? ) + [let | r [ n 1- factor-2s drop ] + s [ n 1- factor-2s nip ] + prime?! [ t ] + a! [ 0 ] + count! [ 0 ] | + trials [ + n 1- [1,b] random a! + a s n ^mod 1 = [ + 0 count! + r [ + 2^ s * a swap n ^mod n - -1 = + [ count 1+ count! r + ] when + ] each + count zero? [ f prime?! trials + ] when + ] unless drop + ] each prime? ] ; + +PRIVATE> + +: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ; + +: miller-rabin* ( n numtrials -- ? ) + over { + { [ dup 1 <= ] [ 3drop f ] } + { [ dup 2 = ] [ 3drop t ] } + { [ dup even? ] [ 3drop f ] } + [ drop (miller-rabin) ] + } cond ; + +: miller-rabin ( n -- ? ) 10 miller-rabin* ; + +: next-prime ( n -- p ) + next-odd dup miller-rabin [ next-prime ] unless ; + +: random-prime ( numbits -- p ) + random-bits next-prime ; + +ERROR: no-relative-prime n ; + + [ 2 + (find-relative-prime) ] [ nip ] if ; + +PRIVATE> + +: find-relative-prime* ( n guess -- p ) + #! find a prime relative to n with initial guess + >odd (find-relative-prime) ; + +: find-relative-prime ( n -- p ) + dup random find-relative-prime* ; + +ERROR: too-few-primes ; + +: unique-primes ( numbits n -- seq ) + #! generate two primes + swap + dup 5 < [ too-few-primes ] when + 2dup [ random-prime ] curry replicate + dup all-unique? [ 2nip ] [ drop unique-primes ] if ; diff --git a/basis/math/miller-rabin/summary.txt b/basis/math/miller-rabin/summary.txt new file mode 100644 index 0000000000..b2591a3182 --- /dev/null +++ b/basis/math/miller-rabin/summary.txt @@ -0,0 +1 @@ +Miller-Rabin probabilistic primality test diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index 13090b6486..5783dfdf41 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -68,7 +68,8 @@ PRIVATE> dup V{ 0 } clone p= [ drop nip ] [ - tuck p/mod [ pick p* swap [ swapd p- ] dip ] dip (pgcd) + [ nip ] [ p/mod ] 2bi + [ pick p* swap [ swapd p- ] dip ] dip (pgcd) ] if ; PRIVATE> diff --git a/basis/math/primes/authors.txt b/basis/math/primes/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/basis/math/primes/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/basis/math/primes/erato/authors.txt b/basis/math/primes/erato/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/basis/math/primes/erato/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/basis/math/primes/erato/erato-docs.factor b/basis/math/primes/erato/erato-docs.factor new file mode 100644 index 0000000000..b12ea45052 --- /dev/null +++ b/basis/math/primes/erato/erato-docs.factor @@ -0,0 +1,12 @@ +USING: help.markup help.syntax ; +IN: math.primes.erato + +HELP: sieve +{ $values { "n" "the greatest odd number to consider" } { "arr" "a bit array" } } +{ $description "Return a bit array containing a primality bit for every odd number between 3 and " { $snippet "n" } " (inclusive). " { $snippet ">index" } " can be used to retrieve the index of an odd number to be tested." } ; + +HELP: >index +{ $values { "n" "an odd number" } { "i" "the corresponding index" } } +{ $description "Retrieve the index corresponding to the odd number on the stack." } ; + +{ sieve >index } related-words diff --git a/basis/math/primes/erato/erato-tests.factor b/basis/math/primes/erato/erato-tests.factor new file mode 100644 index 0000000000..917824c9c1 --- /dev/null +++ b/basis/math/primes/erato/erato-tests.factor @@ -0,0 +1,3 @@ +USING: bit-arrays math.primes.erato tools.test ; + +[ ?{ t t t f t t f t t f t f f t } ] [ 29 sieve ] unit-test diff --git a/basis/math/primes/erato/erato.factor b/basis/math/primes/erato/erato.factor new file mode 100644 index 0000000000..70a9c10ff5 --- /dev/null +++ b/basis/math/primes/erato/erato.factor @@ -0,0 +1,25 @@ +! Copyright (C) 2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: bit-arrays kernel math math.functions math.ranges sequences ; +IN: math.primes.erato + +: >index ( n -- i ) + 3 - 2 /i ; inline + +: index> ( i -- n ) + 2 * 3 + ; inline + +: mark-multiples ( i arr -- ) + [ index> [ sq >index ] keep ] dip + [ length 1 - swap f swap ] keep + [ set-nth ] curry with each ; + +: maybe-mark-multiples ( i arr -- ) + 2dup nth [ mark-multiples ] [ 2drop ] if ; + +: init-sieve ( n -- arr ) + >index 1 + dup set-bits ; + +: sieve ( n -- arr ) + [ init-sieve ] [ sqrt >index [0,b] ] bi + over [ maybe-mark-multiples ] curry each ; foldable diff --git a/basis/math/primes/erato/summary.txt b/basis/math/primes/erato/summary.txt new file mode 100644 index 0000000000..6ecb893cd5 --- /dev/null +++ b/basis/math/primes/erato/summary.txt @@ -0,0 +1 @@ +Eratosthene sieve diff --git a/basis/math/primes/factors/authors.txt b/basis/math/primes/factors/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/basis/math/primes/factors/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/basis/math/primes/factors/factors-docs.factor b/basis/math/primes/factors/factors-docs.factor new file mode 100644 index 0000000000..f9fe4d5dcb --- /dev/null +++ b/basis/math/primes/factors/factors-docs.factor @@ -0,0 +1,23 @@ +USING: help.markup help.syntax math sequences ; +IN: math.primes.factors + +{ factors group-factors unique-factors } related-words + +HELP: factors +{ $values { "n" "a positive integer" } { "seq" sequence } } +{ $description { "Return an ordered list of a number's prime factors, possibly repeated." } } +{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 factors ." "{ 2 2 3 5 5 }" } } ; + +HELP: group-factors +{ $values { "n" "a positive integer" } { "seq" sequence } } +{ $description { "Return a sequence of pairs representing each prime factor in the number and its corresponding power (multiplicity)." } } +{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 group-factors ." "{ { 2 2 } { 3 1 } { 5 2 } }" } } ; + +HELP: unique-factors +{ $values { "n" "a positive integer" } { "seq" sequence } } +{ $description { "Return an ordered list of a number's unique prime factors." } } +{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 unique-factors ." "{ 2 3 5 }" } } ; + +HELP: totient +{ $values { "n" "a positive integer" } { "t" integer } } +{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ; diff --git a/basis/math/primes/factors/factors-tests.factor b/basis/math/primes/factors/factors-tests.factor new file mode 100644 index 0000000000..f247683c1c --- /dev/null +++ b/basis/math/primes/factors/factors-tests.factor @@ -0,0 +1,8 @@ +USING: math.primes.factors tools.test ; + +{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test +{ { } } [ -5 factors ] unit-test +{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test +{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test +{ 999967000236000612 } [ 999969000187000867 totient ] unit-test +{ 0 } [ 1 totient ] unit-test diff --git a/basis/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor new file mode 100644 index 0000000000..05d6b26010 --- /dev/null +++ b/basis/math/primes/factors/factors.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2007-2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays combinators kernel make math math.primes sequences ; +IN: math.primes.factors + + + +: group-factors ( n -- seq ) + [ 2 [ over 1 > ] [ write-factor next-prime ] [ ] while 2drop ] { } make ; + +: unique-factors ( n -- seq ) group-factors [ first ] map ; + +: factors ( n -- seq ) group-factors [ first2 swap ] map concat ; + +: totient ( n -- t ) + { + { [ dup 2 < ] [ drop 0 ] } + [ dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * ] + } cond ; foldable diff --git a/basis/math/primes/factors/summary.txt b/basis/math/primes/factors/summary.txt new file mode 100644 index 0000000000..1440dddc7f --- /dev/null +++ b/basis/math/primes/factors/summary.txt @@ -0,0 +1 @@ +Prime factors decomposition diff --git a/basis/math/primes/primes-docs.factor b/basis/math/primes/primes-docs.factor new file mode 100644 index 0000000000..c7dbc950e8 --- /dev/null +++ b/basis/math/primes/primes-docs.factor @@ -0,0 +1,22 @@ +USING: help.markup help.syntax ; +IN: math.primes + +{ next-prime prime? } related-words + +HELP: next-prime +{ $values { "n" "an integer not smaller than 2" } { "p" "a prime number" } } +{ $description "Return the next prime number greater than " { $snippet "n" } "." } ; + +HELP: prime? +{ $values { "n" "an integer" } { "?" "a boolean" } } +{ $description "Test if an integer is a prime number." } ; + +{ primes-upto primes-between } related-words + +HELP: primes-upto +{ $values { "n" "an integer" } { "seq" "a sequence" } } +{ $description "Return a sequence containing all the prime numbers smaller or equal to " { $snippet "n" } "." } ; + +HELP: primes-between +{ $values { "low" "an integer" } { "high" "an integer" } { "seq" "a sequence" } } +{ $description "Return a sequence containing all the prime numbers between " { $snippet "low" } " and " { $snippet "high" } "." } ; diff --git a/basis/math/primes/primes-tests.factor b/basis/math/primes/primes-tests.factor new file mode 100644 index 0000000000..db738399ef --- /dev/null +++ b/basis/math/primes/primes-tests.factor @@ -0,0 +1,9 @@ +USING: arrays math.primes tools.test ; + +{ 1237 } [ 1234 next-prime ] unit-test +{ f t } [ 1234 prime? 1237 prime? ] unit-test +{ { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test +{ { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test + +{ { 4999963 4999999 5000011 5000077 5000081 } } +[ 4999962 5000082 primes-between >array ] unit-test diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor new file mode 100644 index 0000000000..807ebf097b --- /dev/null +++ b/basis/math/primes/primes.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2007-2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators kernel math math.functions math.miller-rabin +math.order math.primes.erato math.ranges sequences ; +IN: math.primes + +index 4999999 sieve nth ; + +: really-prime? ( n -- ? ) + dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable + +PRIVATE> + +: prime? ( n -- ? ) + { + { [ dup 2 < ] [ drop f ] } + { [ dup even? ] [ 2 = ] } + [ really-prime? ] + } cond ; foldable + +: next-prime ( n -- p ) + next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable + +: primes-between ( low high -- seq ) + [ dup 3 max dup even? [ 1 + ] when ] dip + 2 [ prime? ] filter + swap 3 < [ 2 prefix ] when ; + +: primes-upto ( n -- seq ) 2 swap primes-between ; + +: coprime? ( a b -- ? ) gcd nip 1 = ; foldable diff --git a/basis/math/primes/summary.txt b/basis/math/primes/summary.txt new file mode 100644 index 0000000000..41b4197178 --- /dev/null +++ b/basis/math/primes/summary.txt @@ -0,0 +1,2 @@ +Prime numbers test and generation + diff --git a/basis/math/quaternions/quaternions.factor b/basis/math/quaternions/quaternions.factor index bb0d025dc6..bc6da9f564 100755 --- a/basis/math/quaternions/quaternions.factor +++ b/basis/math/quaternions/quaternions.factor @@ -10,7 +10,7 @@ IN: math.quaternions array ] unit-test @@ -11,7 +11,7 @@ IN: math.ranges.tests [ { 1 } ] [ 1 2 [a,b) >array ] unit-test [ { 1 2 } ] [ 1 2 [a,b] >array ] unit-test -[ { } ] [ 2 1 (a,b) >array ] unit-test +[ { } ] [ 2 1 (a,b) >array ] unit-test [ { 1 } ] [ 2 1 (a,b] >array ] unit-test [ { 2 } ] [ 2 1 [a,b) >array ] unit-test [ { 2 1 } ] [ 2 1 [a,b] >array ] unit-test @@ -32,3 +32,7 @@ IN: math.ranges.tests [ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test [ 5 ] [ 6 5 [0,b] clamp-to-range ] unit-test [ { 0 1 2 3 4 } ] [ 5 sequence-index-range >array ] unit-test + +[ 100 ] [ + 1 100 [a,b] [ 2^ [1,b] ] map prune length +] unit-test \ No newline at end of file diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index f7b3b37e25..068f599b6f 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel layouts math math.order namespaces sequences -sequences.private accessors ; +sequences.private accessors classes.tuple arrays ; IN: math.ranges TUPLE: range @@ -18,13 +18,19 @@ M: range length ( seq -- n ) M: range nth-unsafe ( n range -- obj ) [ step>> * ] keep from>> + ; +! For ranges with many elements, the default element-wise methods +! sequences define are unsuitable because they're O(n) +M: range equal? over range? [ tuple= ] [ 2drop f ] if ; + +M: range hashcode* tuple-hashcode ; + INSTANCE: range immutable-sequence -: twiddle 2dup > -1 1 ? ; inline +: twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline -: (a, dup [ + ] curry 2dip ; inline +: (a, ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline -: ,b) dup [ - ] curry dip ; inline +: ,b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline : [a,b] ( a b -- range ) twiddle ; inline diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index 81294d29f7..e44dbd1a75 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -24,7 +24,7 @@ M: integer / "Division by zero" throw ] [ dup 0 < [ [ neg ] bi@ ] when - 2dup gcd nip tuck /i [ /i ] dip fraction> + 2dup gcd nip tuck [ /i ] 2bi@ fraction> ] if ; M: ratio hashcode* @@ -50,11 +50,11 @@ M: ratio <= scale <= ; M: ratio > scale > ; M: ratio >= scale >= ; -M: ratio + 2dup scale + -rot ratio+d / ; -M: ratio - 2dup scale - -rot ratio+d / ; -M: ratio * 2>fraction * [ * ] dip / ; +M: ratio + [ scale + ] [ ratio+d ] 2bi / ; +M: ratio - [ scale - ] [ ratio+d ] 2bi / ; +M: ratio * 2>fraction [ * ] 2bi@ / ; M: ratio / scale / ; M: ratio /i scale /i ; M: ratio /f scale /f ; -M: ratio mod [ /i ] 2keep rot * - ; +M: ratio mod 2dup /i * - ; M: ratio /mod [ /i ] 2keep mod ; diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index d2494ee32a..09caebcf07 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Michael Judge. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators kernel math math.analysis math.functions sequences - sequences.lib sorting ; +USING: arrays combinators kernel math math.analysis +math.functions math.order sequences sorting ; IN: math.statistics : mean ( seq -- n ) @@ -20,6 +20,10 @@ IN: math.statistics [ midpoint@ ] keep nth ] if ; +: minmax ( seq -- min max ) + #! find the min and max of a seq in one pass + [ 1/0. -1/0. ] dip [ tuck [ min ] [ max ] 2bi* ] each ; + : range ( seq -- n ) minmax swap - ; diff --git a/basis/mime/multipart/multipart-tests.factor b/basis/mime/multipart/multipart-tests.factor index 1445af8309..d91e31cca2 100644 --- a/basis/mime/multipart/multipart-tests.factor +++ b/basis/mime/multipart/multipart-tests.factor @@ -1,2661 +1,35 @@ -USING: accessors checksums checksums.md5 io io.encodings.ascii -io.encodings.binary io.files io.streams.byte-array -io.streams.string kernel make mime.multipart -mime.multipart.private multiline sequences strings tools.test ; +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: io.encodings.ascii io.files io.files.unique kernel +mime.multipart tools.test io.streams.duplex io multiline +assocs accessors ; IN: mime.multipart.tests -[ { "a" } ] [ - [ - "azzbzzczzdzz" "z" 1 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "a" } ] [ - [ - "azzbzzczzdzz" "z" 2 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "a" } ] [ - [ - "azzbzzczzdzz" "z" 3 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "a" } ] [ - [ - "azzbzzczzdzz" "z" 4 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "a" } ] [ - [ - "azzbzzczzdzz" "z" 5 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - - -[ { "a" "a" } ] [ - [ - "aazzbzzczzdzz" "z" 1 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "aa" } ] [ - [ - "aazzbzzczzdzz" "z" 2 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "aa" } ] [ - [ - "aazzbzzczzdzz" "z" 3 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "aa" } ] [ - [ - "aazzbzzczzdzz" "z" 4 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "aa" } ] [ - [ - "aazzbzzczzdzz" "z" 5 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test +: upload-separator ( -- seq ) + "----WebKitFormBoundary6odjpVPXIighAE2L" ; +: upload ( -- seq ) + "------WebKitFormBoundary6odjpVPXIighAE2L\r\nContent-Disposition: form-data; name=\"file1\"; filename=\"up.txt\"\r\nContent-Type: text/plain\r\n\r\nuploaded!\n\r\n------WebKitFormBoundary6odjpVPXIighAE2L\r\nContent-Disposition: form-data; name=\"file2\"; filename=\"\"\r\n\r\n\r\n------WebKitFormBoundary6odjpVPXIighAE2L\r\nContent-Disposition: form-data; name=\"file3\"; filename=\"\"\r\n\r\n\r\n------WebKitFormBoundary6odjpVPXIighAE2L\r\nContent-Disposition: form-data; name=\"text1\"\r\n\r\nlol\r\n------WebKitFormBoundary6odjpVPXIighAE2L--\r\n" ; +: mime-test-stream ( -- stream ) + upload + "mime" "test" make-unique-file ascii + [ set-file-contents ] [ ] 2bi ; -[ { "a" } ] [ - [ - "azzbzzczzdzz" "zz" 1 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" "zz" } ] [ - [ - "azzbzzczzdzz" "zzz" 1 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" } ] [ - [ - "azzbzzczzdzzz" "zzz" 1 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test - -[ { "az" "zb" "zz" "cz" "zd" } ] [ - [ - "azzbzzczzdzzz" "zzz" 2 >>n - [ , ] multipart-step-loop drop - ] { } make -] unit-test +[ ] [ mime-test-stream [ ] with-input-stream ] unit-test -[ { "a" "zzb" "zzc" "zzd" } ] [ - [ - "azzbzzczzdzzz" "zzz" 3 >>n - [ , ] multipart-step-loop drop - ] { } make +[ t ] [ + mime-test-stream [ upload-separator parse-multipart ] with-input-stream + "file1" swap key? ] unit-test -[ { "az" "zbzz" "czzd" } ] [ - [ - "azzbzzczzdzzz" "zzz" 4 >>n - [ , ] multipart-step-loop drop - ] { } make +[ t ] [ + mime-test-stream [ upload-separator parse-multipart ] with-input-stream + "file1" swap key? ] unit-test -[ { "azz" "bzzcz" "zd" } ] [ - [ - "azzbzzczzdzzz" "zzz" 5 >>n - [ , ] multipart-step-loop drop - ] { } make +[ t ] [ + mime-test-stream [ upload-separator parse-multipart ] with-input-stream + "file1" swap at filename>> "up.txt" = ] unit-test - - -: dog-test-empty-bytes-safari ( -- bytes ) - B{ - 45 45 45 45 45 45 87 101 98 75 105 116 70 111 114 109 66 - 111 117 110 100 97 114 121 74 57 98 119 65 87 115 51 121 - 110 112 113 115 72 53 75 13 10 67 111 110 116 101 110 116 - 45 68 105 115 112 111 115 105 116 105 111 110 58 32 102 111 - 114 109 45 100 97 116 97 59 32 110 97 109 101 61 34 102 105 - 108 101 49 34 59 32 102 105 108 101 110 97 109 101 61 34 - 100 111 103 46 106 112 103 34 13 10 67 111 110 116 101 110 - 116 45 84 121 112 101 58 32 105 109 97 103 101 47 106 112 - 101 103 13 10 13 10 255 216 255 224 0 16 74 70 73 70 0 1 1 - 0 0 1 0 1 0 0 255 219 0 67 0 5 3 4 4 4 3 5 4 4 4 5 5 5 6 7 - 12 8 7 7 7 7 15 11 11 9 12 17 15 18 18 17 15 17 17 19 22 28 - 23 19 20 26 21 17 17 24 33 24 26 29 29 31 31 31 19 23 34 36 - 34 30 36 28 30 31 30 255 219 0 67 1 5 5 5 7 6 7 14 8 8 14 - 30 20 17 20 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 - 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 - 30 30 30 30 30 30 30 30 30 30 30 30 30 30 255 192 0 17 8 1 - 49 1 64 3 1 34 0 2 17 1 3 17 1 255 196 0 29 0 0 2 2 3 1 1 1 - 0 0 0 0 0 0 0 0 0 4 5 6 7 2 3 8 0 1 9 255 196 0 74 16 0 2 1 - 3 3 2 4 4 3 4 5 10 5 3 5 1 1 2 3 0 4 17 5 18 33 6 49 19 34 - 65 81 7 50 97 113 20 35 129 21 51 66 82 36 52 145 161 177 8 - 53 83 98 114 115 147 178 193 209 22 37 67 116 241 99 130 - 240 23 68 84 100 146 225 255 196 0 25 1 0 3 1 1 1 0 0 0 0 0 - 0 0 0 0 0 0 1 2 3 0 4 5 255 196 0 39 17 0 2 2 2 2 3 0 2 1 5 - 1 0 0 0 0 0 0 1 2 17 3 33 18 49 34 50 65 19 81 4 5 20 35 66 - 97 82 255 218 0 12 3 1 0 2 17 3 17 0 63 0 228 200 149 136 - 219 131 200 207 233 68 196 145 112 60 21 45 234 91 181 57 - 177 178 138 75 56 95 111 152 196 51 250 209 11 167 198 14 - 118 138 22 138 153 104 150 118 82 46 217 45 161 98 79 242 - 102 157 38 151 98 174 64 211 237 72 247 49 46 104 11 8 140 - 111 229 247 166 194 70 137 12 146 112 61 235 57 36 172 31 - 82 7 154 199 78 244 176 178 255 0 132 41 100 195 76 15 183 - 240 118 60 31 244 85 237 126 241 237 237 157 213 176 113 - 197 66 158 254 234 82 74 49 45 187 144 42 49 155 158 217 - 108 152 99 21 68 214 88 116 217 83 17 218 218 171 250 109 - 138 180 254 6 221 83 205 109 1 199 115 225 10 141 90 106 23 - 106 187 95 59 73 239 237 77 44 111 89 79 136 24 186 250 131 - 235 86 199 166 71 143 20 52 181 211 237 24 143 232 150 236 - 61 140 66 155 65 167 233 251 64 252 5 158 127 221 45 3 99 - 42 220 42 186 240 79 247 83 139 38 86 92 21 57 20 76 246 - 140 78 155 98 88 31 217 246 125 191 209 45 108 253 159 97 - 255 0 240 44 255 0 225 45 22 216 200 199 181 99 88 74 98 77 - 99 78 178 69 111 14 194 213 23 28 226 48 15 246 212 30 242 - 21 252 105 8 145 170 103 178 213 137 172 121 162 127 181 87 - 151 141 182 247 31 235 210 180 216 209 28 88 217 219 120 99 - 250 52 100 255 0 172 155 168 248 108 109 11 103 240 208 127 - 194 173 118 82 71 225 47 148 246 163 11 169 30 74 81 140 - 102 182 178 35 203 97 104 62 162 46 104 41 45 109 119 127 - 86 131 254 21 48 144 225 9 198 104 105 198 24 118 53 76 77 - 81 141 73 105 109 143 234 176 127 193 21 146 89 219 110 63 - 209 97 255 0 131 69 65 183 110 15 39 218 182 144 160 159 41 - 6 169 102 5 22 54 138 114 109 45 216 123 24 184 53 177 45 - 44 137 231 79 179 237 254 138 179 118 101 112 167 159 181 - 102 131 140 212 35 236 99 95 224 172 119 143 252 190 207 - 254 21 18 186 125 129 92 254 2 207 254 16 172 15 148 230 - 182 71 46 225 198 106 178 78 204 40 213 237 109 83 33 45 - 224 237 223 195 199 247 214 189 30 222 222 69 45 37 165 187 - 156 227 12 161 177 245 230 143 214 212 8 75 123 138 15 69 - 96 7 220 214 159 169 135 31 129 177 192 198 159 102 120 255 - 0 68 181 240 216 217 12 15 217 214 156 246 252 165 230 137 - 139 205 235 128 7 204 123 80 183 154 148 118 202 66 225 156 - 118 62 148 169 174 38 91 55 193 167 233 191 60 214 22 96 14 - 249 137 107 84 199 69 137 246 174 157 100 255 0 65 18 210 - 43 237 82 105 148 188 108 64 254 31 102 164 243 223 204 146 - 249 155 39 233 73 38 50 84 137 156 112 233 19 200 4 118 54 - 201 238 22 33 68 54 153 166 52 96 173 149 163 15 115 16 205 - 66 244 189 77 141 226 40 115 143 90 155 91 73 192 116 245 - 29 141 77 233 140 177 169 46 64 109 167 88 45 203 31 217 - 246 92 127 244 171 19 97 99 226 16 218 125 152 227 63 186 - 20 100 204 56 247 245 175 66 84 145 191 147 235 246 174 140 - 125 18 180 125 183 211 108 72 7 246 125 158 63 221 45 109 - 151 77 177 219 254 111 179 255 0 132 180 68 76 163 133 206 - 51 197 103 43 0 184 166 158 144 72 133 244 54 113 220 5 91 - 120 50 59 254 77 7 120 109 188 48 22 8 1 207 242 98 152 106 - 170 191 137 45 239 218 149 93 41 97 129 239 73 97 143 96 19 - 172 103 204 161 23 232 181 164 71 152 93 143 173 110 117 - 101 67 90 142 239 195 55 165 97 229 251 37 122 124 138 182 - 48 118 253 210 81 66 116 250 82 123 2 205 103 108 55 30 99 - 31 221 218 140 134 63 56 221 200 169 147 26 90 229 159 56 - 20 109 242 171 89 16 217 251 80 214 190 80 49 197 110 212 - 63 168 147 234 107 74 62 44 166 36 156 209 17 234 235 140 - 193 26 170 182 230 227 21 40 248 113 208 240 234 214 169 53 - 194 224 63 166 57 168 167 85 55 136 34 5 87 126 124 170 123 - 26 233 15 129 214 42 221 59 108 123 112 51 27 14 223 90 142 - 61 68 233 206 227 249 58 35 7 224 252 57 252 133 141 91 25 - 82 71 24 255 0 189 44 212 254 21 222 99 16 171 120 139 234 - 160 97 171 165 99 81 143 5 145 74 142 199 29 171 239 225 99 - 121 138 149 80 127 133 241 205 22 229 96 121 19 84 145 199 - 250 231 77 106 61 62 210 25 35 114 189 212 1 198 43 237 133 - 210 72 71 24 56 228 125 107 167 186 179 163 236 245 93 61 - 149 35 76 148 42 43 154 186 195 167 175 58 123 85 149 9 37 - 67 103 63 74 117 39 123 37 151 26 110 226 20 14 64 53 246 - 132 211 174 22 234 21 216 217 111 83 69 22 80 72 197 89 245 - 103 61 238 128 117 60 155 121 15 174 218 174 239 8 23 141 - 158 251 170 192 213 36 219 11 175 169 28 85 123 169 237 93 - 64 240 57 52 99 32 142 45 89 191 15 229 231 154 46 201 155 - 60 214 141 48 43 69 141 163 24 162 109 227 61 199 21 57 118 - 96 244 57 92 227 52 43 198 219 143 126 244 68 18 3 88 202 - 172 141 134 108 147 205 8 107 64 62 65 223 145 131 239 91 - 25 188 199 39 38 181 163 99 191 122 250 112 199 118 59 213 - 83 160 114 54 59 46 211 239 89 39 203 90 93 89 88 115 197 - 110 64 74 113 83 138 169 5 59 62 183 35 214 189 16 193 197 - 124 109 202 123 154 251 19 13 199 35 38 170 242 69 62 194 - 105 214 255 0 171 138 85 166 169 82 204 164 237 60 103 235 - 77 181 129 226 66 184 98 163 220 82 155 73 24 202 45 34 81 - 201 239 75 44 138 141 7 114 72 110 146 203 36 73 12 42 207 - 150 193 197 73 52 191 135 215 186 168 241 220 180 113 177 - 206 49 200 90 153 124 40 248 122 110 151 241 183 65 66 12 - 48 207 191 189 94 54 186 61 165 156 94 28 123 10 149 10 78 - 59 138 231 109 252 58 163 8 163 159 236 254 19 73 53 176 86 - 80 176 175 171 1 197 107 185 248 77 101 105 103 51 204 187 - 36 199 24 25 39 255 0 249 93 18 176 195 18 157 177 168 30 - 212 191 85 132 201 109 39 134 138 204 227 110 8 160 175 232 - 210 227 196 226 14 170 210 27 66 215 60 46 54 110 5 72 31 - 227 82 141 57 214 72 145 137 198 64 237 70 127 148 13 146 - 219 107 208 145 150 5 240 91 211 245 165 58 75 237 130 48 - 72 36 47 117 237 71 39 113 4 23 248 216 202 224 96 100 114 - 107 24 148 183 126 62 213 182 101 57 231 145 89 70 6 7 2 - 174 221 35 133 71 102 248 84 40 245 172 110 57 38 182 175 3 - 140 86 19 1 142 194 145 182 199 34 250 129 197 226 100 241 - 154 211 52 121 77 194 182 234 67 117 238 223 236 162 150 17 - 248 81 218 138 116 52 72 228 225 183 246 21 241 148 126 30 - 79 76 46 234 62 234 16 27 181 7 34 55 135 55 63 250 116 232 - 210 118 168 117 167 172 127 132 183 220 224 15 13 127 187 - 189 16 10 135 194 144 69 43 176 144 155 88 23 212 71 70 32 - 110 251 129 165 170 25 99 99 139 78 127 182 179 213 220 199 - 167 141 190 86 35 191 189 42 241 228 132 174 50 65 246 162 - 53 9 89 172 227 221 158 212 178 151 139 54 61 100 68 118 - 241 86 227 89 182 132 121 247 72 1 2 186 187 225 157 184 - 131 70 182 143 28 162 128 203 234 167 235 92 181 211 246 87 - 23 221 92 145 198 173 133 144 121 192 249 107 170 250 103 - 242 236 35 241 147 194 157 84 6 99 252 85 36 169 34 249 98 - 229 34 100 89 89 139 43 6 97 192 35 211 233 95 94 86 17 2 - 199 56 238 105 119 226 188 171 223 183 39 222 190 27 172 16 - 95 113 79 95 173 16 199 30 134 246 242 11 133 60 242 59 212 - 75 226 103 77 91 235 58 101 204 138 159 154 145 147 145 235 - 78 97 152 171 248 145 200 10 31 65 222 138 155 100 200 21 - 178 222 167 29 171 5 87 211 144 110 214 109 31 80 240 36 - 111 32 39 57 244 57 237 77 224 152 92 69 226 174 49 142 126 - 149 105 124 86 232 27 125 70 22 187 178 132 9 2 229 177 247 - 53 76 66 38 209 181 65 109 48 111 8 156 18 123 81 229 20 - 170 201 101 196 253 163 208 94 161 14 251 105 27 217 106 - 189 213 20 11 226 125 51 138 177 181 70 205 153 104 249 87 - 28 85 117 117 253 117 247 251 241 84 87 240 231 26 233 108 - 192 5 3 131 77 145 78 243 74 180 213 193 7 138 115 18 229 - 137 172 227 33 27 48 183 64 24 26 202 126 13 108 140 169 - 242 142 9 236 79 106 26 92 150 228 250 209 140 93 140 124 - 254 48 107 34 195 39 154 215 255 0 231 122 247 191 253 234 - 188 65 196 223 27 151 24 144 101 253 40 152 179 130 49 233 - 90 109 85 29 124 217 163 226 218 19 28 98 163 123 176 165 - 64 46 219 13 122 22 223 39 28 147 216 86 219 133 4 19 90 1 - 240 161 50 28 131 252 52 91 131 219 55 144 62 189 56 91 68 - 133 88 110 245 30 213 37 248 49 210 178 106 58 188 51 73 - 144 138 119 19 233 140 208 189 61 210 211 245 12 232 193 79 - 204 57 32 226 186 51 161 250 90 195 65 211 161 138 8 255 0 - 51 104 46 125 106 115 146 78 145 124 17 113 143 146 37 26 - 85 188 122 109 132 113 68 184 96 49 159 165 125 185 185 85 - 59 90 64 119 124 198 180 205 43 5 43 156 31 79 181 10 178 - 36 44 26 70 222 205 223 30 148 165 210 177 139 150 149 10 - 227 98 142 192 250 214 155 147 253 28 199 177 88 122 238 - 244 250 208 171 52 155 134 88 98 133 150 237 164 36 46 112 - 15 53 129 56 190 145 65 255 0 148 77 158 235 69 153 118 182 - 199 218 54 118 239 154 175 116 73 72 181 129 135 204 203 - 218 174 31 142 22 18 234 26 36 203 2 72 21 60 229 64 253 - 225 207 106 165 244 67 38 194 37 36 178 240 51 90 91 175 - 248 104 234 13 18 169 228 221 230 127 46 43 5 151 196 228 - 214 55 127 186 221 238 43 85 187 100 227 158 213 94 71 20 - 180 232 103 23 43 197 125 145 84 168 201 230 176 135 182 43 - 100 156 40 165 9 22 212 144 45 249 247 163 161 254 174 40 - 93 79 157 67 62 153 166 22 234 166 1 197 96 53 98 235 149 - 12 167 222 147 234 3 242 102 81 220 71 82 41 99 12 59 129 - 74 117 91 114 45 167 117 31 250 103 251 169 148 140 129 45 - 55 44 17 99 253 29 23 12 204 28 6 3 20 20 19 127 71 139 159 - 253 42 223 28 129 136 7 156 154 103 208 255 0 153 177 205 - 170 120 204 3 12 12 240 69 111 213 199 134 145 66 163 36 - 143 90 246 154 141 148 231 143 74 203 89 138 67 123 11 6 57 - 199 21 63 134 139 243 68 211 224 110 159 102 218 140 243 - 189 188 178 60 152 249 192 192 171 213 173 128 140 176 141 - 15 25 193 244 168 39 193 43 63 15 79 19 76 7 140 199 206 - 184 171 30 250 50 146 43 42 228 48 193 168 219 163 177 55 - 200 71 226 254 97 228 140 28 99 210 183 69 117 30 226 31 - 105 30 222 148 46 161 152 75 141 229 148 156 226 149 60 140 - 70 248 137 80 189 241 75 143 34 186 101 158 54 201 25 102 - 241 55 70 35 3 216 118 162 108 39 87 144 66 242 108 61 243 - 239 244 168 180 119 82 49 253 233 136 123 10 206 207 82 89 - 36 88 174 150 38 195 121 37 76 247 250 213 123 36 224 214 - 201 204 169 20 145 60 61 148 240 72 245 170 127 227 23 70 - 172 150 134 226 214 223 107 103 141 130 173 155 70 86 183 - 66 28 179 3 250 26 58 242 194 43 232 66 92 66 187 79 189 - 115 201 108 56 230 163 105 156 115 105 60 208 196 214 23 80 - 148 145 71 5 135 122 132 235 145 201 29 249 42 188 22 245 - 174 164 248 151 240 207 198 70 212 45 21 81 145 142 204 10 - 160 186 163 71 154 222 77 183 49 8 157 84 246 254 35 239 93 - 112 206 180 145 203 60 93 201 116 37 211 39 10 0 126 41 220 - 119 81 1 144 213 22 120 174 35 92 237 226 135 146 250 234 - 33 235 143 65 87 228 217 13 50 87 226 199 254 144 126 149 - 245 166 141 200 243 10 133 46 162 232 115 146 72 172 206 - 175 41 238 191 223 67 147 9 51 12 132 227 114 214 82 120 - 106 56 113 80 209 170 72 88 5 76 31 189 20 215 178 152 212 - 149 201 197 50 102 37 118 211 195 242 150 227 222 140 18 71 - 129 181 137 168 84 119 151 1 73 197 49 180 191 153 148 110 - 200 199 106 231 250 104 246 74 29 148 174 230 227 29 177 89 - 232 58 77 246 183 172 195 20 112 177 141 125 135 6 153 244 - 151 75 234 157 65 36 113 136 241 9 0 230 186 15 162 250 19 - 79 208 225 79 42 25 145 130 183 31 74 76 146 138 71 84 49 - 211 183 209 143 68 244 245 174 149 167 6 252 56 86 28 246 - 169 45 207 130 182 134 66 222 30 61 187 214 251 192 182 235 - 26 15 40 39 210 144 107 247 22 176 249 46 37 36 124 193 127 - 155 233 83 91 118 86 172 214 151 14 236 220 228 103 130 222 - 213 147 204 138 164 48 86 39 185 168 228 218 149 196 206 56 - 17 91 129 133 81 243 17 88 53 227 180 137 28 114 56 92 122 - 247 170 27 241 177 225 187 24 231 251 171 43 85 241 50 170 - 14 15 36 154 87 109 34 151 27 134 121 167 54 108 225 129 12 - 118 251 82 185 168 151 112 226 129 250 130 194 222 77 30 - 118 120 247 237 140 250 122 215 48 107 54 169 103 169 201 - 224 163 129 188 240 195 138 235 187 203 101 109 50 82 205 - 130 227 143 181 115 71 197 11 55 183 214 228 88 219 17 239 - 224 1 244 162 157 171 57 102 252 68 107 48 54 234 27 24 175 - 68 15 114 49 158 213 166 218 19 37 160 207 38 140 137 120 - 10 220 145 86 198 173 108 227 123 9 130 182 203 218 181 195 - 216 240 59 214 215 70 49 131 73 244 196 91 80 99 248 197 62 - 230 152 193 145 111 145 75 245 24 207 226 147 159 90 109 - 103 31 244 97 158 115 84 140 28 140 40 184 185 117 148 100 - 12 118 173 183 172 143 165 92 48 193 34 39 175 186 149 168 - 14 24 142 49 64 220 201 183 78 157 87 129 225 61 43 84 232 - 196 94 55 155 195 207 134 216 61 168 155 89 101 241 16 108 - 61 232 168 236 220 219 161 11 198 208 223 219 91 173 172 - 157 100 86 32 119 166 109 80 30 201 95 79 166 228 30 245 - 150 187 129 127 18 255 0 101 110 209 23 195 43 246 175 107 - 136 5 253 171 30 119 29 181 54 44 125 209 127 252 28 119 - 147 73 72 230 142 40 215 60 31 122 156 223 199 182 38 200 - 192 3 32 212 119 225 21 138 174 131 12 155 67 115 220 84 - 183 91 141 148 97 89 64 199 32 251 84 228 244 119 67 216 - 175 53 163 38 215 30 25 199 112 213 29 69 63 48 152 73 159 - 65 233 83 13 65 48 37 1 124 167 249 170 55 61 169 40 20 109 - 200 254 90 129 218 4 247 78 190 70 24 83 220 214 80 238 154 - 69 16 176 14 14 87 234 104 11 230 104 238 90 118 5 84 252 - 202 125 190 148 126 152 158 21 202 220 69 135 4 103 13 217 - 215 233 250 215 70 55 226 38 88 187 39 154 13 208 252 34 - 163 33 141 193 243 231 212 251 211 251 121 149 85 1 97 130 - 112 191 90 135 90 206 197 188 64 27 45 201 207 127 214 134 - 215 181 195 98 143 189 138 237 77 203 207 99 70 147 236 131 - 99 174 169 234 43 123 77 62 84 37 70 88 247 53 203 223 20 - 122 138 214 234 127 203 100 102 12 71 7 177 230 180 252 80 - 248 131 123 168 93 92 217 90 92 48 143 126 11 3 85 179 199 - 52 132 72 237 36 140 199 144 125 105 163 26 232 132 230 210 - 164 48 75 217 26 50 178 31 175 216 86 192 177 179 120 114 - 70 67 241 199 223 181 123 78 176 141 158 25 60 57 29 36 94 - 123 112 125 170 77 160 116 237 205 192 152 92 70 3 69 180 - 142 14 72 30 149 94 150 201 70 42 93 246 70 127 3 111 32 5 - 156 28 246 30 245 190 13 46 213 184 24 7 252 106 204 181 - 232 39 188 134 25 214 2 158 110 1 167 211 252 45 149 128 - 217 22 112 6 10 158 230 167 249 25 79 192 83 113 90 218 43 - 149 217 141 188 156 214 187 150 139 38 69 97 207 165 90 154 - 223 195 91 168 237 85 150 18 178 103 7 158 226 163 250 159 - 68 74 152 183 104 138 133 245 230 154 51 108 73 97 165 178 - 2 110 35 93 185 140 228 246 250 214 22 218 145 75 144 79 49 - 169 237 237 76 239 180 139 136 30 225 167 183 116 136 113 - 19 250 19 244 164 87 118 130 221 66 140 239 113 150 255 0 - 84 123 26 210 236 17 199 79 146 58 87 225 47 85 90 20 133 - 99 120 217 252 48 184 7 154 188 44 181 72 110 33 115 28 138 - 189 178 107 243 247 73 212 245 13 34 238 43 139 91 150 86 - 86 224 103 130 43 161 190 21 117 252 218 133 187 199 52 195 - 196 199 42 79 57 169 101 130 173 150 89 37 47 133 243 123 - 62 27 184 205 66 250 153 228 158 87 72 219 242 128 203 31 - 230 250 83 11 125 67 241 86 98 67 184 239 92 140 119 20 179 - 85 146 97 108 214 246 225 124 118 236 237 217 7 169 53 139 - 136 77 210 199 8 240 215 106 142 5 122 9 94 225 177 34 149 - 251 208 119 94 29 164 113 164 108 89 229 206 11 127 16 254 - 111 181 21 167 69 35 196 145 178 183 3 230 247 165 148 171 - 163 166 41 164 130 109 86 72 238 147 99 239 32 246 21 50 - 208 67 51 13 202 70 225 138 143 217 91 1 54 246 198 79 106 - 149 105 49 31 46 210 1 250 210 91 125 141 149 166 135 114 - 167 244 87 221 194 162 96 31 173 115 103 199 23 118 190 241 - 36 82 160 55 148 159 90 234 47 194 238 179 39 25 59 121 246 - 174 109 255 0 40 116 120 110 193 194 99 119 97 84 199 217 - 231 101 232 129 88 15 19 77 12 127 74 223 28 124 80 182 50 - 40 176 133 70 70 70 236 125 40 181 124 40 198 106 216 211 - 226 206 89 109 155 34 93 166 136 112 118 10 12 51 23 28 26 - 222 242 16 170 190 227 251 40 168 180 18 63 170 115 121 30 - 61 233 149 159 238 69 44 213 124 179 41 200 224 209 54 210 - 55 130 49 197 27 163 25 220 166 238 105 102 167 24 91 9 200 - 239 225 63 20 222 94 35 207 189 5 169 47 244 9 255 0 221 61 - 43 70 54 233 208 175 236 235 101 33 79 228 35 103 244 175 - 52 113 171 249 177 244 197 37 178 189 151 240 22 235 26 231 - 108 64 22 250 14 212 76 115 74 236 190 76 156 214 148 120 - 148 135 25 116 137 30 154 114 195 142 115 199 181 103 212 2 - 69 22 211 42 134 41 38 15 181 97 165 135 104 187 109 230 - 137 213 70 52 183 247 83 145 247 160 73 170 154 103 65 124 - 33 150 245 186 106 18 99 120 198 121 199 106 156 223 50 181 - 177 103 80 95 24 21 0 248 17 121 29 215 79 197 27 206 216 7 - 154 178 245 45 63 242 188 72 206 83 28 87 61 118 206 200 63 - 34 5 170 47 149 155 113 35 212 123 82 11 169 21 163 11 24 - 218 71 114 106 73 171 90 72 204 237 27 21 199 124 122 212 - 102 246 53 149 138 188 133 0 61 197 37 89 217 29 136 53 75 - 171 111 21 13 192 196 108 112 91 218 137 211 97 109 58 34 - 151 18 135 183 97 186 25 129 206 207 245 126 212 171 82 145 - 33 117 180 155 5 91 129 159 74 81 38 165 119 166 23 181 185 - 13 36 64 111 140 154 120 107 68 242 77 217 59 186 215 99 - 183 178 109 201 135 81 232 121 199 215 235 84 183 196 238 - 182 55 119 18 90 219 202 225 135 145 142 107 221 79 213 32 - 192 235 24 33 241 140 3 233 239 85 212 183 17 202 254 44 - 222 116 39 42 87 230 253 106 177 77 156 83 157 61 31 45 237 - 237 239 1 102 27 100 118 207 29 137 246 21 186 210 206 226 - 234 117 88 99 32 227 102 0 229 79 210 134 131 114 220 179 - 91 169 147 235 31 106 184 62 29 116 188 215 205 14 160 145 - 168 115 141 216 236 79 184 250 85 23 138 217 40 183 116 197 - 93 13 210 179 94 74 18 230 213 114 14 72 92 240 106 230 233 - 14 149 201 182 205 143 49 182 210 72 249 254 245 48 233 30 - 132 176 210 209 47 24 174 233 57 97 252 167 218 167 186 85 - 149 188 100 34 145 133 57 28 122 212 102 220 186 58 97 20 - 182 200 190 129 210 227 194 72 103 183 201 140 229 192 28 - 17 78 83 165 195 162 4 143 96 7 111 126 245 58 210 108 148 - 90 143 40 231 191 214 137 154 200 237 77 168 54 171 110 34 - 137 185 113 123 101 115 115 210 176 184 101 150 223 113 81 - 198 106 35 212 61 46 204 146 44 118 104 3 38 204 227 176 - 247 251 213 241 45 180 101 119 0 9 35 251 41 14 173 104 170 - 73 101 10 153 224 208 119 240 50 148 89 202 157 87 210 48 - 77 60 202 214 110 145 193 229 140 1 199 222 169 174 161 208 - 175 22 242 86 75 117 218 95 31 252 215 114 106 218 69 181 - 227 52 71 111 57 46 113 223 138 169 250 227 225 231 131 110 - 90 216 198 94 224 22 231 209 126 149 162 223 45 154 81 168 - 156 164 246 105 35 152 164 140 41 67 203 122 15 160 172 244 - 205 66 77 47 82 51 89 54 17 78 55 19 203 125 233 247 94 105 - 223 178 174 22 205 16 237 44 124 64 125 90 162 182 234 136 - 155 102 138 70 62 137 31 173 94 124 90 57 84 156 54 116 39 - 195 190 179 134 247 78 137 124 92 52 99 12 24 250 84 190 - 125 74 222 228 22 13 148 35 12 7 241 125 15 210 185 131 65 - 214 164 211 239 247 12 162 231 205 138 181 180 30 166 140 - 66 173 183 114 133 221 180 251 251 212 163 217 104 57 61 - 217 45 187 183 48 52 154 150 161 34 137 37 242 67 26 246 81 - 232 61 233 182 153 49 100 85 229 112 63 90 138 45 212 147 - 203 251 79 82 37 80 183 229 102 164 26 9 252 67 120 146 72 - 85 91 145 72 227 114 59 160 237 18 88 219 116 161 128 194 - 250 98 164 218 66 175 145 152 176 31 74 141 233 144 188 234 - 35 221 177 148 246 247 169 118 137 110 210 97 23 142 49 73 - 246 131 54 146 29 92 206 230 219 109 190 115 183 140 251 87 - 51 255 0 148 20 183 13 170 120 78 170 124 221 249 174 164 - 185 130 27 123 23 50 76 82 69 143 129 239 92 167 241 178 - 239 241 93 84 144 43 29 170 196 55 214 169 141 83 103 14 94 - 136 60 113 50 75 18 174 79 229 246 52 94 226 2 231 223 154 - 250 84 199 50 150 228 142 7 218 177 118 12 221 171 162 18 - 75 71 56 79 139 25 101 81 243 99 244 172 165 198 194 27 185 - 239 143 74 24 174 210 24 112 43 207 32 216 41 219 179 8 181 - 86 62 48 237 222 143 178 93 208 45 3 170 168 241 215 143 90 - 105 166 46 97 24 246 169 72 198 115 174 16 41 251 208 58 - 145 99 167 93 28 124 176 57 31 217 76 167 70 35 147 64 234 - 8 223 179 47 121 255 0 246 207 255 0 45 82 49 209 133 58 - 116 91 236 237 155 215 195 163 214 53 35 105 60 208 186 71 - 245 59 111 247 99 251 232 167 39 120 199 189 115 61 187 58 - 49 244 62 211 27 106 40 244 11 138 206 245 131 90 52 110 - 112 15 124 250 80 182 59 150 60 230 183 93 131 52 5 27 128 - 123 98 175 195 198 206 121 123 23 111 194 141 25 19 165 163 - 146 25 150 25 163 228 146 123 213 139 166 235 6 72 132 55 - 16 182 244 227 196 61 136 170 231 225 154 76 186 12 22 208 - 179 49 99 134 250 138 156 221 168 180 182 82 216 81 234 125 - 123 87 36 175 164 117 198 187 96 58 228 214 203 59 186 202 - 20 145 242 147 193 53 1 215 181 21 183 159 204 200 184 60 - 224 240 43 87 94 245 125 134 157 20 166 73 17 216 118 25 - 230 168 174 178 235 171 237 81 90 222 215 114 199 158 72 - 239 250 86 132 91 208 207 34 142 209 51 235 190 160 181 86 - 120 81 64 43 192 57 245 168 68 189 85 123 61 177 130 95 57 - 67 149 63 78 212 133 26 107 169 12 183 147 177 200 245 61 - 205 1 113 118 200 204 145 224 15 173 118 67 29 171 100 178 - 229 182 25 125 127 150 37 188 197 251 168 238 15 189 39 185 - 59 88 239 96 227 233 90 204 153 36 243 156 250 214 80 71 44 - 242 42 170 239 102 56 81 158 230 153 164 142 87 119 100 211 - 225 206 159 38 163 172 70 24 180 11 24 192 157 144 149 39 - 254 181 215 159 13 186 114 107 91 40 63 18 33 155 114 143 - 204 72 246 156 125 126 149 76 255 0 147 198 143 171 90 193 - 29 212 150 211 92 187 159 201 137 149 118 238 29 192 231 57 - 31 95 210 186 179 67 253 204 19 79 111 28 23 17 128 94 51 - 243 21 255 0 10 231 148 172 183 14 42 205 194 198 51 182 56 - 212 246 239 76 244 141 60 52 109 25 57 246 62 245 140 23 - 182 18 93 21 158 101 66 237 144 163 184 167 169 60 62 42 - 219 197 177 155 211 111 183 189 78 154 232 101 145 208 77 - 140 91 97 53 181 215 56 86 224 19 201 175 182 255 0 153 207 - 99 244 237 88 207 34 169 11 131 222 155 95 72 74 219 179 99 - 70 54 96 118 28 10 87 127 110 100 144 112 118 47 115 77 147 - 204 156 80 119 141 180 129 42 159 15 233 220 208 119 240 - 104 57 39 178 37 117 96 85 213 147 200 51 198 125 105 102 - 187 166 69 54 157 34 149 46 249 193 30 255 0 74 152 93 203 - 101 248 35 47 136 164 33 198 65 165 111 61 188 182 243 165 - 187 70 230 70 249 143 96 43 36 238 217 105 100 109 81 202 - 255 0 26 122 94 231 240 119 19 36 177 69 30 60 177 32 36 - 177 255 0 189 115 30 160 38 130 83 13 194 52 108 59 6 24 56 - 175 208 63 136 208 223 92 105 207 21 134 158 207 19 103 243 - 21 87 43 199 98 73 239 92 75 241 71 69 212 236 122 138 225 - 174 109 229 104 249 35 198 24 32 125 72 227 251 234 139 100 - 114 69 209 22 180 152 162 121 78 1 245 167 218 70 173 115 - 107 34 186 254 98 142 224 122 138 138 6 100 227 248 79 106 - 221 5 228 177 159 47 98 49 85 171 22 46 145 97 69 213 51 92 - 95 197 248 179 182 5 249 99 61 254 245 105 116 222 187 111 - 113 98 30 50 170 84 236 7 61 207 181 115 221 153 241 206 - 226 88 47 185 244 52 108 26 166 163 165 220 175 225 238 11 - 170 182 229 0 240 77 35 196 213 179 170 57 18 143 103 91 - 244 253 212 110 23 116 170 167 102 50 125 13 77 116 75 168 - 109 109 131 33 103 25 229 147 214 185 131 161 190 34 36 211 - 8 175 36 104 229 7 140 227 7 251 234 246 233 77 90 222 254 - 213 26 9 55 2 61 235 145 220 101 208 202 74 107 178 77 121 - 113 115 170 188 145 70 36 181 135 30 99 47 241 253 171 159 - 62 46 90 90 218 245 34 77 104 193 54 183 0 213 253 169 91 - 200 150 203 113 19 96 168 36 227 218 185 235 226 187 51 106 - 194 86 112 70 227 192 239 84 199 53 100 178 105 82 35 18 57 - 99 90 7 239 43 4 155 33 91 156 123 86 107 203 110 174 142 - 36 101 166 19 130 0 200 199 21 237 170 121 39 154 248 155 - 177 230 32 214 71 129 156 142 105 210 179 8 245 140 248 163 - 138 109 163 200 162 223 130 51 138 85 173 224 74 87 190 61 - 69 29 163 254 235 244 161 40 152 57 183 51 103 6 131 213 8 - 93 58 247 60 127 71 127 249 104 238 62 180 22 177 183 246 - 101 239 127 234 239 255 0 45 20 233 24 85 167 73 26 216 65 - 158 254 18 86 70 100 50 129 159 90 89 104 199 240 86 236 - 199 63 150 63 186 178 133 100 146 225 112 199 147 197 69 37 - 101 99 145 116 137 133 143 154 42 223 50 31 8 149 228 138 - 209 167 127 87 0 247 94 9 162 157 136 78 14 51 222 171 242 - 136 228 246 39 127 8 122 155 193 211 165 220 219 222 54 192 - 218 113 254 52 71 92 124 78 134 206 23 182 242 187 28 252 - 196 228 113 244 170 88 223 220 219 207 44 80 206 241 239 - 239 180 227 38 144 234 211 205 121 49 73 228 101 63 206 79 - 45 244 169 180 145 73 78 162 107 234 29 90 235 92 212 101 - 113 39 229 150 254 34 104 102 133 173 146 56 230 104 163 6 - 61 202 249 206 107 11 155 118 183 143 115 52 123 72 227 117 - 42 184 144 147 183 57 35 142 15 24 167 142 136 115 114 14 - 212 175 140 155 18 48 170 23 212 122 208 18 51 72 219 155 - 143 181 124 141 89 188 217 237 82 45 15 165 239 239 228 64 - 35 220 172 50 60 164 211 60 180 168 122 182 34 182 181 150 - 105 22 52 83 150 56 21 119 124 40 232 61 22 11 120 117 14 - 162 91 71 193 223 137 156 141 163 244 168 207 76 244 169 - 183 63 136 212 18 225 18 57 54 168 100 219 185 135 63 225 - 91 58 183 90 125 107 82 255 0 195 61 62 206 225 188 133 223 - 130 120 244 164 82 82 209 69 162 234 185 248 149 211 250 36 - 150 134 27 173 53 90 60 43 62 205 196 168 237 185 135 124 - 122 30 226 143 31 29 52 104 209 202 95 254 32 5 27 100 36 - 236 45 159 148 10 175 236 62 14 116 119 78 233 49 106 29 - 125 173 188 6 78 209 228 140 254 148 143 173 126 25 244 255 - 0 254 31 184 234 111 135 186 191 237 75 11 33 253 58 212 - 252 240 131 193 111 211 138 203 18 248 105 41 203 127 11 55 - 77 248 167 13 230 169 52 150 247 62 32 50 141 165 57 219 - 192 206 71 176 171 175 165 122 166 5 180 105 218 238 57 174 - 14 11 190 120 198 63 135 233 92 19 209 178 53 191 80 219 - 134 145 158 37 96 36 8 112 28 122 30 61 49 87 123 245 75 - 105 182 99 207 52 183 69 118 195 26 0 16 169 237 74 213 104 - 10 171 71 82 105 125 92 178 27 168 173 231 133 252 12 41 37 - 143 45 235 68 75 172 79 115 181 162 5 128 229 177 233 84 - 103 195 200 167 142 199 241 23 49 151 121 21 93 163 36 242 - 199 230 63 165 90 218 115 72 203 28 109 148 86 95 48 30 130 - 163 46 131 68 134 62 164 146 22 88 78 21 152 231 46 120 197 - 44 126 179 134 226 226 72 124 104 153 146 79 13 129 39 0 - 251 253 170 55 212 64 44 102 54 86 40 36 33 28 158 7 21 76 - 245 62 169 115 211 218 200 159 30 37 165 208 49 206 224 240 - 62 181 88 250 152 177 62 34 245 140 58 102 239 2 121 12 14 - 222 120 80 249 147 237 244 168 54 141 241 163 78 211 141 - 197 165 197 196 110 210 203 184 16 199 40 158 223 78 113 - 222 160 191 17 53 127 196 104 134 75 123 167 145 74 17 20 - 217 230 63 175 255 0 62 245 82 116 190 137 169 117 70 175 - 107 165 233 240 120 183 183 79 225 199 158 199 156 150 111 - 160 28 213 97 20 214 197 201 168 218 58 99 87 248 221 161 - 73 107 36 48 234 16 164 172 70 232 230 77 202 62 162 133 - 213 239 186 63 173 172 13 173 252 186 108 175 26 9 160 13 - 46 213 115 245 3 147 81 85 248 123 240 135 79 184 58 54 177 - 212 210 207 171 96 36 146 110 10 187 253 64 250 103 181 70 - 126 35 124 48 190 232 99 6 191 161 221 181 213 145 243 70 - 249 7 2 179 138 55 41 69 121 116 68 62 34 244 106 232 154 - 139 73 100 209 61 179 246 17 146 66 253 179 80 146 152 39 - 131 199 28 213 195 105 171 105 157 87 161 143 26 59 165 188 - 183 127 13 178 23 185 254 44 14 194 162 250 143 68 106 158 - 61 204 107 110 234 144 30 119 14 228 250 214 186 216 120 - 166 66 226 186 146 33 181 64 42 79 57 166 150 183 81 221 67 - 28 108 18 34 131 27 135 115 75 245 13 58 230 209 218 57 151 - 105 30 148 26 50 169 243 12 143 106 111 201 100 165 221 14 - 110 45 100 30 29 202 108 93 231 201 176 249 179 245 169 239 - 195 46 190 155 65 116 134 233 140 202 14 56 39 138 173 172 - 165 241 167 102 114 65 246 205 29 45 139 162 248 204 228 - 123 82 154 13 217 214 154 111 94 193 127 103 35 13 219 89 - 59 103 214 170 30 176 184 55 250 195 158 200 28 241 237 81 - 14 158 212 46 196 42 137 52 136 163 140 3 222 158 137 55 - 121 155 204 199 185 62 181 62 153 119 177 106 33 86 39 146 - 15 247 81 80 227 28 214 137 102 84 57 35 143 81 91 33 60 96 - 250 242 42 184 246 182 77 236 45 72 53 242 65 229 28 154 - 249 12 110 20 229 189 107 50 141 142 244 244 97 14 171 216 - 100 246 245 166 26 88 99 0 35 218 130 215 35 41 149 62 180 - 126 145 34 139 101 76 115 75 35 4 237 124 253 43 70 167 206 - 153 122 63 254 179 255 0 203 71 73 185 87 191 122 7 80 255 - 0 54 94 255 0 237 223 254 90 41 42 48 158 198 216 61 132 13 - 234 34 76 10 223 4 91 101 25 226 129 180 188 95 192 192 168 - 74 159 13 123 253 40 136 174 55 56 243 115 92 231 71 24 168 - 162 77 103 194 133 29 143 173 23 183 3 142 104 29 53 183 69 - 159 173 28 161 137 32 48 31 122 183 250 156 242 236 132 107 - 158 77 85 199 161 245 165 154 157 228 75 20 143 224 147 38 - 208 160 254 180 95 83 57 138 255 0 123 28 143 97 222 163 23 - 119 6 86 113 187 3 28 3 64 73 118 105 188 158 75 137 188 71 - 96 196 142 62 149 164 43 30 194 155 233 90 68 247 146 69 24 - 134 76 56 200 101 82 71 247 84 150 223 225 254 169 117 125 - 13 172 54 206 217 30 128 228 208 177 150 50 61 211 246 17 - 93 221 197 19 50 151 102 24 78 228 254 149 210 29 55 105 99 - 164 244 220 104 153 154 237 211 1 35 143 5 190 134 190 116 - 95 193 91 125 52 67 53 238 212 144 12 22 9 206 126 149 105 - 216 232 54 58 126 158 27 240 202 229 60 161 207 115 250 84 - 178 100 101 225 138 145 205 127 16 35 235 141 54 194 107 - 169 173 82 194 202 102 43 28 64 121 177 238 126 181 183 252 - 152 180 184 110 186 206 59 139 153 55 120 114 255 0 23 124 - 138 184 254 36 90 166 177 166 141 46 104 35 142 4 39 108 - 140 60 196 227 176 199 115 84 102 142 215 157 3 174 165 245 - 152 155 98 49 145 210 65 182 66 185 239 131 86 197 41 73 81 - 57 175 22 75 126 54 92 222 106 189 105 168 45 206 80 193 62 - 200 131 127 20 127 74 19 225 245 222 151 210 147 38 181 113 - 169 69 121 103 125 101 56 212 44 99 102 221 6 60 168 178 - 103 131 158 249 20 247 171 250 255 0 225 55 87 218 197 168 - 106 38 238 29 67 24 153 33 139 7 31 169 239 80 253 42 199 - 77 234 9 221 244 173 34 120 116 93 223 60 242 238 146 225 - 135 191 176 197 36 63 140 227 147 155 122 59 223 245 28 95 - 218 44 42 62 68 123 167 116 185 33 117 214 20 71 109 12 210 - 51 36 95 197 180 158 0 171 51 165 244 73 181 27 215 191 191 - 183 154 71 150 61 177 2 56 219 239 254 213 35 135 77 93 99 - 94 75 88 99 72 173 161 199 135 10 231 9 138 187 122 35 69 - 184 136 199 113 225 112 23 204 91 181 105 61 158 122 116 - 182 109 183 177 142 215 72 137 99 152 44 139 202 169 238 - 135 220 211 173 10 247 84 145 37 105 49 49 72 240 127 183 - 230 20 195 195 180 216 86 107 115 34 158 225 69 108 183 146 - 21 220 177 126 90 40 200 92 115 82 158 217 76 73 209 23 188 - 188 186 187 184 17 77 43 73 110 173 231 66 57 205 36 235 93 - 26 222 248 180 239 3 92 196 188 182 206 202 49 86 11 61 188 - 190 105 20 200 254 158 80 48 43 69 253 168 184 183 219 28 - 107 27 24 246 133 127 95 236 162 131 61 28 197 173 216 222 - 88 217 13 44 226 43 73 31 242 89 255 0 139 239 65 124 52 - 190 183 232 190 169 212 34 186 137 37 188 186 211 165 252 - 20 241 182 10 183 7 106 159 114 1 171 31 226 39 74 188 150 - 165 68 82 126 72 47 156 241 159 165 66 44 180 219 125 107 - 79 75 123 168 137 187 181 36 199 112 14 10 48 237 131 86 - 134 153 9 78 169 175 217 28 191 211 109 173 111 109 205 190 - 165 6 167 45 196 98 226 89 34 13 152 157 143 40 229 191 136 - 122 213 219 240 252 182 169 240 123 92 211 245 15 204 134 - 221 191 163 153 62 94 59 129 85 78 147 168 244 85 173 233 - 139 172 44 181 29 51 80 138 76 59 194 229 163 155 253 110 - 121 201 246 169 111 88 252 86 233 143 252 53 7 76 244 23 - 143 35 72 140 37 121 34 218 50 125 205 8 97 148 95 43 61 95 - 231 255 0 59 22 124 80 140 35 180 82 80 254 51 75 234 219 - 152 244 185 25 31 199 17 162 17 228 111 191 210 174 222 139 - 139 169 109 103 71 234 59 16 208 73 134 91 132 28 99 218 - 162 191 15 58 89 110 181 4 213 181 39 113 32 199 134 93 114 - 142 255 0 82 43 162 180 147 22 161 107 2 222 219 198 147 - 162 132 64 7 148 175 189 35 200 250 103 18 132 111 179 158 - 126 54 232 182 47 178 234 216 143 12 182 230 34 169 75 216 - 226 86 62 11 7 25 238 43 184 58 167 161 44 181 120 36 73 6 - 204 140 99 195 4 19 238 42 138 248 143 240 98 250 192 126 - 51 78 18 73 30 114 219 87 3 251 40 197 162 83 195 78 202 44 - 103 52 211 78 187 145 54 164 135 122 127 47 168 167 119 125 - 31 117 14 158 39 146 60 72 6 74 169 228 212 106 230 9 109 - 91 44 172 185 28 110 20 233 139 199 137 59 211 30 223 194 6 - 21 216 9 228 123 154 117 19 21 183 101 35 181 68 58 114 224 - 52 41 184 147 232 64 247 169 58 179 120 108 164 130 77 35 - 236 22 8 208 254 98 209 16 202 21 112 8 197 15 63 136 172 6 - 112 125 43 234 35 110 238 0 255 0 173 87 23 65 24 66 236 - 121 193 197 109 144 238 21 170 15 42 121 151 28 214 213 59 - 184 170 24 79 174 144 84 145 216 246 173 250 79 238 135 218 - 133 214 206 213 17 144 115 69 105 35 49 45 99 12 223 228 - 160 245 15 243 101 239 254 217 255 0 229 163 101 24 10 191 - 74 11 81 227 77 189 255 0 219 191 252 181 140 66 237 225 - 152 136 216 103 105 143 138 42 222 57 150 117 57 39 154 107 - 103 110 162 194 219 10 63 171 171 126 167 189 98 177 159 20 - 10 230 67 56 162 65 166 16 176 15 122 57 202 178 141 172 - 115 64 88 198 124 49 205 27 28 101 92 179 114 41 211 177 27 - 43 190 181 38 61 66 76 115 159 127 74 142 91 196 102 157 87 - 146 88 212 151 174 163 111 198 6 254 126 212 171 167 182 - 166 169 24 144 2 50 57 62 156 208 151 236 120 165 106 206 - 132 248 59 209 94 38 135 22 165 116 100 87 219 133 80 70 49 - 138 180 58 43 73 68 189 154 226 52 220 241 182 23 35 56 160 - 58 34 72 173 250 58 47 54 209 225 129 24 247 207 173 79 186 - 31 77 16 218 248 219 67 25 6 226 42 13 203 224 242 236 123 - 167 216 226 13 203 26 128 188 231 57 255 0 26 95 212 86 203 - 14 38 0 224 17 188 125 42 75 20 6 20 41 26 240 252 40 164 - 186 234 187 174 24 60 133 78 89 87 218 149 187 209 148 221 - 236 138 245 22 157 60 140 183 218 74 1 34 249 247 204 160 - 162 241 142 213 79 245 47 72 111 89 117 61 99 84 182 187 - 158 103 33 174 166 206 10 255 0 42 133 245 251 213 175 213 - 218 164 50 217 172 77 44 214 192 54 8 65 153 36 250 40 165 - 235 164 216 95 233 145 223 73 17 140 91 201 143 195 177 220 - 227 244 236 198 173 6 250 55 37 118 206 124 181 232 213 212 - 181 136 196 118 238 246 80 74 54 160 1 90 97 239 159 229 - 171 3 81 179 134 222 91 125 63 77 88 108 247 70 21 97 132 - 238 43 245 53 45 120 119 180 159 135 218 145 202 124 24 230 - 10 1 96 59 138 144 116 239 76 219 104 202 250 174 165 4 101 - 194 238 201 94 91 218 157 201 213 11 26 91 162 47 209 221 - 26 52 117 23 55 18 44 146 183 32 241 146 126 181 97 105 233 - 20 118 239 243 120 107 243 2 121 52 161 18 107 251 179 117 - 35 164 17 70 249 66 107 125 213 247 138 230 59 119 1 148 - 224 149 236 106 118 51 105 187 99 27 235 207 20 237 133 85 - 51 237 90 163 140 144 27 36 55 175 214 176 176 141 3 171 57 - 220 128 242 222 212 213 32 181 101 44 179 99 53 59 41 141 - 241 20 200 230 41 119 134 56 245 197 31 105 121 29 194 42 - 177 193 3 134 254 42 198 107 120 2 16 178 100 251 210 153 - 213 161 184 13 20 228 145 243 173 50 86 9 53 123 50 234 11 - 11 107 132 41 134 60 99 35 4 255 0 125 85 157 71 210 82 232 - 87 15 123 4 237 225 49 203 32 28 15 92 241 86 153 120 245 - 40 4 33 140 12 220 54 239 152 214 173 37 225 148 75 165 223 - 70 178 197 38 80 59 12 213 185 19 139 75 225 77 117 119 76 - 218 117 23 78 199 47 225 99 146 248 121 146 242 54 243 3 - 252 172 191 245 164 29 51 210 246 205 122 209 95 27 104 110 - 162 249 76 132 248 83 143 117 43 87 61 247 76 54 135 118 - 243 89 248 81 68 91 43 159 95 113 205 124 211 116 235 59 - 199 54 23 81 195 110 249 202 133 64 54 122 231 39 248 104 - 114 98 73 236 91 209 125 35 169 105 98 107 75 29 66 7 178 - 150 60 155 57 0 59 121 244 39 154 176 161 130 56 45 161 131 - 240 242 36 164 237 44 221 179 244 168 206 172 145 216 106 - 169 111 43 77 19 68 121 184 135 229 199 250 223 79 168 169 - 93 165 218 234 150 209 172 106 222 64 48 87 215 30 166 167 - 40 219 177 137 5 164 77 225 36 102 48 236 7 36 210 254 160 - 178 221 27 70 208 171 41 249 151 210 159 105 140 205 10 22 - 12 209 109 192 217 232 126 191 90 251 119 110 165 6 236 183 - 213 187 209 72 45 183 217 69 183 75 195 125 121 61 155 100 - 5 30 184 205 115 207 198 174 155 151 68 213 222 32 25 161 - 83 228 98 7 34 186 207 88 181 139 79 234 23 149 155 247 220 - 10 163 255 0 202 41 80 99 115 120 135 178 3 252 67 6 155 28 - 147 208 117 84 202 79 164 121 159 185 198 123 26 153 3 129 - 233 81 14 155 253 250 152 252 188 224 129 233 82 233 50 23 - 235 76 227 178 79 197 31 83 243 62 113 147 239 69 69 10 17 - 207 56 237 66 70 234 20 224 115 68 71 56 0 125 120 167 197 - 209 141 160 49 250 250 86 74 25 125 43 234 28 14 56 205 101 - 147 239 84 48 155 89 82 249 46 54 159 165 109 209 219 49 - 125 171 29 96 150 206 121 226 190 232 192 180 71 21 140 53 - 145 153 136 192 29 168 109 70 54 253 151 120 205 192 54 207 - 255 0 45 18 119 46 57 244 172 117 94 116 59 175 253 179 255 - 0 202 107 24 142 89 51 27 24 6 15 238 146 183 163 13 224 - 100 103 53 170 197 15 224 160 237 251 164 175 174 140 178 - 175 110 245 199 99 146 109 59 247 127 173 22 85 73 60 208 - 90 110 68 32 159 122 34 114 206 190 203 233 142 245 117 29 - 89 39 221 16 158 179 54 177 220 6 150 54 101 29 212 54 9 - 253 107 111 65 52 119 55 208 199 14 159 167 164 123 191 120 - 209 111 147 191 189 1 214 76 222 33 221 130 113 71 252 41 - 88 255 0 104 199 36 165 130 171 100 227 214 150 79 84 58 - 126 71 78 217 170 67 162 91 71 31 38 76 42 17 235 86 191 71 - 218 226 40 183 157 227 104 3 30 245 85 116 252 107 47 224 - 147 147 26 121 176 106 212 209 200 68 130 221 153 131 103 - 118 229 237 138 136 242 236 147 52 74 210 101 92 7 94 113 - 81 206 163 180 146 65 45 212 115 0 66 224 212 170 13 172 85 - 149 148 48 60 230 163 157 92 118 146 241 130 177 200 118 96 - 251 227 63 244 167 125 0 170 250 146 107 143 26 41 174 154 - 105 32 81 183 100 67 37 142 104 141 62 226 225 44 37 156 - 192 167 127 149 93 184 194 251 154 34 85 150 107 205 145 - 176 9 27 121 178 56 175 107 55 45 34 236 114 145 219 47 4 - 142 9 164 10 179 239 79 89 193 97 27 94 77 34 162 47 152 51 - 30 13 9 170 235 147 234 243 24 80 18 177 156 130 61 69 71 - 239 239 159 88 188 88 85 21 45 226 60 5 39 154 51 80 158 - 223 65 182 73 37 184 54 225 70 230 4 14 70 59 81 76 106 190 - 198 23 55 145 91 233 127 141 105 132 48 198 48 238 199 3 - 255 0 154 174 58 155 227 6 147 167 135 139 69 183 123 233 - 84 238 241 230 249 11 85 101 241 47 174 53 30 162 190 154 - 40 100 123 125 56 54 216 237 225 111 46 51 220 253 106 53 - 162 195 249 223 155 143 15 235 70 43 147 7 137 100 15 139 - 93 115 122 210 203 111 115 4 1 223 248 98 193 3 233 91 224 - 235 142 190 159 44 117 201 23 112 254 17 66 244 246 143 9 - 132 58 170 159 165 53 93 29 113 226 5 35 43 144 0 167 81 - 127 161 185 68 15 255 0 212 47 136 86 174 118 234 178 76 23 - 130 28 113 138 249 167 124 105 234 91 59 198 143 87 180 181 - 188 182 99 229 35 190 62 148 116 154 76 126 31 238 219 44 - 57 200 168 119 85 233 118 246 170 74 40 12 79 4 246 20 90 - 111 224 27 139 46 222 152 235 237 19 169 151 109 140 198 - 218 240 156 61 180 237 134 79 246 126 181 34 212 21 229 41 - 26 161 241 147 204 8 244 250 215 29 239 158 206 100 158 41 - 36 142 88 206 229 120 216 130 167 220 123 213 223 240 171 - 175 165 212 172 19 76 214 36 205 194 174 216 238 9 229 135 - 177 164 118 129 73 244 93 58 63 80 195 169 35 105 23 135 - 108 177 46 6 238 198 129 182 183 146 199 89 146 65 27 74 - 210 38 207 15 196 194 129 244 164 122 189 171 181 132 55 80 - 183 134 20 238 18 47 175 222 138 210 117 111 218 67 240 247 - 18 5 184 78 3 10 91 12 83 110 168 207 85 150 225 110 90 222 - 68 144 6 95 202 42 60 195 234 79 173 72 186 125 111 38 252 - 53 180 146 166 118 124 222 189 251 26 213 115 190 234 201 0 - 88 214 88 142 85 241 233 68 116 235 184 34 119 145 222 69 - 109 187 113 253 244 108 220 75 31 72 181 120 160 48 25 4 - 128 12 144 43 116 176 199 248 15 13 99 98 8 230 182 105 222 - 91 96 164 129 43 97 183 30 216 199 106 209 172 188 98 216 - 198 172 195 234 180 91 36 221 58 43 158 186 142 72 46 32 - 154 67 149 13 159 189 85 31 25 237 148 233 226 85 240 156 - 21 220 168 235 184 30 61 69 91 221 94 127 21 104 95 4 140 - 121 126 149 89 245 117 172 87 90 116 126 59 200 27 105 92 - 142 64 21 37 26 118 91 134 172 230 221 62 226 221 53 16 143 - 103 28 110 78 73 133 246 47 255 0 230 164 55 238 134 37 218 - 70 61 57 165 29 89 165 92 104 218 195 188 136 230 34 124 - 178 122 99 222 178 134 224 188 74 172 114 64 239 86 82 100 - 166 188 67 34 108 46 115 69 71 38 229 238 41 100 47 199 122 - 54 221 129 166 140 184 137 45 58 24 219 252 167 62 245 183 - 156 103 210 180 68 234 171 94 150 96 20 14 106 139 34 97 0 - 213 121 25 29 141 124 210 37 111 8 166 59 26 245 243 6 77 - 163 248 123 159 122 195 70 238 212 121 196 195 144 196 247 - 21 163 84 35 246 77 208 245 17 57 63 109 180 65 27 87 60 80 - 154 145 255 0 203 111 127 246 207 254 24 173 206 38 21 233 - 188 216 219 159 254 146 127 133 110 4 9 121 25 161 108 37 - 85 177 183 95 85 140 110 250 226 136 143 243 36 7 208 26 - 228 41 30 199 214 25 240 78 71 173 109 150 64 16 143 95 65 - 239 88 90 16 109 248 227 28 86 139 146 119 231 60 142 213 - 107 124 73 201 121 16 206 172 95 26 80 23 191 175 210 166 - 191 9 186 121 141 170 220 180 51 57 39 129 129 239 222 144 - 217 105 82 234 218 199 131 179 11 184 110 53 209 157 23 211 - 214 182 122 44 81 201 48 241 182 0 61 49 74 24 251 14 122 - 66 214 229 94 48 208 133 80 63 139 189 88 90 72 96 192 54 - 56 236 105 7 78 88 164 31 52 129 163 94 88 231 204 79 181 - 74 32 134 75 123 116 196 68 156 118 110 226 145 143 46 198 - 179 58 65 18 179 74 219 207 112 59 84 115 170 46 217 180 - 249 95 121 44 62 81 237 245 251 209 183 119 81 180 108 184 - 238 42 25 212 90 162 174 228 102 93 157 155 119 96 41 152 - 42 207 186 29 184 107 71 154 87 35 185 99 238 106 35 214 90 - 132 78 5 157 187 22 99 232 41 157 222 169 44 26 83 52 101 - 76 44 48 54 118 53 26 208 109 228 190 214 33 145 162 12 12 - 152 25 246 164 47 12 111 76 155 124 53 233 149 16 45 197 - 218 110 64 114 115 235 84 239 199 221 101 78 177 123 102 - 140 26 56 188 160 102 186 123 67 179 75 123 51 101 8 13 193 - 12 127 147 235 92 107 241 198 27 139 126 176 212 98 152 146 - 230 124 159 246 105 148 28 132 134 68 242 52 200 12 48 44 - 118 198 237 149 195 183 37 15 202 62 213 165 53 63 1 131 60 - 39 195 251 84 155 168 46 180 217 180 109 62 218 212 51 92 - 54 12 161 7 205 247 165 87 82 89 54 159 36 87 22 142 140 62 - 94 59 85 34 168 156 161 110 209 97 124 56 215 45 245 8 28 - 170 12 227 145 237 86 5 215 225 226 75 113 12 108 254 77 - 217 110 56 170 35 225 13 243 91 235 38 53 243 161 111 238 - 171 123 169 245 84 91 139 104 17 137 65 24 17 253 15 181 - 116 66 105 160 113 67 109 70 91 88 173 214 118 0 239 5 72 - 81 218 169 78 186 234 56 127 27 45 154 167 136 55 144 49 - 222 173 110 160 212 29 58 101 228 42 5 202 198 66 12 122 - 123 215 62 233 243 164 250 255 0 141 116 60 92 49 242 142 - 237 247 161 55 72 220 80 93 188 222 50 8 230 132 164 141 - 199 110 5 49 209 255 0 242 221 97 24 23 216 28 40 223 199 - 127 181 107 189 186 73 119 50 219 202 189 176 224 114 121 - 166 125 93 62 159 113 248 25 172 29 213 196 65 164 200 238 - 213 12 177 114 141 153 73 69 209 212 95 8 26 223 168 186 54 - 104 166 219 35 68 72 81 246 21 27 234 77 54 125 23 88 18 - 236 216 132 242 69 51 255 0 37 139 27 166 208 175 174 74 - 150 141 66 149 95 114 123 212 179 226 94 151 227 217 181 - 196 42 36 98 114 19 249 126 149 25 174 40 188 50 46 64 61 - 45 117 107 170 89 51 69 38 14 57 7 189 109 179 111 194 245 - 10 13 196 46 60 195 211 25 168 15 76 222 92 88 234 70 5 5 - 73 60 113 145 82 150 213 51 126 143 112 34 19 99 128 135 - 119 30 249 255 0 165 104 116 52 210 79 69 167 109 119 185 - 17 22 66 87 119 13 235 138 35 83 11 140 198 229 199 166 106 - 45 162 220 120 138 36 207 25 230 164 81 75 226 40 88 227 - 223 143 74 214 115 53 228 70 181 136 157 225 117 141 64 227 - 133 53 93 235 150 179 52 130 23 132 62 14 0 95 191 173 90 - 250 196 56 152 49 219 150 249 75 118 6 161 215 246 48 139 - 215 146 105 24 130 48 71 240 211 36 55 39 209 207 127 20 33 - 179 180 212 101 79 6 102 89 24 46 201 62 82 113 220 84 6 88 - 22 44 52 44 206 159 94 226 174 175 140 58 47 137 104 38 179 - 101 148 71 150 81 184 6 83 244 205 83 54 30 42 72 232 246 - 243 3 159 48 200 110 126 244 64 246 104 220 241 131 186 137 - 182 184 64 57 110 107 102 161 110 172 9 141 65 30 254 212 - 166 104 218 35 156 253 42 148 128 210 100 129 46 99 63 197 - 95 39 148 99 200 115 72 34 149 193 201 99 138 221 248 229 - 67 207 106 87 20 128 208 222 233 129 143 30 222 190 245 142 - 151 235 247 165 175 125 226 2 84 226 143 210 100 5 194 255 - 0 53 40 7 133 191 44 80 90 144 206 153 122 114 127 171 61 - 109 150 224 46 87 219 138 26 250 101 109 34 233 189 225 112 - 126 213 168 70 221 137 52 247 111 194 91 140 28 136 249 166 - 118 114 121 192 160 116 224 166 24 71 111 203 163 173 194 - 248 234 5 98 204 146 89 170 152 115 187 239 66 223 99 5 148 - 225 63 157 62 106 105 99 25 48 42 199 183 39 190 104 203 - 189 29 230 179 1 21 83 112 249 143 111 238 172 37 48 14 133 - 210 188 109 107 241 144 164 50 46 209 151 99 130 13 116 78 - 131 56 158 218 20 150 81 189 80 13 158 131 235 85 223 195 - 94 156 59 143 226 99 12 217 225 135 21 108 90 233 166 36 79 - 10 30 0 239 88 172 152 218 198 23 133 149 225 96 185 238 - 126 148 254 207 12 187 34 137 143 243 63 165 35 182 146 88 - 80 35 67 128 79 239 15 240 253 41 148 55 50 71 3 198 155 - 223 63 59 227 185 250 86 20 246 175 9 49 238 137 75 194 7 - 14 59 26 171 122 185 101 146 252 170 221 70 138 79 57 171 - 19 90 190 184 150 223 207 136 198 60 160 85 91 173 91 79 - 121 123 35 126 42 20 85 57 229 143 253 169 39 236 52 59 21 - 95 71 52 120 85 189 141 19 24 193 61 254 181 38 232 109 62 - 56 84 95 120 139 52 177 12 70 23 208 251 210 8 45 33 102 62 - 35 69 113 183 143 43 28 138 150 244 28 129 53 1 12 177 109 - 133 56 69 30 223 90 89 71 145 87 58 90 44 222 153 135 108 - 45 112 24 137 64 59 200 35 39 138 160 63 202 143 164 236 - 110 35 77 90 16 177 220 71 31 157 207 118 63 203 255 0 95 - 210 186 59 76 240 101 45 113 224 67 10 200 219 34 218 152 - 57 168 199 95 116 226 234 154 109 212 19 66 158 32 207 206 - 14 8 193 237 93 81 141 66 145 199 109 202 217 193 218 38 - 143 125 172 92 206 182 82 120 115 194 3 167 250 199 216 81 - 186 229 182 179 114 195 76 184 142 52 153 64 252 208 57 63 - 83 79 238 108 238 58 51 172 102 142 72 93 32 119 36 100 119 - 25 197 72 174 109 109 245 43 132 213 172 128 119 83 202 159 - 81 83 166 116 173 171 43 142 148 209 167 210 53 87 186 109 - 225 20 130 8 29 254 212 255 0 168 117 88 99 189 18 151 121 - 75 184 112 15 163 10 115 169 205 104 214 160 109 219 47 168 - 3 24 168 70 191 34 35 161 50 198 74 190 79 218 171 23 76 95 - 199 68 203 87 214 37 213 236 26 53 97 28 146 199 220 255 0 - 102 42 186 135 166 111 237 101 123 191 50 170 19 133 35 150 - 251 84 183 68 104 4 177 177 98 112 6 125 170 84 82 27 248 - 197 189 188 97 156 253 56 169 202 77 176 113 118 65 83 78 - 215 58 130 206 36 216 150 214 208 121 188 131 131 250 210 - 254 157 210 219 80 215 226 210 252 97 8 241 48 197 189 106 - 194 214 117 11 77 19 76 125 54 215 30 57 82 9 28 3 79 255 0 - 201 219 162 228 212 181 51 171 222 70 35 241 27 10 204 14 - 59 131 237 70 9 216 217 101 20 182 116 135 194 61 10 223 71 - 233 107 107 59 21 100 11 15 159 61 137 250 208 157 71 12 97 - 154 215 143 1 137 222 171 83 13 26 218 43 88 139 75 108 35 - 139 110 197 57 225 143 189 38 234 185 161 181 211 101 183 - 48 140 177 224 142 226 182 98 56 211 178 137 234 75 3 103 - 126 235 13 210 69 179 144 73 173 130 222 67 20 99 241 145 - 191 102 220 13 27 168 199 28 215 18 77 53 184 93 195 130 79 - 106 16 88 52 155 213 111 32 12 167 182 227 255 0 106 132 - 186 59 155 209 97 116 84 108 85 3 72 36 56 192 34 167 80 70 - 200 128 172 81 179 175 24 61 234 176 232 167 154 223 242 - 154 101 45 191 131 159 165 88 208 95 93 44 106 165 81 128 - 31 50 250 211 199 212 228 105 169 108 211 171 31 16 177 142 - 51 27 145 202 159 74 142 94 195 25 140 200 192 22 94 114 87 - 52 250 250 105 35 117 104 83 45 234 27 185 165 119 214 183 - 19 184 62 25 85 110 227 183 52 76 85 255 0 17 132 154 166 - 147 37 186 248 46 20 21 7 110 222 125 170 129 155 79 252 60 - 230 39 32 182 79 145 107 171 122 135 68 142 75 86 221 25 92 - 100 146 59 26 162 186 143 167 38 135 88 220 138 165 119 28 - 30 107 24 133 203 14 207 44 159 150 79 240 175 99 75 110 45 - 85 216 243 83 62 164 210 229 135 108 166 18 138 125 248 34 - 163 110 129 92 228 86 17 232 71 37 152 0 226 130 158 215 - 239 82 48 136 202 124 190 180 37 197 190 92 129 142 244 105 - 152 143 205 19 33 242 127 109 63 233 213 252 149 242 146 - 217 228 214 155 139 85 10 78 40 189 15 8 59 113 154 120 166 - 96 249 147 50 29 220 26 211 168 68 19 72 186 62 190 11 147 - 246 162 174 15 230 134 247 21 167 84 255 0 50 221 55 24 107 - 119 24 162 97 14 159 36 102 218 32 205 180 248 116 198 213 - 226 87 83 188 147 154 81 107 167 220 53 140 18 7 35 242 249 - 163 44 237 37 105 17 119 28 131 147 82 28 156 233 82 143 18 - 49 232 69 79 180 187 75 121 32 92 220 73 28 184 249 68 69 - 133 65 186 106 197 231 158 36 49 201 38 61 87 210 174 190 - 145 211 94 68 137 95 195 66 171 140 177 231 245 172 97 191 - 72 233 106 109 6 103 93 195 186 142 230 167 58 110 155 149 - 2 36 4 1 146 204 199 138 15 167 44 108 128 241 124 25 230 - 127 226 240 71 203 82 107 123 49 34 172 113 248 241 71 156 - 226 65 131 88 87 42 6 22 110 1 241 219 196 92 121 84 129 - 138 211 5 149 227 238 88 149 84 19 252 93 170 65 111 103 - 146 84 149 104 151 251 65 172 166 82 241 42 66 205 41 31 - 194 220 17 253 148 44 28 209 92 245 109 181 212 113 110 220 - 74 129 192 30 181 84 206 151 127 141 151 198 194 3 192 4 - 213 229 213 154 108 146 218 14 114 49 230 95 229 174 127 - 235 72 166 211 53 41 87 12 242 147 223 39 129 83 156 188 - 139 225 142 218 26 233 208 201 11 157 171 16 82 114 78 78 - 106 95 211 141 17 148 180 69 153 211 137 31 248 84 253 106 - 187 210 229 27 98 154 234 102 10 87 29 253 106 99 211 247 - 50 71 229 137 138 237 243 73 143 226 31 90 220 138 100 73 - 45 23 31 79 177 184 177 104 84 141 225 195 120 141 198 71 - 208 83 253 66 55 75 114 242 175 137 43 240 0 25 207 21 16 - 233 137 18 107 104 217 110 11 55 0 15 166 123 84 230 250 - 120 225 136 200 204 200 137 128 8 25 197 118 65 218 60 188 - 146 119 163 156 190 49 244 36 186 173 171 92 181 143 225 - 228 44 85 153 187 143 94 42 128 158 223 90 233 105 158 56 - 219 198 133 143 215 143 181 117 247 196 9 154 123 217 165 - 105 34 104 200 206 194 249 195 127 241 84 31 89 91 238 184 - 157 99 133 30 82 55 40 29 143 214 169 197 23 199 41 112 162 - 186 185 214 103 186 102 123 219 95 57 239 33 24 3 251 42 61 - 172 120 51 36 69 109 119 3 47 206 61 78 15 21 33 184 142 - 230 221 222 9 70 84 15 54 125 169 116 176 205 24 93 141 132 - 241 6 6 59 26 159 17 249 72 198 214 241 98 108 27 117 4 224 - 149 92 211 111 252 65 168 64 98 75 43 87 17 129 229 44 56 - 199 233 205 3 107 110 99 99 52 152 50 150 56 99 237 154 123 - 211 176 77 38 160 37 101 223 31 177 237 70 43 246 110 82 10 - 232 190 141 212 53 205 71 241 87 143 28 140 88 121 125 43 - 171 254 26 232 50 233 22 137 111 248 16 144 42 133 223 142 - 9 170 163 225 212 126 10 143 13 109 192 115 128 31 230 253 - 42 249 232 235 223 11 77 134 25 36 73 90 110 236 15 57 166 - 215 194 25 174 84 55 189 178 97 21 188 74 235 225 15 54 210 - 121 53 5 235 9 86 234 105 118 131 187 119 150 33 243 84 243 - 168 21 134 153 148 145 35 216 255 0 49 238 56 170 163 172 - 110 246 221 148 183 185 203 147 193 90 134 99 163 9 14 213 - 90 57 49 224 176 111 230 87 226 144 79 4 139 52 147 43 196 - 140 253 129 124 12 209 122 205 212 6 227 198 110 1 242 103 - 63 197 239 81 141 94 238 226 25 194 40 87 70 244 127 81 244 - 174 103 45 29 138 28 145 48 233 15 198 27 192 146 18 27 119 - 163 2 63 76 85 189 164 89 221 73 26 42 185 200 28 131 85 - 191 195 29 42 75 141 146 194 172 24 159 144 255 0 15 30 149 - 113 233 150 55 16 170 135 252 206 60 210 123 85 99 234 114 - 229 146 230 1 29 155 9 135 226 87 9 252 254 162 190 157 54 - 73 150 76 206 179 156 121 119 112 64 253 42 68 34 23 10 4 - 109 226 159 76 208 151 54 110 238 87 196 43 32 237 232 7 - 222 137 62 104 132 107 26 118 99 219 226 136 152 14 121 205 - 86 125 99 167 175 237 5 105 110 23 96 62 102 65 87 101 229 - 188 101 30 59 139 121 159 159 51 70 50 13 67 181 253 46 209 - 204 177 194 198 53 217 156 74 7 6 176 201 217 68 117 172 48 - 8 222 72 228 50 38 223 33 116 108 230 160 19 129 180 62 59 - 174 113 87 71 94 233 47 38 158 234 139 184 43 97 86 169 187 - 184 158 34 241 200 48 85 138 129 236 43 2 74 221 128 250 - 103 222 176 101 39 229 25 53 159 210 179 135 230 170 115 85 - 64 52 201 22 80 150 24 56 161 172 78 217 8 0 119 166 23 142 - 190 27 113 233 75 237 10 155 130 2 253 105 224 237 24 105 - 58 110 10 223 74 18 255 0 63 178 110 193 244 129 218 143 - 149 149 99 11 142 72 160 117 31 243 85 217 61 204 78 15 218 - 131 236 193 186 90 198 116 139 76 50 159 232 201 254 21 240 - 8 214 109 220 18 57 24 165 154 124 231 246 109 170 238 218 - 22 221 20 215 212 185 118 155 195 29 189 234 35 147 62 151 - 185 63 180 227 85 109 196 243 145 232 125 170 240 233 87 - 154 98 130 117 42 224 113 159 90 231 254 159 141 77 220 110 - 210 109 243 14 213 208 95 13 174 45 209 81 90 100 44 23 203 - 187 146 127 178 177 139 91 167 68 45 106 163 233 147 24 238 - 194 164 246 194 223 193 93 177 201 193 236 190 159 122 65 - 161 25 226 95 204 138 16 51 198 79 27 105 254 159 226 186 - 121 152 39 60 39 253 105 146 178 13 219 8 84 102 112 4 112 - 237 246 207 52 108 80 71 23 155 240 209 243 245 175 145 32 - 81 150 82 62 181 181 229 80 128 114 126 212 234 128 38 234 - 59 17 121 1 113 181 118 131 149 240 176 107 157 254 36 105 - 145 172 225 132 94 57 82 119 47 168 174 150 190 241 164 6 - 72 31 195 35 212 142 106 176 235 237 5 174 124 86 101 12 - 216 221 187 24 57 164 156 20 138 96 157 62 69 19 13 184 134 - 214 71 243 120 132 102 52 147 248 105 222 141 61 221 194 - 172 215 18 131 50 12 125 90 134 154 19 103 168 120 18 237 - 96 217 0 125 104 103 241 173 101 252 106 134 27 79 111 74 - 229 105 166 119 57 114 90 45 126 140 184 86 180 102 55 40 8 - 237 205 78 191 31 60 86 95 135 107 229 220 190 111 47 36 - 241 242 213 27 163 234 202 176 41 241 140 81 191 112 123 - 211 185 186 180 219 217 198 209 221 168 144 143 56 99 206 - 43 167 30 95 140 228 201 141 223 67 62 185 190 0 22 88 89 - 78 194 89 166 24 85 62 245 68 234 173 20 200 146 120 151 15 - 39 140 216 192 249 177 223 21 100 234 93 81 167 222 233 242 - 121 135 138 27 206 9 24 97 75 172 109 244 123 201 222 118 - 186 72 146 21 59 6 6 11 55 106 235 82 137 57 41 69 21 69 - 244 107 60 211 93 169 222 178 249 75 55 4 26 2 230 55 93 - 145 140 130 91 129 142 245 120 75 240 222 29 147 220 75 118 - 30 222 100 81 28 157 134 226 70 72 166 215 191 0 76 154 124 - 23 81 107 2 210 70 149 7 157 187 131 233 218 133 196 73 100 - 226 172 231 200 35 12 21 130 144 9 218 51 234 105 173 147 - 53 180 47 106 237 55 154 81 38 213 29 143 181 92 250 183 - 193 155 93 2 226 207 241 55 27 217 230 97 184 158 15 181 0 - 157 15 107 160 194 127 107 93 71 0 157 155 135 97 207 177 - 173 113 30 18 114 86 36 232 155 166 181 212 229 142 20 15 - 143 149 27 248 143 181 95 61 33 125 178 213 99 141 94 2 163 - 115 73 32 242 131 237 84 149 189 254 147 167 202 177 171 - 167 138 174 4 135 0 227 235 82 24 186 206 56 238 36 138 210 - 113 176 227 37 143 31 165 36 164 146 26 172 183 53 139 233 - 37 145 47 13 228 65 72 33 147 61 170 172 234 89 213 239 76 - 97 195 43 49 243 10 217 127 212 139 61 152 48 202 93 149 - 124 192 17 222 162 154 181 244 173 190 4 254 177 41 201 39 - 176 251 87 62 73 166 138 98 139 176 77 70 226 105 110 227 - 128 248 50 89 41 255 0 238 31 106 9 108 115 118 169 36 98 - 88 216 249 95 209 13 31 102 134 210 220 137 35 60 142 239 - 220 83 222 137 209 164 212 174 195 188 108 235 158 0 251 - 215 53 72 232 121 20 116 139 19 225 174 154 190 12 107 17 - 119 219 130 199 244 255 0 10 182 236 213 161 183 40 171 147 - 237 81 142 150 210 174 172 237 217 18 40 227 82 0 5 187 212 - 174 22 216 118 158 113 234 59 26 234 132 93 108 243 231 92 - 172 209 53 180 127 188 240 78 87 156 30 213 161 217 164 25 - 154 48 24 118 49 242 113 76 193 89 99 56 237 67 205 20 120 - 199 202 125 13 55 16 8 111 196 76 140 161 37 39 25 203 14 - 213 1 234 117 1 164 101 229 74 96 55 189 88 23 183 19 70 - 204 138 137 142 217 62 181 21 215 72 134 54 150 70 183 84 - 245 221 158 63 186 183 18 176 119 162 142 235 107 139 179 - 101 112 48 74 131 149 250 213 55 169 21 153 101 109 195 118 - 226 49 87 143 197 11 59 89 172 228 240 238 163 86 11 193 86 - 242 213 7 168 41 183 153 227 13 189 119 119 20 133 31 26 4 - 138 53 225 183 114 56 162 35 249 141 99 16 93 166 190 134 - 10 199 218 177 51 11 207 221 183 218 128 179 230 224 227 - 154 97 117 242 31 181 45 179 202 206 87 215 189 82 14 145 - 135 197 65 136 103 142 40 13 74 48 116 219 220 28 255 0 70 - 122 48 73 249 67 52 22 160 196 88 93 242 60 240 56 20 89 - 132 246 173 33 176 131 211 242 147 181 25 98 164 202 55 122 - 241 90 172 99 38 202 223 63 232 146 141 137 10 48 53 33 195 - 237 36 17 76 55 59 140 28 241 86 191 194 221 82 71 187 85 - 134 86 137 241 229 144 138 169 145 73 66 203 220 28 154 150 - 252 57 214 154 199 83 71 134 72 163 97 235 39 106 198 58 - 223 67 121 30 205 68 246 178 34 103 201 57 60 49 250 84 166 - 202 250 59 114 171 42 153 28 140 2 7 97 80 110 157 214 5 - 238 147 18 27 150 57 60 113 156 126 149 55 208 161 152 66 - 38 143 136 200 198 120 57 63 173 89 164 186 57 199 169 35 - 72 23 119 0 142 213 189 35 81 233 199 181 13 8 118 33 179 - 192 224 209 101 148 32 227 154 6 62 50 174 119 99 129 233 - 74 122 130 205 110 173 152 236 11 246 29 233 163 72 161 114 - 71 21 131 48 145 10 178 239 83 233 237 65 179 45 20 167 88 - 244 52 211 91 27 203 104 80 178 18 119 122 231 218 171 11 - 187 123 200 110 31 78 189 93 162 67 243 123 87 79 107 176 - 53 157 147 186 43 75 17 238 139 232 125 234 136 248 146 177 - 73 114 100 84 96 155 185 13 195 126 181 25 70 203 225 156 - 147 164 35 210 116 152 166 184 16 52 171 42 149 202 236 247 - 170 207 226 54 139 175 105 90 204 242 61 196 190 11 28 198 - 83 149 219 237 83 222 151 214 197 133 218 194 100 240 225 - 249 67 96 114 61 170 196 212 52 152 117 189 17 90 56 209 - 212 12 238 35 56 21 60 77 73 157 83 132 226 185 72 228 251 - 45 112 139 146 26 86 59 20 134 4 156 22 162 52 205 98 226 - 222 203 242 166 62 57 186 18 54 227 193 3 211 237 83 78 185 - 248 112 99 190 184 149 45 13 188 32 231 116 125 152 213 121 - 169 104 183 182 101 130 238 0 252 153 238 5 116 62 206 120 - 228 82 123 39 58 151 88 245 117 197 134 159 165 75 124 86 - 218 24 205 202 70 184 218 7 177 53 60 215 254 43 117 237 - 199 75 232 182 247 182 18 89 199 225 44 214 243 173 187 21 - 184 10 123 130 51 199 189 115 249 107 184 36 221 151 221 - 141 188 156 241 237 82 109 7 226 31 89 104 177 71 109 109 - 172 94 4 130 217 160 129 50 8 138 54 238 160 17 218 154 133 - 88 87 254 139 31 226 175 196 126 181 234 43 13 48 94 88 61 - 132 70 63 26 222 88 247 33 125 191 196 51 233 144 106 29 - 212 157 103 212 58 189 165 140 186 165 244 83 35 32 88 176 - 131 32 47 114 126 181 19 213 186 147 168 117 153 33 159 81 - 212 174 238 154 217 12 80 120 178 110 240 211 249 71 211 - 147 66 44 55 19 90 71 181 75 159 155 25 236 115 90 135 73 - 46 221 140 238 53 67 251 78 238 95 20 178 77 146 50 121 205 - 104 210 245 75 139 217 34 181 134 232 137 3 16 192 3 154 47 - 67 232 251 173 64 201 227 187 71 35 225 148 14 248 207 106 - 185 62 27 244 16 178 195 61 132 105 48 148 18 242 96 22 95 - 214 132 163 171 4 230 170 162 7 208 29 47 125 30 141 53 238 - 172 242 178 203 251 188 30 64 199 253 232 177 103 28 123 - 100 241 137 149 120 84 110 199 239 83 126 177 191 182 208 - 237 37 183 143 116 44 56 85 36 55 24 244 170 238 202 83 123 - 118 94 66 67 19 148 106 228 116 203 168 73 18 94 153 233 - 253 83 95 144 76 202 76 46 112 163 31 227 87 31 73 116 153 - 210 204 49 204 170 14 1 194 210 111 135 23 11 20 34 8 35 - 145 159 56 201 3 21 104 90 90 27 93 175 36 126 35 176 206 - 242 79 31 74 233 199 7 86 206 60 143 97 118 241 133 77 187 - 118 129 233 239 91 90 53 199 28 125 171 21 155 60 50 225 - 171 238 252 119 170 217 42 53 58 136 187 51 42 250 129 65 - 234 23 94 12 69 100 143 35 221 123 138 60 149 151 229 20 27 - 169 71 219 252 62 223 90 1 35 215 115 43 40 113 32 251 55 - 124 84 47 171 100 186 49 179 184 154 201 65 231 124 91 149 - 170 85 173 98 202 233 252 103 42 224 121 152 199 145 223 - 251 170 186 248 147 214 183 90 125 177 91 107 171 105 7 250 - 223 246 53 138 68 162 190 47 107 186 95 138 214 49 248 190 - 48 28 73 25 198 223 211 181 87 209 0 214 161 139 51 100 247 - 110 244 87 94 106 67 88 234 55 186 240 194 31 92 113 154 14 - 73 213 85 87 233 82 4 244 244 124 133 130 190 211 235 68 52 - 89 229 73 52 2 183 155 121 163 109 174 50 160 131 233 88 17 - 102 171 131 149 35 233 75 163 27 110 179 76 238 20 96 210 - 213 254 179 85 198 149 14 54 149 179 26 231 142 61 41 102 - 163 41 252 21 194 142 194 39 166 50 168 48 131 244 165 151 - 202 63 5 63 251 167 162 251 17 183 102 122 48 63 179 160 - 224 254 233 43 126 71 137 143 90 203 72 79 252 174 220 129 - 222 36 197 18 45 198 75 17 81 101 227 217 227 251 146 61 77 - 15 111 122 246 87 65 149 118 227 187 30 213 235 171 133 141 - 128 57 237 90 226 219 121 34 110 71 40 7 56 28 154 186 143 - 40 137 47 99 167 126 4 117 157 174 161 167 172 63 153 44 - 136 120 24 171 231 78 212 65 81 225 218 249 118 231 115 28 - 0 107 144 190 28 89 173 188 130 77 54 89 34 32 231 105 56 - 39 237 138 178 180 238 161 234 84 87 102 17 76 136 48 6 9 - 199 215 154 14 60 65 197 51 163 45 102 103 1 100 216 170 - 121 5 78 69 99 169 220 54 192 163 201 236 199 214 170 77 11 - 171 245 39 17 71 112 168 23 28 248 35 183 223 62 181 53 209 - 175 226 185 45 33 153 131 255 0 44 188 98 164 251 19 36 117 - 72 147 192 159 42 72 164 38 120 62 244 112 27 80 5 35 111 - 160 165 118 19 120 142 1 96 223 202 1 230 152 44 168 80 110 - 202 243 142 105 211 64 173 30 154 21 153 25 100 25 82 48 69 - 84 255 0 18 122 82 19 35 155 101 32 179 100 10 183 3 46 56 - 96 104 109 66 202 27 200 240 200 140 222 153 173 40 218 27 - 28 169 232 228 91 238 152 186 91 147 43 63 135 20 71 60 142 - 255 0 74 125 211 93 69 117 98 88 93 200 22 221 92 4 207 160 - 171 91 173 250 76 108 150 72 227 80 51 187 143 106 165 250 - 146 41 68 141 111 29 187 8 213 253 185 205 113 188 124 37 - 103 124 36 178 42 147 44 121 46 108 53 205 177 220 69 249 - 108 155 65 247 250 212 119 170 190 23 217 155 104 37 134 - 225 10 63 203 143 240 164 218 37 252 214 58 188 112 204 228 - 64 202 48 79 189 89 90 93 253 188 177 237 89 214 103 253 - 214 210 123 15 113 245 170 71 43 229 103 52 177 46 52 138 - 27 93 248 99 116 151 210 44 86 251 160 69 196 44 163 211 - 220 84 30 247 64 107 107 182 140 171 56 31 46 7 173 118 133 - 237 180 90 149 144 93 194 54 141 118 57 42 57 250 138 137 - 106 125 33 167 197 120 100 88 86 104 216 96 101 107 174 50 - 199 37 105 28 235 179 155 116 14 140 186 212 193 240 55 51 - 49 206 208 188 226 167 125 55 240 195 54 203 45 210 186 72 - 143 198 70 55 15 122 186 52 46 153 179 177 138 55 182 217 - 20 217 228 99 140 83 173 90 104 225 84 141 97 141 86 49 134 - 36 96 181 53 165 234 138 37 201 144 171 110 135 210 116 79 - 10 226 121 20 205 225 229 4 124 130 107 238 173 212 150 246 - 54 203 105 24 72 156 55 151 216 241 254 53 171 169 181 136 - 109 237 36 219 112 30 68 114 145 166 114 77 87 147 73 121 - 168 91 139 182 87 46 210 121 71 176 174 73 101 116 209 214 - 176 213 51 45 96 106 26 245 227 195 122 216 99 204 45 232 5 - 54 233 30 147 152 202 177 205 147 199 3 20 227 163 244 134 - 213 30 40 228 140 164 138 70 25 187 26 185 250 111 167 99 - 183 132 60 209 70 37 3 154 92 80 79 108 76 217 56 233 25 - 116 63 79 219 217 233 161 221 79 138 125 79 165 74 23 229 - 25 227 28 115 88 194 137 12 33 19 140 119 175 179 58 38 55 - 56 31 90 233 163 142 105 182 99 58 163 46 230 96 160 118 - 165 215 146 52 67 197 102 150 48 222 168 51 69 207 44 126 - 25 60 176 250 14 212 174 246 96 84 171 178 178 5 200 32 240 - 69 103 163 40 114 26 137 15 135 230 81 199 203 187 179 80 - 83 95 73 202 136 33 56 255 0 91 154 134 235 29 68 108 99 48 - 219 9 166 0 124 199 24 63 110 106 11 172 117 110 189 53 203 - 197 225 196 233 140 169 112 114 181 135 88 210 44 46 168 - 215 33 143 79 157 228 73 85 84 16 222 249 250 87 37 124 96 - 235 11 91 205 78 75 11 75 153 21 131 19 137 70 56 171 39 86 - 212 53 237 70 57 32 188 185 82 161 14 28 13 187 87 254 188 - 213 69 213 58 29 188 241 201 42 67 113 123 118 92 225 136 0 - 99 251 107 112 79 232 106 136 45 172 37 228 105 14 112 123 - 31 122 33 161 221 231 60 55 108 125 40 217 99 104 81 97 112 - 145 183 177 239 65 22 96 73 244 237 74 218 163 27 60 53 9 - 206 43 43 104 195 112 57 172 21 183 33 251 215 212 98 157 - 142 13 32 12 175 65 7 145 74 155 137 197 57 148 111 83 187 - 154 73 38 127 24 71 165 60 69 147 25 187 226 49 142 120 165 - 247 103 117 189 217 247 183 113 250 209 172 165 163 31 106 - 22 244 40 211 231 199 205 225 62 105 133 25 233 30 109 42 - 213 113 140 198 159 225 154 57 216 44 44 48 59 119 160 52 - 103 85 211 44 148 142 76 8 127 93 180 85 196 171 225 242 42 - 71 74 116 70 181 2 242 94 14 113 199 97 247 169 87 65 219 - 36 215 177 195 40 220 8 228 47 113 253 180 141 109 252 107 - 213 37 60 184 239 237 83 174 143 211 149 39 87 0 110 35 200 - 195 131 138 180 102 170 137 190 236 187 58 103 166 236 35 - 48 52 114 32 24 221 133 249 170 91 107 165 194 210 5 148 4 - 24 192 56 168 247 77 204 176 89 68 222 55 138 83 229 76 14 - 126 149 52 209 238 55 145 226 76 129 217 126 87 3 129 90 82 - 85 70 74 194 44 116 24 227 153 78 119 103 182 208 48 71 214 - 155 92 104 236 214 174 17 76 111 252 203 220 211 109 38 72 - 100 140 6 240 164 218 118 249 123 230 152 203 11 109 9 28 - 140 152 244 32 100 84 69 110 136 158 149 251 66 218 111 194 - 218 184 47 158 78 114 5 72 45 159 86 128 156 172 114 40 93 - 204 199 57 253 41 93 196 81 199 127 137 15 131 38 120 34 - 155 219 106 64 58 195 28 121 80 57 111 115 72 60 23 137 178 - 29 74 89 38 86 154 45 171 252 195 176 251 209 173 121 8 5 - 150 64 9 249 72 245 173 55 48 174 4 182 234 178 49 30 104 - 207 111 191 222 180 189 188 19 219 238 145 124 39 95 238 - 166 78 76 87 75 160 203 219 113 121 98 20 190 254 57 35 214 - 161 183 93 11 13 220 146 220 54 84 224 236 80 7 38 165 58 - 35 53 189 185 93 199 104 244 166 73 134 1 135 108 230 179 - 175 160 230 215 69 41 170 244 5 221 179 37 204 176 248 171 - 17 59 84 14 231 235 81 248 244 109 67 78 159 196 11 34 144 - 251 184 245 174 141 101 220 140 49 201 239 154 73 168 104 - 208 238 105 240 173 207 153 113 72 240 193 236 172 103 162 - 162 147 168 46 237 252 56 132 78 217 143 156 131 205 101 - 107 212 23 37 89 165 134 70 77 222 78 15 53 53 189 211 108 - 154 225 166 107 120 194 42 144 191 65 65 219 221 104 214 54 - 107 248 235 88 252 36 82 219 206 125 234 111 148 53 101 249 - 127 194 40 122 138 227 204 86 41 3 231 142 15 106 211 125 - 123 169 234 176 162 109 146 54 3 146 163 189 74 236 166 211 - 53 75 176 109 97 70 129 135 151 138 145 105 90 109 177 111 - 195 248 9 145 242 253 41 146 151 105 153 78 190 21 78 149 - 210 55 151 72 200 33 98 31 141 199 146 15 189 75 116 79 135 - 114 8 209 111 35 196 123 118 140 119 31 90 179 52 205 54 27 - 24 246 140 125 168 227 207 113 84 73 62 200 203 249 18 122 - 100 95 167 186 102 29 46 97 225 64 133 23 213 187 231 222 - 164 83 203 28 108 25 164 31 111 122 251 43 108 224 71 147 - 239 154 80 109 218 109 77 228 152 17 30 121 25 239 77 72 - 156 83 126 193 247 23 107 26 144 60 205 232 40 24 111 174 - 166 111 14 8 145 142 78 75 103 138 222 87 50 5 130 208 2 59 - 190 79 21 153 11 103 110 207 18 6 62 173 236 105 28 218 10 - 236 85 123 38 178 45 252 88 165 81 144 67 32 30 148 134 222 - 198 235 80 184 114 210 22 10 249 108 30 62 195 233 79 46 46 - 86 123 98 100 102 137 7 30 94 228 214 26 28 69 220 52 56 95 - 109 180 109 181 108 51 175 245 23 221 104 208 203 25 13 31 - 229 129 194 251 210 27 221 6 56 84 182 239 46 120 12 163 2 - 172 115 20 110 160 110 19 183 169 110 21 62 216 168 230 179 - 52 101 156 43 64 138 157 234 170 104 69 127 74 251 80 209 - 225 184 180 144 51 194 168 14 15 166 106 191 234 221 39 75 - 179 211 165 184 146 21 154 112 126 84 98 23 245 171 39 87 - 185 202 186 49 71 82 114 25 71 106 174 122 230 37 156 40 50 - 77 55 180 64 0 15 246 86 228 53 20 87 81 74 130 251 153 35 - 67 39 101 143 36 99 238 104 9 50 234 54 142 213 35 235 13 - 19 195 45 36 96 65 27 252 170 57 231 245 168 229 186 201 20 - 4 73 195 103 24 247 20 128 122 116 122 47 148 253 235 9 178 - 172 72 247 172 226 32 3 159 122 215 63 53 128 213 133 195 - 34 136 200 60 253 233 61 209 254 151 156 12 102 155 69 26 - 176 198 222 244 166 249 130 92 5 250 211 196 70 168 105 11 - 47 131 230 224 80 87 255 0 212 238 63 221 191 248 86 208 - 219 160 3 210 133 190 99 248 41 249 255 0 210 122 167 17 92 - 141 118 127 137 253 159 1 207 30 18 86 196 51 186 156 182 - 87 212 211 13 50 12 216 64 27 31 186 76 140 246 162 217 225 - 136 120 123 80 41 224 115 206 106 40 232 98 43 123 241 111 - 55 242 128 113 147 235 86 7 70 235 76 246 230 31 197 68 140 - 195 200 164 237 96 62 135 214 163 182 90 28 218 158 99 130 - 221 164 59 178 0 198 15 235 239 83 110 151 232 9 102 141 45 - 238 237 102 138 39 28 156 252 191 98 41 210 160 39 68 255 0 - 165 250 138 212 58 193 170 73 178 233 134 228 73 134 1 30 - 245 97 104 186 198 154 206 169 103 118 214 236 71 158 25 - 198 232 228 63 70 244 168 62 133 208 169 21 164 118 179 70 - 211 148 27 99 71 200 199 234 65 53 34 178 233 77 74 194 47 - 232 114 58 143 68 151 133 31 99 89 171 11 157 178 203 176 - 99 185 30 56 210 54 198 74 171 102 50 61 193 247 166 203 - 120 56 63 32 61 188 78 23 244 53 94 105 26 213 214 151 34 - 65 172 88 220 66 190 147 198 165 215 63 92 122 84 202 206 - 234 75 168 188 68 219 34 158 79 151 1 190 191 74 70 19 118 - 187 11 222 67 44 177 177 18 6 220 184 239 75 186 90 250 71 - 102 183 153 124 225 176 64 244 250 211 153 97 142 226 50 - 193 164 82 7 96 188 138 91 106 39 134 247 250 138 202 231 - 141 231 130 71 181 35 84 131 21 240 154 167 49 34 238 13 - 199 24 160 103 45 29 214 214 82 84 247 241 56 81 69 217 110 - 49 40 48 52 89 28 140 19 254 21 246 250 214 73 151 104 141 - 217 125 8 28 212 219 108 77 38 107 71 120 216 109 66 69 16 - 38 82 128 134 28 156 80 86 73 58 66 99 117 124 158 57 70 - 255 0 181 100 201 60 78 89 81 153 49 200 8 114 63 186 130 - 116 48 99 44 138 63 45 178 123 226 132 186 185 120 226 220 - 97 102 63 196 69 97 52 178 170 171 68 178 242 57 204 109 - 255 0 106 85 169 92 92 179 21 69 112 185 231 32 138 22 195 - 24 41 50 63 213 151 154 140 182 87 118 246 208 73 27 225 - 138 101 126 149 203 122 183 93 117 30 165 38 161 167 94 204 - 208 248 19 164 109 30 48 78 61 8 174 179 185 188 189 92 25 - 97 105 87 248 252 157 197 85 223 17 250 3 72 234 125 66 13 - 98 214 217 180 157 71 112 23 37 99 32 78 61 73 24 239 79 39 - 25 157 120 230 177 233 171 1 248 55 105 213 17 233 144 222 - 220 248 50 217 52 132 194 7 204 23 255 0 154 187 244 141 66 - 229 131 52 208 177 193 218 131 28 154 143 104 115 197 97 - 103 13 142 159 96 237 28 40 168 143 225 156 240 63 252 52 - 217 46 47 152 134 48 50 182 253 196 178 145 71 81 68 114 91 - 118 137 97 184 157 190 85 49 159 102 172 252 67 180 110 96 - 88 154 77 109 119 50 219 170 24 228 45 252 71 109 24 101 - 102 64 162 57 11 247 225 73 197 73 79 147 209 37 141 160 - 167 186 40 14 197 220 115 130 7 165 7 113 54 223 48 243 159 - 85 126 194 182 71 11 42 110 109 229 255 0 216 108 127 133 - 105 72 101 150 243 196 145 88 133 236 2 54 15 247 83 59 176 - 85 5 105 241 55 134 93 243 188 118 52 46 171 34 67 3 185 - 145 93 199 101 3 36 83 68 142 84 92 172 100 125 233 38 189 - 36 203 4 135 240 108 231 30 163 138 165 94 128 145 12 135 - 241 90 158 160 99 86 111 12 54 91 105 201 21 39 134 85 183 - 137 98 82 177 198 6 60 79 251 82 189 46 217 152 134 104 12 - 1 142 78 208 114 104 235 213 217 228 142 57 60 188 6 101 - 237 246 166 173 81 154 62 94 77 44 150 225 83 42 23 213 199 - 155 244 21 29 213 174 34 181 133 247 220 69 1 3 45 52 190 - 103 31 65 255 0 106 47 91 215 45 44 81 252 95 21 220 29 171 - 26 33 44 199 219 21 16 190 126 161 214 8 240 109 13 165 190 - 237 202 146 99 113 250 241 154 41 1 161 62 179 175 104 240 - 69 36 239 49 42 23 205 52 173 134 99 238 61 170 187 215 53 - 233 37 34 230 214 241 150 215 186 60 131 195 76 125 9 239 - 86 14 163 209 114 73 40 146 238 54 109 195 45 189 72 254 - 193 138 135 117 47 195 150 190 148 93 78 178 76 35 253 216 - 201 217 143 246 79 21 130 138 135 172 58 169 217 198 39 142 - 64 252 43 3 197 34 211 238 191 16 134 70 238 220 131 232 69 - 75 117 206 133 188 138 228 205 37 140 174 15 206 242 112 - 168 61 197 71 36 129 44 93 193 85 69 221 181 85 152 3 143 - 240 166 143 96 146 189 131 187 237 63 74 196 29 195 53 186 - 102 73 6 236 167 232 192 255 0 133 106 85 227 140 99 239 79 - 45 128 38 30 212 162 251 139 174 120 230 156 64 8 250 15 - 189 1 168 70 11 124 188 147 223 35 20 189 9 35 116 37 90 - 223 5 128 29 243 65 234 18 255 0 67 184 255 0 116 244 90 41 - 16 1 142 195 222 151 106 24 252 61 194 110 27 188 54 227 61 - 179 78 165 162 110 34 139 47 220 55 251 165 160 238 251 175 - 251 85 234 245 73 118 116 190 131 109 63 174 219 83 53 253 - 234 126 181 234 245 80 80 139 143 222 15 189 122 95 221 143 - 189 122 189 88 198 235 207 234 95 253 163 252 107 86 155 - 251 179 246 175 87 169 31 209 144 77 191 121 255 0 217 173 - 49 127 90 95 246 133 122 189 74 198 143 99 214 236 104 22 - 253 243 125 235 213 234 148 69 126 198 211 251 197 175 79 - 251 179 94 175 80 8 60 191 187 95 181 100 191 184 74 245 - 122 153 244 62 46 204 26 180 183 239 79 218 189 94 166 47 - 30 205 144 126 248 81 147 250 215 171 213 136 100 236 244 - 63 45 125 184 253 239 255 0 109 122 189 80 143 177 51 91 - 252 181 157 167 205 94 175 85 95 208 154 161 175 147 126 - 234 111 246 63 235 94 175 83 46 204 129 173 191 131 237 91 - 117 15 221 138 245 122 156 192 58 215 249 246 111 247 149 - 242 127 221 39 251 85 234 245 17 88 116 223 212 135 218 148 - 220 254 224 87 171 212 16 77 109 253 105 105 76 159 214 222 - 189 94 162 140 205 87 255 0 50 255 0 179 88 71 242 10 245 - 122 156 64 133 253 217 161 174 254 85 255 0 106 189 94 165 - 125 139 35 47 253 58 105 99 253 68 255 0 186 175 87 168 174 - 133 63 255 217 13 10 45 45 45 45 45 45 87 101 98 75 105 116 - 70 111 114 109 66 111 117 110 100 97 114 121 74 57 98 119 - 65 87 115 51 121 110 112 113 115 72 53 75 13 10 67 111 110 - 116 101 110 116 45 68 105 115 112 111 115 105 116 105 111 - 110 58 32 102 111 114 109 45 100 97 116 97 59 32 110 97 109 - 101 61 34 102 105 108 101 50 34 59 32 102 105 108 101 110 - 97 109 101 61 34 116 101 115 116 46 116 120 116 34 13 10 67 - 111 110 116 101 110 116 45 84 121 112 101 58 32 116 101 120 - 116 47 112 108 97 105 110 13 10 13 10 116 101 115 116 10 13 - 10 45 45 45 45 45 45 87 101 98 75 105 116 70 111 114 109 66 - 111 117 110 100 97 114 121 74 57 98 119 65 87 115 51 121 - 110 112 113 115 72 53 75 13 10 67 111 110 116 101 110 116 - 45 68 105 115 112 111 115 105 116 105 111 110 58 32 102 111 - 114 109 45 100 97 116 97 59 32 110 97 109 101 61 34 102 105 - 108 101 51 34 59 32 102 105 108 101 110 97 109 101 61 34 34 - 13 10 13 10 13 10 45 45 45 45 45 45 87 101 98 75 105 116 70 - 111 114 109 66 111 117 110 100 97 114 121 74 57 98 119 65 - 87 115 51 121 110 112 113 115 72 53 75 45 45 13 10 - } ; - -: dog-test-empty-bytes-firefox ( -- bytes ) - B{ - 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 - 45 45 45 45 45 45 45 45 45 49 49 51 55 53 50 50 53 48 51 49 - 52 52 49 50 56 50 51 50 55 49 54 53 51 49 55 50 57 13 10 67 - 111 110 116 101 110 116 45 68 105 115 112 111 115 105 116 - 105 111 110 58 32 102 111 114 109 45 100 97 116 97 59 32 - 110 97 109 101 61 34 102 105 108 101 49 34 59 32 102 105 - 108 101 110 97 109 101 61 34 100 111 103 46 106 112 103 34 - 13 10 67 111 110 116 101 110 116 45 84 121 112 101 58 32 - 105 109 97 103 101 47 106 112 101 103 13 10 13 10 255 216 - 255 224 0 16 74 70 73 70 0 1 1 0 0 1 0 1 0 0 255 219 0 67 0 - 5 3 4 4 4 3 5 4 4 4 5 5 5 6 7 12 8 7 7 7 7 15 11 11 9 12 17 - 15 18 18 17 15 17 17 19 22 28 23 19 20 26 21 17 17 24 33 24 - 26 29 29 31 31 31 19 23 34 36 34 30 36 28 30 31 30 255 219 - 0 67 1 5 5 5 7 6 7 14 8 8 14 30 20 17 20 30 30 30 30 30 30 - 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 - 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 - 30 30 30 30 255 192 0 17 8 1 49 1 64 3 1 34 0 2 17 1 3 17 1 - 255 196 0 29 0 0 2 2 3 1 1 1 0 0 0 0 0 0 0 0 0 4 5 6 7 2 3 - 8 0 1 9 255 196 0 74 16 0 2 1 3 3 2 4 4 3 4 5 10 5 3 5 1 1 - 2 3 0 4 17 5 18 33 6 49 19 34 65 81 7 50 97 113 20 35 129 - 21 51 66 82 36 52 145 161 177 8 53 83 98 114 115 147 178 - 193 209 22 37 67 116 241 99 130 240 23 68 84 100 146 225 - 255 196 0 25 1 0 3 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 2 3 0 4 5 - 255 196 0 39 17 0 2 2 2 2 3 0 2 1 5 1 0 0 0 0 0 0 1 2 17 3 - 33 18 49 34 50 65 19 81 4 5 20 35 66 97 82 255 218 0 12 3 1 - 0 2 17 3 17 0 63 0 228 200 149 136 219 131 200 207 233 68 - 196 145 112 60 21 45 234 91 181 57 177 178 138 75 56 95 111 - 152 196 51 250 209 11 167 198 14 118 138 22 138 153 104 150 - 118 82 46 217 45 161 98 79 242 102 157 38 151 98 174 64 211 - 237 72 247 49 46 104 11 8 140 111 229 247 166 194 70 137 12 - 146 112 61 235 57 36 172 31 82 7 154 199 78 244 176 178 255 - 0 132 41 100 195 76 15 183 240 118 60 31 244 85 237 126 241 - 237 237 157 213 176 113 197 66 158 254 234 82 74 49 45 187 - 144 42 49 155 158 217 108 152 99 21 68 214 88 116 217 83 17 - 218 218 171 250 109 138 180 254 6 221 83 205 109 1 199 115 - 225 10 141 90 106 23 106 187 95 59 73 239 237 77 44 111 89 - 79 136 24 186 250 131 235 86 199 166 71 143 20 52 181 211 - 237 24 143 232 150 236 61 140 66 155 65 167 233 251 64 252 - 5 158 127 221 45 3 99 42 220 42 186 240 79 247 83 139 38 86 - 92 21 57 20 76 246 140 78 155 98 88 31 217 246 125 191 209 - 45 108 253 159 97 255 0 240 44 255 0 225 45 22 216 200 199 - 181 99 88 74 98 77 99 78 178 69 111 14 194 213 23 28 226 48 - 15 246 212 30 242 21 252 105 8 145 170 103 178 213 137 172 - 121 162 127 181 87 151 141 182 247 31 235 210 180 216 209 - 28 88 217 219 120 99 250 52 100 255 0 172 155 168 248 108 - 109 11 103 240 208 127 194 173 118 82 71 225 47 148 246 163 - 11 169 30 74 81 140 102 182 178 35 203 97 104 62 162 46 104 - 41 45 109 119 127 86 131 254 21 48 144 225 9 198 104 105 - 198 24 118 53 76 77 81 141 73 105 109 143 234 176 127 193 - 21 146 89 219 110 63 209 97 255 0 131 69 65 183 110 15 39 - 218 182 144 160 159 41 6 169 102 5 22 54 138 114 109 45 216 - 123 24 184 53 177 45 44 137 231 79 179 237 254 138 179 118 - 101 112 167 159 181 102 131 140 212 35 236 99 95 224 172 - 119 143 252 190 207 254 21 18 186 125 129 92 254 2 207 254 - 16 172 15 148 230 182 71 46 225 198 106 178 78 204 40 213 - 237 109 83 33 45 224 237 223 195 199 247 214 189 30 222 222 - 69 45 37 165 187 156 227 12 161 177 245 230 143 214 212 8 - 75 123 138 15 69 96 7 220 214 159 169 135 31 129 177 192 - 198 159 102 120 255 0 68 181 240 216 217 12 15 217 214 156 - 246 252 165 230 137 139 205 235 128 7 204 123 80 183 154 - 148 118 202 66 225 156 118 62 148 169 174 38 91 55 193 167 - 233 191 60 214 22 96 14 249 137 107 84 199 69 137 246 174 - 157 100 255 0 65 18 210 43 237 82 105 148 188 108 64 254 31 - 102 164 243 223 204 146 249 155 39 233 73 38 50 84 137 156 - 112 233 19 200 4 118 54 201 238 22 33 68 54 153 166 52 96 - 173 149 163 15 115 16 205 66 244 189 77 141 226 40 115 143 - 90 155 91 73 192 116 245 29 141 77 233 140 177 169 46 64 - 109 167 88 45 203 31 217 246 92 127 244 171 19 97 99 226 16 - 218 125 152 227 63 186 20 100 204 56 247 245 175 66 84 145 - 191 147 235 246 174 140 125 18 180 125 183 211 108 72 7 246 - 125 158 63 221 45 109 151 77 177 219 254 111 179 255 0 132 - 180 68 76 163 133 206 51 197 103 43 0 184 166 158 144 72 - 133 244 54 113 220 5 91 120 50 59 254 77 7 120 109 188 48 - 22 8 1 207 242 98 152 106 170 191 137 45 239 218 149 93 41 - 97 129 239 73 97 143 96 19 172 103 204 161 23 232 181 164 - 71 152 93 143 173 110 117 101 67 90 142 239 195 55 165 97 - 229 251 37 122 124 138 182 48 118 253 210 81 66 116 250 82 - 123 2 205 103 108 55 30 99 31 221 218 140 134 63 56 221 200 - 169 147 26 90 229 159 56 20 109 242 171 89 16 217 251 80 - 214 190 80 49 197 110 212 63 168 147 234 107 74 62 44 166 - 36 156 209 17 234 235 140 193 26 170 182 230 227 21 40 248 - 113 208 240 234 214 169 53 194 224 63 166 57 168 167 85 55 - 136 34 5 87 126 124 170 123 26 233 15 129 214 42 221 59 108 - 123 112 51 27 14 223 90 142 61 68 233 206 227 249 58 35 7 - 224 252 57 252 133 141 91 25 82 71 24 255 0 189 44 212 254 - 21 222 99 16 171 120 139 234 160 97 171 165 99 81 143 5 145 - 74 142 199 29 171 239 225 99 121 138 149 80 127 133 241 205 - 22 229 96 121 19 84 145 199 250 231 77 106 61 62 210 25 35 - 114 189 212 1 198 43 237 133 210 72 71 24 56 228 125 107 - 167 186 179 163 236 245 93 61 149 35 76 148 42 43 154 186 - 195 167 175 58 123 85 149 9 37 67 103 63 74 117 39 123 37 - 151 26 110 226 20 14 64 53 246 132 211 174 22 234 21 216 - 217 111 83 69 22 80 72 197 89 245 103 61 238 128 117 60 155 - 121 15 174 218 174 239 8 23 141 158 251 170 192 213 36 219 - 11 175 169 28 85 123 169 237 93 64 240 57 52 99 32 142 45 - 89 191 15 229 231 154 46 201 155 60 214 141 48 43 69 141 - 163 24 162 109 227 61 199 21 57 118 96 244 57 92 227 52 43 - 198 219 143 126 244 68 18 3 88 202 172 141 134 108 147 205 - 8 107 64 62 65 223 145 131 239 91 25 188 199 39 38 181 163 - 99 191 122 250 112 199 118 59 213 83 160 114 54 59 46 211 - 239 89 39 203 90 93 89 88 115 197 110 64 74 113 83 138 169 - 5 59 62 183 35 214 189 16 193 197 124 109 202 123 154 251 - 19 13 199 35 38 170 242 69 62 194 105 214 255 0 171 138 85 - 166 169 82 204 164 237 60 103 235 77 181 129 226 66 184 98 - 163 220 82 155 73 24 202 45 34 81 201 239 75 44 138 141 7 - 114 72 110 146 203 36 73 12 42 207 150 193 197 73 52 191 - 135 215 186 168 241 220 180 113 177 206 49 200 90 153 124 - 40 248 122 110 151 241 183 65 66 12 48 207 191 189 94 54 - 186 61 165 156 94 28 123 10 149 10 78 59 138 231 109 252 58 - 163 8 163 159 236 254 19 73 53 176 86 80 176 175 171 1 197 - 107 185 248 77 101 105 103 51 204 187 36 199 24 25 39 255 0 - 249 93 18 176 195 18 157 177 168 30 212 191 85 132 201 109 - 39 134 138 204 227 110 8 160 175 232 210 227 196 226 14 170 - 210 27 66 215 60 46 54 110 5 72 31 227 82 141 57 214 72 145 - 137 198 64 237 70 127 148 13 146 219 107 208 145 150 5 240 - 91 211 245 165 58 75 237 130 48 72 36 47 117 237 71 39 113 - 4 23 248 216 202 224 96 100 114 107 24 148 183 126 62 213 - 182 101 57 231 145 89 70 6 7 2 174 221 35 133 71 102 248 84 - 40 245 172 110 57 38 182 175 3 140 86 19 1 142 194 145 182 - 199 34 250 129 197 226 100 241 154 211 52 121 77 194 182 - 234 67 117 238 223 236 162 150 17 248 81 218 138 116 52 72 - 228 225 183 246 21 241 148 126 30 79 76 46 234 62 234 16 27 - 181 7 34 55 135 55 63 250 116 232 210 118 168 117 167 172 - 127 132 183 220 224 15 13 127 187 189 16 10 135 194 144 69 - 43 176 144 155 88 23 212 71 70 32 110 251 129 165 170 25 99 - 99 139 78 127 182 179 213 220 199 167 141 190 86 35 191 189 - 42 241 228 132 174 50 65 246 162 53 9 89 172 227 221 158 - 212 178 151 139 54 61 100 68 118 241 86 227 89 182 132 121 - 247 72 1 2 186 187 225 157 184 131 70 182 143 28 162 128 - 203 234 167 235 92 181 211 246 87 23 221 92 145 198 173 133 - 144 121 192 249 107 170 250 103 242 236 35 241 147 194 157 - 84 6 99 252 85 36 169 34 249 98 229 34 100 89 89 139 43 6 - 97 192 35 211 233 95 94 86 17 2 199 56 238 105 119 226 188 - 171 223 183 39 222 190 27 172 16 95 113 79 95 173 16 199 30 - 134 246 242 11 133 60 242 59 212 75 226 103 77 91 235 58 - 101 204 138 159 154 145 147 145 235 78 97 152 171 248 145 - 200 10 31 65 222 138 155 100 200 21 178 222 167 29 171 5 87 - 211 144 110 214 109 31 80 240 36 111 32 39 57 244 57 237 77 - 224 152 92 69 226 174 49 142 126 149 105 124 86 232 27 125 - 70 22 187 178 132 9 2 229 177 247 53 76 66 38 209 181 65 - 109 48 111 8 156 18 123 81 229 20 170 201 101 196 253 163 - 208 94 161 14 251 105 27 217 106 189 213 20 11 226 125 51 - 138 177 181 70 205 153 104 249 87 28 85 117 117 253 117 247 - 251 241 84 87 240 231 26 233 108 192 5 3 131 77 145 78 243 - 74 180 213 193 7 138 115 18 229 137 172 227 33 27 48 183 64 - 24 26 202 126 13 108 140 169 242 142 9 236 79 106 26 92 150 - 228 250 209 140 93 140 124 254 48 107 34 195 39 154 215 255 - 0 231 122 247 191 253 234 188 65 196 223 27 151 24 144 101 - 253 40 152 179 130 49 233 90 109 85 29 124 217 163 226 218 - 19 28 98 163 123 176 165 64 46 219 13 122 22 223 39 28 147 - 216 86 219 133 4 19 90 1 240 161 50 28 131 252 52 91 131 - 219 55 144 62 189 56 91 68 133 88 110 245 30 213 37 248 49 - 210 178 106 58 188 51 73 144 138 119 19 233 140 208 189 61 - 210 211 245 12 232 193 79 204 57 32 226 186 51 161 250 90 - 195 65 211 161 138 8 255 0 51 104 46 125 106 115 146 78 145 - 124 17 113 143 146 37 26 85 188 122 109 132 113 68 184 96 - 49 159 165 125 185 185 85 59 90 64 119 124 198 180 205 43 5 - 43 156 31 79 181 10 178 36 44 26 70 222 205 223 30 148 165 - 210 177 139 150 149 10 227 98 142 192 250 214 155 147 253 - 28 199 177 88 122 238 244 250 208 171 52 155 134 88 98 133 - 150 237 164 36 46 112 15 53 129 56 190 145 65 255 0 148 77 - 158 235 69 153 118 182 199 218 54 118 239 154 175 116 73 72 - 181 129 135 204 203 218 174 31 142 22 18 234 26 36 203 2 72 - 21 60 229 64 253 225 207 106 165 244 67 38 194 37 36 178 - 240 51 90 91 175 248 104 234 13 18 169 228 221 230 127 46 - 43 5 151 196 228 214 55 127 186 221 238 43 85 187 100 227 - 158 213 94 71 20 180 232 103 23 43 197 125 145 84 168 201 - 230 176 135 182 43 100 156 40 165 9 22 212 144 45 249 247 - 163 161 254 174 40 93 79 157 67 62 153 166 22 234 166 1 197 - 96 53 98 235 149 12 167 222 147 234 3 242 102 81 220 71 82 - 41 99 12 59 129 74 117 91 114 45 167 117 31 250 103 251 169 - 148 140 129 45 55 44 17 99 253 29 23 12 204 28 6 3 20 20 19 - 127 71 139 159 253 42 223 28 129 136 7 156 154 103 208 255 - 0 153 177 205 170 120 204 3 12 12 240 69 111 213 199 134 - 145 66 163 36 143 90 246 154 141 148 231 143 74 203 89 138 - 67 123 11 6 57 199 21 63 134 139 243 68 211 224 110 159 102 - 218 140 243 189 188 178 60 152 249 192 192 171 213 173 128 - 140 176 141 15 25 193 244 168 39 193 43 63 15 79 19 76 7 - 140 199 206 184 171 30 250 50 146 43 42 228 48 193 168 219 - 163 177 55 200 71 226 254 97 228 140 28 99 210 183 69 117 - 30 226 31 105 30 222 148 46 161 152 75 141 229 148 156 226 - 149 60 140 70 248 137 80 189 241 75 143 34 186 101 158 54 - 201 25 102 241 55 70 35 3 216 118 162 108 39 87 144 66 242 - 108 61 243 239 244 168 180 119 82 49 253 233 136 123 10 206 - 207 82 89 36 88 174 150 38 195 121 37 76 247 250 213 123 36 - 224 214 201 204 169 20 145 60 61 148 240 72 245 170 127 227 - 23 70 172 150 134 226 214 223 107 103 141 130 173 155 70 86 - 183 66 28 179 3 250 26 58 242 194 43 232 66 92 66 187 79 - 189 115 201 108 56 230 163 105 156 115 105 60 208 196 214 - 23 80 148 145 71 5 135 122 132 235 145 201 29 249 42 188 22 - 245 174 164 248 151 240 207 198 70 212 45 21 81 145 142 204 - 10 160 186 163 71 154 222 77 183 49 8 157 84 246 254 35 239 - 93 112 206 180 145 203 60 93 201 116 37 211 39 10 0 126 41 - 220 119 81 1 144 213 22 120 174 35 92 237 226 135 146 250 - 234 33 235 143 65 87 228 217 13 50 87 226 199 254 144 126 - 149 245 166 141 200 243 10 133 46 162 232 115 146 72 172 - 206 175 41 238 191 223 67 147 9 51 12 132 227 114 214 82 - 120 106 56 113 80 209 170 72 88 5 76 31 189 20 215 178 152 - 212 149 201 197 50 102 37 118 211 195 242 150 227 222 140 - 18 71 129 181 137 168 84 119 151 1 73 197 49 180 191 153 - 148 110 200 199 106 231 250 104 246 74 29 148 174 230 227 - 29 177 89 232 58 77 246 183 172 195 20 112 177 141 125 135 - 6 153 244 151 75 234 157 65 36 113 136 241 9 0 230 186 15 - 162 250 19 79 208 225 79 42 25 145 130 183 31 74 76 146 138 - 71 84 49 211 183 209 143 68 244 245 174 149 167 6 252 56 86 - 28 246 169 45 207 130 182 134 66 222 30 61 187 214 251 192 - 182 235 26 15 40 39 210 144 107 247 22 176 249 46 37 36 124 - 193 127 155 233 83 91 118 86 172 214 151 14 236 220 228 103 - 130 222 213 147 204 138 164 48 86 39 185 168 228 218 149 - 196 206 56 17 91 129 133 81 243 17 88 53 227 180 137 28 114 - 56 92 122 247 170 27 241 177 225 187 24 231 251 171 43 85 - 241 50 170 14 15 36 154 87 109 34 151 27 134 121 167 54 108 - 225 129 12 118 251 82 185 168 151 112 226 129 250 130 194 - 222 77 30 118 120 247 237 140 250 122 215 48 107 54 169 103 - 169 201 224 163 129 188 240 195 138 235 187 203 101 109 50 - 82 205 130 227 143 181 115 71 197 11 55 183 214 228 88 219 - 17 239 224 1 244 162 157 171 57 102 252 68 107 48 54 234 27 - 24 175 68 15 114 49 158 213 166 218 19 37 160 207 38 140 - 137 120 10 220 145 86 198 173 108 227 123 9 130 182 203 218 - 181 195 216 240 59 214 215 70 49 131 73 244 196 91 80 99 - 248 197 62 230 152 193 145 111 145 75 245 24 207 226 147 - 159 90 109 103 31 244 97 158 115 84 140 28 140 40 184 185 - 117 148 100 12 118 173 183 172 143 165 92 48 193 34 39 175 - 186 149 168 14 24 142 49 64 220 201 183 78 157 87 129 225 - 61 43 84 232 196 94 55 155 195 207 134 216 61 168 155 89 - 101 241 16 108 61 232 168 236 220 219 161 11 198 208 223 - 219 91 173 172 157 100 86 32 119 166 109 80 30 201 95 79 - 166 228 30 245 150 187 129 127 18 255 0 101 110 209 23 195 - 43 246 175 107 136 5 253 171 30 119 29 181 54 44 125 209 - 127 252 28 119 147 73 72 230 142 40 215 60 31 122 156 223 - 199 182 38 200 192 3 32 212 119 225 21 138 174 131 12 155 - 67 115 220 84 183 91 141 148 97 89 64 199 32 251 84 228 244 - 119 67 216 175 53 163 38 215 30 25 199 112 213 29 69 63 48 - 152 73 159 65 233 83 13 65 48 37 1 124 167 249 170 55 61 - 169 40 20 109 200 254 90 129 218 4 247 78 190 70 24 83 220 - 214 80 238 154 69 16 176 14 14 87 234 104 11 230 104 238 90 - 118 5 84 252 202 125 190 148 126 152 158 21 202 220 69 135 - 4 103 13 217 215 233 250 215 70 55 226 38 88 187 39 154 13 - 208 252 34 163 33 141 193 243 231 212 251 211 251 121 149 - 85 1 97 130 112 191 90 135 90 206 197 188 64 27 45 201 207 - 127 214 134 215 181 195 98 143 189 138 237 77 203 207 99 70 - 147 236 131 99 174 169 234 43 123 77 62 84 37 70 88 247 53 - 203 223 20 122 138 214 234 127 203 100 102 12 71 7 177 230 - 180 252 80 248 131 123 168 93 92 217 90 92 48 143 126 11 3 - 85 179 199 52 132 72 237 36 140 199 144 125 105 163 26 232 - 132 230 210 164 48 75 217 26 50 178 31 175 216 86 192 177 - 179 120 114 70 67 241 199 223 181 123 78 176 141 158 25 60 - 57 29 36 94 123 112 125 170 77 160 116 237 205 192 152 92 - 70 3 69 180 142 14 72 30 149 94 150 201 70 42 93 246 70 127 - 3 111 32 5 156 28 246 30 245 190 13 46 213 184 24 7 252 106 - 204 181 232 39 188 134 25 214 2 158 110 1 167 211 252 45 - 149 128 217 22 112 6 10 158 230 167 249 25 79 192 83 113 90 - 218 43 149 217 141 188 156 214 187 150 139 38 69 97 207 165 - 90 154 223 195 91 168 237 85 150 18 178 103 7 158 226 163 - 250 159 68 74 152 183 104 138 133 245 230 154 51 108 73 97 - 165 178 2 110 35 93 185 140 228 246 250 214 22 218 145 75 - 144 79 49 169 237 237 76 239 180 139 136 30 225 167 183 116 - 136 113 19 250 19 244 164 87 118 130 221 66 140 239 113 150 - 255 0 84 123 26 210 236 17 199 79 146 58 87 225 47 85 90 20 - 133 99 120 217 252 48 184 7 154 188 44 181 72 110 33 115 28 - 138 189 178 107 243 247 73 212 245 13 34 238 43 139 91 150 - 86 86 224 103 130 43 161 190 21 117 252 218 133 187 199 52 - 195 196 199 42 79 57 169 101 130 173 150 89 37 47 133 243 - 123 62 27 184 205 66 250 153 228 158 87 72 219 242 128 203 - 31 230 250 83 11 125 67 241 86 98 67 184 239 92 140 119 20 - 179 85 146 97 108 214 246 225 124 118 236 237 217 7 169 53 - 139 136 77 210 199 8 240 215 106 142 5 122 9 94 225 177 34 - 149 251 208 119 94 29 164 113 164 108 89 229 206 11 127 16 - 254 111 181 21 167 69 35 196 145 178 183 3 230 247 165 148 - 171 163 166 41 164 130 109 86 72 238 147 99 239 32 246 21 - 50 208 67 51 13 202 70 225 138 143 217 91 1 54 246 198 79 - 106 149 105 49 31 46 210 1 250 210 91 125 141 149 166 135 - 114 167 244 87 221 194 162 96 31 173 115 103 199 23 118 190 - 241 36 82 160 55 148 159 90 234 47 194 238 179 39 25 59 121 - 246 174 109 255 0 40 116 120 110 193 194 99 119 97 84 199 - 217 231 101 232 129 88 15 19 77 12 127 74 223 28 124 80 182 - 50 40 176 133 70 70 70 236 125 40 181 124 40 198 106 216 - 211 226 206 89 109 155 34 93 166 136 112 118 10 12 51 23 28 - 26 222 242 16 170 190 227 251 40 168 180 18 63 170 115 121 - 30 61 233 149 159 238 69 44 213 124 179 41 200 224 209 54 - 210 55 130 49 197 27 163 25 220 166 238 105 102 167 24 91 9 - 200 239 225 63 20 222 94 35 207 189 5 169 47 244 9 255 0 - 221 61 43 70 54 233 208 175 236 235 101 33 79 228 35 103 - 244 175 52 113 171 249 177 244 197 37 178 189 151 240 22 - 235 26 231 108 64 22 250 14 212 76 115 74 236 190 76 156 - 214 148 120 148 135 25 116 137 30 154 114 195 142 115 199 - 181 103 212 2 69 22 211 42 134 41 38 15 181 97 165 135 104 - 187 109 230 137 213 70 52 183 247 83 145 247 160 73 170 154 - 103 65 124 33 150 245 186 106 18 99 120 198 121 199 106 156 - 223 50 181 177 103 80 95 24 21 0 248 17 121 29 215 79 197 - 27 206 216 7 154 178 245 45 63 242 188 72 206 83 28 87 61 - 118 206 200 63 34 5 170 47 149 155 113 35 212 123 82 11 169 - 21 163 11 24 218 71 114 106 73 171 90 72 204 237 27 21 199 - 124 122 212 102 246 53 149 138 188 133 0 61 197 37 89 217 - 29 136 53 75 171 111 21 13 192 196 108 112 91 218 137 211 - 97 109 58 34 151 18 135 183 97 186 25 129 206 207 245 126 - 212 171 82 145 33 117 180 155 5 91 129 159 74 81 38 165 119 - 166 23 181 185 13 36 64 111 140 154 120 107 68 242 77 217 - 59 186 215 99 183 178 109 201 135 81 232 121 199 215 235 84 - 183 196 238 182 55 119 18 90 219 202 225 135 145 142 107 - 221 79 213 32 192 235 24 33 241 140 3 233 239 85 212 183 17 - 202 254 44 222 116 39 42 87 230 253 106 177 77 156 83 157 - 61 31 45 237 237 239 1 102 27 100 118 207 29 137 246 21 186 - 210 206 226 234 117 88 99 32 227 102 0 229 79 210 134 131 - 114 220 179 91 169 147 235 31 106 184 62 29 116 188 215 205 - 14 160 145 168 115 141 216 236 79 184 250 85 23 138 217 40 - 183 116 197 93 13 210 179 94 74 18 230 213 114 14 72 92 240 - 106 230 233 14 149 201 182 205 143 49 182 210 72 249 254 - 245 48 233 30 132 176 210 209 47 24 174 233 57 97 252 167 - 218 167 186 85 149 188 100 34 145 133 57 28 122 212 102 220 - 186 58 97 20 182 200 190 129 210 227 194 72 103 183 201 140 - 229 192 28 17 78 83 165 195 162 4 143 96 7 111 126 245 58 - 210 108 148 90 143 40 231 191 214 137 154 200 237 77 168 54 - 171 110 34 137 185 113 123 101 115 115 210 176 184 101 150 - 223 113 81 198 106 35 212 61 46 204 146 44 118 104 3 38 204 - 227 176 247 251 213 241 45 180 101 119 0 9 35 251 41 14 173 - 104 170 73 101 10 153 224 208 119 240 50 148 89 202 157 87 - 210 48 77 60 202 214 110 145 193 229 140 1 199 222 169 174 - 161 208 175 22 242 86 75 117 218 95 31 252 215 114 106 218 - 69 181 227 52 71 111 57 46 113 223 138 169 250 227 225 231 - 131 110 90 216 198 94 224 22 231 209 126 149 162 223 45 154 - 81 168 156 164 246 105 35 152 164 140 41 67 203 122 15 160 - 172 244 205 66 77 47 82 51 89 54 17 78 55 19 203 125 233 - 247 94 105 223 178 174 22 205 16 237 44 124 64 125 90 162 - 182 234 136 155 102 138 70 62 137 31 173 94 124 90 57 84 - 156 54 116 39 195 190 179 134 247 78 137 124 92 52 99 12 24 - 250 84 190 125 74 222 228 22 13 148 35 12 7 241 125 15 210 - 185 131 65 214 164 211 239 247 12 162 231 205 138 181 180 - 30 166 140 66 173 183 114 133 221 180 251 251 212 163 217 - 104 57 61 217 45 187 183 48 52 154 150 161 34 137 37 242 67 - 26 246 81 232 61 233 182 153 49 100 85 229 112 63 90 138 45 - 212 147 203 251 79 82 37 80 183 229 102 164 26 9 252 67 120 - 146 72 85 91 145 72 227 114 59 160 237 18 88 219 116 161 - 128 194 250 98 164 218 66 175 145 152 176 31 74 141 233 144 - 188 234 35 221 177 148 246 247 169 118 137 110 210 97 23 - 142 49 73 246 131 54 146 29 92 206 230 219 109 190 115 183 - 140 251 87 51 255 0 148 20 183 13 170 120 78 170 124 221 - 249 174 164 185 130 27 123 23 50 76 82 69 143 129 239 92 - 167 241 178 239 241 93 84 144 43 29 170 196 55 214 169 141 - 83 103 14 94 136 60 113 50 75 18 174 79 229 246 52 94 226 2 - 231 223 154 250 84 199 50 150 228 142 7 218 177 118 12 221 - 171 162 18 75 71 56 79 139 25 101 81 243 99 244 172 165 198 - 194 27 185 239 143 74 24 174 210 24 112 43 207 32 216 41 - 219 179 8 181 86 62 48 237 222 143 178 93 208 45 3 170 168 - 241 215 143 90 105 166 46 97 24 246 169 72 198 115 174 16 - 41 251 208 58 145 99 167 93 28 124 176 57 31 217 76 167 70 - 35 147 64 234 8 223 179 47 121 255 0 246 207 255 0 45 82 49 - 209 133 58 116 91 236 237 155 215 195 163 214 53 35 105 60 - 208 186 71 245 59 111 247 99 251 232 167 39 120 199 189 115 - 61 187 58 49 244 62 211 27 106 40 244 11 138 206 245 131 90 - 52 110 112 15 124 250 80 182 59 150 60 230 183 93 131 52 5 - 27 128 123 98 175 195 198 206 121 123 23 111 194 141 25 19 - 165 163 146 25 150 25 163 228 146 123 213 139 166 235 6 72 - 132 55 16 182 244 227 196 61 136 170 231 225 154 76 186 12 - 22 208 179 49 99 134 250 138 156 221 168 180 182 82 216 81 - 234 125 123 87 36 175 164 117 198 187 96 58 228 214 203 59 - 186 202 20 145 242 147 193 53 1 215 181 21 183 159 204 200 - 184 60 224 240 43 87 94 245 125 134 157 20 166 73 17 216 - 118 25 230 168 174 178 235 171 237 81 90 222 215 114 199 - 158 72 239 250 86 132 91 208 207 34 142 209 51 235 190 160 - 181 86 120 81 64 43 192 57 245 168 68 189 85 123 61 177 130 - 95 57 67 149 63 78 212 133 26 107 169 12 183 147 177 200 - 245 61 205 1 113 118 200 204 145 224 15 173 118 67 29 171 - 100 178 229 182 25 125 127 150 37 188 197 251 168 238 15 - 189 39 185 59 88 239 96 227 233 90 204 153 36 243 156 250 - 214 80 71 44 242 42 170 239 102 56 81 158 230 153 164 142 - 87 119 100 211 225 206 159 38 163 172 70 24 180 11 24 192 - 157 144 149 39 254 181 215 159 13 186 114 107 91 40 63 18 - 33 155 114 143 204 72 246 156 125 126 149 76 255 0 147 198 - 143 171 90 193 29 212 150 211 92 187 159 201 137 149 118 - 238 29 192 231 57 31 95 210 186 179 67 253 204 19 79 111 28 - 23 17 128 94 51 243 21 255 0 10 231 148 172 183 14 42 205 - 194 198 51 182 56 212 246 239 76 244 141 60 52 109 25 57 - 246 62 245 140 23 182 18 93 21 158 101 66 237 144 163 184 - 167 169 60 62 42 219 197 177 155 211 111 183 189 78 154 232 - 101 145 208 77 140 91 97 53 181 215 56 86 224 19 201 175 - 182 255 0 153 207 99 244 237 88 207 34 169 11 131 222 155 - 95 72 74 219 179 99 70 54 96 118 28 10 87 127 110 100 144 - 112 118 47 115 77 147 204 156 80 119 141 180 129 42 159 15 - 233 220 208 119 240 104 57 39 178 37 117 96 85 213 147 200 - 51 198 125 105 102 187 166 69 54 157 34 149 46 249 193 30 - 255 0 74 152 93 203 101 248 35 47 136 164 33 198 65 165 111 - 61 188 182 243 165 187 70 230 70 249 143 96 43 36 238 217 - 105 100 109 81 202 255 0 26 122 94 231 240 119 19 36 177 69 - 30 60 177 32 36 177 255 0 189 115 30 160 38 130 83 13 194 - 52 108 59 6 24 56 175 208 63 136 208 223 92 105 207 21 134 - 158 207 19 103 243 21 87 43 199 98 73 239 92 75 241 71 69 - 212 236 122 138 225 174 109 229 104 249 35 198 24 32 125 72 - 227 251 234 139 100 114 69 209 22 180 152 162 121 78 1 245 - 167 218 70 173 115 107 34 186 254 98 142 224 122 138 138 6 - 100 227 248 79 106 221 5 228 177 159 47 98 49 85 171 22 46 - 145 97 69 213 51 92 95 197 248 179 182 5 249 99 61 254 245 - 105 116 222 187 111 113 98 30 50 170 84 236 7 61 207 181 - 115 221 153 241 206 226 88 47 185 244 52 108 26 166 163 165 - 220 175 225 238 11 170 182 229 0 240 77 35 196 213 179 170 - 57 18 143 103 91 244 253 212 110 23 116 170 167 102 50 125 - 13 77 116 75 168 109 109 131 33 103 25 229 147 214 185 131 - 161 190 34 36 211 8 175 36 104 229 7 140 227 7 251 234 246 - 233 77 90 222 254 213 26 9 55 2 61 235 145 220 101 208 202 - 74 107 178 77 121 113 115 170 188 145 70 36 181 135 30 99 - 47 241 253 171 159 62 46 90 90 218 245 34 77 104 193 54 183 - 0 213 253 169 91 200 150 203 113 19 96 168 36 227 218 185 - 235 226 187 51 106 194 86 112 70 227 192 239 84 199 53 100 - 178 105 82 35 18 57 99 90 7 239 43 4 155 33 91 156 123 86 - 107 203 110 174 142 36 101 166 19 130 0 200 199 21 237 170 - 121 39 154 248 155 177 230 32 214 71 129 156 142 105 210 - 179 8 245 140 248 163 138 109 163 200 162 223 130 51 138 85 - 173 224 74 87 190 61 69 29 163 254 235 244 161 40 152 57 - 183 51 103 6 131 213 8 93 58 247 60 127 71 127 249 104 238 - 62 180 22 177 183 246 101 239 127 234 239 255 0 45 20 233 - 24 85 167 73 26 216 65 158 254 18 86 70 100 50 129 159 90 - 89 104 199 240 86 236 199 63 150 63 186 178 133 100 146 225 - 112 199 147 197 69 37 101 99 145 116 137 133 143 154 42 223 - 50 31 8 149 228 138 209 167 127 87 0 247 94 9 162 157 136 - 78 14 51 222 171 242 136 228 246 39 127 8 122 155 193 211 - 165 220 219 222 54 192 218 113 254 52 71 92 124 78 134 206 - 23 182 242 187 28 252 196 228 113 244 170 88 223 220 219 - 207 44 80 206 241 239 239 180 227 38 144 234 211 205 121 49 - 73 228 101 63 206 79 45 244 169 180 145 73 78 162 107 234 - 29 90 235 92 212 101 113 39 229 150 254 34 104 102 133 173 - 146 56 230 104 163 6 61 202 249 206 107 11 155 118 183 143 - 115 52 123 72 227 117 42 184 144 147 183 57 35 142 15 24 - 167 142 136 115 114 14 212 175 140 155 18 48 170 23 212 122 - 208 18 51 72 219 155 143 181 124 141 89 188 217 237 82 45 - 15 165 239 239 228 64 35 220 172 50 60 164 211 60 180 168 - 122 182 34 182 181 150 105 22 52 83 150 56 21 119 124 40 - 232 61 22 11 120 117 14 162 91 71 193 223 137 156 141 163 - 244 168 207 76 244 169 183 63 136 212 18 225 18 57 54 168 - 100 219 185 135 63 225 91 58 183 90 125 107 82 255 0 195 61 - 62 206 225 188 133 223 130 120 244 164 82 82 209 69 162 234 - 185 248 149 211 250 36 150 134 27 173 53 90 60 43 62 205 - 196 168 237 185 135 124 122 30 226 143 31 29 52 104 209 202 - 95 254 32 5 27 100 36 236 45 159 148 10 175 236 62 14 116 - 119 78 233 49 106 29 125 173 188 6 78 209 228 140 254 148 - 143 173 126 25 244 255 0 254 31 184 234 111 135 186 191 237 - 75 11 33 253 58 212 252 240 131 193 111 211 138 203 18 248 - 105 41 203 127 11 55 77 248 167 13 230 169 52 150 247 62 32 - 50 141 165 57 219 192 206 71 176 171 175 165 122 166 5 180 - 105 218 238 57 174 14 11 190 120 198 63 135 233 92 19 209 - 178 53 191 80 219 134 145 158 37 96 36 8 112 28 122 30 61 - 49 87 123 245 75 105 182 99 207 52 183 69 118 195 26 0 16 - 169 237 74 213 104 10 171 71 82 105 125 92 178 27 168 173 - 231 133 252 12 41 37 143 45 235 68 75 172 79 115 181 162 5 - 128 229 177 233 84 103 195 200 167 142 199 241 23 49 151 - 121 21 93 163 36 242 199 230 63 165 90 218 115 72 203 28 - 109 148 86 95 48 30 130 163 46 131 68 134 62 164 146 22 88 - 78 21 152 231 46 120 197 44 126 179 134 226 226 72 124 104 - 153 146 79 13 129 39 0 251 253 170 55 212 64 44 102 54 86 - 40 36 33 28 158 7 21 76 245 62 169 115 211 218 200 159 30 - 37 165 208 49 206 224 240 62 181 88 250 152 177 62 34 245 - 140 58 102 239 2 121 12 14 222 120 80 249 147 237 244 168 - 54 141 241 163 78 211 141 197 165 197 196 110 210 203 184 - 16 199 40 158 223 78 113 222 160 191 17 53 127 196 104 134 - 75 123 167 145 74 17 20 217 230 63 175 255 0 62 245 82 116 - 190 137 169 117 70 175 107 165 233 240 120 183 183 79 225 - 199 158 199 156 150 111 160 28 213 97 20 214 197 201 168 - 218 58 99 87 248 221 161 73 107 36 48 234 16 164 172 70 232 - 230 77 202 62 162 133 213 239 186 63 173 172 13 173 252 186 - 108 175 26 9 160 13 46 213 115 245 3 147 81 85 248 123 240 - 135 79 184 58 54 177 212 210 207 171 96 36 146 110 10 187 - 253 64 250 103 181 70 126 35 124 48 190 232 99 6 191 161 - 221 181 213 145 243 70 249 7 2 179 138 55 41 69 121 116 68 - 62 34 244 106 232 154 139 73 100 209 61 179 246 17 146 66 - 253 179 80 146 152 39 131 199 28 213 195 105 171 105 157 87 - 161 143 26 59 165 188 183 127 13 178 23 185 254 44 14 194 - 162 250 143 68 106 158 61 204 107 110 234 144 30 119 14 228 - 250 214 186 216 120 166 66 226 186 146 33 181 64 42 79 57 - 166 150 183 81 221 67 28 108 18 34 131 27 135 115 75 245 13 - 58 230 209 218 57 151 105 30 148 26 50 169 243 12 143 106 - 111 201 100 165 221 14 110 45 100 30 29 202 108 93 231 201 - 176 249 179 245 169 239 195 46 190 155 65 116 134 233 140 - 202 14 56 39 138 173 172 165 241 167 102 114 65 246 205 29 - 45 139 162 248 204 228 123 82 154 13 217 214 154 111 94 193 - 127 103 35 13 219 89 59 103 214 170 30 176 184 55 250 195 - 158 200 28 241 237 81 14 158 212 46 196 42 137 52 136 163 - 140 3 222 158 137 55 121 155 204 199 185 62 181 62 153 119 - 177 106 33 86 39 146 15 247 81 80 227 28 214 137 102 84 57 - 35 143 81 91 33 60 96 250 242 42 184 246 182 77 236 45 72 - 53 242 65 229 28 154 249 12 110 20 229 189 107 50 141 142 - 244 244 97 14 171 216 100 246 245 166 26 88 99 0 35 218 130 - 215 35 41 149 62 180 126 145 34 139 101 76 115 75 35 4 237 - 124 253 43 70 167 206 153 122 63 254 179 255 0 203 71 73 - 185 87 191 122 7 80 255 0 54 94 255 0 237 223 254 90 41 42 - 48 158 198 216 61 132 13 234 34 76 10 223 4 91 101 25 226 - 129 180 188 95 192 192 168 74 159 13 123 253 40 136 174 55 - 56 243 115 92 231 71 24 168 162 77 103 194 133 29 143 173 - 23 183 3 142 104 29 53 183 69 159 173 28 161 137 32 48 31 - 122 183 250 156 242 236 132 107 158 77 85 199 161 245 165 - 154 157 228 75 20 143 224 147 38 208 160 254 180 95 83 57 - 138 255 0 123 28 143 97 222 163 23 119 6 86 113 187 3 28 3 - 64 73 118 105 188 158 75 137 188 71 96 196 142 62 149 164 - 43 30 194 155 233 90 68 247 146 69 24 134 76 56 200 101 82 - 71 247 84 150 223 225 254 169 117 125 13 172 54 206 217 30 - 128 228 208 177 150 50 61 211 246 17 93 221 197 19 50 151 - 102 24 78 228 254 149 210 29 55 105 99 164 244 220 104 153 - 154 237 211 1 35 143 5 190 134 190 116 95 193 91 125 52 67 - 53 238 212 144 12 22 9 206 126 149 105 216 232 54 58 126 - 158 27 240 202 229 60 161 207 115 250 84 178 100 101 225 - 138 145 205 127 16 35 235 141 54 194 107 169 173 82 194 202 - 102 43 28 64 121 177 238 126 181 183 252 152 180 184 110 - 186 206 59 139 153 55 120 114 255 0 23 124 138 184 254 36 - 90 166 177 166 141 46 104 35 142 4 39 108 140 60 196 227 - 176 199 115 84 102 142 215 157 3 174 165 245 152 155 98 49 - 145 210 65 182 66 185 239 131 86 197 41 73 81 57 175 22 75 - 126 54 92 222 106 189 105 168 45 206 80 193 62 200 131 127 - 20 127 74 19 225 245 222 151 210 147 38 181 113 169 69 121 - 103 125 101 56 212 44 99 102 221 6 60 168 178 103 131 158 - 249 20 247 171 250 255 0 225 55 87 218 197 168 106 38 238 - 29 67 24 153 33 139 7 31 169 239 80 253 42 199 77 234 9 221 - 244 173 34 120 116 93 223 60 242 238 146 225 135 191 176 - 197 36 63 140 227 147 155 122 59 223 245 28 95 218 44 42 62 - 68 123 167 116 185 33 117 214 20 71 109 12 210 51 36 95 197 - 180 158 0 171 51 165 244 73 181 27 215 191 191 183 154 71 - 150 61 177 2 56 219 239 254 213 35 135 77 93 99 94 75 88 99 - 72 173 161 199 135 10 231 9 138 187 122 35 69 184 136 199 - 113 225 112 23 204 91 181 105 61 158 122 116 182 109 183 - 177 142 215 72 137 99 152 44 139 202 169 238 135 220 211 - 173 10 247 84 145 37 105 49 49 72 240 127 183 230 20 195 - 195 180 216 86 107 115 34 158 225 69 108 183 146 21 220 177 - 126 90 40 200 92 115 82 158 217 76 73 209 23 188 188 186 - 187 184 17 77 43 73 110 173 231 66 57 205 36 235 93 26 222 - 248 180 239 3 92 196 188 182 206 202 49 86 11 61 188 190 - 105 20 200 254 158 80 48 43 69 253 168 184 183 219 28 107 - 27 24 246 133 127 95 236 162 131 61 28 197 173 216 222 88 - 217 13 44 226 43 73 31 242 89 255 0 139 239 65 124 52 190 - 183 232 190 169 212 34 186 137 37 188 186 211 165 252 20 - 241 182 10 183 7 106 159 114 1 171 31 226 39 74 188 150 165 - 68 82 126 72 47 156 241 159 165 66 44 180 219 125 107 79 75 - 123 168 137 187 181 36 199 112 14 10 48 237 131 86 134 153 - 9 78 169 175 217 28 191 211 109 173 111 109 205 190 165 6 - 167 45 196 98 226 89 34 13 152 157 143 40 229 191 136 122 - 213 219 240 252 182 169 240 123 92 211 245 15 204 134 221 - 191 163 153 62 94 59 129 85 78 147 168 244 85 173 233 139 - 172 44 181 29 51 80 138 76 59 194 229 163 155 253 110 121 - 201 246 169 111 88 252 86 233 143 252 53 7 76 244 23 143 35 - 72 140 37 121 34 218 50 125 205 8 97 148 95 43 61 95 231 - 255 0 59 22 124 80 140 35 180 82 80 254 51 75 234 219 152 - 244 185 25 31 199 17 162 17 228 111 191 210 174 222 139 139 - 169 109 103 71 234 59 16 208 73 134 91 132 28 99 218 162 - 191 15 58 89 110 181 4 213 181 39 113 32 199 134 93 114 142 - 255 0 82 43 162 180 147 22 161 107 2 222 219 198 147 162 - 132 64 7 148 175 189 35 200 250 103 18 132 111 179 158 126 - 54 232 182 47 178 234 216 143 12 182 230 34 169 75 216 226 - 86 62 11 7 25 238 43 184 58 167 161 44 181 120 36 73 6 204 - 140 99 195 4 19 238 42 138 248 143 240 98 250 192 126 51 78 - 18 73 30 114 219 87 3 251 40 197 162 83 195 78 202 44 103 - 52 211 78 187 145 54 164 135 122 127 47 168 167 119 125 31 - 117 14 158 39 146 60 72 6 74 169 228 212 106 230 9 109 91 - 44 172 185 28 110 20 233 139 199 137 59 211 30 223 194 6 21 - 216 9 228 123 154 117 19 21 183 101 35 181 68 58 114 224 52 - 41 184 147 232 64 247 169 58 179 120 108 164 130 77 35 236 - 22 8 208 254 98 209 16 202 21 112 8 197 15 63 136 172 6 112 - 125 43 234 35 110 238 0 255 0 173 87 23 65 24 66 236 121 - 193 197 109 144 238 21 170 15 42 121 151 28 214 213 59 184 - 170 24 79 174 144 84 145 216 246 173 250 79 238 135 218 133 - 214 206 213 17 144 115 69 105 35 49 45 99 12 223 228 160 - 245 15 243 101 239 254 217 255 0 229 163 101 24 10 191 74 - 11 81 227 77 189 255 0 219 191 252 181 140 66 237 225 152 - 136 216 103 105 143 138 42 222 57 150 117 57 39 154 107 103 - 110 162 194 219 10 63 171 171 126 167 189 98 177 159 20 10 - 230 67 56 162 65 166 16 176 15 122 57 202 178 141 172 115 - 64 88 198 124 49 205 27 28 101 92 179 114 41 211 177 27 43 - 190 181 38 61 66 76 115 159 127 74 142 91 196 102 157 87 - 146 88 212 151 174 163 111 198 6 254 126 212 171 167 182 - 166 169 24 144 2 50 57 62 156 208 151 236 120 165 106 206 - 132 248 59 209 94 38 135 22 165 116 100 87 219 133 80 70 49 - 138 180 58 43 73 68 189 154 226 52 220 241 182 23 35 56 160 - 58 34 72 173 250 58 47 54 209 225 129 24 247 207 173 79 186 - 31 77 16 218 248 219 67 25 6 226 42 13 203 224 242 236 123 - 167 216 226 13 203 26 128 188 231 57 255 0 26 95 212 86 203 - 14 38 0 224 17 188 125 42 75 20 6 20 41 26 240 252 40 164 - 186 234 187 174 24 60 133 78 89 87 218 149 187 209 148 221 - 236 138 245 22 157 60 140 183 218 74 1 34 249 247 204 160 - 162 241 142 213 79 245 47 72 111 89 117 61 99 84 182 187 - 158 103 33 174 166 206 10 255 0 42 133 245 251 213 175 213 - 218 164 50 217 172 77 44 214 192 54 8 65 153 36 250 40 165 - 235 164 216 95 233 145 223 73 17 140 91 201 143 195 177 220 - 227 244 236 198 173 6 250 55 37 118 206 124 181 232 213 212 - 181 136 196 118 238 246 80 74 54 160 1 90 97 239 159 229 - 171 3 81 179 134 222 91 125 63 77 88 108 247 70 21 97 132 - 238 43 245 53 45 120 119 180 159 135 218 145 202 124 24 230 - 10 1 96 59 138 144 116 239 76 219 104 202 250 174 165 4 101 - 194 238 201 94 91 218 157 201 213 11 26 91 162 47 209 221 - 26 52 117 23 55 18 44 146 183 32 241 146 126 181 97 105 233 - 20 118 239 243 120 107 243 2 121 52 161 18 107 251 179 117 - 35 164 17 70 249 66 107 125 213 247 138 230 59 119 1 148 - 224 149 236 106 118 51 105 187 99 27 235 207 20 237 133 85 - 51 237 90 163 140 144 27 36 55 175 214 176 176 141 3 171 57 - 220 128 242 222 212 213 32 181 101 44 179 99 53 59 41 141 - 241 20 200 230 41 119 134 56 245 197 31 105 121 29 194 42 - 177 193 3 134 254 42 198 107 120 2 16 178 100 251 210 153 - 213 161 184 13 20 228 145 243 173 50 86 9 53 123 50 234 11 - 11 107 132 41 134 60 99 35 4 255 0 125 85 157 71 210 82 232 - 87 15 123 4 237 225 49 203 32 28 15 92 241 86 153 120 245 - 40 4 33 140 12 220 54 239 152 214 173 37 225 148 75 165 223 - 70 178 197 38 80 59 12 213 185 19 139 75 225 77 117 119 76 - 218 117 23 78 199 47 225 99 146 248 121 146 242 54 243 3 - 252 172 191 245 164 29 51 210 246 205 122 209 95 27 104 110 - 162 249 76 132 248 83 143 117 43 87 61 247 76 54 135 118 - 243 89 248 81 68 91 43 159 95 113 205 124 211 116 235 59 - 199 54 23 81 195 110 249 202 133 64 54 122 231 39 248 104 - 114 98 73 236 91 209 125 35 169 105 98 107 75 29 66 7 178 - 150 60 155 57 0 59 121 244 39 154 176 161 130 56 45 161 131 - 240 242 36 164 237 44 221 179 244 168 206 172 145 216 106 - 169 111 43 77 19 68 121 184 135 229 199 250 223 79 168 169 - 93 165 218 234 150 209 172 106 222 64 48 87 215 30 166 167 - 40 219 177 137 5 164 77 225 36 102 48 236 7 36 210 254 160 - 178 221 27 70 208 171 41 249 151 210 159 105 140 205 10 22 - 12 209 109 192 217 232 126 191 90 251 119 110 165 6 236 183 - 213 187 209 72 45 183 217 69 183 75 195 125 121 61 155 100 - 5 30 184 205 115 207 198 174 155 151 68 213 222 32 25 161 - 83 228 98 7 34 186 207 88 181 139 79 234 23 149 155 247 220 - 10 163 255 0 202 41 80 99 115 120 135 178 3 252 67 6 155 28 - 147 208 117 84 202 79 164 121 159 185 198 123 26 153 3 129 - 233 81 14 155 253 250 152 252 188 224 129 233 82 233 50 23 - 235 76 227 178 79 197 31 83 243 62 113 147 239 69 69 10 17 - 207 56 237 66 70 234 20 224 115 68 71 56 0 125 120 167 197 - 209 141 160 49 250 250 86 74 25 125 43 234 28 14 56 205 101 - 147 239 84 48 155 89 82 249 46 54 159 165 109 209 219 49 - 125 171 29 96 150 206 121 226 190 232 192 180 71 21 140 53 - 145 153 136 192 29 168 109 70 54 253 151 120 205 192 54 207 - 255 0 45 18 119 46 57 244 172 117 94 116 59 175 253 179 255 - 0 202 107 24 142 89 51 27 24 6 15 238 146 183 163 13 224 - 100 103 53 170 197 15 224 160 237 251 164 175 174 140 178 - 175 110 245 199 99 146 109 59 247 127 173 22 85 73 60 208 - 90 110 68 32 159 122 34 114 206 190 203 233 142 245 117 29 - 89 39 221 16 158 179 54 177 220 6 150 54 101 29 212 54 9 - 253 107 111 65 52 119 55 208 199 14 159 167 164 123 191 120 - 209 111 147 191 189 1 214 76 222 33 221 130 113 71 252 41 - 88 255 0 104 199 36 165 130 171 100 227 214 150 79 84 58 - 126 71 78 217 170 67 162 91 71 31 38 76 42 17 235 86 191 71 - 218 226 40 183 157 227 104 3 30 245 85 116 252 107 47 224 - 147 147 26 121 176 106 212 209 200 68 130 221 153 131 103 - 118 229 237 138 136 242 236 147 52 74 210 101 92 7 94 113 - 81 206 163 180 146 65 45 212 115 0 66 224 212 170 13 172 85 - 149 148 48 60 230 163 157 92 118 146 241 130 177 200 118 96 - 251 227 63 244 167 125 0 170 250 146 107 143 26 41 174 154 - 105 32 81 183 100 67 37 142 104 141 62 226 225 44 37 156 - 192 167 127 149 93 184 194 251 154 34 85 150 107 205 145 - 176 9 27 121 178 56 175 107 55 45 34 236 114 145 219 47 4 - 142 9 164 10 179 239 79 89 193 97 27 94 77 34 162 47 152 51 - 30 13 9 170 235 147 234 243 24 80 18 177 156 130 61 69 71 - 239 239 159 88 188 88 85 21 45 226 60 5 39 154 51 80 158 - 223 65 182 73 37 184 54 225 70 230 4 14 70 59 81 76 106 190 - 198 23 55 145 91 233 127 141 105 132 48 198 48 238 199 3 - 255 0 154 174 58 155 227 6 147 167 135 139 69 183 123 233 - 84 238 241 230 249 11 85 101 241 47 174 53 30 162 190 154 - 40 100 123 125 56 54 216 237 225 111 46 51 220 253 106 53 - 162 195 249 223 155 143 15 235 70 43 147 7 137 100 15 139 - 93 115 122 210 203 111 115 4 1 223 248 98 193 3 233 91 224 - 235 142 190 159 44 117 201 23 112 254 17 66 244 246 143 9 - 132 58 170 159 165 53 93 29 113 226 5 35 43 144 0 167 81 - 127 161 185 68 15 255 0 212 47 136 86 174 118 234 178 76 23 - 130 28 113 138 249 167 124 105 234 91 59 198 143 87 180 181 - 188 182 99 229 35 190 62 148 116 154 76 126 31 238 219 44 - 57 200 168 119 85 233 118 246 170 74 40 12 79 4 246 20 90 - 111 224 27 139 46 222 152 235 237 19 169 151 109 140 198 - 218 240 156 61 180 237 134 79 246 126 181 34 212 21 229 41 - 26 161 241 147 204 8 244 250 215 29 239 158 206 100 158 41 - 36 142 88 206 229 120 216 130 167 220 123 213 223 240 171 - 175 165 212 172 19 76 214 36 205 194 174 216 238 9 229 135 - 177 164 118 129 73 244 93 58 63 80 195 169 35 105 23 135 - 108 177 46 6 238 198 129 182 183 146 199 89 146 65 27 74 - 210 38 207 15 196 194 129 244 164 122 189 171 181 132 55 80 - 183 134 20 238 18 47 175 222 138 210 117 111 218 67 240 247 - 18 5 184 78 3 10 91 12 83 110 168 207 85 150 225 110 90 222 - 68 144 6 95 202 42 60 195 234 79 173 72 186 125 111 38 252 - 53 180 146 166 118 124 222 189 251 26 213 115 190 234 201 0 - 88 214 88 142 85 241 233 68 116 235 184 34 119 145 222 69 - 109 187 113 253 244 108 220 75 31 72 181 120 160 48 25 4 - 128 12 144 43 116 176 199 248 15 13 99 98 8 230 182 105 222 - 91 96 164 129 43 97 183 30 216 199 106 209 172 188 98 216 - 198 172 195 234 180 91 36 221 58 43 158 186 142 72 46 32 - 154 67 149 13 159 189 85 31 25 237 148 233 226 85 240 156 - 21 220 168 235 184 30 61 69 91 221 94 127 21 104 95 4 140 - 121 126 149 89 245 117 172 87 90 116 126 59 200 27 105 92 - 142 64 21 37 26 118 91 134 172 230 221 62 226 221 53 16 143 - 103 28 110 78 73 133 246 47 255 0 230 164 55 238 134 37 218 - 70 61 57 165 29 89 165 92 104 218 195 188 136 230 34 124 - 178 122 99 222 178 134 224 188 74 172 114 64 239 86 82 100 - 166 188 67 34 108 46 115 69 71 38 229 238 41 100 47 199 122 - 54 221 129 166 140 184 137 45 58 24 219 252 167 62 245 183 - 156 103 210 180 68 234 171 94 150 96 20 14 106 139 34 97 0 - 213 121 25 29 141 124 210 37 111 8 166 59 26 245 243 6 77 - 163 248 123 159 122 195 70 238 212 121 196 195 144 196 247 - 21 163 84 35 246 77 208 245 17 57 63 109 180 65 27 87 60 80 - 154 145 255 0 203 111 127 246 207 254 24 173 206 38 21 233 - 188 216 219 159 254 146 127 133 110 4 9 121 25 161 108 37 - 85 177 183 95 85 140 110 250 226 136 143 243 36 7 208 26 - 228 41 30 199 214 25 240 78 71 173 109 150 64 16 143 95 65 - 239 88 90 16 109 248 227 28 86 139 146 119 231 60 142 213 - 107 124 73 201 121 16 206 172 95 26 80 23 191 175 210 166 - 191 9 186 121 141 170 220 180 51 57 39 129 129 239 222 144 - 217 105 82 234 218 199 131 179 11 184 110 53 209 157 23 211 - 214 182 122 44 81 201 48 241 182 0 61 49 74 24 251 14 122 - 66 214 229 94 48 208 133 80 63 139 189 88 90 72 96 192 54 - 56 236 105 7 78 88 164 31 52 129 163 94 88 231 204 79 181 - 74 32 134 75 123 116 196 68 156 118 110 226 145 143 46 198 - 179 58 65 18 179 74 219 207 112 59 84 115 170 46 217 180 - 249 95 121 44 62 81 237 245 251 209 183 119 81 180 108 184 - 238 42 25 212 90 162 174 228 102 93 157 155 119 96 41 152 - 42 207 186 29 184 107 71 154 87 35 185 99 238 106 35 214 90 - 132 78 5 157 187 22 99 232 41 157 222 169 44 26 83 52 101 - 76 44 48 54 118 53 26 208 109 228 190 214 33 145 162 12 12 - 152 25 246 164 47 12 111 76 155 124 53 233 149 16 45 197 - 218 110 64 114 115 235 84 239 199 221 101 78 177 123 102 - 140 26 56 188 160 102 186 123 67 179 75 123 51 101 8 13 193 - 12 127 147 235 92 107 241 198 27 139 126 176 212 98 152 146 - 230 124 159 246 105 148 28 132 134 68 242 52 200 12 48 44 - 118 198 237 149 195 183 37 15 202 62 213 165 53 63 1 131 60 - 39 195 251 84 155 168 46 180 217 180 109 62 218 212 51 92 - 54 12 161 7 205 247 165 87 82 89 54 159 36 87 22 142 140 62 - 94 59 85 34 168 156 161 110 209 97 124 56 215 45 245 8 28 - 170 12 227 145 237 86 5 215 225 226 75 113 12 108 254 77 - 217 110 56 170 35 225 13 243 91 235 38 53 243 161 111 238 - 171 123 169 245 84 91 139 104 17 137 65 24 17 253 15 181 - 116 66 105 160 113 67 109 70 91 88 173 214 118 0 239 5 72 - 81 218 169 78 186 234 56 127 27 45 154 167 136 55 144 49 - 222 173 110 160 212 29 58 101 228 42 5 202 198 66 12 122 - 123 215 62 233 243 164 250 255 0 141 116 60 92 49 242 142 - 237 247 161 55 72 220 80 93 188 222 50 8 230 132 164 141 - 199 110 5 49 209 255 0 242 221 97 24 23 216 28 40 223 199 - 127 181 107 189 186 73 119 50 219 202 189 176 224 114 121 - 166 125 93 62 159 113 248 25 172 29 213 196 65 164 200 238 - 213 12 177 114 141 153 73 69 209 212 95 8 26 223 168 186 54 - 104 166 219 35 68 72 81 246 21 27 234 77 54 125 23 88 18 - 236 216 132 242 69 51 255 0 37 139 27 166 208 175 174 74 - 150 141 66 149 95 114 123 212 179 226 94 151 227 217 181 - 196 42 36 98 114 19 249 126 149 25 174 40 188 50 46 64 61 - 45 117 107 170 89 51 69 38 14 57 7 189 109 179 111 194 245 - 10 13 196 46 60 195 211 25 168 15 76 222 92 88 234 70 5 5 - 73 60 113 145 82 150 213 51 126 143 112 34 19 99 128 135 - 119 30 249 255 0 165 104 116 52 210 79 69 167 109 119 185 - 17 22 66 87 119 13 235 138 35 83 11 140 198 229 199 166 106 - 45 162 220 120 138 36 207 25 230 164 81 75 226 40 88 227 - 223 143 74 214 115 53 228 70 181 136 157 225 117 141 64 227 - 133 53 93 235 150 179 52 130 23 132 62 14 0 95 191 173 90 - 250 196 56 152 49 219 150 249 75 118 6 161 215 246 48 139 - 215 146 105 24 130 48 71 240 211 36 55 39 209 207 127 20 33 - 179 180 212 101 79 6 102 89 24 46 201 62 82 113 220 84 6 88 - 22 44 52 44 206 159 94 226 174 175 140 58 47 137 104 38 179 - 101 148 71 150 81 184 6 83 244 205 83 54 30 42 72 232 246 - 243 3 159 48 200 110 126 244 64 246 104 220 241 131 186 137 - 182 184 64 57 110 107 102 161 110 172 9 141 65 30 254 212 - 166 104 218 35 156 253 42 148 128 210 100 129 46 99 63 197 - 95 39 148 99 200 115 72 34 149 193 201 99 138 221 248 229 - 67 207 106 87 20 128 208 222 233 129 143 30 222 190 245 142 - 151 235 247 165 175 125 226 2 84 226 143 210 100 5 194 255 - 0 53 40 7 133 191 44 80 90 144 206 153 122 114 127 171 61 - 109 150 224 46 87 219 138 26 250 101 109 34 233 189 225 112 - 126 213 168 70 221 137 52 247 111 194 91 140 28 136 249 166 - 118 114 121 192 160 116 224 166 24 71 111 203 163 173 194 - 248 234 5 98 204 146 89 170 152 115 187 239 66 223 99 5 148 - 225 63 157 62 106 105 99 25 48 42 199 183 39 190 104 203 - 189 29 230 179 1 21 83 112 249 143 111 238 172 37 48 14 133 - 210 188 109 107 241 144 164 50 46 209 151 99 130 13 116 78 - 131 56 158 218 20 150 81 189 80 13 158 131 235 85 223 195 - 94 156 59 143 226 99 12 217 225 135 21 108 90 233 166 36 79 - 10 30 0 239 88 172 152 218 198 23 133 149 225 96 185 238 - 126 148 254 207 12 187 34 137 143 243 63 165 35 182 146 88 - 80 35 67 128 79 239 15 240 253 41 148 55 50 71 3 198 155 - 223 63 59 227 185 250 86 20 246 175 9 49 238 137 75 194 7 - 14 59 26 171 122 185 101 146 252 170 221 70 138 79 57 171 - 19 90 190 184 150 223 207 136 198 60 160 85 91 173 91 79 - 121 123 35 126 42 20 85 57 229 143 253 169 39 236 52 59 21 - 95 71 52 120 85 189 141 19 24 193 61 254 181 38 232 109 62 - 56 84 95 120 139 52 177 12 70 23 208 251 210 8 45 33 102 62 - 35 69 113 183 143 43 28 138 150 244 28 129 53 1 12 177 109 - 133 56 69 30 223 90 89 71 145 87 58 90 44 222 153 135 108 - 45 112 24 137 64 59 200 35 39 138 160 63 202 143 164 236 - 110 35 77 90 16 177 220 71 31 157 207 118 63 203 255 0 95 - 210 186 59 76 240 101 45 113 224 67 10 200 219 34 218 152 - 57 168 199 95 116 226 234 154 109 212 19 66 158 32 207 206 - 14 8 193 237 93 81 141 66 145 199 109 202 217 193 218 38 - 143 125 172 92 206 182 82 120 115 194 3 167 250 199 216 81 - 186 229 182 179 114 195 76 184 142 52 153 64 252 208 57 63 - 83 79 238 108 238 58 51 172 102 142 72 93 32 119 36 100 119 - 25 197 72 174 109 109 245 43 132 213 172 128 119 83 202 159 - 81 83 166 116 173 171 43 142 148 209 167 210 53 87 186 109 - 225 20 130 8 29 254 212 255 0 168 117 88 99 189 18 151 121 - 75 184 112 15 163 10 115 169 205 104 214 160 109 219 47 168 - 3 24 168 70 191 34 35 161 50 198 74 190 79 218 171 23 76 95 - 199 68 203 87 214 37 213 236 26 53 97 28 146 199 220 255 0 - 102 42 186 135 166 111 237 101 123 191 50 170 19 133 35 150 - 251 84 183 68 104 4 177 177 98 112 6 125 170 84 82 27 248 - 197 189 188 97 156 253 56 169 202 77 176 113 118 65 83 78 - 215 58 130 206 36 216 150 214 208 121 188 131 131 250 210 - 254 157 210 219 80 215 226 210 252 97 8 241 48 197 189 106 - 194 214 117 11 77 19 76 125 54 215 30 57 82 9 28 3 79 255 0 - 201 219 162 228 212 181 51 171 222 70 35 241 27 10 204 14 - 59 131 237 70 9 216 217 101 20 182 116 135 194 61 10 223 71 - 233 107 107 59 21 100 11 15 159 61 137 250 208 157 71 12 97 - 154 215 143 1 137 222 171 83 13 26 218 43 88 139 75 108 35 - 139 110 197 57 225 143 189 38 234 185 161 181 211 101 183 - 48 140 177 224 142 226 182 98 56 211 178 137 234 75 3 103 - 126 235 13 210 69 179 144 73 173 130 222 67 20 99 241 145 - 191 102 220 13 27 168 199 28 215 18 77 53 184 93 195 130 79 - 106 16 88 52 155 213 111 32 12 167 182 227 255 0 106 132 - 186 59 155 209 97 116 84 108 85 3 72 36 56 192 34 167 80 70 - 200 128 172 81 179 175 24 61 234 176 232 167 154 223 242 - 154 101 45 191 131 159 165 88 208 95 93 44 106 165 81 128 - 31 50 250 211 199 212 228 105 169 108 211 171 31 16 177 142 - 51 27 145 202 159 74 142 94 195 25 140 200 192 22 94 114 87 - 52 250 250 105 35 117 104 83 45 234 27 185 165 119 214 183 - 19 184 62 25 85 110 227 183 52 76 85 255 0 17 132 154 166 - 147 37 186 248 46 20 21 7 110 222 125 170 129 155 79 252 60 - 230 39 32 182 79 145 107 171 122 135 68 142 75 86 221 25 92 - 100 146 59 26 162 186 143 167 38 135 88 220 138 165 119 28 - 30 107 24 133 203 14 207 44 159 150 79 240 175 99 75 110 45 - 85 216 243 83 62 164 210 229 135 108 166 18 138 125 248 34 - 163 110 129 92 228 86 17 232 71 37 152 0 226 130 158 215 - 239 82 48 136 202 124 190 180 37 197 190 92 129 142 244 105 - 152 143 205 19 33 242 127 109 63 233 213 252 149 242 146 - 217 228 214 155 139 85 10 78 40 189 15 8 59 113 154 120 166 - 96 249 147 50 29 220 26 211 168 68 19 72 186 62 190 11 147 - 246 162 174 15 230 134 247 21 167 84 255 0 50 221 55 24 107 - 119 24 162 97 14 159 36 102 218 32 205 180 248 116 198 213 - 226 87 83 188 147 154 81 107 167 220 53 140 18 7 35 242 249 - 163 44 237 37 105 17 119 28 131 147 82 28 156 233 82 143 18 - 49 232 69 79 180 187 75 121 32 92 220 73 28 184 249 68 69 - 133 65 186 106 197 231 158 36 49 201 38 61 87 210 174 190 - 145 211 94 68 137 95 195 66 171 140 177 231 245 172 97 191 - 72 233 106 109 6 103 93 195 186 142 230 167 58 110 155 149 - 2 36 4 1 146 204 199 138 15 167 44 108 128 241 124 25 230 - 127 226 240 71 203 82 107 123 49 34 172 113 248 241 71 156 - 226 65 131 88 87 42 6 22 110 1 241 219 196 92 121 84 129 - 138 211 5 149 227 238 88 149 84 19 252 93 170 65 111 103 - 146 84 149 104 151 251 65 172 166 82 241 42 66 205 41 31 - 194 220 17 253 148 44 28 209 92 245 109 181 212 113 110 220 - 74 129 192 30 181 84 206 151 127 141 151 198 194 3 192 4 - 213 229 213 154 108 146 218 14 114 49 230 95 229 174 127 - 235 72 166 211 53 41 87 12 242 147 223 39 129 83 156 188 - 139 225 142 218 26 233 208 201 11 157 171 16 82 114 78 78 - 106 95 211 141 17 148 180 69 153 211 137 31 248 84 253 106 - 187 210 229 27 98 154 234 102 10 87 29 253 106 99 211 247 - 50 71 229 137 138 237 243 73 143 226 31 90 220 138 100 73 - 45 23 31 79 177 184 177 104 84 141 225 195 120 141 198 71 - 208 83 253 66 55 75 114 242 175 137 43 240 0 25 207 21 16 - 233 137 18 107 104 217 110 11 55 0 15 166 123 84 230 250 - 120 225 136 200 204 200 137 128 8 25 197 118 65 218 60 188 - 146 119 163 156 190 49 244 36 186 173 171 92 181 143 225 - 228 44 85 153 187 143 94 42 128 158 223 90 233 105 158 56 - 219 198 133 143 215 143 181 117 247 196 9 154 123 217 165 - 105 34 104 200 206 194 249 195 127 241 84 31 89 91 238 184 - 157 99 133 30 82 55 40 29 143 214 169 197 23 199 41 112 162 - 186 185 214 103 186 102 123 219 95 57 239 33 24 3 251 42 61 - 172 120 51 36 69 109 119 3 47 206 61 78 15 21 33 184 142 - 230 221 222 9 70 84 15 54 125 169 116 176 205 24 93 141 132 - 241 6 6 59 26 159 17 249 72 198 214 241 98 108 27 117 4 224 - 149 92 211 111 252 65 168 64 98 75 43 87 17 129 229 44 56 - 199 233 205 3 107 110 99 99 52 152 50 150 56 99 237 154 123 - 211 176 77 38 160 37 101 223 31 177 237 70 43 246 110 82 10 - 232 190 141 212 53 205 71 241 87 143 28 140 88 121 125 43 - 171 254 26 232 50 233 22 137 111 248 16 144 42 133 223 142 - 9 170 163 225 212 126 10 143 13 109 192 115 128 31 230 253 - 42 249 232 235 223 11 77 134 25 36 73 90 110 236 15 57 166 - 215 194 25 174 84 55 189 178 97 21 188 74 235 225 15 54 210 - 121 53 5 235 9 86 234 105 118 131 187 119 150 33 243 84 243 - 168 21 134 153 148 145 35 216 255 0 49 238 56 170 163 172 - 110 246 221 148 183 185 203 147 193 90 134 99 163 9 14 213 - 90 57 49 224 176 111 230 87 226 144 79 4 139 52 147 43 196 - 140 253 129 124 12 209 122 205 212 6 227 198 110 1 242 103 - 63 197 239 81 141 94 238 226 25 194 40 87 70 244 127 81 244 - 174 103 45 29 138 28 145 48 233 15 198 27 192 146 18 27 119 - 163 2 63 76 85 189 164 89 221 73 26 42 185 200 28 131 85 - 191 195 29 42 75 141 146 194 172 24 159 144 255 0 15 30 149 - 113 233 150 55 16 170 135 252 206 60 210 123 85 99 234 114 - 229 146 230 1 29 155 9 135 226 87 9 252 254 162 190 157 54 - 73 150 76 206 179 156 121 119 112 64 253 42 68 34 23 10 4 - 109 226 159 76 208 151 54 110 238 87 196 43 32 237 232 7 - 222 137 62 104 132 107 26 118 99 219 226 136 152 14 121 205 - 86 125 99 167 175 237 5 105 110 23 96 62 102 65 87 101 229 - 188 101 30 59 139 121 159 159 51 70 50 13 67 181 253 46 209 - 204 177 194 198 53 217 156 74 7 6 176 201 217 68 117 172 48 - 8 222 72 228 50 38 223 33 116 108 230 160 19 129 180 62 59 - 174 113 87 71 94 233 47 38 158 234 139 184 43 97 86 169 187 - 184 158 34 241 200 48 85 138 129 236 43 2 74 221 128 250 - 103 222 176 101 39 229 25 53 159 210 179 135 230 170 115 85 - 64 52 201 22 80 150 24 56 161 172 78 217 8 0 119 166 23 142 - 190 27 113 233 75 237 10 155 130 2 253 105 224 237 24 105 - 58 110 10 223 74 18 255 0 63 178 110 193 244 129 218 143 - 149 149 99 11 142 72 160 117 31 243 85 217 61 204 78 15 218 - 131 236 193 186 90 198 116 139 76 50 159 232 201 254 21 240 - 8 214 109 220 18 57 24 165 154 124 231 246 109 170 238 218 - 22 221 20 215 212 185 118 155 195 29 189 234 35 147 62 151 - 185 63 180 227 85 109 196 243 145 232 125 170 240 233 87 - 154 98 130 117 42 224 113 159 90 231 254 159 141 77 220 110 - 210 109 243 14 213 208 95 13 174 45 209 81 90 100 44 23 203 - 187 146 127 178 177 139 91 167 68 45 106 163 233 147 24 238 - 194 164 246 194 223 193 93 177 201 193 236 190 159 122 65 - 161 25 226 95 204 138 16 51 198 79 27 105 254 159 226 186 - 121 152 39 60 39 253 105 146 178 13 219 8 84 102 112 4 112 - 237 246 207 52 108 80 71 23 155 240 209 243 245 175 145 32 - 81 150 82 62 181 181 229 80 128 114 126 212 234 128 38 234 - 59 17 121 1 113 181 118 131 149 240 176 107 157 254 36 105 - 145 172 225 132 94 57 82 119 47 168 174 150 190 241 164 6 - 72 31 195 35 212 142 106 176 235 237 5 174 124 86 101 12 - 216 221 187 24 57 164 156 20 138 96 157 62 69 19 13 184 134 - 214 71 243 120 132 102 52 147 248 105 222 141 61 221 194 - 172 215 18 131 50 12 125 90 134 154 19 103 168 120 18 237 - 96 217 0 125 104 103 241 173 101 252 106 134 27 79 111 74 - 229 105 166 119 57 114 90 45 126 140 184 86 180 102 55 40 8 - 237 205 78 191 31 60 86 95 135 107 229 220 190 111 47 36 - 241 242 213 27 163 234 202 176 41 241 140 81 191 112 123 - 211 185 186 180 219 217 198 209 221 168 144 143 56 99 206 - 43 167 30 95 140 228 201 141 223 67 62 185 190 0 22 88 89 - 78 194 89 166 24 85 62 245 68 234 173 20 200 146 120 151 15 - 39 140 216 192 249 177 223 21 100 234 93 81 167 222 233 242 - 121 135 138 27 206 9 24 97 75 172 109 244 123 201 222 118 - 186 72 146 21 59 6 6 11 55 106 235 82 137 57 41 69 21 69 - 244 107 60 211 93 169 222 178 249 75 55 4 26 2 230 55 93 - 145 140 130 91 129 142 245 120 75 240 222 29 147 220 75 118 - 30 222 100 81 28 157 134 226 70 72 166 215 191 0 76 154 124 - 23 81 107 2 210 70 149 7 157 187 131 233 218 133 196 73 100 - 226 172 231 200 35 12 21 130 144 9 218 51 234 105 173 147 - 53 180 47 106 237 55 154 81 38 213 29 143 181 92 250 183 - 193 155 93 2 226 207 241 55 27 217 230 97 184 158 15 181 0 - 157 15 107 160 194 127 107 93 71 0 157 155 135 97 207 177 - 173 113 30 18 114 86 36 232 155 166 181 212 229 142 20 15 - 143 149 27 248 143 181 95 61 33 125 178 213 99 141 94 2 163 - 115 73 32 242 131 237 84 149 189 254 147 167 202 177 171 - 167 138 174 4 135 0 227 235 82 24 186 206 56 238 36 138 210 - 113 176 227 37 143 31 165 36 164 146 26 172 183 53 139 233 - 37 145 47 13 228 65 72 33 147 61 170 172 234 89 213 239 76 - 97 195 43 49 243 10 217 127 212 139 61 152 48 202 93 149 - 124 192 17 222 162 154 181 244 173 190 4 254 177 41 201 39 - 176 251 87 62 73 166 138 98 139 176 77 70 226 105 110 227 - 128 248 50 89 41 255 0 238 31 106 9 108 115 118 169 36 98 - 88 216 249 95 209 13 31 102 134 210 220 137 35 60 142 239 - 220 83 222 137 209 164 212 174 195 188 108 235 158 0 251 - 215 53 72 232 121 20 116 139 19 225 174 154 190 12 107 17 - 119 219 130 199 244 255 0 10 182 236 213 161 183 40 171 147 - 237 81 142 150 210 174 172 237 217 18 40 227 82 0 5 187 212 - 174 22 216 118 158 113 234 59 26 234 132 93 108 243 231 92 - 172 209 53 180 127 188 240 78 87 156 30 213 161 217 164 25 - 154 48 24 118 49 242 113 76 193 89 99 56 237 67 205 20 120 - 199 202 125 13 55 16 8 111 196 76 140 161 37 39 25 203 14 - 213 1 234 117 1 164 101 229 74 96 55 189 88 23 183 19 70 - 204 138 137 142 217 62 181 21 215 72 134 54 150 70 183 84 - 245 221 158 63 186 183 18 176 119 162 142 235 107 139 179 - 101 112 48 74 131 149 250 213 55 169 21 153 101 109 195 118 - 226 49 87 143 197 11 59 89 172 228 240 238 163 86 11 193 86 - 242 213 7 168 41 183 153 227 13 189 119 119 20 133 31 26 4 - 138 53 225 183 114 56 162 35 249 141 99 16 93 166 190 134 - 10 199 218 177 51 11 207 221 183 218 128 179 230 224 227 - 154 97 117 242 31 181 45 179 202 206 87 215 189 82 14 145 - 135 197 65 136 103 142 40 13 74 48 116 219 220 28 255 0 70 - 122 48 73 249 67 52 22 160 196 88 93 242 60 240 56 20 89 - 132 246 173 33 176 131 211 242 147 181 25 98 164 202 55 122 - 241 90 172 99 38 202 223 63 232 146 141 137 10 48 53 33 195 - 237 36 17 76 55 59 140 28 241 86 191 194 221 82 71 187 85 - 134 86 137 241 229 144 138 169 145 73 66 203 220 28 154 150 - 252 57 214 154 199 83 71 134 72 163 97 235 39 106 198 58 - 223 67 121 30 205 68 246 178 34 103 201 57 60 49 250 84 166 - 202 250 59 114 171 42 153 28 140 2 7 97 80 110 157 214 5 - 238 147 18 27 150 57 60 113 156 126 149 55 208 161 152 66 - 38 143 136 200 198 120 57 63 173 89 164 186 57 199 169 35 - 72 23 119 0 142 213 189 35 81 233 199 181 13 8 118 33 179 - 192 224 209 101 148 32 227 154 6 62 50 174 119 99 129 233 - 74 122 130 205 110 173 152 236 11 246 29 233 163 72 161 114 - 71 21 131 48 145 10 178 239 83 233 237 65 179 45 20 167 88 - 244 52 211 91 27 203 104 80 178 18 119 122 231 218 171 11 - 187 123 200 110 31 78 189 93 162 67 243 123 87 79 107 176 - 53 157 147 186 43 75 17 238 139 232 125 234 136 248 146 177 - 73 114 100 84 96 155 185 13 195 126 181 25 70 203 225 156 - 147 164 35 210 116 152 166 184 16 52 171 42 149 202 236 247 - 170 207 226 54 139 175 105 90 204 242 61 196 190 11 28 198 - 83 149 219 237 83 222 151 214 197 133 218 194 100 240 225 - 249 67 96 114 61 170 196 212 52 152 117 189 17 90 56 209 - 212 12 238 35 56 21 60 77 73 157 83 132 226 185 72 228 251 - 45 112 139 146 26 86 59 20 134 4 156 22 162 52 205 98 226 - 222 203 242 166 62 57 186 18 54 227 193 3 211 237 83 78 185 - 248 112 99 190 184 149 45 13 188 32 231 116 125 152 213 121 - 169 104 183 182 101 130 238 0 252 153 238 5 116 62 206 120 - 228 82 123 39 58 151 88 245 117 197 134 159 165 75 124 86 - 218 24 205 202 70 184 218 7 177 53 60 215 254 43 117 237 - 199 75 232 182 247 182 18 89 199 225 44 214 243 173 187 21 - 184 10 123 130 51 199 189 115 249 107 184 36 221 151 221 - 141 188 156 241 237 82 109 7 226 31 89 104 177 71 109 109 - 172 94 4 130 217 160 129 50 8 138 54 238 160 17 218 154 133 - 88 87 254 139 31 226 175 196 126 181 234 43 13 48 94 88 61 - 132 70 63 26 222 88 247 33 125 191 196 51 233 144 106 29 - 212 157 103 212 58 189 165 140 186 165 244 83 35 32 88 176 - 131 32 47 114 126 181 19 213 186 147 168 117 153 33 159 81 - 212 174 238 154 217 12 80 120 178 110 240 211 249 71 211 - 147 66 44 55 19 90 71 181 75 159 155 25 236 115 90 135 73 - 46 221 140 238 53 67 251 78 238 95 20 178 77 146 50 121 205 - 104 210 245 75 139 217 34 181 134 232 137 3 16 192 3 154 47 - 67 232 251 173 64 201 227 187 71 35 225 148 14 248 207 106 - 185 62 27 244 16 178 195 61 132 105 48 148 18 242 96 22 95 - 214 132 163 171 4 230 170 162 7 208 29 47 125 30 141 53 238 - 172 242 178 203 251 188 30 64 199 253 232 177 103 28 123 - 100 241 137 149 120 84 110 199 239 83 126 177 191 182 208 - 237 37 183 143 116 44 56 85 36 55 24 244 170 238 202 83 123 - 118 94 66 67 19 148 106 228 116 203 168 73 18 94 153 233 - 253 83 95 144 76 202 76 46 112 163 31 227 87 31 73 116 153 - 210 204 49 204 170 14 1 194 210 111 135 23 11 20 34 8 35 - 145 159 56 201 3 21 104 90 90 27 93 175 36 126 35 176 206 - 242 79 31 74 233 199 7 86 206 60 143 97 118 241 133 77 187 - 118 129 233 239 91 90 53 199 28 125 171 21 155 60 50 225 - 171 238 252 119 170 217 42 53 58 136 187 51 42 250 129 65 - 234 23 94 12 69 100 143 35 221 123 138 60 149 151 229 20 27 - 169 71 219 252 62 223 90 1 35 215 115 43 40 113 32 251 55 - 124 84 47 171 100 186 49 179 184 154 201 65 231 124 91 149 - 170 85 173 98 202 233 252 103 42 224 121 152 199 145 223 - 251 170 186 248 147 214 183 90 125 177 91 107 171 105 7 250 - 223 246 53 138 68 162 190 47 107 186 95 138 214 49 248 190 - 48 28 73 25 198 223 211 181 87 209 0 214 161 139 51 100 247 - 110 244 87 94 106 67 88 234 55 186 240 194 31 92 113 154 14 - 73 213 85 87 233 82 4 244 244 124 133 130 190 211 235 68 52 - 89 229 73 52 2 183 155 121 163 109 174 50 160 131 233 88 17 - 102 171 131 149 35 233 75 163 27 110 179 76 238 20 96 210 - 213 254 179 85 198 149 14 54 149 179 26 231 142 61 41 102 - 163 41 252 21 194 142 194 39 166 50 168 48 131 244 165 151 - 202 63 5 63 251 167 162 251 17 183 102 122 48 63 179 160 - 224 254 233 43 126 71 137 143 90 203 72 79 252 174 220 129 - 222 36 197 18 45 198 75 17 81 101 227 217 227 251 146 61 77 - 15 111 122 246 87 65 149 118 227 187 30 213 235 171 133 141 - 128 57 237 90 226 219 121 34 110 71 40 7 56 28 154 186 143 - 40 137 47 99 167 126 4 117 157 174 161 167 172 63 153 44 - 136 120 24 171 231 78 212 65 81 225 218 249 118 231 115 28 - 0 107 144 190 28 89 173 188 130 77 54 89 34 32 231 105 56 - 39 237 138 178 180 238 161 234 84 87 102 17 76 136 48 6 9 - 199 215 154 14 60 65 197 51 163 45 102 103 1 100 216 170 - 121 5 78 69 99 169 220 54 192 163 201 236 199 214 170 77 11 - 171 245 39 17 71 112 168 23 28 248 35 183 223 62 181 53 209 - 175 226 185 45 33 153 131 255 0 44 188 98 164 251 19 36 117 - 72 147 192 159 42 72 164 38 120 62 244 112 27 80 5 35 111 - 160 165 118 19 120 142 1 96 223 202 1 230 152 44 168 80 110 - 202 243 142 105 211 64 173 30 154 21 153 25 100 25 82 48 69 - 84 255 0 18 122 82 19 35 155 101 32 179 100 10 183 3 46 56 - 96 104 109 66 202 27 200 240 200 140 222 153 173 40 218 27 - 28 169 232 228 91 238 152 186 91 147 43 63 135 20 71 60 142 - 255 0 74 125 211 93 69 117 98 88 93 200 22 221 92 4 207 160 - 171 91 173 250 76 108 150 72 227 80 51 187 143 106 165 250 - 146 41 68 141 111 29 187 8 213 253 185 205 113 188 124 37 - 103 124 36 178 42 147 44 121 46 108 53 205 177 220 69 249 - 108 155 65 247 250 212 119 170 190 23 217 155 104 37 134 - 225 10 63 203 143 240 164 218 37 252 214 58 188 112 204 228 - 64 202 48 79 189 89 90 93 253 188 177 237 89 214 103 253 - 214 210 123 15 113 245 170 71 43 229 103 52 177 46 52 138 - 27 93 248 99 116 151 210 44 86 251 160 69 196 44 163 211 - 220 84 30 247 64 107 107 182 140 171 56 31 46 7 173 118 133 - 237 180 90 149 144 93 194 54 141 118 57 42 57 250 138 137 - 106 125 33 167 197 120 100 88 86 104 216 96 101 107 174 50 - 199 37 105 28 235 179 155 116 14 140 186 212 193 240 55 51 - 49 206 208 188 226 167 125 55 240 195 54 203 45 210 186 72 - 143 198 70 55 15 122 186 52 46 153 179 177 138 55 182 217 - 20 217 228 99 140 83 173 90 104 225 84 141 97 141 86 49 134 - 36 96 181 53 165 234 138 37 201 144 171 110 135 210 116 79 - 10 226 121 20 205 225 229 4 124 130 107 238 173 212 150 246 - 54 203 105 24 72 156 55 151 216 241 254 53 171 169 181 136 - 109 237 36 219 112 30 68 114 145 166 114 77 87 147 73 121 - 168 91 139 182 87 46 210 121 71 176 174 73 101 116 209 214 - 176 213 51 45 96 106 26 245 227 195 122 216 99 204 45 232 5 - 54 233 30 147 152 202 177 205 147 199 3 20 227 163 244 134 - 213 30 40 228 140 164 138 70 25 187 26 185 250 111 167 99 - 183 132 60 209 70 37 3 154 92 80 79 108 76 217 56 233 25 - 116 63 79 219 217 233 161 221 79 138 125 79 165 74 23 229 - 25 227 28 115 88 194 137 12 33 19 140 119 175 179 58 38 55 - 56 31 90 233 163 142 105 182 99 58 163 46 230 96 160 118 - 165 215 146 52 67 197 102 150 48 222 168 51 69 207 44 126 - 25 60 176 250 14 212 174 246 96 84 171 178 178 5 200 32 240 - 69 103 163 40 114 26 137 15 135 230 81 199 203 187 179 80 - 83 95 73 202 136 33 56 255 0 91 154 134 235 29 68 108 99 48 - 219 9 166 0 124 199 24 63 110 106 11 172 117 110 189 53 203 - 197 225 196 233 140 169 112 114 181 135 88 210 44 46 168 - 215 33 143 79 157 228 73 85 84 16 222 249 250 87 37 124 96 - 235 11 91 205 78 75 11 75 153 21 131 19 137 70 56 171 39 86 - 212 53 237 70 57 32 188 185 82 161 14 28 13 187 87 254 188 - 213 69 213 58 29 188 241 201 42 67 113 123 118 92 225 136 0 - 99 251 107 112 79 232 106 136 45 172 37 228 105 14 112 123 - 31 122 33 161 221 231 60 55 108 125 40 217 99 104 81 97 112 - 145 183 177 239 65 22 96 73 244 237 74 218 163 27 60 53 9 - 206 43 43 104 195 112 57 172 21 183 33 251 215 212 98 157 - 142 13 32 12 175 65 7 145 74 155 137 197 57 148 111 83 187 - 154 73 38 127 24 71 165 60 69 147 25 187 226 49 142 120 165 - 247 103 117 189 217 247 183 113 250 209 172 165 163 31 106 - 22 244 40 211 231 199 205 225 62 105 133 25 233 30 109 42 - 213 113 140 198 159 225 154 57 216 44 44 48 59 119 160 52 - 103 85 211 44 148 142 76 8 127 93 180 85 196 171 225 242 42 - 71 74 116 70 181 2 242 94 14 113 199 97 247 169 87 65 219 - 36 215 177 195 40 220 8 228 47 113 253 180 141 109 252 107 - 213 37 60 184 239 237 83 174 143 211 149 39 87 0 110 35 200 - 195 131 138 180 102 170 137 190 236 187 58 103 166 236 35 - 48 52 114 32 24 221 133 249 170 91 107 165 194 210 5 148 4 - 24 192 56 168 247 77 204 176 89 68 222 55 138 83 229 76 14 - 126 149 52 209 238 55 145 226 76 129 217 126 87 3 129 90 82 - 85 70 74 194 44 116 24 227 153 78 119 103 182 208 48 71 214 - 155 92 104 236 214 174 17 76 111 252 203 220 211 109 38 72 - 100 140 6 240 164 218 118 249 123 230 152 203 11 109 9 28 - 140 152 244 32 100 84 69 110 136 158 149 251 66 218 111 194 - 218 184 47 158 78 114 5 72 45 159 86 128 156 172 114 40 93 - 204 199 57 253 41 93 196 81 199 127 137 15 131 38 120 34 - 155 219 106 64 58 195 28 121 80 57 111 115 72 60 23 137 178 - 29 74 89 38 86 154 45 171 252 195 176 251 209 173 121 8 5 - 150 64 9 249 72 245 173 55 48 174 4 182 234 178 49 30 104 - 207 111 191 222 180 189 188 19 219 238 145 124 39 95 238 - 166 78 76 87 75 160 203 219 113 121 98 20 190 254 57 35 214 - 161 183 93 11 13 220 146 220 54 84 224 236 80 7 38 165 58 - 35 53 189 185 93 199 104 244 166 73 134 1 135 108 230 179 - 175 160 230 215 69 41 170 244 5 221 179 37 204 176 248 171 - 17 59 84 14 231 235 81 248 244 109 67 78 159 196 11 34 144 - 251 184 245 174 141 101 220 140 49 201 239 154 73 168 104 - 208 238 105 240 173 207 153 113 72 240 193 236 172 103 162 - 162 147 168 46 237 252 56 132 78 217 143 156 131 205 101 - 107 212 23 37 89 165 134 70 77 222 78 15 53 53 189 211 108 - 154 225 166 107 120 194 42 144 191 65 65 219 221 104 214 54 - 107 248 235 88 252 36 82 219 206 125 234 111 148 53 101 249 - 127 194 40 122 138 227 204 86 41 3 231 142 15 106 211 125 - 123 169 234 176 162 109 146 54 3 146 163 189 74 236 166 211 - 53 75 176 109 97 70 129 135 151 138 145 105 90 109 177 111 - 195 248 9 145 242 253 41 146 151 105 153 78 190 21 78 149 - 210 55 151 72 200 33 98 31 141 199 146 15 189 75 116 79 135 - 114 8 209 111 35 196 123 118 140 119 31 90 179 52 205 54 27 - 24 246 140 125 168 227 207 113 84 73 62 200 203 249 18 122 - 100 95 167 186 102 29 46 97 225 64 133 23 213 187 231 222 - 164 83 203 28 108 25 164 31 111 122 251 43 108 224 71 147 - 239 154 80 109 218 109 77 228 152 17 30 121 25 239 77 72 - 156 83 126 193 247 23 107 26 144 60 205 232 40 24 111 174 - 166 111 14 8 145 142 78 75 103 138 222 87 50 5 130 208 2 59 - 190 79 21 153 11 103 110 207 18 6 62 173 236 105 28 218 10 - 236 85 123 38 178 45 252 88 165 81 144 67 32 30 148 134 222 - 198 235 80 184 114 210 22 10 249 108 30 62 195 233 79 46 46 - 86 123 98 100 102 137 7 30 94 228 214 26 28 69 220 52 56 95 - 109 180 109 181 108 51 175 245 23 221 104 208 203 25 13 31 - 229 129 194 251 210 27 221 6 56 84 182 239 46 120 12 163 2 - 172 115 20 110 160 110 19 183 169 110 21 62 216 168 230 179 - 52 101 156 43 64 138 157 234 170 104 69 127 74 251 80 209 - 225 184 180 144 51 194 168 14 15 166 106 191 234 221 39 75 - 179 211 165 184 146 21 154 112 126 84 98 23 245 171 39 87 - 185 202 186 49 71 82 114 25 71 106 174 122 230 37 156 40 50 - 77 55 180 64 0 15 246 86 228 53 20 87 81 74 130 251 153 35 - 67 39 101 143 36 99 238 104 9 50 234 54 142 213 35 235 13 - 19 195 45 36 96 65 27 252 170 57 231 245 168 229 186 201 20 - 4 73 195 103 24 247 20 128 122 116 122 47 148 253 235 9 178 - 172 72 247 172 226 32 3 159 122 215 63 53 128 213 133 195 - 34 136 200 60 253 233 61 209 254 151 156 12 102 155 69 26 - 176 198 222 244 166 249 130 92 5 250 211 196 70 168 105 11 - 47 131 230 224 80 87 255 0 212 238 63 221 191 248 86 208 - 219 160 3 210 133 190 99 248 41 249 255 0 210 122 167 17 92 - 141 118 127 137 253 159 1 207 30 18 86 196 51 186 156 182 - 87 212 211 13 50 12 216 64 27 31 186 76 140 246 162 217 225 - 136 120 123 80 41 224 115 206 106 40 232 98 43 123 241 111 - 55 242 128 113 147 235 86 7 70 235 76 246 230 31 197 68 140 - 195 200 164 237 96 62 135 214 163 182 90 28 218 158 99 130 - 221 164 59 178 0 198 15 235 239 83 110 151 232 9 102 141 45 - 238 237 102 138 39 28 156 252 191 98 41 210 160 39 68 255 0 - 165 250 138 212 58 193 170 73 178 233 134 228 73 134 1 30 - 245 97 104 186 198 154 206 169 103 118 214 236 71 158 25 - 198 232 228 63 70 244 168 62 133 208 169 21 164 118 179 70 - 211 148 27 99 71 200 199 234 65 53 34 178 233 77 74 194 47 - 232 114 58 143 68 151 133 31 99 89 171 11 157 178 203 176 - 99 185 30 56 210 54 198 74 171 102 50 61 193 247 166 203 - 120 56 63 32 61 188 78 23 244 53 94 105 26 213 214 151 34 - 65 172 88 220 66 190 147 198 165 215 63 92 122 84 202 206 - 234 75 168 188 68 219 34 158 79 151 1 190 191 74 70 19 118 - 187 11 222 67 44 177 177 18 6 220 184 239 75 186 90 250 71 - 102 183 153 124 225 176 64 244 250 211 153 97 142 226 50 - 193 164 82 7 96 188 138 91 106 39 134 247 250 138 202 231 - 141 231 130 71 181 35 84 131 21 240 154 167 49 34 238 13 - 199 24 160 103 45 29 214 214 82 84 247 241 56 81 69 217 110 - 49 40 48 52 89 28 140 19 254 21 246 250 214 73 151 104 141 - 217 125 8 28 212 219 108 77 38 107 71 120 216 109 66 69 16 - 38 82 128 134 28 156 80 86 73 58 66 99 117 124 158 57 70 - 255 0 181 100 201 60 78 89 81 153 49 200 8 114 63 186 130 - 116 48 99 44 138 63 45 178 123 226 132 186 185 120 226 220 - 97 102 63 196 69 97 52 178 170 171 68 178 242 57 204 109 - 255 0 106 85 169 92 92 179 21 69 112 185 231 32 138 22 195 - 24 41 50 63 213 151 154 140 182 87 118 246 208 73 27 225 - 138 101 126 149 203 122 183 93 117 30 165 38 161 167 94 204 - 208 248 19 164 109 30 48 78 61 8 174 179 185 188 189 92 25 - 97 105 87 248 252 157 197 85 223 17 250 3 72 234 125 66 13 - 98 214 217 180 157 71 112 23 37 99 32 78 61 73 24 239 79 39 - 25 157 120 230 177 233 171 1 248 55 105 213 17 233 144 222 - 220 248 50 217 52 132 194 7 204 23 255 0 154 187 244 141 66 - 229 131 52 208 177 193 218 131 28 154 143 104 115 197 97 - 103 13 142 159 96 237 28 40 168 143 225 156 240 63 252 52 - 217 46 47 152 134 48 50 182 253 196 178 145 71 81 68 114 91 - 118 137 97 184 157 190 85 49 159 102 172 252 67 180 110 96 - 88 154 77 109 119 50 219 170 24 228 45 252 71 109 24 101 - 102 64 162 57 11 247 225 73 197 73 79 147 209 37 141 160 - 167 186 40 14 197 220 115 130 7 165 7 113 54 223 48 243 159 - 85 126 194 182 71 11 42 110 109 229 255 0 216 108 127 133 - 105 72 101 150 243 196 145 88 133 236 2 54 15 247 83 59 176 - 85 5 105 241 55 134 93 243 188 118 52 46 171 34 67 3 185 - 145 93 199 101 3 36 83 68 142 84 92 172 100 125 233 38 189 - 36 203 4 135 240 108 231 30 163 138 165 94 128 145 12 135 - 241 90 158 160 99 86 111 12 54 91 105 201 21 39 134 85 183 - 137 98 82 177 198 6 60 79 251 82 189 46 217 152 134 104 12 - 1 142 78 208 114 104 235 213 217 228 142 57 60 188 6 101 - 237 246 166 173 81 154 62 94 77 44 150 225 83 42 23 213 199 - 155 244 21 29 213 174 34 181 133 247 220 69 1 3 45 52 190 - 103 31 65 255 0 106 47 91 215 45 44 81 252 95 21 220 29 171 - 26 33 44 199 219 21 16 190 126 161 214 8 240 109 13 165 190 - 237 202 146 99 113 250 241 154 41 1 161 62 179 175 104 240 - 69 36 239 49 42 23 205 52 173 134 99 238 61 170 187 215 53 - 233 37 34 230 214 241 150 215 186 60 131 195 76 125 9 239 - 86 14 163 209 114 73 40 146 238 54 109 195 45 189 72 254 - 193 138 135 117 47 195 150 190 148 93 78 178 76 35 253 216 - 201 217 143 246 79 21 130 138 135 172 58 169 217 198 39 142 - 64 252 43 3 197 34 211 238 191 16 134 70 238 220 131 232 69 - 75 117 206 133 188 138 228 205 37 140 174 15 206 242 112 - 168 61 197 71 36 129 44 93 193 85 69 221 181 85 152 3 143 - 240 166 143 96 146 189 131 187 237 63 74 196 29 195 53 186 - 102 73 6 236 167 232 192 255 0 133 106 85 227 140 99 239 79 - 45 128 38 30 212 162 251 139 174 120 230 156 64 8 250 15 - 189 1 168 70 11 124 188 147 223 35 20 189 9 35 116 37 90 - 223 5 128 29 243 65 234 18 255 0 67 184 255 0 116 244 90 41 - 16 1 142 195 222 151 106 24 252 61 194 110 27 188 54 227 61 - 179 78 165 162 110 34 139 47 220 55 251 165 160 238 251 175 - 251 85 234 245 73 118 116 190 131 109 63 174 219 83 53 253 - 234 126 181 234 245 80 80 139 143 222 15 189 122 95 221 143 - 189 122 189 88 198 235 207 234 95 253 163 252 107 86 155 - 251 179 246 175 87 169 31 209 144 77 191 121 255 0 217 173 - 49 127 90 95 246 133 122 189 74 198 143 99 214 236 104 22 - 253 243 125 235 213 234 148 69 126 198 211 251 197 175 79 - 251 179 94 175 80 8 60 191 187 95 181 100 191 184 74 245 - 122 153 244 62 46 204 26 180 183 239 79 218 189 94 166 47 - 30 205 144 126 248 81 147 250 215 171 213 136 100 236 244 - 63 45 125 184 253 239 255 0 109 122 189 80 143 177 51 91 - 252 181 157 167 205 94 175 85 95 208 154 161 175 147 126 - 234 111 246 63 235 94 175 83 46 204 129 173 191 131 237 91 - 117 15 221 138 245 122 156 192 58 215 249 246 111 247 149 - 242 127 221 39 251 85 234 245 17 88 116 223 212 135 218 148 - 220 254 224 87 171 212 16 77 109 253 105 105 76 159 214 222 - 189 94 162 140 205 87 255 0 50 255 0 179 88 71 242 10 245 - 122 156 64 133 253 217 161 174 254 85 255 0 106 189 94 165 - 125 139 35 47 253 58 105 99 253 68 255 0 186 175 87 168 174 - 133 63 255 217 13 10 45 45 45 45 45 45 45 45 45 45 45 45 45 - 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 49 49 51 55 - 53 50 50 53 48 51 49 52 52 49 50 56 50 51 50 55 49 54 53 51 - 49 55 50 57 13 10 67 111 110 116 101 110 116 45 68 105 115 - 112 111 115 105 116 105 111 110 58 32 102 111 114 109 45 - 100 97 116 97 59 32 110 97 109 101 61 34 102 105 108 101 50 - 34 59 32 102 105 108 101 110 97 109 101 61 34 116 101 115 - 116 46 116 120 116 34 13 10 67 111 110 116 101 110 116 45 - 84 121 112 101 58 32 116 101 120 116 47 112 108 97 105 110 - 13 10 13 10 116 101 115 116 10 13 10 45 45 45 45 45 45 45 - 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 - 45 45 49 49 51 55 53 50 50 53 48 51 49 52 52 49 50 56 50 51 - 50 55 49 54 53 51 49 55 50 57 13 10 67 111 110 116 101 110 - 116 45 68 105 115 112 111 115 105 116 105 111 110 58 32 102 - 111 114 109 45 100 97 116 97 59 32 110 97 109 101 61 34 102 - 105 108 101 51 34 59 32 102 105 108 101 110 97 109 101 61 - 34 34 13 10 67 111 110 116 101 110 116 45 84 121 112 101 58 - 32 97 112 112 108 105 99 97 116 105 111 110 47 111 99 116 - 101 116 45 115 116 114 101 97 109 13 10 13 10 13 10 45 45 - 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 - 45 45 45 45 45 45 45 49 49 51 55 53 50 50 53 48 51 49 52 52 - 49 50 56 50 51 50 55 49 54 53 51 49 55 50 57 45 45 13 10 - } ; - -: test-file ( bytes -- seq ) - binary parse-multipart ; - -: test-file1 ( bytes -- ? ) - test-file - first [ filename>> "dog.jpg" = ] [ name>> "file1" = ] - [ path>> md5 checksum-file B{ 172 192 179 2 18 210 155 156 115 186 169 30 147 51 91 82 } = ] tri and and ; - -: test-file2 ( bytes -- ? ) - test-file - second [ filename>> "test.txt" = ] [ name>> "file2" = ] - [ path>> ascii file-contents "test\n" = ] tri and and ; - -: test-file3 ( bytes -- ? ) - test-file - third [ filename>> "" = ] - [ name>> "file3" = ] - [ path>> file-info size>> 0 = ] tri and and ; - -[ t ] [ dog-test-empty-bytes-firefox test-file1 ] unit-test -[ t ] [ dog-test-empty-bytes-firefox test-file2 ] unit-test -[ t ] [ dog-test-empty-bytes-firefox test-file3 ] unit-test - -[ t ] [ dog-test-empty-bytes-safari test-file1 ] unit-test -[ t ] [ dog-test-empty-bytes-safari test-file2 ] unit-test -[ t ] [ dog-test-empty-bytes-safari test-file3 ] unit-test diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor old mode 100644 new mode 100755 index 3e44f163ed..fc3024bd01 --- a/basis/mime/multipart/multipart.factor +++ b/basis/mime/multipart/multipart.factor @@ -1,105 +1,168 @@ -! Copyright (C) 2008 Doug Coleman. +! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io kernel locals math multiline -sequences splitting prettyprint namespaces http.parsers -ascii assocs unicode.case io.files.unique io.files io.encodings.binary -byte-arrays io.encodings make fry ; +USING: multiline kernel sequences io splitting fry namespaces +http.parsers hashtables assocs combinators ascii io.files.unique +accessors io.encodings.binary io.files byte-arrays math +io.streams.string combinators.short-circuit strings math.order ; IN: mime.multipart -TUPLE: multipart-stream stream n leftover separator ; +CONSTANT: buffer-size 65536 +CONSTANT: separator-prefix "\r\n--" -: ( stream separator -- multipart-stream ) - multipart-stream new - swap >>separator - swap >>stream - 16 2^ >>n ; +TUPLE: multipart +end-of-stream? +current-separator mime-separator +header +content-disposition bytes +filename temp-file +name name-content +mime-parts ; - ( mime-separator -- multipart ) + multipart new + swap >>mime-separator + H{ } clone >>mime-parts ; -: ?cut* ( seq n -- before after ) - over length over <= [ drop f swap ] [ cut* ] if ; - -: read-n ( stream -- bytes end-stream? ) - [ f ] change-leftover - [ n>> ] [ stream>> ] bi stream-read [ ?append ] keep not ; +ERROR: bad-header bytes ; -: multipart-split ( bytes separator -- before after seq=? ) - 2dup sequence= [ 2drop f f t ] [ split1 f ] if ; +: mime-write ( sequence -- ) + >byte-array write ; -:: multipart-step-found ( bytes stream quot: ( bytes -- ) -- ? ) - bytes [ quot unless-empty ] - [ stream (>>leftover) quot unless-empty ] if-empty f ; inline +: parse-headers ( string -- hashtable ) + string-lines harvest [ parse-header-line ] map >hashtable ; -:: multipart-step-not-found ( bytes stream end-stream? separator quot: ( bytes -- ) -- ? ) - bytes end-stream? [ - quot unless-empty f - ] [ - separator length 1- ?cut* stream (>>leftover) - quot unless-empty t - ] if ; inline - -:: multipart-step ( stream bytes end-stream? separator quot: ( bytes -- ) -- ? end-stream? ) - #! return t to loop again - bytes separator multipart-split - [ 2drop f ] - [ - [ stream quot multipart-step-found ] - [ stream end-stream? separator quot multipart-step-not-found ] if* - ] if stream leftover>> end-stream? not or >boolean ; +ERROR: end-of-stream multipart ; +: fill-bytes ( multipart -- multipart ) + buffer-size read + [ '[ _ append ] change-bytes ] + [ t >>end-of-stream? ] if* ; -:: multipart-step-loop ( stream quot1: ( bytes -- ) -- ? ) - stream dup [ read-n ] [ separator>> ] bi quot1 multipart-step - swap [ drop stream quot1 multipart-step-loop ] when ; inline recursive +: maybe-fill-bytes ( multipart -- multipart ) + dup bytes>> [ fill-bytes ] unless ; -SYMBOL: header -SYMBOL: parsed-header -SYMBOL: magic-separator +: split-bytes ( bytes separator -- leftover-bytes safe-to-dump ) + dupd [ length ] bi@ 1- - short cut-slice swap ; -: trim-blanks ( str -- str' ) [ blank? ] trim ; +: dump-until-separator ( multipart -- multipart ) + dup + [ current-separator>> ] [ bytes>> ] bi + [ nip ] [ start ] 2bi [ + cut-slice + [ mime-write ] + [ over current-separator>> length short tail-slice >>bytes ] bi* + ] [ + drop + dup [ bytes>> ] [ current-separator>> ] bi split-bytes mime-write + >>bytes fill-bytes dup end-of-stream?>> [ dump-until-separator ] unless + ] if* ; + +: dump-string ( multipart separator -- multipart string ) + >>current-separator + [ dump-until-separator ] with-string-writer ; + +: read-header ( multipart -- multipart ) + dup bytes>> "--\r\n" sequence= [ + t >>end-of-stream? + ] [ + "\r\n\r\n" dump-string parse-headers >>header + ] if ; -: trim-quotes ( str -- str' ) - [ [ CHAR: " = ] [ CHAR: ' = ] bi or ] trim ; +: empty-name? ( string -- ? ) + { "''" "\"\"" "" f } member? ; -: parse-content-disposition ( str -- content-disposition hash ) - ";" split [ first ] [ rest-slice ] bi [ "=" split ] map - [ [ trim-blanks ] [ trim-quotes ] bi* ] H{ } assoc-map-as ; +: quote? ( ch -- ? ) "'\"" member? ; -: parse-multipart-header ( string -- headers ) - "\r\n" split harvest - [ parse-header-line first2 ] H{ } map>assoc ; +: quoted? ( str -- ? ) + { + [ length 1 > ] + [ first quote? ] + [ [ first ] [ peek ] bi = ] + } 1&& ; -ERROR: expected-file ; +: unquote ( str -- newstr ) + dup quoted? [ but-last-slice rest-slice >string ] when ; -TUPLE: uploaded-file path filename name ; +: save-uploaded-file ( multipart -- ) + dup filename>> empty-name? [ + drop + ] [ + [ [ header>> ] [ filename>> ] [ temp-file>> ] tri mime-file boa ] + [ content-disposition>> "name" swap at unquote ] + [ mime-parts>> set-at ] tri + ] if ; -: (parse-multipart) ( stream -- ? ) - "\r\n\r\n" >>separator - header off - dup [ header [ prepend ] change ] multipart-step-loop drop - header get dup magic-separator get [ length ] bi@ < [ - 2drop f +: save-mime-part ( multipart -- ) + dup name>> empty-name? [ + drop ] [ - parse-multipart-header - parsed-header set - "\r\n" magic-separator get append >>separator - "factor-upload" "httpd" make-unique-file tuck - binary [ [ write ] multipart-step-loop ] with-file-writer swap - "content-disposition" parsed-header get at parse-content-disposition - nip [ "filename" swap at ] [ "name" swap at ] bi - uploaded-file boa , + [ [ header>> ] [ name>> unquote ] [ name-content>> ] tri mime-variable boa ] + [ name>> unquote ] + [ mime-parts>> set-at ] tri ] if ; -PRIVATE> +: dump-mime-file ( multipart filename -- multipart ) + binary [ + dup mime-separator>> >>current-separator dump-until-separator + ] with-output-stream ; + +: dump-file ( multipart -- multipart ) + "factor-" "-upload" make-unique-file + [ >>temp-file ] [ dump-mime-file ] bi ; + +: parse-content-disposition-form-data ( string -- hashtable ) + ";" split + [ "=" split1 [ [ blank? ] trim ] bi@ ] H{ } map>assoc ; -: parse-multipart ( stream -- array ) - [ - "\r\n" - magic-separator off - dup [ magic-separator [ prepend ] change ] - multipart-step-loop drop - '[ [ _ (parse-multipart) ] loop ] { } make - ] with-scope ; +: lookup-disposition ( multipart string -- multipart value/f ) + over content-disposition>> at ; + +ERROR: unknown-content-disposition multipart ; + +: parse-form-data ( multipart -- multipart ) + "filename" lookup-disposition [ + unquote + >>filename + [ dump-file ] [ save-uploaded-file ] bi + ] [ + "name" lookup-disposition [ + [ dup mime-separator>> dump-string >>name-content ] dip + >>name dup save-mime-part + ] [ + unknown-content-disposition + ] if* + ] if* ; + +ERROR: no-content-disposition multipart ; + +: process-header ( multipart -- multipart ) + "content-disposition" over header>> at ";" split1 swap { + { "form-data" [ + parse-content-disposition-form-data >>content-disposition + parse-form-data + ] } + [ no-content-disposition ] + } case ; + +: assert-sequence= ( a b -- ) + 2dup sequence= [ 2drop ] [ assert ] if ; + +: read-assert-sequence= ( sequence -- ) + [ length read ] keep assert-sequence= ; + +: parse-beginning ( multipart -- multipart ) + "--" read-assert-sequence= + dup mime-separator>> + [ read-assert-sequence= ] + [ separator-prefix prepend >>mime-separator ] bi ; + +: parse-multipart-loop ( multipart -- multipart ) + read-header + dup end-of-stream?>> [ process-header parse-multipart-loop ] unless ; + +: parse-multipart ( separator -- mime-parts ) + parse-beginning fill-bytes parse-multipart-loop + mime-parts>> ; diff --git a/basis/mime/types/types.factor b/basis/mime/types/types.factor index bb0d674f23..ac5233c543 100644 --- a/basis/mime/types/types.factor +++ b/basis/mime/types/types.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.files io.encodings.ascii assocs sequences splitting -kernel namespaces fry memoize ; +USING: io.pathnames io.files io.encodings.ascii assocs sequences +splitting kernel namespaces fry memoize ; IN: mime.types MEMO: mime-db ( -- seq ) diff --git a/basis/mirrors/mirrors-docs.factor b/basis/mirrors/mirrors-docs.factor index d6a8d51fbe..e498919f11 100644 --- a/basis/mirrors/mirrors-docs.factor +++ b/basis/mirrors/mirrors-docs.factor @@ -20,7 +20,7 @@ $nl $nl "Mirrors are created by calling " { $link } " or " { $link make-mirror } "." } ; -HELP: ( object -- mirror ) +HELP: { $values { "object" object } { "mirror" mirror } } { $description "Creates a " { $link mirror } " reflecting an object." } { $examples diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor index d3d6dbdb04..25486d127d 100644 --- a/basis/mirrors/mirrors.factor +++ b/basis/mirrors/mirrors.factor @@ -32,7 +32,7 @@ M: mirror set-at ( val key mirror -- ) swap set-slot ; M: mirror delete-at ( key mirror -- ) - f -rot set-at ; + [ f ] 2dip set-at ; M: mirror clear-assoc ( mirror -- ) [ object>> ] [ object-slots ] bi [ diff --git a/basis/models/compose/compose-tests.factor b/basis/models/compose/compose-tests.factor index 16a5ab339c..0644bb6841 100644 --- a/basis/models/compose/compose-tests.factor +++ b/basis/models/compose/compose-tests.factor @@ -1,5 +1,5 @@ USING: arrays generic kernel math models namespaces sequences assocs -tools.test models.compose accessors ; +tools.test models.compose accessors locals ; IN: models.compose.tests ! Test compose @@ -22,3 +22,25 @@ IN: models.compose.tests [ { 4 5 } ] [ "c" get value>> ] unit-test [ ] [ "c" get deactivate-model ] unit-test + +TUPLE: an-observer { i integer } ; + +M: an-observer model-changed nip [ 1+ ] change-i drop ; + +[ 1 0 ] [ + [let* | m1 [ 1 ] + m2 [ 2 ] + c [ { m1 m2 } ] + o1 [ an-observer new ] + o2 [ an-observer new ] | + + o1 m1 add-connection + o2 m2 add-connection + + c activate-model + + "OH HAI" m1 set-model + o1 i>> + o2 i>> + ] +] unit-test \ No newline at end of file diff --git a/basis/models/compose/compose.factor b/basis/models/compose/compose.factor index a2c3385248..386a06781d 100644 --- a/basis/models/compose/compose.factor +++ b/basis/models/compose/compose.factor @@ -18,7 +18,8 @@ TUPLE: compose < model ; M: compose model-changed nip - [ [ value>> ] composed-value ] keep set-model ; + dup [ value>> ] composed-value >>value + notify-connections ; M: compose model-activated dup model-changed ; diff --git a/basis/multiline/multiline-tests.factor b/basis/multiline/multiline-tests.factor index 357fd2cb6c..153b6cedbe 100644 --- a/basis/multiline/multiline-tests.factor +++ b/basis/multiline/multiline-tests.factor @@ -14,3 +14,8 @@ bar [ "hello\nworld" ] [ <" hello world"> ] unit-test + +[ "hello" "world" ] [ <" hello"> <" world"> ] unit-test + +[ "\nhi" ] [ <" +hi"> ] unit-test diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor index 64d4b1a041..53c2789c50 100644 --- a/basis/multiline/multiline.factor +++ b/basis/multiline/multiline.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: namespaces make parser lexer kernel sequences words -quotations math accessors ; +quotations math accessors locals ; IN: multiline : STRING: CREATE-WORD - parse-here 1quotation define-inline ; parsing + parse-here 1quotation + (( -- string )) define-inline ; parsing > [ - 2dup start - [ rot dupd [ swap subseq % ] 2dip length + ] [ - rot tail % "\n" % 0 - lexer get next-line swap (parse-multiline-string) + +:: (parse-multiline-string) ( i end -- j ) + lexer get line-text>> :> text + text [ + end text i start* [| j | + i j text subseq % j end length + + ] [ + text i short tail % CHAR: \n , + lexer get next-line + 0 end (parse-multiline-string) ] if* - ] [ nip unexpected-eof ] if* ; + ] [ end unexpected-eof ] if ; + PRIVATE> : parse-multiline-string ( end-text -- str ) [ - lexer get [ swap (parse-multiline-string) ] change-column drop - ] "" make rest ; + lexer get + [ 1+ swap (parse-multiline-string) ] + change-column drop + ] "" make ; : <" "\">" parse-multiline-string parsed ; parsing +: <' + "'>" parse-multiline-string parsed ; parsing + +: {' + "'}" parse-multiline-string parsed ; parsing + +: {" + "\"}" parse-multiline-string parsed ; parsing + : /* "*/" parse-multiline-string drop ; parsing diff --git a/basis/nibble-arrays/nibble-arrays.factor b/basis/nibble-arrays/nibble-arrays.factor index 82643bef15..d1ab0a34c1 100644 --- a/basis/nibble-arrays/nibble-arrays.factor +++ b/basis/nibble-arrays/nibble-arrays.factor @@ -12,7 +12,7 @@ TUPLE: nibble-array : nibble BIN: 1111 ; inline -: nibbles>bytes 1 + 2/ ; inline +: nibbles>bytes ( m -- n ) 1 + 2/ ; inline : byte/nibble ( n -- shift n' ) [ 1 bitand 2 shift ] [ -1 shift ] bi ; inline diff --git a/basis/opengl/capabilities/authors.txt b/basis/opengl/capabilities/authors.txt new file mode 100644 index 0000000000..6a0dc7293a --- /dev/null +++ b/basis/opengl/capabilities/authors.txt @@ -0,0 +1 @@ +Joe Groff \ No newline at end of file diff --git a/basis/opengl/capabilities/capabilities-docs.factor b/basis/opengl/capabilities/capabilities-docs.factor new file mode 100644 index 0000000000..f5424e19da --- /dev/null +++ b/basis/opengl/capabilities/capabilities-docs.factor @@ -0,0 +1,59 @@ +USING: help.markup help.syntax io kernel math quotations +opengl.gl multiline assocs ; +IN: opengl.capabilities + +HELP: gl-version +{ $values { "version" "The version string from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ; + +HELP: gl-vendor-version +{ $values { "version" "The vendor-specific version information from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ; + +HELP: has-gl-version? +{ $values { "version" "A version string" } { "?" "A boolean value" } } +{ $description "Compares the version string returned by " { $link gl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ; + +HELP: require-gl-version +{ $values { "version" "A version string" } } +{ $description "Throws an exception if " { $link has-gl-version? } " returns false for " { $snippet "version" } "." } ; + +HELP: glsl-version +{ $values { "version" "The GLSL version string from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ; + +HELP: glsl-vendor-version +{ $values { "version" "The vendor-specific GLSL version information from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ; + +HELP: has-glsl-version? +{ $values { "version" "A version string" } { "?" "A boolean value" } } +{ $description "Compares the version string returned by " { $link glsl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ; + +HELP: require-glsl-version +{ $values { "version" "A version string" } } +{ $description "Throws an exception if " { $link has-glsl-version? } " returns false for " { $snippet "version" } "." } ; + +HELP: gl-extensions +{ $values { "seq" "A sequence of strings naming the implementation-supported OpenGL extensions" } } +{ $description "Wrapper for " { $snippet "GL_EXTENSIONS glGetString" } " that returns a sequence of extension names supported by the OpenGL implementation." } ; + +HELP: has-gl-extensions? +{ $values { "extensions" "A sequence of extension name strings" } { "?" "A boolean value" } } +{ $description "Returns true if the set of " { $snippet "extensions" } " is a subset of the implementation-supported extensions returned by " { $link gl-extensions } "." } ; + +HELP: has-gl-version-or-extensions? +{ $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } { "?" "a boolean" } } +{ $description "Returns true if either " { $link has-gl-version? } " or " { $link has-gl-extensions? } " returns true for " { $snippet "version" } " or " { $snippet "extensions" } ", respectively. Intended for use when required OpenGL functionality can be verified either by a minimum version or a set of equivalent extensions." } ; + +HELP: require-gl-extensions +{ $values { "extensions" "A sequence of extension name strings" } } +{ $description "Throws an exception if " { $link has-gl-extensions? } " returns false for " { $snippet "extensions" } "." } ; + +HELP: require-gl-version-or-extensions +{ $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } } +{ $description "Throws an exception if neither " { $link has-gl-version? } " nor " { $link has-gl-extensions? } " returns true for " { $snippet "version" } " or " { $snippet "extensions" } ", respectively. Intended for use when required OpenGL functionality can be verified either by a minimum version or a set of equivalent extensions." } ; + +{ require-gl-version require-glsl-version require-gl-extensions require-gl-version-or-extensions has-gl-version? has-glsl-version? has-gl-extensions? has-gl-version-or-extensions? gl-version glsl-version gl-extensions } related-words + +ABOUT: "gl-utilities" diff --git a/basis/opengl/capabilities/capabilities.factor b/basis/opengl/capabilities/capabilities.factor new file mode 100755 index 0000000000..09d49b33c2 --- /dev/null +++ b/basis/opengl/capabilities/capabilities.factor @@ -0,0 +1,64 @@ +! Copyright (C) 2008 Joe Groff. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces make sequences splitting opengl.gl +continuations math.parser math arrays sets math.order fry ; +IN: opengl.capabilities + +: (require-gl) ( thing require-quot make-error-quot -- ) + [ dupd call [ drop ] ] dip '[ _ " " make throw ] if ; inline + +: gl-extensions ( -- seq ) + GL_EXTENSIONS glGetString " " split ; +: has-gl-extensions? ( extensions -- ? ) + gl-extensions swap [ over member? ] all? nip ; +: (make-gl-extensions-error) ( required-extensions -- ) + gl-extensions diff + "Required OpenGL extensions not supported:\n" % + [ " " % % "\n" % ] each ; +: require-gl-extensions ( extensions -- ) + [ has-gl-extensions? ] + [ (make-gl-extensions-error) ] + (require-gl) ; + +: version-seq ( version-string -- version-seq ) + "." split [ string>number ] map ; + +: version-before? ( version1 version2 -- ? ) + swap version-seq swap version-seq before=? ; + +: (gl-version) ( -- version vendor ) + GL_VERSION glGetString " " split1 ; +: gl-version ( -- version ) + (gl-version) drop ; +: gl-vendor-version ( -- version ) + (gl-version) nip ; +: has-gl-version? ( version -- ? ) + gl-version version-before? ; +: (make-gl-version-error) ( required-version -- ) + "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ; +: require-gl-version ( version -- ) + [ has-gl-version? ] + [ (make-gl-version-error) ] + (require-gl) ; + +: (glsl-version) ( -- version vendor ) + GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ; +: glsl-version ( -- version ) + (glsl-version) drop ; +: glsl-vendor-version ( -- version ) + (glsl-version) nip ; +: has-glsl-version? ( version -- ? ) + glsl-version version-before? ; +: require-glsl-version ( version -- ) + [ has-glsl-version? ] + [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ] + (require-gl) ; + +: has-gl-version-or-extensions? ( version extensions -- ? ) + has-gl-extensions? swap has-gl-version? or ; + +: require-gl-version-or-extensions ( version extensions -- ) + 2array [ first2 has-gl-version-or-extensions? ] [ + dup first (make-gl-version-error) "\n" % + second (make-gl-extensions-error) "\n" % + ] (require-gl) ; diff --git a/basis/opengl/capabilities/summary.txt b/basis/opengl/capabilities/summary.txt new file mode 100644 index 0000000000..d31b63b8d4 --- /dev/null +++ b/basis/opengl/capabilities/summary.txt @@ -0,0 +1 @@ +Testing for OpenGL versions and extensions \ No newline at end of file diff --git a/basis/opengl/capabilities/tags.txt b/basis/opengl/capabilities/tags.txt new file mode 100644 index 0000000000..77282be3a9 --- /dev/null +++ b/basis/opengl/capabilities/tags.txt @@ -0,0 +1,2 @@ +opengl +bindings diff --git a/basis/opengl/framebuffers/authors.txt b/basis/opengl/framebuffers/authors.txt new file mode 100644 index 0000000000..6a0dc7293a --- /dev/null +++ b/basis/opengl/framebuffers/authors.txt @@ -0,0 +1 @@ +Joe Groff \ No newline at end of file diff --git a/basis/opengl/framebuffers/framebuffers-docs.factor b/basis/opengl/framebuffers/framebuffers-docs.factor new file mode 100644 index 0000000000..c5507dcce1 --- /dev/null +++ b/basis/opengl/framebuffers/framebuffers-docs.factor @@ -0,0 +1,35 @@ +USING: help.markup help.syntax io kernel math quotations +opengl.gl multiline assocs ; +IN: opengl.framebuffers + +HELP: gen-framebuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ; + +HELP: gen-renderbuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ; + +HELP: delete-framebuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ; + +HELP: delete-renderbuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ; + +{ gen-framebuffer delete-framebuffer } related-words +{ gen-renderbuffer delete-renderbuffer } related-words + +HELP: framebuffer-incomplete? +{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } } +{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ; + +HELP: check-framebuffer +{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ; + +HELP: with-framebuffer +{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } } +{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ; + +ABOUT: "gl-utilities" \ No newline at end of file diff --git a/basis/opengl/framebuffers/framebuffers.factor b/basis/opengl/framebuffers/framebuffers.factor new file mode 100644 index 0000000000..346789e1c5 --- /dev/null +++ b/basis/opengl/framebuffers/framebuffers.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2008 Joe Groff. +! See http://factorcode.org/license.txt for BSD license. +USING: opengl opengl.gl combinators continuations kernel +alien.c-types ; +IN: opengl.framebuffers + +: gen-framebuffer ( -- id ) + [ glGenFramebuffersEXT ] (gen-gl-object) ; +: gen-renderbuffer ( -- id ) + [ glGenRenderbuffersEXT ] (gen-gl-object) ; + +: delete-framebuffer ( id -- ) + [ glDeleteFramebuffersEXT ] (delete-gl-object) ; +: delete-renderbuffer ( id -- ) + [ glDeleteRenderbuffersEXT ] (delete-gl-object) ; + +: framebuffer-incomplete? ( -- status/f ) + GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT + dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ; + +: framebuffer-error ( status -- * ) + { + { GL_FRAMEBUFFER_COMPLETE_EXT [ "framebuffer complete" ] } + { GL_FRAMEBUFFER_UNSUPPORTED_EXT [ "framebuffer configuration unsupported" ] } + { GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT [ "framebuffer incomplete (incomplete attachment)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT [ "framebuffer incomplete (missing attachment)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT [ "framebuffer incomplete (dimension mismatch)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT [ "framebuffer incomplete (format mismatch)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT [ "framebuffer incomplete (read buffer has no attachment)" ] } + [ drop gl-error "unknown framebuffer error" ] + } case throw ; + +: check-framebuffer ( -- ) + framebuffer-incomplete? [ framebuffer-error ] when* ; + +: with-framebuffer ( id quot -- ) + GL_FRAMEBUFFER_EXT rot glBindFramebufferEXT + [ GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ] [ ] cleanup ; inline + +: framebuffer-attachment ( attachment -- id ) + GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT + 0 [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ; diff --git a/basis/opengl/framebuffers/summary.txt b/basis/opengl/framebuffers/summary.txt new file mode 100644 index 0000000000..3ef713ac13 --- /dev/null +++ b/basis/opengl/framebuffers/summary.txt @@ -0,0 +1 @@ +Rendering to offscreen textures using the GL_EXT_framebuffer_object extension \ No newline at end of file diff --git a/basis/opengl/framebuffers/tags.txt b/basis/opengl/framebuffers/tags.txt new file mode 100644 index 0000000000..77282be3a9 --- /dev/null +++ b/basis/opengl/framebuffers/tags.txt @@ -0,0 +1,2 @@ +opengl +bindings diff --git a/basis/opengl/gl/extensions/extensions.factor b/basis/opengl/gl/extensions/extensions.factor index ea37829d0e..fb2ddfaf3e 100644 --- a/basis/opengl/gl/extensions/extensions.factor +++ b/basis/opengl/gl/extensions/extensions.factor @@ -1,6 +1,6 @@ USING: alien alien.syntax alien.parser combinators kernel parser sequences system words namespaces hashtables init -math arrays assocs continuations lexer fry locals ; +math arrays assocs continuations lexer fry locals vocabs.parser ; IN: opengl.gl.extensions ERROR: unknown-gl-platform ; diff --git a/basis/opengl/gl/gl.factor b/basis/opengl/gl/gl.factor index 59b2422d73..c32f62bf33 100644 --- a/basis/opengl/gl/gl.factor +++ b/basis/opengl/gl/gl.factor @@ -27,603 +27,599 @@ TYPEDEF: void* GLvoid* ! Constants ! Boolean values -: GL_FALSE HEX: 0 ; inline -: GL_TRUE HEX: 1 ; inline +CONSTANT: GL_FALSE HEX: 0 +CONSTANT: GL_TRUE HEX: 1 ! Data types -: GL_BYTE HEX: 1400 ; inline -: GL_UNSIGNED_BYTE HEX: 1401 ; inline -: GL_SHORT HEX: 1402 ; inline -: GL_UNSIGNED_SHORT HEX: 1403 ; inline -: GL_INT HEX: 1404 ; inline -: GL_UNSIGNED_INT HEX: 1405 ; inline -: GL_FLOAT HEX: 1406 ; inline -: GL_2_BYTES HEX: 1407 ; inline -: GL_3_BYTES HEX: 1408 ; inline -: GL_4_BYTES HEX: 1409 ; inline -: GL_DOUBLE HEX: 140A ; inline +CONSTANT: GL_BYTE HEX: 1400 +CONSTANT: GL_UNSIGNED_BYTE HEX: 1401 +CONSTANT: GL_SHORT HEX: 1402 +CONSTANT: GL_UNSIGNED_SHORT HEX: 1403 +CONSTANT: GL_INT HEX: 1404 +CONSTANT: GL_UNSIGNED_INT HEX: 1405 +CONSTANT: GL_FLOAT HEX: 1406 +CONSTANT: GL_2_BYTES HEX: 1407 +CONSTANT: GL_3_BYTES HEX: 1408 +CONSTANT: GL_4_BYTES HEX: 1409 +CONSTANT: GL_DOUBLE HEX: 140A ! Primitives -: GL_POINTS HEX: 0000 ; inline -: GL_LINES HEX: 0001 ; inline -: GL_LINE_LOOP HEX: 0002 ; inline -: GL_LINE_STRIP HEX: 0003 ; inline -: GL_TRIANGLES HEX: 0004 ; inline -: GL_TRIANGLE_STRIP HEX: 0005 ; inline -: GL_TRIANGLE_FAN HEX: 0006 ; inline -: GL_QUADS HEX: 0007 ; inline -: GL_QUAD_STRIP HEX: 0008 ; inline -: GL_POLYGON HEX: 0009 ; inline +CONSTANT: GL_POINTS HEX: 0000 +CONSTANT: GL_LINES HEX: 0001 +CONSTANT: GL_LINE_LOOP HEX: 0002 +CONSTANT: GL_LINE_STRIP HEX: 0003 +CONSTANT: GL_TRIANGLES HEX: 0004 +CONSTANT: GL_TRIANGLE_STRIP HEX: 0005 +CONSTANT: GL_TRIANGLE_FAN HEX: 0006 +CONSTANT: GL_QUADS HEX: 0007 +CONSTANT: GL_QUAD_STRIP HEX: 0008 +CONSTANT: GL_POLYGON HEX: 0009 ! Vertex arrays -: GL_VERTEX_ARRAY HEX: 8074 ; inline -: GL_NORMAL_ARRAY HEX: 8075 ; inline -: GL_COLOR_ARRAY HEX: 8076 ; inline -: GL_INDEX_ARRAY HEX: 8077 ; inline -: GL_TEXTURE_COORD_ARRAY HEX: 8078 ; inline -: GL_EDGE_FLAG_ARRAY HEX: 8079 ; inline -: GL_VERTEX_ARRAY_SIZE HEX: 807A ; inline -: GL_VERTEX_ARRAY_TYPE HEX: 807B ; inline -: GL_VERTEX_ARRAY_STRIDE HEX: 807C ; inline -: GL_NORMAL_ARRAY_TYPE HEX: 807E ; inline -: GL_NORMAL_ARRAY_STRIDE HEX: 807F ; inline -: GL_COLOR_ARRAY_SIZE HEX: 8081 ; inline -: GL_COLOR_ARRAY_TYPE HEX: 8082 ; inline -: GL_COLOR_ARRAY_STRIDE HEX: 8083 ; inline -: GL_INDEX_ARRAY_TYPE HEX: 8085 ; inline -: GL_INDEX_ARRAY_STRIDE HEX: 8086 ; inline -: GL_TEXTURE_COORD_ARRAY_SIZE HEX: 8088 ; inline -: GL_TEXTURE_COORD_ARRAY_TYPE HEX: 8089 ; inline -: GL_TEXTURE_COORD_ARRAY_STRIDE HEX: 808A ; inline -: GL_EDGE_FLAG_ARRAY_STRIDE HEX: 808C ; inline -: GL_VERTEX_ARRAY_POINTER HEX: 808E ; inline -: GL_NORMAL_ARRAY_POINTER HEX: 808F ; inline -: GL_COLOR_ARRAY_POINTER HEX: 8090 ; inline -: GL_INDEX_ARRAY_POINTER HEX: 8091 ; inline -: GL_TEXTURE_COORD_ARRAY_POINTER HEX: 8092 ; inline -: GL_EDGE_FLAG_ARRAY_POINTER HEX: 8093 ; inline -: GL_V2F HEX: 2A20 ; inline -: GL_V3F HEX: 2A21 ; inline -: GL_C4UB_V2F HEX: 2A22 ; inline -: GL_C4UB_V3F HEX: 2A23 ; inline -: GL_C3F_V3F HEX: 2A24 ; inline -: GL_N3F_V3F HEX: 2A25 ; inline -: GL_C4F_N3F_V3F HEX: 2A26 ; inline -: GL_T2F_V3F HEX: 2A27 ; inline -: GL_T4F_V4F HEX: 2A28 ; inline -: GL_T2F_C4UB_V3F HEX: 2A29 ; inline -: GL_T2F_C3F_V3F HEX: 2A2A ; inline -: GL_T2F_N3F_V3F HEX: 2A2B ; inline -: GL_T2F_C4F_N3F_V3F HEX: 2A2C ; inline -: GL_T4F_C4F_N3F_V4F HEX: 2A2D ; inline +CONSTANT: GL_VERTEX_ARRAY HEX: 8074 +CONSTANT: GL_NORMAL_ARRAY HEX: 8075 +CONSTANT: GL_COLOR_ARRAY HEX: 8076 +CONSTANT: GL_INDEX_ARRAY HEX: 8077 +CONSTANT: GL_TEXTURE_COORD_ARRAY HEX: 8078 +CONSTANT: GL_EDGE_FLAG_ARRAY HEX: 8079 +CONSTANT: GL_VERTEX_ARRAY_SIZE HEX: 807A +CONSTANT: GL_VERTEX_ARRAY_TYPE HEX: 807B +CONSTANT: GL_VERTEX_ARRAY_STRIDE HEX: 807C +CONSTANT: GL_NORMAL_ARRAY_TYPE HEX: 807E +CONSTANT: GL_NORMAL_ARRAY_STRIDE HEX: 807F +CONSTANT: GL_COLOR_ARRAY_SIZE HEX: 8081 +CONSTANT: GL_COLOR_ARRAY_TYPE HEX: 8082 +CONSTANT: GL_COLOR_ARRAY_STRIDE HEX: 8083 +CONSTANT: GL_INDEX_ARRAY_TYPE HEX: 8085 +CONSTANT: GL_INDEX_ARRAY_STRIDE HEX: 8086 +CONSTANT: GL_TEXTURE_COORD_ARRAY_SIZE HEX: 8088 +CONSTANT: GL_TEXTURE_COORD_ARRAY_TYPE HEX: 8089 +CONSTANT: GL_TEXTURE_COORD_ARRAY_STRIDE HEX: 808A +CONSTANT: GL_EDGE_FLAG_ARRAY_STRIDE HEX: 808C +CONSTANT: GL_VERTEX_ARRAY_POINTER HEX: 808E +CONSTANT: GL_NORMAL_ARRAY_POINTER HEX: 808F +CONSTANT: GL_COLOR_ARRAY_POINTER HEX: 8090 +CONSTANT: GL_INDEX_ARRAY_POINTER HEX: 8091 +CONSTANT: GL_TEXTURE_COORD_ARRAY_POINTER HEX: 8092 +CONSTANT: GL_EDGE_FLAG_ARRAY_POINTER HEX: 8093 +CONSTANT: GL_V2F HEX: 2A20 +CONSTANT: GL_V3F HEX: 2A21 +CONSTANT: GL_C4UB_V2F HEX: 2A22 +CONSTANT: GL_C4UB_V3F HEX: 2A23 +CONSTANT: GL_C3F_V3F HEX: 2A24 +CONSTANT: GL_N3F_V3F HEX: 2A25 +CONSTANT: GL_C4F_N3F_V3F HEX: 2A26 +CONSTANT: GL_T2F_V3F HEX: 2A27 +CONSTANT: GL_T4F_V4F HEX: 2A28 +CONSTANT: GL_T2F_C4UB_V3F HEX: 2A29 +CONSTANT: GL_T2F_C3F_V3F HEX: 2A2A +CONSTANT: GL_T2F_N3F_V3F HEX: 2A2B +CONSTANT: GL_T2F_C4F_N3F_V3F HEX: 2A2C +CONSTANT: GL_T4F_C4F_N3F_V4F HEX: 2A2D ! Matrix mode -: GL_MATRIX_MODE HEX: 0BA0 ; inline -: GL_MODELVIEW HEX: 1700 ; inline -: GL_PROJECTION HEX: 1701 ; inline -: GL_TEXTURE HEX: 1702 ; inline +CONSTANT: GL_MATRIX_MODE HEX: 0BA0 +CONSTANT: GL_MODELVIEW HEX: 1700 +CONSTANT: GL_PROJECTION HEX: 1701 +CONSTANT: GL_TEXTURE HEX: 1702 ! Points -: GL_POINT_SMOOTH HEX: 0B10 ; inline -: GL_POINT_SIZE HEX: 0B11 ; inline -: GL_POINT_SIZE_GRANULARITY HEX: 0B13 ; inline -: GL_POINT_SIZE_RANGE HEX: 0B12 ; inline +CONSTANT: GL_POINT_SMOOTH HEX: 0B10 +CONSTANT: GL_POINT_SIZE HEX: 0B11 +CONSTANT: GL_POINT_SIZE_GRANULARITY HEX: 0B13 +CONSTANT: GL_POINT_SIZE_RANGE HEX: 0B12 ! Lines -: GL_LINE_SMOOTH HEX: 0B20 ; inline -: GL_LINE_STIPPLE HEX: 0B24 ; inline -: GL_LINE_STIPPLE_PATTERN HEX: 0B25 ; inline -: GL_LINE_STIPPLE_REPEAT HEX: 0B26 ; inline -: GL_LINE_WIDTH HEX: 0B21 ; inline -: GL_LINE_WIDTH_GRANULARITY HEX: 0B23 ; inline -: GL_LINE_WIDTH_RANGE HEX: 0B22 ; inline +CONSTANT: GL_LINE_SMOOTH HEX: 0B20 +CONSTANT: GL_LINE_STIPPLE HEX: 0B24 +CONSTANT: GL_LINE_STIPPLE_PATTERN HEX: 0B25 +CONSTANT: GL_LINE_STIPPLE_REPEAT HEX: 0B26 +CONSTANT: GL_LINE_WIDTH HEX: 0B21 +CONSTANT: GL_LINE_WIDTH_GRANULARITY HEX: 0B23 +CONSTANT: GL_LINE_WIDTH_RANGE HEX: 0B22 ! Polygons -: GL_POINT HEX: 1B00 ; inline -: GL_LINE HEX: 1B01 ; inline -: GL_FILL HEX: 1B02 ; inline -: GL_CW HEX: 0900 ; inline -: GL_CCW HEX: 0901 ; inline -: GL_FRONT HEX: 0404 ; inline -: GL_BACK HEX: 0405 ; inline -: GL_POLYGON_MODE HEX: 0B40 ; inline -: GL_POLYGON_SMOOTH HEX: 0B41 ; inline -: GL_POLYGON_STIPPLE HEX: 0B42 ; inline -: GL_EDGE_FLAG HEX: 0B43 ; inline -: GL_CULL_FACE HEX: 0B44 ; inline -: GL_CULL_FACE_MODE HEX: 0B45 ; inline -: GL_FRONT_FACE HEX: 0B46 ; inline -: GL_POLYGON_OFFSET_FACTOR HEX: 8038 ; inline -: GL_POLYGON_OFFSET_UNITS HEX: 2A00 ; inline -: GL_POLYGON_OFFSET_POINT HEX: 2A01 ; inline -: GL_POLYGON_OFFSET_LINE HEX: 2A02 ; inline -: GL_POLYGON_OFFSET_FILL HEX: 8037 ; inline +CONSTANT: GL_POINT HEX: 1B00 +CONSTANT: GL_LINE HEX: 1B01 +CONSTANT: GL_FILL HEX: 1B02 +CONSTANT: GL_CW HEX: 0900 +CONSTANT: GL_CCW HEX: 0901 +CONSTANT: GL_FRONT HEX: 0404 +CONSTANT: GL_BACK HEX: 0405 +CONSTANT: GL_POLYGON_MODE HEX: 0B40 +CONSTANT: GL_POLYGON_SMOOTH HEX: 0B41 +CONSTANT: GL_POLYGON_STIPPLE HEX: 0B42 +CONSTANT: GL_EDGE_FLAG HEX: 0B43 +CONSTANT: GL_CULL_FACE HEX: 0B44 +CONSTANT: GL_CULL_FACE_MODE HEX: 0B45 +CONSTANT: GL_FRONT_FACE HEX: 0B46 +CONSTANT: GL_POLYGON_OFFSET_FACTOR HEX: 8038 +CONSTANT: GL_POLYGON_OFFSET_UNITS HEX: 2A00 +CONSTANT: GL_POLYGON_OFFSET_POINT HEX: 2A01 +CONSTANT: GL_POLYGON_OFFSET_LINE HEX: 2A02 +CONSTANT: GL_POLYGON_OFFSET_FILL HEX: 8037 ! Display Lists -: GL_COMPILE HEX: 1300 ; inline -: GL_COMPILE_AND_EXECUTE HEX: 1301 ; inline -: GL_LIST_BASE HEX: 0B32 ; inline -: GL_LIST_INDEX HEX: 0B33 ; inline -: GL_LIST_MODE HEX: 0B30 ; inline +CONSTANT: GL_COMPILE HEX: 1300 +CONSTANT: GL_COMPILE_AND_EXECUTE HEX: 1301 +CONSTANT: GL_LIST_BASE HEX: 0B32 +CONSTANT: GL_LIST_INDEX HEX: 0B33 +CONSTANT: GL_LIST_MODE HEX: 0B30 ! Depth buffer -: GL_NEVER HEX: 0200 ; inline -: GL_LESS HEX: 0201 ; inline -: GL_EQUAL HEX: 0202 ; inline -: GL_LEQUAL HEX: 0203 ; inline -: GL_GREATER HEX: 0204 ; inline -: GL_NOTEQUAL HEX: 0205 ; inline -: GL_GEQUAL HEX: 0206 ; inline -: GL_ALWAYS HEX: 0207 ; inline -: GL_DEPTH_TEST HEX: 0B71 ; inline -: GL_DEPTH_BITS HEX: 0D56 ; inline -: GL_DEPTH_CLEAR_VALUE HEX: 0B73 ; inline -: GL_DEPTH_FUNC HEX: 0B74 ; inline -: GL_DEPTH_RANGE HEX: 0B70 ; inline -: GL_DEPTH_WRITEMASK HEX: 0B72 ; inline -: GL_DEPTH_COMPONENT HEX: 1902 ; inline +CONSTANT: GL_NEVER HEX: 0200 +CONSTANT: GL_LESS HEX: 0201 +CONSTANT: GL_EQUAL HEX: 0202 +CONSTANT: GL_LEQUAL HEX: 0203 +CONSTANT: GL_GREATER HEX: 0204 +CONSTANT: GL_NOTEQUAL HEX: 0205 +CONSTANT: GL_GEQUAL HEX: 0206 +CONSTANT: GL_ALWAYS HEX: 0207 +CONSTANT: GL_DEPTH_TEST HEX: 0B71 +CONSTANT: GL_DEPTH_BITS HEX: 0D56 +CONSTANT: GL_DEPTH_CLEAR_VALUE HEX: 0B73 +CONSTANT: GL_DEPTH_FUNC HEX: 0B74 +CONSTANT: GL_DEPTH_RANGE HEX: 0B70 +CONSTANT: GL_DEPTH_WRITEMASK HEX: 0B72 +CONSTANT: GL_DEPTH_COMPONENT HEX: 1902 ! Lighting -: GL_LIGHTING HEX: 0B50 ; inline -: GL_LIGHT0 HEX: 4000 ; inline -: GL_LIGHT1 HEX: 4001 ; inline -: GL_LIGHT2 HEX: 4002 ; inline -: GL_LIGHT3 HEX: 4003 ; inline -: GL_LIGHT4 HEX: 4004 ; inline -: GL_LIGHT5 HEX: 4005 ; inline -: GL_LIGHT6 HEX: 4006 ; inline -: GL_LIGHT7 HEX: 4007 ; inline -: GL_SPOT_EXPONENT HEX: 1205 ; inline -: GL_SPOT_CUTOFF HEX: 1206 ; inline -: GL_CONSTANT_ATTENUATION HEX: 1207 ; inline -: GL_LINEAR_ATTENUATION HEX: 1208 ; inline -: GL_QUADRATIC_ATTENUATION HEX: 1209 ; inline -: GL_AMBIENT HEX: 1200 ; inline -: GL_DIFFUSE HEX: 1201 ; inline -: GL_SPECULAR HEX: 1202 ; inline -: GL_SHININESS HEX: 1601 ; inline -: GL_EMISSION HEX: 1600 ; inline -: GL_POSITION HEX: 1203 ; inline -: GL_SPOT_DIRECTION HEX: 1204 ; inline -: GL_AMBIENT_AND_DIFFUSE HEX: 1602 ; inline -: GL_COLOR_INDEXES HEX: 1603 ; inline -: GL_LIGHT_MODEL_TWO_SIDE HEX: 0B52 ; inline -: GL_LIGHT_MODEL_LOCAL_VIEWER HEX: 0B51 ; inline -: GL_LIGHT_MODEL_AMBIENT HEX: 0B53 ; inline -: GL_FRONT_AND_BACK HEX: 0408 ; inline -: GL_SHADE_MODEL HEX: 0B54 ; inline -: GL_FLAT HEX: 1D00 ; inline -: GL_SMOOTH HEX: 1D01 ; inline -: GL_COLOR_MATERIAL HEX: 0B57 ; inline -: GL_COLOR_MATERIAL_FACE HEX: 0B55 ; inline -: GL_COLOR_MATERIAL_PARAMETER HEX: 0B56 ; inline -: GL_NORMALIZE HEX: 0BA1 ; inline +CONSTANT: GL_LIGHTING HEX: 0B50 +CONSTANT: GL_LIGHT0 HEX: 4000 +CONSTANT: GL_LIGHT1 HEX: 4001 +CONSTANT: GL_LIGHT2 HEX: 4002 +CONSTANT: GL_LIGHT3 HEX: 4003 +CONSTANT: GL_LIGHT4 HEX: 4004 +CONSTANT: GL_LIGHT5 HEX: 4005 +CONSTANT: GL_LIGHT6 HEX: 4006 +CONSTANT: GL_LIGHT7 HEX: 4007 +CONSTANT: GL_SPOT_EXPONENT HEX: 1205 +CONSTANT: GL_SPOT_CUTOFF HEX: 1206 +CONSTANT: GL_CONSTANT_ATTENUATION HEX: 1207 +CONSTANT: GL_LINEAR_ATTENUATION HEX: 1208 +CONSTANT: GL_QUADRATIC_ATTENUATION HEX: 1209 +CONSTANT: GL_AMBIENT HEX: 1200 +CONSTANT: GL_DIFFUSE HEX: 1201 +CONSTANT: GL_SPECULAR HEX: 1202 +CONSTANT: GL_SHININESS HEX: 1601 +CONSTANT: GL_EMISSION HEX: 1600 +CONSTANT: GL_POSITION HEX: 1203 +CONSTANT: GL_SPOT_DIRECTION HEX: 1204 +CONSTANT: GL_AMBIENT_AND_DIFFUSE HEX: 1602 +CONSTANT: GL_COLOR_INDEXES HEX: 1603 +CONSTANT: GL_LIGHT_MODEL_TWO_SIDE HEX: 0B52 +CONSTANT: GL_LIGHT_MODEL_LOCAL_VIEWER HEX: 0B51 +CONSTANT: GL_LIGHT_MODEL_AMBIENT HEX: 0B53 +CONSTANT: GL_FRONT_AND_BACK HEX: 0408 +CONSTANT: GL_SHADE_MODEL HEX: 0B54 +CONSTANT: GL_FLAT HEX: 1D00 +CONSTANT: GL_SMOOTH HEX: 1D01 +CONSTANT: GL_COLOR_MATERIAL HEX: 0B57 +CONSTANT: GL_COLOR_MATERIAL_FACE HEX: 0B55 +CONSTANT: GL_COLOR_MATERIAL_PARAMETER HEX: 0B56 +CONSTANT: GL_NORMALIZE HEX: 0BA1 ! User clipping planes -: GL_CLIP_PLANE0 HEX: 3000 ; inline -: GL_CLIP_PLANE1 HEX: 3001 ; inline -: GL_CLIP_PLANE2 HEX: 3002 ; inline -: GL_CLIP_PLANE3 HEX: 3003 ; inline -: GL_CLIP_PLANE4 HEX: 3004 ; inline -: GL_CLIP_PLANE5 HEX: 3005 ; inline +CONSTANT: GL_CLIP_PLANE0 HEX: 3000 +CONSTANT: GL_CLIP_PLANE1 HEX: 3001 +CONSTANT: GL_CLIP_PLANE2 HEX: 3002 +CONSTANT: GL_CLIP_PLANE3 HEX: 3003 +CONSTANT: GL_CLIP_PLANE4 HEX: 3004 +CONSTANT: GL_CLIP_PLANE5 HEX: 3005 ! Accumulation buffer -: GL_ACCUM_RED_BITS HEX: 0D58 ; inline -: GL_ACCUM_GREEN_BITS HEX: 0D59 ; inline -: GL_ACCUM_BLUE_BITS HEX: 0D5A ; inline -: GL_ACCUM_ALPHA_BITS HEX: 0D5B ; inline -: GL_ACCUM_CLEAR_VALUE HEX: 0B80 ; inline -: GL_ACCUM HEX: 0100 ; inline -: GL_ADD HEX: 0104 ; inline -: GL_LOAD HEX: 0101 ; inline -: GL_MULT HEX: 0103 ; inline -: GL_RETURN HEX: 0102 ; inline +CONSTANT: GL_ACCUM_RED_BITS HEX: 0D58 +CONSTANT: GL_ACCUM_GREEN_BITS HEX: 0D59 +CONSTANT: GL_ACCUM_BLUE_BITS HEX: 0D5A +CONSTANT: GL_ACCUM_ALPHA_BITS HEX: 0D5B +CONSTANT: GL_ACCUM_CLEAR_VALUE HEX: 0B80 +CONSTANT: GL_ACCUM HEX: 0100 +CONSTANT: GL_ADD HEX: 0104 +CONSTANT: GL_LOAD HEX: 0101 +CONSTANT: GL_MULT HEX: 0103 +CONSTANT: GL_RETURN HEX: 0102 ! Alpha testing -: GL_ALPHA_TEST HEX: 0BC0 ; inline -: GL_ALPHA_TEST_REF HEX: 0BC2 ; inline -: GL_ALPHA_TEST_FUNC HEX: 0BC1 ; inline +CONSTANT: GL_ALPHA_TEST HEX: 0BC0 +CONSTANT: GL_ALPHA_TEST_REF HEX: 0BC2 +CONSTANT: GL_ALPHA_TEST_FUNC HEX: 0BC1 ! Blending -: GL_BLEND HEX: 0BE2 ; inline -: GL_BLEND_SRC HEX: 0BE1 ; inline -: GL_BLEND_DST HEX: 0BE0 ; inline -: GL_ZERO HEX: 0 ; inline -: GL_ONE HEX: 1 ; inline -: GL_SRC_COLOR HEX: 0300 ; inline -: GL_ONE_MINUS_SRC_COLOR HEX: 0301 ; inline -: GL_SRC_ALPHA HEX: 0302 ; inline -: GL_ONE_MINUS_SRC_ALPHA HEX: 0303 ; inline -: GL_DST_ALPHA HEX: 0304 ; inline -: GL_ONE_MINUS_DST_ALPHA HEX: 0305 ; inline -: GL_DST_COLOR HEX: 0306 ; inline -: GL_ONE_MINUS_DST_COLOR HEX: 0307 ; inline -: GL_SRC_ALPHA_SATURATE HEX: 0308 ; inline +CONSTANT: GL_BLEND HEX: 0BE2 +CONSTANT: GL_BLEND_SRC HEX: 0BE1 +CONSTANT: GL_BLEND_DST HEX: 0BE0 +CONSTANT: GL_ZERO HEX: 0 +CONSTANT: GL_ONE HEX: 1 +CONSTANT: GL_SRC_COLOR HEX: 0300 +CONSTANT: GL_ONE_MINUS_SRC_COLOR HEX: 0301 +CONSTANT: GL_SRC_ALPHA HEX: 0302 +CONSTANT: GL_ONE_MINUS_SRC_ALPHA HEX: 0303 +CONSTANT: GL_DST_ALPHA HEX: 0304 +CONSTANT: GL_ONE_MINUS_DST_ALPHA HEX: 0305 +CONSTANT: GL_DST_COLOR HEX: 0306 +CONSTANT: GL_ONE_MINUS_DST_COLOR HEX: 0307 +CONSTANT: GL_SRC_ALPHA_SATURATE HEX: 0308 ! Render Mode -: GL_FEEDBACK HEX: 1C01 ; inline -: GL_RENDER HEX: 1C00 ; inline -: GL_SELECT HEX: 1C02 ; inline +CONSTANT: GL_FEEDBACK HEX: 1C01 +CONSTANT: GL_RENDER HEX: 1C00 +CONSTANT: GL_SELECT HEX: 1C02 ! Feedback -: GL_2D HEX: 0600 ; inline -: GL_3D HEX: 0601 ; inline -: GL_3D_COLOR HEX: 0602 ; inline -: GL_3D_COLOR_TEXTURE HEX: 0603 ; inline -: GL_4D_COLOR_TEXTURE HEX: 0604 ; inline -: GL_POINT_TOKEN HEX: 0701 ; inline -: GL_LINE_TOKEN HEX: 0702 ; inline -: GL_LINE_RESET_TOKEN HEX: 0707 ; inline -: GL_POLYGON_TOKEN HEX: 0703 ; inline -: GL_BITMAP_TOKEN HEX: 0704 ; inline -: GL_DRAW_PIXEL_TOKEN HEX: 0705 ; inline -: GL_COPY_PIXEL_TOKEN HEX: 0706 ; inline -: GL_PASS_THROUGH_TOKEN HEX: 0700 ; inline -: GL_FEEDBACK_BUFFER_POINTER HEX: 0DF0 ; inline -: GL_FEEDBACK_BUFFER_SIZE HEX: 0DF1 ; inline -: GL_FEEDBACK_BUFFER_TYPE HEX: 0DF2 ; inline +CONSTANT: GL_2D HEX: 0600 +CONSTANT: GL_3D HEX: 0601 +CONSTANT: GL_3D_COLOR HEX: 0602 +CONSTANT: GL_3D_COLOR_TEXTURE HEX: 0603 +CONSTANT: GL_4D_COLOR_TEXTURE HEX: 0604 +CONSTANT: GL_POINT_TOKEN HEX: 0701 +CONSTANT: GL_LINE_TOKEN HEX: 0702 +CONSTANT: GL_LINE_RESET_TOKEN HEX: 0707 +CONSTANT: GL_POLYGON_TOKEN HEX: 0703 +CONSTANT: GL_BITMAP_TOKEN HEX: 0704 +CONSTANT: GL_DRAW_PIXEL_TOKEN HEX: 0705 +CONSTANT: GL_COPY_PIXEL_TOKEN HEX: 0706 +CONSTANT: GL_PASS_THROUGH_TOKEN HEX: 0700 +CONSTANT: GL_FEEDBACK_BUFFER_POINTER HEX: 0DF0 +CONSTANT: GL_FEEDBACK_BUFFER_SIZE HEX: 0DF1 +CONSTANT: GL_FEEDBACK_BUFFER_TYPE HEX: 0DF2 ! Selection -: GL_SELECTION_BUFFER_POINTER HEX: 0DF3 ; inline -: GL_SELECTION_BUFFER_SIZE HEX: 0DF4 ; inline +CONSTANT: GL_SELECTION_BUFFER_POINTER HEX: 0DF3 +CONSTANT: GL_SELECTION_BUFFER_SIZE HEX: 0DF4 ! Fog -: GL_FOG HEX: 0B60 ; inline -: GL_FOG_MODE HEX: 0B65 ; inline -: GL_FOG_DENSITY HEX: 0B62 ; inline -: GL_FOG_COLOR HEX: 0B66 ; inline -: GL_FOG_INDEX HEX: 0B61 ; inline -: GL_FOG_START HEX: 0B63 ; inline -: GL_FOG_END HEX: 0B64 ; inline -: GL_LINEAR HEX: 2601 ; inline -: GL_EXP HEX: 0800 ; inline -: GL_EXP2 HEX: 0801 ; inline +CONSTANT: GL_FOG HEX: 0B60 +CONSTANT: GL_FOG_MODE HEX: 0B65 +CONSTANT: GL_FOG_DENSITY HEX: 0B62 +CONSTANT: GL_FOG_COLOR HEX: 0B66 +CONSTANT: GL_FOG_INDEX HEX: 0B61 +CONSTANT: GL_FOG_START HEX: 0B63 +CONSTANT: GL_FOG_END HEX: 0B64 +CONSTANT: GL_LINEAR HEX: 2601 +CONSTANT: GL_EXP HEX: 0800 +CONSTANT: GL_EXP2 HEX: 0801 ! Logic Ops -: GL_LOGIC_OP HEX: 0BF1 ; inline -: GL_INDEX_LOGIC_OP HEX: 0BF1 ; inline -: GL_COLOR_LOGIC_OP HEX: 0BF2 ; inline -: GL_LOGIC_OP_MODE HEX: 0BF0 ; inline -: GL_CLEAR HEX: 1500 ; inline -: GL_SET HEX: 150F ; inline -: GL_COPY HEX: 1503 ; inline -: GL_COPY_INVERTED HEX: 150C ; inline -: GL_NOOP HEX: 1505 ; inline -: GL_INVERT HEX: 150A ; inline -: GL_AND HEX: 1501 ; inline -: GL_NAND HEX: 150E ; inline -: GL_OR HEX: 1507 ; inline -: GL_NOR HEX: 1508 ; inline -: GL_XOR HEX: 1506 ; inline -: GL_EQUIV HEX: 1509 ; inline -: GL_AND_REVERSE HEX: 1502 ; inline -: GL_AND_INVERTED HEX: 1504 ; inline -: GL_OR_REVERSE HEX: 150B ; inline -: GL_OR_INVERTED HEX: 150D ; inline +CONSTANT: GL_LOGIC_OP HEX: 0BF1 +CONSTANT: GL_INDEX_LOGIC_OP HEX: 0BF1 +CONSTANT: GL_COLOR_LOGIC_OP HEX: 0BF2 +CONSTANT: GL_LOGIC_OP_MODE HEX: 0BF0 +CONSTANT: GL_CLEAR HEX: 1500 +CONSTANT: GL_SET HEX: 150F +CONSTANT: GL_COPY HEX: 1503 +CONSTANT: GL_COPY_INVERTED HEX: 150C +CONSTANT: GL_NOOP HEX: 1505 +CONSTANT: GL_INVERT HEX: 150A +CONSTANT: GL_AND HEX: 1501 +CONSTANT: GL_NAND HEX: 150E +CONSTANT: GL_OR HEX: 1507 +CONSTANT: GL_NOR HEX: 1508 +CONSTANT: GL_XOR HEX: 1506 +CONSTANT: GL_EQUIV HEX: 1509 +CONSTANT: GL_AND_REVERSE HEX: 1502 +CONSTANT: GL_AND_INVERTED HEX: 1504 +CONSTANT: GL_OR_REVERSE HEX: 150B +CONSTANT: GL_OR_INVERTED HEX: 150D ! Stencil -: GL_STENCIL_TEST HEX: 0B90 ; inline -: GL_STENCIL_WRITEMASK HEX: 0B98 ; inline -: GL_STENCIL_BITS HEX: 0D57 ; inline -: GL_STENCIL_FUNC HEX: 0B92 ; inline -: GL_STENCIL_VALUE_MASK HEX: 0B93 ; inline -: GL_STENCIL_REF HEX: 0B97 ; inline -: GL_STENCIL_FAIL HEX: 0B94 ; inline -: GL_STENCIL_PASS_DEPTH_PASS HEX: 0B96 ; inline -: GL_STENCIL_PASS_DEPTH_FAIL HEX: 0B95 ; inline -: GL_STENCIL_CLEAR_VALUE HEX: 0B91 ; inline -: GL_STENCIL_INDEX HEX: 1901 ; inline -: GL_KEEP HEX: 1E00 ; inline -: GL_REPLACE HEX: 1E01 ; inline -: GL_INCR HEX: 1E02 ; inline -: GL_DECR HEX: 1E03 ; inline +CONSTANT: GL_STENCIL_TEST HEX: 0B90 +CONSTANT: GL_STENCIL_WRITEMASK HEX: 0B98 +CONSTANT: GL_STENCIL_BITS HEX: 0D57 +CONSTANT: GL_STENCIL_FUNC HEX: 0B92 +CONSTANT: GL_STENCIL_VALUE_MASK HEX: 0B93 +CONSTANT: GL_STENCIL_REF HEX: 0B97 +CONSTANT: GL_STENCIL_FAIL HEX: 0B94 +CONSTANT: GL_STENCIL_PASS_DEPTH_PASS HEX: 0B96 +CONSTANT: GL_STENCIL_PASS_DEPTH_FAIL HEX: 0B95 +CONSTANT: GL_STENCIL_CLEAR_VALUE HEX: 0B91 +CONSTANT: GL_STENCIL_INDEX HEX: 1901 +CONSTANT: GL_KEEP HEX: 1E00 +CONSTANT: GL_REPLACE HEX: 1E01 +CONSTANT: GL_INCR HEX: 1E02 +CONSTANT: GL_DECR HEX: 1E03 ! Buffers, Pixel Drawing/Reading -: GL_NONE HEX: 0 ; inline -: GL_LEFT HEX: 0406 ; inline -: GL_RIGHT HEX: 0407 ; inline -! defined elsewhere -! GL_FRONT HEX: 0404 -! GL_BACK HEX: 0405 -! GL_FRONT_AND_BACK HEX: 0408 -: GL_FRONT_LEFT HEX: 0400 ; inline -: GL_FRONT_RIGHT HEX: 0401 ; inline -: GL_BACK_LEFT HEX: 0402 ; inline -: GL_BACK_RIGHT HEX: 0403 ; inline -: GL_AUX0 HEX: 0409 ; inline -: GL_AUX1 HEX: 040A ; inline -: GL_AUX2 HEX: 040B ; inline -: GL_AUX3 HEX: 040C ; inline -: GL_COLOR_INDEX HEX: 1900 ; inline -: GL_RED HEX: 1903 ; inline -: GL_GREEN HEX: 1904 ; inline -: GL_BLUE HEX: 1905 ; inline -: GL_ALPHA HEX: 1906 ; inline -: GL_LUMINANCE HEX: 1909 ; inline -: GL_LUMINANCE_ALPHA HEX: 190A ; inline -: GL_ALPHA_BITS HEX: 0D55 ; inline -: GL_RED_BITS HEX: 0D52 ; inline -: GL_GREEN_BITS HEX: 0D53 ; inline -: GL_BLUE_BITS HEX: 0D54 ; inline -: GL_INDEX_BITS HEX: 0D51 ; inline -: GL_SUBPIXEL_BITS HEX: 0D50 ; inline -: GL_AUX_BUFFERS HEX: 0C00 ; inline -: GL_READ_BUFFER HEX: 0C02 ; inline -: GL_DRAW_BUFFER HEX: 0C01 ; inline -: GL_DOUBLEBUFFER HEX: 0C32 ; inline -: GL_STEREO HEX: 0C33 ; inline -: GL_BITMAP HEX: 1A00 ; inline -: GL_COLOR HEX: 1800 ; inline -: GL_DEPTH HEX: 1801 ; inline -: GL_STENCIL HEX: 1802 ; inline -: GL_DITHER HEX: 0BD0 ; inline -: GL_RGB HEX: 1907 ; inline -: GL_RGBA HEX: 1908 ; inline +CONSTANT: GL_NONE HEX: 0 +CONSTANT: GL_LEFT HEX: 0406 +CONSTANT: GL_RIGHT HEX: 0407 + +CONSTANT: GL_FRONT_RIGHT HEX: 0401 +CONSTANT: GL_BACK_LEFT HEX: 0402 +CONSTANT: GL_BACK_RIGHT HEX: 0403 +CONSTANT: GL_AUX0 HEX: 0409 +CONSTANT: GL_AUX1 HEX: 040A +CONSTANT: GL_AUX2 HEX: 040B +CONSTANT: GL_AUX3 HEX: 040C +CONSTANT: GL_COLOR_INDEX HEX: 1900 +CONSTANT: GL_RED HEX: 1903 +CONSTANT: GL_GREEN HEX: 1904 +CONSTANT: GL_BLUE HEX: 1905 +CONSTANT: GL_ALPHA HEX: 1906 +CONSTANT: GL_LUMINANCE HEX: 1909 +CONSTANT: GL_LUMINANCE_ALPHA HEX: 190A +CONSTANT: GL_ALPHA_BITS HEX: 0D55 +CONSTANT: GL_RED_BITS HEX: 0D52 +CONSTANT: GL_GREEN_BITS HEX: 0D53 +CONSTANT: GL_BLUE_BITS HEX: 0D54 +CONSTANT: GL_INDEX_BITS HEX: 0D51 +CONSTANT: GL_SUBPIXEL_BITS HEX: 0D50 +CONSTANT: GL_AUX_BUFFERS HEX: 0C00 +CONSTANT: GL_READ_BUFFER HEX: 0C02 +CONSTANT: GL_DRAW_BUFFER HEX: 0C01 +CONSTANT: GL_DOUBLEBUFFER HEX: 0C32 +CONSTANT: GL_STEREO HEX: 0C33 +CONSTANT: GL_BITMAP HEX: 1A00 +CONSTANT: GL_COLOR HEX: 1800 +CONSTANT: GL_DEPTH HEX: 1801 +CONSTANT: GL_STENCIL HEX: 1802 +CONSTANT: GL_DITHER HEX: 0BD0 +CONSTANT: GL_RGB HEX: 1907 +CONSTANT: GL_RGBA HEX: 1908 ! Implementation limits -: GL_MAX_LIST_NESTING HEX: 0B31 ; inline -: GL_MAX_ATTRIB_STACK_DEPTH HEX: 0D35 ; inline -: GL_MAX_MODELVIEW_STACK_DEPTH HEX: 0D36 ; inline -: GL_MAX_NAME_STACK_DEPTH HEX: 0D37 ; inline -: GL_MAX_PROJECTION_STACK_DEPTH HEX: 0D38 ; inline -: GL_MAX_TEXTURE_STACK_DEPTH HEX: 0D39 ; inline -: GL_MAX_EVAL_ORDER HEX: 0D30 ; inline -: GL_MAX_LIGHTS HEX: 0D31 ; inline -: GL_MAX_CLIP_PLANES HEX: 0D32 ; inline -: GL_MAX_TEXTURE_SIZE HEX: 0D33 ; inline -: GL_MAX_PIXEL_MAP_TABLE HEX: 0D34 ; inline -: GL_MAX_VIEWPORT_DIMS HEX: 0D3A ; inline -: GL_MAX_CLIENT_ATTRIB_STACK_DEPTH HEX: 0D3B ; inline +CONSTANT: GL_MAX_LIST_NESTING HEX: 0B31 +CONSTANT: GL_MAX_ATTRIB_STACK_DEPTH HEX: 0D35 +CONSTANT: GL_MAX_MODELVIEW_STACK_DEPTH HEX: 0D36 +CONSTANT: GL_MAX_NAME_STACK_DEPTH HEX: 0D37 +CONSTANT: GL_MAX_PROJECTION_STACK_DEPTH HEX: 0D38 +CONSTANT: GL_MAX_TEXTURE_STACK_DEPTH HEX: 0D39 +CONSTANT: GL_MAX_EVAL_ORDER HEX: 0D30 +CONSTANT: GL_MAX_LIGHTS HEX: 0D31 +CONSTANT: GL_MAX_CLIP_PLANES HEX: 0D32 +CONSTANT: GL_MAX_TEXTURE_SIZE HEX: 0D33 +CONSTANT: GL_MAX_PIXEL_MAP_TABLE HEX: 0D34 +CONSTANT: GL_MAX_VIEWPORT_DIMS HEX: 0D3A +CONSTANT: GL_MAX_CLIENT_ATTRIB_STACK_DEPTH HEX: 0D3B ! Gets -: GL_ATTRIB_STACK_DEPTH HEX: 0BB0 ; inline -: GL_CLIENT_ATTRIB_STACK_DEPTH HEX: 0BB1 ; inline -: GL_COLOR_CLEAR_VALUE HEX: 0C22 ; inline -: GL_COLOR_WRITEMASK HEX: 0C23 ; inline -: GL_CURRENT_INDEX HEX: 0B01 ; inline -: GL_CURRENT_COLOR HEX: 0B00 ; inline -: GL_CURRENT_NORMAL HEX: 0B02 ; inline -: GL_CURRENT_RASTER_COLOR HEX: 0B04 ; inline -: GL_CURRENT_RASTER_DISTANCE HEX: 0B09 ; inline -: GL_CURRENT_RASTER_INDEX HEX: 0B05 ; inline -: GL_CURRENT_RASTER_POSITION HEX: 0B07 ; inline -: GL_CURRENT_RASTER_TEXTURE_COORDS HEX: 0B06 ; inline -: GL_CURRENT_RASTER_POSITION_VALID HEX: 0B08 ; inline -: GL_CURRENT_TEXTURE_COORDS HEX: 0B03 ; inline -: GL_INDEX_CLEAR_VALUE HEX: 0C20 ; inline -: GL_INDEX_MODE HEX: 0C30 ; inline -: GL_INDEX_WRITEMASK HEX: 0C21 ; inline -: GL_MODELVIEW_MATRIX HEX: 0BA6 ; inline -: GL_MODELVIEW_STACK_DEPTH HEX: 0BA3 ; inline -: GL_NAME_STACK_DEPTH HEX: 0D70 ; inline -: GL_PROJECTION_MATRIX HEX: 0BA7 ; inline -: GL_PROJECTION_STACK_DEPTH HEX: 0BA4 ; inline -: GL_RENDER_MODE HEX: 0C40 ; inline -: GL_RGBA_MODE HEX: 0C31 ; inline -: GL_TEXTURE_MATRIX HEX: 0BA8 ; inline -: GL_TEXTURE_STACK_DEPTH HEX: 0BA5 ; inline -: GL_VIEWPORT HEX: 0BA2 ; inline +CONSTANT: GL_ATTRIB_STACK_DEPTH HEX: 0BB0 +CONSTANT: GL_CLIENT_ATTRIB_STACK_DEPTH HEX: 0BB1 +CONSTANT: GL_COLOR_CLEAR_VALUE HEX: 0C22 +CONSTANT: GL_COLOR_WRITEMASK HEX: 0C23 +CONSTANT: GL_CURRENT_INDEX HEX: 0B01 +CONSTANT: GL_CURRENT_COLOR HEX: 0B00 +CONSTANT: GL_CURRENT_NORMAL HEX: 0B02 +CONSTANT: GL_CURRENT_RASTER_COLOR HEX: 0B04 +CONSTANT: GL_CURRENT_RASTER_DISTANCE HEX: 0B09 +CONSTANT: GL_CURRENT_RASTER_INDEX HEX: 0B05 +CONSTANT: GL_CURRENT_RASTER_POSITION HEX: 0B07 +CONSTANT: GL_CURRENT_RASTER_TEXTURE_COORDS HEX: 0B06 +CONSTANT: GL_CURRENT_RASTER_POSITION_VALID HEX: 0B08 +CONSTANT: GL_CURRENT_TEXTURE_COORDS HEX: 0B03 +CONSTANT: GL_INDEX_CLEAR_VALUE HEX: 0C20 +CONSTANT: GL_INDEX_MODE HEX: 0C30 +CONSTANT: GL_INDEX_WRITEMASK HEX: 0C21 +CONSTANT: GL_MODELVIEW_MATRIX HEX: 0BA6 +CONSTANT: GL_MODELVIEW_STACK_DEPTH HEX: 0BA3 +CONSTANT: GL_NAME_STACK_DEPTH HEX: 0D70 +CONSTANT: GL_PROJECTION_MATRIX HEX: 0BA7 +CONSTANT: GL_PROJECTION_STACK_DEPTH HEX: 0BA4 +CONSTANT: GL_RENDER_MODE HEX: 0C40 +CONSTANT: GL_RGBA_MODE HEX: 0C31 +CONSTANT: GL_TEXTURE_MATRIX HEX: 0BA8 +CONSTANT: GL_TEXTURE_STACK_DEPTH HEX: 0BA5 +CONSTANT: GL_VIEWPORT HEX: 0BA2 ! Evaluators inline -: GL_AUTO_NORMAL HEX: 0D80 ; inline -: GL_MAP1_COLOR_4 HEX: 0D90 ; inline -: GL_MAP1_INDEX HEX: 0D91 ; inline -: GL_MAP1_NORMAL HEX: 0D92 ; inline -: GL_MAP1_TEXTURE_COORD_1 HEX: 0D93 ; inline -: GL_MAP1_TEXTURE_COORD_2 HEX: 0D94 ; inline -: GL_MAP1_TEXTURE_COORD_3 HEX: 0D95 ; inline -: GL_MAP1_TEXTURE_COORD_4 HEX: 0D96 ; inline -: GL_MAP1_VERTEX_3 HEX: 0D97 ; inline -: GL_MAP1_VERTEX_4 HEX: 0D98 ; inline -: GL_MAP2_COLOR_4 HEX: 0DB0 ; inline -: GL_MAP2_INDEX HEX: 0DB1 ; inline -: GL_MAP2_NORMAL HEX: 0DB2 ; inline -: GL_MAP2_TEXTURE_COORD_1 HEX: 0DB3 ; inline -: GL_MAP2_TEXTURE_COORD_2 HEX: 0DB4 ; inline -: GL_MAP2_TEXTURE_COORD_3 HEX: 0DB5 ; inline -: GL_MAP2_TEXTURE_COORD_4 HEX: 0DB6 ; inline -: GL_MAP2_VERTEX_3 HEX: 0DB7 ; inline -: GL_MAP2_VERTEX_4 HEX: 0DB8 ; inline -: GL_MAP1_GRID_DOMAIN HEX: 0DD0 ; inline -: GL_MAP1_GRID_SEGMENTS HEX: 0DD1 ; inline -: GL_MAP2_GRID_DOMAIN HEX: 0DD2 ; inline -: GL_MAP2_GRID_SEGMENTS HEX: 0DD3 ; inline -: GL_COEFF HEX: 0A00 ; inline -: GL_DOMAIN HEX: 0A02 ; inline -: GL_ORDER HEX: 0A01 ; inline +CONSTANT: GL_AUTO_NORMAL HEX: 0D80 +CONSTANT: GL_MAP1_COLOR_4 HEX: 0D90 +CONSTANT: GL_MAP1_INDEX HEX: 0D91 +CONSTANT: GL_MAP1_NORMAL HEX: 0D92 +CONSTANT: GL_MAP1_TEXTURE_COORD_1 HEX: 0D93 +CONSTANT: GL_MAP1_TEXTURE_COORD_2 HEX: 0D94 +CONSTANT: GL_MAP1_TEXTURE_COORD_3 HEX: 0D95 +CONSTANT: GL_MAP1_TEXTURE_COORD_4 HEX: 0D96 +CONSTANT: GL_MAP1_VERTEX_3 HEX: 0D97 +CONSTANT: GL_MAP1_VERTEX_4 HEX: 0D98 +CONSTANT: GL_MAP2_COLOR_4 HEX: 0DB0 +CONSTANT: GL_MAP2_INDEX HEX: 0DB1 +CONSTANT: GL_MAP2_NORMAL HEX: 0DB2 +CONSTANT: GL_MAP2_TEXTURE_COORD_1 HEX: 0DB3 +CONSTANT: GL_MAP2_TEXTURE_COORD_2 HEX: 0DB4 +CONSTANT: GL_MAP2_TEXTURE_COORD_3 HEX: 0DB5 +CONSTANT: GL_MAP2_TEXTURE_COORD_4 HEX: 0DB6 +CONSTANT: GL_MAP2_VERTEX_3 HEX: 0DB7 +CONSTANT: GL_MAP2_VERTEX_4 HEX: 0DB8 +CONSTANT: GL_MAP1_GRID_DOMAIN HEX: 0DD0 +CONSTANT: GL_MAP1_GRID_SEGMENTS HEX: 0DD1 +CONSTANT: GL_MAP2_GRID_DOMAIN HEX: 0DD2 +CONSTANT: GL_MAP2_GRID_SEGMENTS HEX: 0DD3 +CONSTANT: GL_COEFF HEX: 0A00 +CONSTANT: GL_DOMAIN HEX: 0A02 +CONSTANT: GL_ORDER HEX: 0A01 ! Hints inline -: GL_FOG_HINT HEX: 0C54 ; inline -: GL_LINE_SMOOTH_HINT HEX: 0C52 ; inline -: GL_PERSPECTIVE_CORRECTION_HINT HEX: 0C50 ; inline -: GL_POINT_SMOOTH_HINT HEX: 0C51 ; inline -: GL_POLYGON_SMOOTH_HINT HEX: 0C53 ; inline -: GL_DONT_CARE HEX: 1100 ; inline -: GL_FASTEST HEX: 1101 ; inline -: GL_NICEST HEX: 1102 ; inline +CONSTANT: GL_FOG_HINT HEX: 0C54 +CONSTANT: GL_LINE_SMOOTH_HINT HEX: 0C52 +CONSTANT: GL_PERSPECTIVE_CORRECTION_HINT HEX: 0C50 +CONSTANT: GL_POINT_SMOOTH_HINT HEX: 0C51 +CONSTANT: GL_POLYGON_SMOOTH_HINT HEX: 0C53 +CONSTANT: GL_DONT_CARE HEX: 1100 +CONSTANT: GL_FASTEST HEX: 1101 +CONSTANT: GL_NICEST HEX: 1102 ! Scissor box inline -: GL_SCISSOR_TEST HEX: 0C11 ; inline -: GL_SCISSOR_BOX HEX: 0C10 ; inline +CONSTANT: GL_SCISSOR_TEST HEX: 0C11 +CONSTANT: GL_SCISSOR_BOX HEX: 0C10 ! Pixel Mode / Transfer inline -: GL_MAP_COLOR HEX: 0D10 ; inline -: GL_MAP_STENCIL HEX: 0D11 ; inline -: GL_INDEX_SHIFT HEX: 0D12 ; inline -: GL_INDEX_OFFSET HEX: 0D13 ; inline -: GL_RED_SCALE HEX: 0D14 ; inline -: GL_RED_BIAS HEX: 0D15 ; inline -: GL_GREEN_SCALE HEX: 0D18 ; inline -: GL_GREEN_BIAS HEX: 0D19 ; inline -: GL_BLUE_SCALE HEX: 0D1A ; inline -: GL_BLUE_BIAS HEX: 0D1B ; inline -: GL_ALPHA_SCALE HEX: 0D1C ; inline -: GL_ALPHA_BIAS HEX: 0D1D ; inline -: GL_DEPTH_SCALE HEX: 0D1E ; inline -: GL_DEPTH_BIAS HEX: 0D1F ; inline -: GL_PIXEL_MAP_S_TO_S_SIZE HEX: 0CB1 ; inline -: GL_PIXEL_MAP_I_TO_I_SIZE HEX: 0CB0 ; inline -: GL_PIXEL_MAP_I_TO_R_SIZE HEX: 0CB2 ; inline -: GL_PIXEL_MAP_I_TO_G_SIZE HEX: 0CB3 ; inline -: GL_PIXEL_MAP_I_TO_B_SIZE HEX: 0CB4 ; inline -: GL_PIXEL_MAP_I_TO_A_SIZE HEX: 0CB5 ; inline -: GL_PIXEL_MAP_R_TO_R_SIZE HEX: 0CB6 ; inline -: GL_PIXEL_MAP_G_TO_G_SIZE HEX: 0CB7 ; inline -: GL_PIXEL_MAP_B_TO_B_SIZE HEX: 0CB8 ; inline -: GL_PIXEL_MAP_A_TO_A_SIZE HEX: 0CB9 ; inline -: GL_PIXEL_MAP_S_TO_S HEX: 0C71 ; inline -: GL_PIXEL_MAP_I_TO_I HEX: 0C70 ; inline -: GL_PIXEL_MAP_I_TO_R HEX: 0C72 ; inline -: GL_PIXEL_MAP_I_TO_G HEX: 0C73 ; inline -: GL_PIXEL_MAP_I_TO_B HEX: 0C74 ; inline -: GL_PIXEL_MAP_I_TO_A HEX: 0C75 ; inline -: GL_PIXEL_MAP_R_TO_R HEX: 0C76 ; inline -: GL_PIXEL_MAP_G_TO_G HEX: 0C77 ; inline -: GL_PIXEL_MAP_B_TO_B HEX: 0C78 ; inline -: GL_PIXEL_MAP_A_TO_A HEX: 0C79 ; inline -: GL_PACK_ALIGNMENT HEX: 0D05 ; inline -: GL_PACK_LSB_FIRST HEX: 0D01 ; inline -: GL_PACK_ROW_LENGTH HEX: 0D02 ; inline -: GL_PACK_SKIP_PIXELS HEX: 0D04 ; inline -: GL_PACK_SKIP_ROWS HEX: 0D03 ; inline -: GL_PACK_SWAP_BYTES HEX: 0D00 ; inline -: GL_UNPACK_ALIGNMENT HEX: 0CF5 ; inline -: GL_UNPACK_LSB_FIRST HEX: 0CF1 ; inline -: GL_UNPACK_ROW_LENGTH HEX: 0CF2 ; inline -: GL_UNPACK_SKIP_PIXELS HEX: 0CF4 ; inline -: GL_UNPACK_SKIP_ROWS HEX: 0CF3 ; inline -: GL_UNPACK_SWAP_BYTES HEX: 0CF0 ; inline -: GL_ZOOM_X HEX: 0D16 ; inline -: GL_ZOOM_Y HEX: 0D17 ; inline +CONSTANT: GL_MAP_COLOR HEX: 0D10 +CONSTANT: GL_MAP_STENCIL HEX: 0D11 +CONSTANT: GL_INDEX_SHIFT HEX: 0D12 +CONSTANT: GL_INDEX_OFFSET HEX: 0D13 +CONSTANT: GL_RED_SCALE HEX: 0D14 +CONSTANT: GL_RED_BIAS HEX: 0D15 +CONSTANT: GL_GREEN_SCALE HEX: 0D18 +CONSTANT: GL_GREEN_BIAS HEX: 0D19 +CONSTANT: GL_BLUE_SCALE HEX: 0D1A +CONSTANT: GL_BLUE_BIAS HEX: 0D1B +CONSTANT: GL_ALPHA_SCALE HEX: 0D1C +CONSTANT: GL_ALPHA_BIAS HEX: 0D1D +CONSTANT: GL_DEPTH_SCALE HEX: 0D1E +CONSTANT: GL_DEPTH_BIAS HEX: 0D1F +CONSTANT: GL_PIXEL_MAP_S_TO_S_SIZE HEX: 0CB1 +CONSTANT: GL_PIXEL_MAP_I_TO_I_SIZE HEX: 0CB0 +CONSTANT: GL_PIXEL_MAP_I_TO_R_SIZE HEX: 0CB2 +CONSTANT: GL_PIXEL_MAP_I_TO_G_SIZE HEX: 0CB3 +CONSTANT: GL_PIXEL_MAP_I_TO_B_SIZE HEX: 0CB4 +CONSTANT: GL_PIXEL_MAP_I_TO_A_SIZE HEX: 0CB5 +CONSTANT: GL_PIXEL_MAP_R_TO_R_SIZE HEX: 0CB6 +CONSTANT: GL_PIXEL_MAP_G_TO_G_SIZE HEX: 0CB7 +CONSTANT: GL_PIXEL_MAP_B_TO_B_SIZE HEX: 0CB8 +CONSTANT: GL_PIXEL_MAP_A_TO_A_SIZE HEX: 0CB9 +CONSTANT: GL_PIXEL_MAP_S_TO_S HEX: 0C71 +CONSTANT: GL_PIXEL_MAP_I_TO_I HEX: 0C70 +CONSTANT: GL_PIXEL_MAP_I_TO_R HEX: 0C72 +CONSTANT: GL_PIXEL_MAP_I_TO_G HEX: 0C73 +CONSTANT: GL_PIXEL_MAP_I_TO_B HEX: 0C74 +CONSTANT: GL_PIXEL_MAP_I_TO_A HEX: 0C75 +CONSTANT: GL_PIXEL_MAP_R_TO_R HEX: 0C76 +CONSTANT: GL_PIXEL_MAP_G_TO_G HEX: 0C77 +CONSTANT: GL_PIXEL_MAP_B_TO_B HEX: 0C78 +CONSTANT: GL_PIXEL_MAP_A_TO_A HEX: 0C79 +CONSTANT: GL_PACK_ALIGNMENT HEX: 0D05 +CONSTANT: GL_PACK_LSB_FIRST HEX: 0D01 +CONSTANT: GL_PACK_ROW_LENGTH HEX: 0D02 +CONSTANT: GL_PACK_SKIP_PIXELS HEX: 0D04 +CONSTANT: GL_PACK_SKIP_ROWS HEX: 0D03 +CONSTANT: GL_PACK_SWAP_BYTES HEX: 0D00 +CONSTANT: GL_UNPACK_ALIGNMENT HEX: 0CF5 +CONSTANT: GL_UNPACK_LSB_FIRST HEX: 0CF1 +CONSTANT: GL_UNPACK_ROW_LENGTH HEX: 0CF2 +CONSTANT: GL_UNPACK_SKIP_PIXELS HEX: 0CF4 +CONSTANT: GL_UNPACK_SKIP_ROWS HEX: 0CF3 +CONSTANT: GL_UNPACK_SWAP_BYTES HEX: 0CF0 +CONSTANT: GL_ZOOM_X HEX: 0D16 +CONSTANT: GL_ZOOM_Y HEX: 0D17 ! Texture mapping inline -: GL_TEXTURE_ENV HEX: 2300 ; inline -: GL_TEXTURE_ENV_MODE HEX: 2200 ; inline -: GL_TEXTURE_1D HEX: 0DE0 ; inline -: GL_TEXTURE_2D HEX: 0DE1 ; inline -: GL_TEXTURE_WRAP_S HEX: 2802 ; inline -: GL_TEXTURE_WRAP_T HEX: 2803 ; inline -: GL_TEXTURE_MAG_FILTER HEX: 2800 ; inline -: GL_TEXTURE_MIN_FILTER HEX: 2801 ; inline -: GL_TEXTURE_ENV_COLOR HEX: 2201 ; inline -: GL_TEXTURE_GEN_S HEX: 0C60 ; inline -: GL_TEXTURE_GEN_T HEX: 0C61 ; inline -: GL_TEXTURE_GEN_MODE HEX: 2500 ; inline -: GL_TEXTURE_BORDER_COLOR HEX: 1004 ; inline -: GL_TEXTURE_WIDTH HEX: 1000 ; inline -: GL_TEXTURE_HEIGHT HEX: 1001 ; inline -: GL_TEXTURE_BORDER HEX: 1005 ; inline -: GL_TEXTURE_COMPONENTS HEX: 1003 ; inline -: GL_TEXTURE_RED_SIZE HEX: 805C ; inline -: GL_TEXTURE_GREEN_SIZE HEX: 805D ; inline -: GL_TEXTURE_BLUE_SIZE HEX: 805E ; inline -: GL_TEXTURE_ALPHA_SIZE HEX: 805F ; inline -: GL_TEXTURE_LUMINANCE_SIZE HEX: 8060 ; inline -: GL_TEXTURE_INTENSITY_SIZE HEX: 8061 ; inline -: GL_NEAREST_MIPMAP_NEAREST HEX: 2700 ; inline -: GL_NEAREST_MIPMAP_LINEAR HEX: 2702 ; inline -: GL_LINEAR_MIPMAP_NEAREST HEX: 2701 ; inline -: GL_LINEAR_MIPMAP_LINEAR HEX: 2703 ; inline -: GL_OBJECT_LINEAR HEX: 2401 ; inline -: GL_OBJECT_PLANE HEX: 2501 ; inline -: GL_EYE_LINEAR HEX: 2400 ; inline -: GL_EYE_PLANE HEX: 2502 ; inline -: GL_SPHERE_MAP HEX: 2402 ; inline -: GL_DECAL HEX: 2101 ; inline -: GL_MODULATE HEX: 2100 ; inline -: GL_NEAREST HEX: 2600 ; inline -: GL_REPEAT HEX: 2901 ; inline -: GL_CLAMP HEX: 2900 ; inline -: GL_S HEX: 2000 ; inline -: GL_T HEX: 2001 ; inline -: GL_R HEX: 2002 ; inline -: GL_Q HEX: 2003 ; inline -: GL_TEXTURE_GEN_R HEX: 0C62 ; inline -: GL_TEXTURE_GEN_Q HEX: 0C63 ; inline +CONSTANT: GL_TEXTURE_ENV HEX: 2300 +CONSTANT: GL_TEXTURE_ENV_MODE HEX: 2200 +CONSTANT: GL_TEXTURE_1D HEX: 0DE0 +CONSTANT: GL_TEXTURE_2D HEX: 0DE1 +CONSTANT: GL_TEXTURE_WRAP_S HEX: 2802 +CONSTANT: GL_TEXTURE_WRAP_T HEX: 2803 +CONSTANT: GL_TEXTURE_MAG_FILTER HEX: 2800 +CONSTANT: GL_TEXTURE_MIN_FILTER HEX: 2801 +CONSTANT: GL_TEXTURE_ENV_COLOR HEX: 2201 +CONSTANT: GL_TEXTURE_GEN_S HEX: 0C60 +CONSTANT: GL_TEXTURE_GEN_T HEX: 0C61 +CONSTANT: GL_TEXTURE_GEN_MODE HEX: 2500 +CONSTANT: GL_TEXTURE_BORDER_COLOR HEX: 1004 +CONSTANT: GL_TEXTURE_WIDTH HEX: 1000 +CONSTANT: GL_TEXTURE_HEIGHT HEX: 1001 +CONSTANT: GL_TEXTURE_BORDER HEX: 1005 +CONSTANT: GL_TEXTURE_COMPONENTS HEX: 1003 +CONSTANT: GL_TEXTURE_RED_SIZE HEX: 805C +CONSTANT: GL_TEXTURE_GREEN_SIZE HEX: 805D +CONSTANT: GL_TEXTURE_BLUE_SIZE HEX: 805E +CONSTANT: GL_TEXTURE_ALPHA_SIZE HEX: 805F +CONSTANT: GL_TEXTURE_LUMINANCE_SIZE HEX: 8060 +CONSTANT: GL_TEXTURE_INTENSITY_SIZE HEX: 8061 +CONSTANT: GL_NEAREST_MIPMAP_NEAREST HEX: 2700 +CONSTANT: GL_NEAREST_MIPMAP_LINEAR HEX: 2702 +CONSTANT: GL_LINEAR_MIPMAP_NEAREST HEX: 2701 +CONSTANT: GL_LINEAR_MIPMAP_LINEAR HEX: 2703 +CONSTANT: GL_OBJECT_LINEAR HEX: 2401 +CONSTANT: GL_OBJECT_PLANE HEX: 2501 +CONSTANT: GL_EYE_LINEAR HEX: 2400 +CONSTANT: GL_EYE_PLANE HEX: 2502 +CONSTANT: GL_SPHERE_MAP HEX: 2402 +CONSTANT: GL_DECAL HEX: 2101 +CONSTANT: GL_MODULATE HEX: 2100 +CONSTANT: GL_NEAREST HEX: 2600 +CONSTANT: GL_REPEAT HEX: 2901 +CONSTANT: GL_CLAMP HEX: 2900 +CONSTANT: GL_S HEX: 2000 +CONSTANT: GL_T HEX: 2001 +CONSTANT: GL_R HEX: 2002 +CONSTANT: GL_Q HEX: 2003 +CONSTANT: GL_TEXTURE_GEN_R HEX: 0C62 +CONSTANT: GL_TEXTURE_GEN_Q HEX: 0C63 ! Utility inline -: GL_VENDOR HEX: 1F00 ; inline -: GL_RENDERER HEX: 1F01 ; inline -: GL_VERSION HEX: 1F02 ; inline -: GL_EXTENSIONS HEX: 1F03 ; inline +CONSTANT: GL_VENDOR HEX: 1F00 +CONSTANT: GL_RENDERER HEX: 1F01 +CONSTANT: GL_VERSION HEX: 1F02 +CONSTANT: GL_EXTENSIONS HEX: 1F03 ! Errors inline -: GL_NO_ERROR HEX: 0 ; inline -: GL_INVALID_VALUE HEX: 0501 ; inline -: GL_INVALID_ENUM HEX: 0500 ; inline -: GL_INVALID_OPERATION HEX: 0502 ; inline -: GL_STACK_OVERFLOW HEX: 0503 ; inline -: GL_STACK_UNDERFLOW HEX: 0504 ; inline -: GL_OUT_OF_MEMORY HEX: 0505 ; inline +CONSTANT: GL_NO_ERROR HEX: 0 +CONSTANT: GL_INVALID_VALUE HEX: 0501 +CONSTANT: GL_INVALID_ENUM HEX: 0500 +CONSTANT: GL_INVALID_OPERATION HEX: 0502 +CONSTANT: GL_STACK_OVERFLOW HEX: 0503 +CONSTANT: GL_STACK_UNDERFLOW HEX: 0504 +CONSTANT: GL_OUT_OF_MEMORY HEX: 0505 ! glPush/PopAttrib bits -: GL_CURRENT_BIT HEX: 00000001 ; inline -: GL_POINT_BIT HEX: 00000002 ; inline -: GL_LINE_BIT HEX: 00000004 ; inline -: GL_POLYGON_BIT HEX: 00000008 ; inline -: GL_POLYGON_STIPPLE_BIT HEX: 00000010 ; inline -: GL_PIXEL_MODE_BIT HEX: 00000020 ; inline -: GL_LIGHTING_BIT HEX: 00000040 ; inline -: GL_FOG_BIT HEX: 00000080 ; inline -: GL_DEPTH_BUFFER_BIT HEX: 00000100 ; inline -: GL_ACCUM_BUFFER_BIT HEX: 00000200 ; inline -: GL_STENCIL_BUFFER_BIT HEX: 00000400 ; inline -: GL_VIEWPORT_BIT HEX: 00000800 ; inline -: GL_TRANSFORM_BIT HEX: 00001000 ; inline -: GL_ENABLE_BIT HEX: 00002000 ; inline -: GL_COLOR_BUFFER_BIT HEX: 00004000 ; inline -: GL_HINT_BIT HEX: 00008000 ; inline -: GL_EVAL_BIT HEX: 00010000 ; inline -: GL_LIST_BIT HEX: 00020000 ; inline -: GL_TEXTURE_BIT HEX: 00040000 ; inline -: GL_SCISSOR_BIT HEX: 00080000 ; inline -: GL_ALL_ATTRIB_BITS HEX: 000FFFFF ; inline +CONSTANT: GL_CURRENT_BIT HEX: 00000001 +CONSTANT: GL_POINT_BIT HEX: 00000002 +CONSTANT: GL_LINE_BIT HEX: 00000004 +CONSTANT: GL_POLYGON_BIT HEX: 00000008 +CONSTANT: GL_POLYGON_STIPPLE_BIT HEX: 00000010 +CONSTANT: GL_PIXEL_MODE_BIT HEX: 00000020 +CONSTANT: GL_LIGHTING_BIT HEX: 00000040 +CONSTANT: GL_FOG_BIT HEX: 00000080 +CONSTANT: GL_DEPTH_BUFFER_BIT HEX: 00000100 +CONSTANT: GL_ACCUM_BUFFER_BIT HEX: 00000200 +CONSTANT: GL_STENCIL_BUFFER_BIT HEX: 00000400 +CONSTANT: GL_VIEWPORT_BIT HEX: 00000800 +CONSTANT: GL_TRANSFORM_BIT HEX: 00001000 +CONSTANT: GL_ENABLE_BIT HEX: 00002000 +CONSTANT: GL_COLOR_BUFFER_BIT HEX: 00004000 +CONSTANT: GL_HINT_BIT HEX: 00008000 +CONSTANT: GL_EVAL_BIT HEX: 00010000 +CONSTANT: GL_LIST_BIT HEX: 00020000 +CONSTANT: GL_TEXTURE_BIT HEX: 00040000 +CONSTANT: GL_SCISSOR_BIT HEX: 00080000 +CONSTANT: GL_ALL_ATTRIB_BITS HEX: 000FFFFF ! OpenGL 1.1 -: GL_PROXY_TEXTURE_1D HEX: 8063 ; inline -: GL_PROXY_TEXTURE_2D HEX: 8064 ; inline -: GL_TEXTURE_PRIORITY HEX: 8066 ; inline -: GL_TEXTURE_RESIDENT HEX: 8067 ; inline -: GL_TEXTURE_BINDING_1D HEX: 8068 ; inline -: GL_TEXTURE_BINDING_2D HEX: 8069 ; inline -: GL_TEXTURE_INTERNAL_FORMAT HEX: 1003 ; inline -: GL_ALPHA4 HEX: 803B ; inline -: GL_ALPHA8 HEX: 803C ; inline -: GL_ALPHA12 HEX: 803D ; inline -: GL_ALPHA16 HEX: 803E ; inline -: GL_LUMINANCE4 HEX: 803F ; inline -: GL_LUMINANCE8 HEX: 8040 ; inline -: GL_LUMINANCE12 HEX: 8041 ; inline -: GL_LUMINANCE16 HEX: 8042 ; inline -: GL_LUMINANCE4_ALPHA4 HEX: 8043 ; inline -: GL_LUMINANCE6_ALPHA2 HEX: 8044 ; inline -: GL_LUMINANCE8_ALPHA8 HEX: 8045 ; inline -: GL_LUMINANCE12_ALPHA4 HEX: 8046 ; inline -: GL_LUMINANCE12_ALPHA12 HEX: 8047 ; inline -: GL_LUMINANCE16_ALPHA16 HEX: 8048 ; inline -: GL_INTENSITY HEX: 8049 ; inline -: GL_INTENSITY4 HEX: 804A ; inline -: GL_INTENSITY8 HEX: 804B ; inline -: GL_INTENSITY12 HEX: 804C ; inline -: GL_INTENSITY16 HEX: 804D ; inline -: GL_R3_G3_B2 HEX: 2A10 ; inline -: GL_RGB4 HEX: 804F ; inline -: GL_RGB5 HEX: 8050 ; inline -: GL_RGB8 HEX: 8051 ; inline -: GL_RGB10 HEX: 8052 ; inline -: GL_RGB12 HEX: 8053 ; inline -: GL_RGB16 HEX: 8054 ; inline -: GL_RGBA2 HEX: 8055 ; inline -: GL_RGBA4 HEX: 8056 ; inline -: GL_RGB5_A1 HEX: 8057 ; inline -: GL_RGBA8 HEX: 8058 ; inline -: GL_RGB10_A2 HEX: 8059 ; inline -: GL_RGBA12 HEX: 805A ; inline -: GL_RGBA16 HEX: 805B ; inline -: GL_CLIENT_PIXEL_STORE_BIT HEX: 00000001 ; inline -: GL_CLIENT_VERTEX_ARRAY_BIT HEX: 00000002 ; inline -: GL_ALL_CLIENT_ATTRIB_BITS HEX: FFFFFFFF ; inline -: GL_CLIENT_ALL_ATTRIB_BITS HEX: FFFFFFFF ; inline +CONSTANT: GL_PROXY_TEXTURE_1D HEX: 8063 +CONSTANT: GL_PROXY_TEXTURE_2D HEX: 8064 +CONSTANT: GL_TEXTURE_PRIORITY HEX: 8066 +CONSTANT: GL_TEXTURE_RESIDENT HEX: 8067 +CONSTANT: GL_TEXTURE_BINDING_1D HEX: 8068 +CONSTANT: GL_TEXTURE_BINDING_2D HEX: 8069 +CONSTANT: GL_TEXTURE_INTERNAL_FORMAT HEX: 1003 +CONSTANT: GL_ALPHA4 HEX: 803B +CONSTANT: GL_ALPHA8 HEX: 803C +CONSTANT: GL_ALPHA12 HEX: 803D +CONSTANT: GL_ALPHA16 HEX: 803E +CONSTANT: GL_LUMINANCE4 HEX: 803F +CONSTANT: GL_LUMINANCE8 HEX: 8040 +CONSTANT: GL_LUMINANCE12 HEX: 8041 +CONSTANT: GL_LUMINANCE16 HEX: 8042 +CONSTANT: GL_LUMINANCE4_ALPHA4 HEX: 8043 +CONSTANT: GL_LUMINANCE6_ALPHA2 HEX: 8044 +CONSTANT: GL_LUMINANCE8_ALPHA8 HEX: 8045 +CONSTANT: GL_LUMINANCE12_ALPHA4 HEX: 8046 +CONSTANT: GL_LUMINANCE12_ALPHA12 HEX: 8047 +CONSTANT: GL_LUMINANCE16_ALPHA16 HEX: 8048 +CONSTANT: GL_INTENSITY HEX: 8049 +CONSTANT: GL_INTENSITY4 HEX: 804A +CONSTANT: GL_INTENSITY8 HEX: 804B +CONSTANT: GL_INTENSITY12 HEX: 804C +CONSTANT: GL_INTENSITY16 HEX: 804D +CONSTANT: GL_R3_G3_B2 HEX: 2A10 +CONSTANT: GL_RGB4 HEX: 804F +CONSTANT: GL_RGB5 HEX: 8050 +CONSTANT: GL_RGB8 HEX: 8051 +CONSTANT: GL_RGB10 HEX: 8052 +CONSTANT: GL_RGB12 HEX: 8053 +CONSTANT: GL_RGB16 HEX: 8054 +CONSTANT: GL_RGBA2 HEX: 8055 +CONSTANT: GL_RGBA4 HEX: 8056 +CONSTANT: GL_RGB5_A1 HEX: 8057 +CONSTANT: GL_RGBA8 HEX: 8058 +CONSTANT: GL_RGB10_A2 HEX: 8059 +CONSTANT: GL_RGBA12 HEX: 805A +CONSTANT: GL_RGBA16 HEX: 805B +CONSTANT: GL_CLIENT_PIXEL_STORE_BIT HEX: 00000001 +CONSTANT: GL_CLIENT_VERTEX_ARRAY_BIT HEX: 00000002 +CONSTANT: GL_ALL_CLIENT_ATTRIB_BITS HEX: FFFFFFFF +CONSTANT: GL_CLIENT_ALL_ATTRIB_BITS HEX: FFFFFFFF LIBRARY: gl @@ -1123,47 +1119,47 @@ FUNCTION: void glPopName ( ) ; ! OpenGL 1.2 -: GL_SMOOTH_POINT_SIZE_RANGE HEX: 0B12 ; inline -: GL_SMOOTH_POINT_SIZE_GRANULARITY HEX: 0B13 ; inline -: GL_SMOOTH_LINE_WIDTH_RANGE HEX: 0B22 ; inline -: GL_SMOOTH_LINE_WIDTH_GRANULARITY HEX: 0B23 ; inline -: GL_UNSIGNED_BYTE_3_3_2 HEX: 8032 ; inline -: GL_UNSIGNED_SHORT_4_4_4_4 HEX: 8033 ; inline -: GL_UNSIGNED_SHORT_5_5_5_1 HEX: 8034 ; inline -: GL_UNSIGNED_INT_8_8_8_8 HEX: 8035 ; inline -: GL_UNSIGNED_INT_10_10_10_2 HEX: 8036 ; inline -: GL_RESCALE_NORMAL HEX: 803A ; inline -: GL_TEXTURE_BINDING_3D HEX: 806A ; inline -: GL_PACK_SKIP_IMAGES HEX: 806B ; inline -: GL_PACK_IMAGE_HEIGHT HEX: 806C ; inline -: GL_UNPACK_SKIP_IMAGES HEX: 806D ; inline -: GL_UNPACK_IMAGE_HEIGHT HEX: 806E ; inline -: GL_TEXTURE_3D HEX: 806F ; inline -: GL_PROXY_TEXTURE_3D HEX: 8070 ; inline -: GL_TEXTURE_DEPTH HEX: 8071 ; inline -: GL_TEXTURE_WRAP_R HEX: 8072 ; inline -: GL_MAX_3D_TEXTURE_SIZE HEX: 8073 ; inline -: GL_BGR HEX: 80E0 ; inline -: GL_BGRA HEX: 80E1 ; inline -: GL_MAX_ELEMENTS_VERTICES HEX: 80E8 ; inline -: GL_MAX_ELEMENTS_INDICES HEX: 80E9 ; inline -: GL_CLAMP_TO_EDGE HEX: 812F ; inline -: GL_TEXTURE_MIN_LOD HEX: 813A ; inline -: GL_TEXTURE_MAX_LOD HEX: 813B ; inline -: GL_TEXTURE_BASE_LEVEL HEX: 813C ; inline -: GL_TEXTURE_MAX_LEVEL HEX: 813D ; inline -: GL_LIGHT_MODEL_COLOR_CONTROL HEX: 81F8 ; inline -: GL_SINGLE_COLOR HEX: 81F9 ; inline -: GL_SEPARATE_SPECULAR_COLOR HEX: 81FA ; inline -: GL_UNSIGNED_BYTE_2_3_3_REV HEX: 8362 ; inline -: GL_UNSIGNED_SHORT_5_6_5 HEX: 8363 ; inline -: GL_UNSIGNED_SHORT_5_6_5_REV HEX: 8364 ; inline -: GL_UNSIGNED_SHORT_4_4_4_4_REV HEX: 8365 ; inline -: GL_UNSIGNED_SHORT_1_5_5_5_REV HEX: 8366 ; inline -: GL_UNSIGNED_INT_8_8_8_8_REV HEX: 8367 ; inline -: GL_UNSIGNED_INT_2_10_10_10_REV HEX: 8368 ; inline -: GL_ALIASED_POINT_SIZE_RANGE HEX: 846D ; inline -: GL_ALIASED_LINE_WIDTH_RANGE HEX: 846E ; inline +CONSTANT: GL_SMOOTH_POINT_SIZE_RANGE HEX: 0B12 +CONSTANT: GL_SMOOTH_POINT_SIZE_GRANULARITY HEX: 0B13 +CONSTANT: GL_SMOOTH_LINE_WIDTH_RANGE HEX: 0B22 +CONSTANT: GL_SMOOTH_LINE_WIDTH_GRANULARITY HEX: 0B23 +CONSTANT: GL_UNSIGNED_BYTE_3_3_2 HEX: 8032 +CONSTANT: GL_UNSIGNED_SHORT_4_4_4_4 HEX: 8033 +CONSTANT: GL_UNSIGNED_SHORT_5_5_5_1 HEX: 8034 +CONSTANT: GL_UNSIGNED_INT_8_8_8_8 HEX: 8035 +CONSTANT: GL_UNSIGNED_INT_10_10_10_2 HEX: 8036 +CONSTANT: GL_RESCALE_NORMAL HEX: 803A +CONSTANT: GL_TEXTURE_BINDING_3D HEX: 806A +CONSTANT: GL_PACK_SKIP_IMAGES HEX: 806B +CONSTANT: GL_PACK_IMAGE_HEIGHT HEX: 806C +CONSTANT: GL_UNPACK_SKIP_IMAGES HEX: 806D +CONSTANT: GL_UNPACK_IMAGE_HEIGHT HEX: 806E +CONSTANT: GL_TEXTURE_3D HEX: 806F +CONSTANT: GL_PROXY_TEXTURE_3D HEX: 8070 +CONSTANT: GL_TEXTURE_DEPTH HEX: 8071 +CONSTANT: GL_TEXTURE_WRAP_R HEX: 8072 +CONSTANT: GL_MAX_3D_TEXTURE_SIZE HEX: 8073 +CONSTANT: GL_BGR HEX: 80E0 +CONSTANT: GL_BGRA HEX: 80E1 +CONSTANT: GL_MAX_ELEMENTS_VERTICES HEX: 80E8 +CONSTANT: GL_MAX_ELEMENTS_INDICES HEX: 80E9 +CONSTANT: GL_CLAMP_TO_EDGE HEX: 812F +CONSTANT: GL_TEXTURE_MIN_LOD HEX: 813A +CONSTANT: GL_TEXTURE_MAX_LOD HEX: 813B +CONSTANT: GL_TEXTURE_BASE_LEVEL HEX: 813C +CONSTANT: GL_TEXTURE_MAX_LEVEL HEX: 813D +CONSTANT: GL_LIGHT_MODEL_COLOR_CONTROL HEX: 81F8 +CONSTANT: GL_SINGLE_COLOR HEX: 81F9 +CONSTANT: GL_SEPARATE_SPECULAR_COLOR HEX: 81FA +CONSTANT: GL_UNSIGNED_BYTE_2_3_3_REV HEX: 8362 +CONSTANT: GL_UNSIGNED_SHORT_5_6_5 HEX: 8363 +CONSTANT: GL_UNSIGNED_SHORT_5_6_5_REV HEX: 8364 +CONSTANT: GL_UNSIGNED_SHORT_4_4_4_4_REV HEX: 8365 +CONSTANT: GL_UNSIGNED_SHORT_1_5_5_5_REV HEX: 8366 +CONSTANT: GL_UNSIGNED_INT_8_8_8_8_REV HEX: 8367 +CONSTANT: GL_UNSIGNED_INT_2_10_10_10_REV HEX: 8368 +CONSTANT: GL_ALIASED_POINT_SIZE_RANGE HEX: 846D +CONSTANT: GL_ALIASED_LINE_WIDTH_RANGE HEX: 846E GL-FUNCTION: void glCopyTexSubImage3D { glCopyTexSubImage3DEXT } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLint x, GLint y, GLsizei width, GLsizei height ) ; GL-FUNCTION: void glDrawRangeElements { glDrawRangeElementsEXT } ( GLenum mode, GLuint start, GLuint end, GLsizei count, GLenum type, GLvoid* indices ) ; @@ -1174,102 +1170,102 @@ GL-FUNCTION: void glTexSubImage3D { glTexSubImage3DEXT } ( GLenum target, GLint ! OpenGL 1.3 -: GL_MULTISAMPLE HEX: 809D ; inline -: GL_SAMPLE_ALPHA_TO_COVERAGE HEX: 809E ; inline -: GL_SAMPLE_ALPHA_TO_ONE HEX: 809F ; inline -: GL_SAMPLE_COVERAGE HEX: 80A0 ; inline -: GL_SAMPLE_BUFFERS HEX: 80A8 ; inline -: GL_SAMPLES HEX: 80A9 ; inline -: GL_SAMPLE_COVERAGE_VALUE HEX: 80AA ; inline -: GL_SAMPLE_COVERAGE_INVERT HEX: 80AB ; inline -: GL_CLAMP_TO_BORDER HEX: 812D ; inline -: GL_TEXTURE0 HEX: 84C0 ; inline -: GL_TEXTURE1 HEX: 84C1 ; inline -: GL_TEXTURE2 HEX: 84C2 ; inline -: GL_TEXTURE3 HEX: 84C3 ; inline -: GL_TEXTURE4 HEX: 84C4 ; inline -: GL_TEXTURE5 HEX: 84C5 ; inline -: GL_TEXTURE6 HEX: 84C6 ; inline -: GL_TEXTURE7 HEX: 84C7 ; inline -: GL_TEXTURE8 HEX: 84C8 ; inline -: GL_TEXTURE9 HEX: 84C9 ; inline -: GL_TEXTURE10 HEX: 84CA ; inline -: GL_TEXTURE11 HEX: 84CB ; inline -: GL_TEXTURE12 HEX: 84CC ; inline -: GL_TEXTURE13 HEX: 84CD ; inline -: GL_TEXTURE14 HEX: 84CE ; inline -: GL_TEXTURE15 HEX: 84CF ; inline -: GL_TEXTURE16 HEX: 84D0 ; inline -: GL_TEXTURE17 HEX: 84D1 ; inline -: GL_TEXTURE18 HEX: 84D2 ; inline -: GL_TEXTURE19 HEX: 84D3 ; inline -: GL_TEXTURE20 HEX: 84D4 ; inline -: GL_TEXTURE21 HEX: 84D5 ; inline -: GL_TEXTURE22 HEX: 84D6 ; inline -: GL_TEXTURE23 HEX: 84D7 ; inline -: GL_TEXTURE24 HEX: 84D8 ; inline -: GL_TEXTURE25 HEX: 84D9 ; inline -: GL_TEXTURE26 HEX: 84DA ; inline -: GL_TEXTURE27 HEX: 84DB ; inline -: GL_TEXTURE28 HEX: 84DC ; inline -: GL_TEXTURE29 HEX: 84DD ; inline -: GL_TEXTURE30 HEX: 84DE ; inline -: GL_TEXTURE31 HEX: 84DF ; inline -: GL_ACTIVE_TEXTURE HEX: 84E0 ; inline -: GL_CLIENT_ACTIVE_TEXTURE HEX: 84E1 ; inline -: GL_MAX_TEXTURE_UNITS HEX: 84E2 ; inline -: GL_TRANSPOSE_MODELVIEW_MATRIX HEX: 84E3 ; inline -: GL_TRANSPOSE_PROJECTION_MATRIX HEX: 84E4 ; inline -: GL_TRANSPOSE_TEXTURE_MATRIX HEX: 84E5 ; inline -: GL_TRANSPOSE_COLOR_MATRIX HEX: 84E6 ; inline -: GL_SUBTRACT HEX: 84E7 ; inline -: GL_COMPRESSED_ALPHA HEX: 84E9 ; inline -: GL_COMPRESSED_LUMINANCE HEX: 84EA ; inline -: GL_COMPRESSED_LUMINANCE_ALPHA HEX: 84EB ; inline -: GL_COMPRESSED_INTENSITY HEX: 84EC ; inline -: GL_COMPRESSED_RGB HEX: 84ED ; inline -: GL_COMPRESSED_RGBA HEX: 84EE ; inline -: GL_TEXTURE_COMPRESSION_HINT HEX: 84EF ; inline -: GL_NORMAL_MAP HEX: 8511 ; inline -: GL_REFLECTION_MAP HEX: 8512 ; inline -: GL_TEXTURE_CUBE_MAP HEX: 8513 ; inline -: GL_TEXTURE_BINDING_CUBE_MAP HEX: 8514 ; inline -: GL_TEXTURE_CUBE_MAP_POSITIVE_X HEX: 8515 ; inline -: GL_TEXTURE_CUBE_MAP_NEGATIVE_X HEX: 8516 ; inline -: GL_TEXTURE_CUBE_MAP_POSITIVE_Y HEX: 8517 ; inline -: GL_TEXTURE_CUBE_MAP_NEGATIVE_Y HEX: 8518 ; inline -: GL_TEXTURE_CUBE_MAP_POSITIVE_Z HEX: 8519 ; inline -: GL_TEXTURE_CUBE_MAP_NEGATIVE_Z HEX: 851A ; inline -: GL_PROXY_TEXTURE_CUBE_MAP HEX: 851B ; inline -: GL_MAX_CUBE_MAP_TEXTURE_SIZE HEX: 851C ; inline -: GL_COMBINE HEX: 8570 ; inline -: GL_COMBINE_RGB HEX: 8571 ; inline -: GL_COMBINE_ALPHA HEX: 8572 ; inline -: GL_RGB_SCALE HEX: 8573 ; inline -: GL_ADD_SIGNED HEX: 8574 ; inline -: GL_INTERPOLATE HEX: 8575 ; inline -: GL_CONSTANT HEX: 8576 ; inline -: GL_PRIMARY_COLOR HEX: 8577 ; inline -: GL_PREVIOUS HEX: 8578 ; inline -: GL_SOURCE0_RGB HEX: 8580 ; inline -: GL_SOURCE1_RGB HEX: 8581 ; inline -: GL_SOURCE2_RGB HEX: 8582 ; inline -: GL_SOURCE0_ALPHA HEX: 8588 ; inline -: GL_SOURCE1_ALPHA HEX: 8589 ; inline -: GL_SOURCE2_ALPHA HEX: 858A ; inline -: GL_OPERAND0_RGB HEX: 8590 ; inline -: GL_OPERAND1_RGB HEX: 8591 ; inline -: GL_OPERAND2_RGB HEX: 8592 ; inline -: GL_OPERAND0_ALPHA HEX: 8598 ; inline -: GL_OPERAND1_ALPHA HEX: 8599 ; inline -: GL_OPERAND2_ALPHA HEX: 859A ; inline -: GL_TEXTURE_COMPRESSED_IMAGE_SIZE HEX: 86A0 ; inline -: GL_TEXTURE_COMPRESSED HEX: 86A1 ; inline -: GL_NUM_COMPRESSED_TEXTURE_FORMATS HEX: 86A2 ; inline -: GL_COMPRESSED_TEXTURE_FORMATS HEX: 86A3 ; inline -: GL_DOT3_RGB HEX: 86AE ; inline -: GL_DOT3_RGBA HEX: 86AF ; inline -: GL_MULTISAMPLE_BIT HEX: 20000000 ; inline +CONSTANT: GL_MULTISAMPLE HEX: 809D +CONSTANT: GL_SAMPLE_ALPHA_TO_COVERAGE HEX: 809E +CONSTANT: GL_SAMPLE_ALPHA_TO_ONE HEX: 809F +CONSTANT: GL_SAMPLE_COVERAGE HEX: 80A0 +CONSTANT: GL_SAMPLE_BUFFERS HEX: 80A8 +CONSTANT: GL_SAMPLES HEX: 80A9 +CONSTANT: GL_SAMPLE_COVERAGE_VALUE HEX: 80AA +CONSTANT: GL_SAMPLE_COVERAGE_INVERT HEX: 80AB +CONSTANT: GL_CLAMP_TO_BORDER HEX: 812D +CONSTANT: GL_TEXTURE0 HEX: 84C0 +CONSTANT: GL_TEXTURE1 HEX: 84C1 +CONSTANT: GL_TEXTURE2 HEX: 84C2 +CONSTANT: GL_TEXTURE3 HEX: 84C3 +CONSTANT: GL_TEXTURE4 HEX: 84C4 +CONSTANT: GL_TEXTURE5 HEX: 84C5 +CONSTANT: GL_TEXTURE6 HEX: 84C6 +CONSTANT: GL_TEXTURE7 HEX: 84C7 +CONSTANT: GL_TEXTURE8 HEX: 84C8 +CONSTANT: GL_TEXTURE9 HEX: 84C9 +CONSTANT: GL_TEXTURE10 HEX: 84CA +CONSTANT: GL_TEXTURE11 HEX: 84CB +CONSTANT: GL_TEXTURE12 HEX: 84CC +CONSTANT: GL_TEXTURE13 HEX: 84CD +CONSTANT: GL_TEXTURE14 HEX: 84CE +CONSTANT: GL_TEXTURE15 HEX: 84CF +CONSTANT: GL_TEXTURE16 HEX: 84D0 +CONSTANT: GL_TEXTURE17 HEX: 84D1 +CONSTANT: GL_TEXTURE18 HEX: 84D2 +CONSTANT: GL_TEXTURE19 HEX: 84D3 +CONSTANT: GL_TEXTURE20 HEX: 84D4 +CONSTANT: GL_TEXTURE21 HEX: 84D5 +CONSTANT: GL_TEXTURE22 HEX: 84D6 +CONSTANT: GL_TEXTURE23 HEX: 84D7 +CONSTANT: GL_TEXTURE24 HEX: 84D8 +CONSTANT: GL_TEXTURE25 HEX: 84D9 +CONSTANT: GL_TEXTURE26 HEX: 84DA +CONSTANT: GL_TEXTURE27 HEX: 84DB +CONSTANT: GL_TEXTURE28 HEX: 84DC +CONSTANT: GL_TEXTURE29 HEX: 84DD +CONSTANT: GL_TEXTURE30 HEX: 84DE +CONSTANT: GL_TEXTURE31 HEX: 84DF +CONSTANT: GL_ACTIVE_TEXTURE HEX: 84E0 +CONSTANT: GL_CLIENT_ACTIVE_TEXTURE HEX: 84E1 +CONSTANT: GL_MAX_TEXTURE_UNITS HEX: 84E2 +CONSTANT: GL_TRANSPOSE_MODELVIEW_MATRIX HEX: 84E3 +CONSTANT: GL_TRANSPOSE_PROJECTION_MATRIX HEX: 84E4 +CONSTANT: GL_TRANSPOSE_TEXTURE_MATRIX HEX: 84E5 +CONSTANT: GL_TRANSPOSE_COLOR_MATRIX HEX: 84E6 +CONSTANT: GL_SUBTRACT HEX: 84E7 +CONSTANT: GL_COMPRESSED_ALPHA HEX: 84E9 +CONSTANT: GL_COMPRESSED_LUMINANCE HEX: 84EA +CONSTANT: GL_COMPRESSED_LUMINANCE_ALPHA HEX: 84EB +CONSTANT: GL_COMPRESSED_INTENSITY HEX: 84EC +CONSTANT: GL_COMPRESSED_RGB HEX: 84ED +CONSTANT: GL_COMPRESSED_RGBA HEX: 84EE +CONSTANT: GL_TEXTURE_COMPRESSION_HINT HEX: 84EF +CONSTANT: GL_NORMAL_MAP HEX: 8511 +CONSTANT: GL_REFLECTION_MAP HEX: 8512 +CONSTANT: GL_TEXTURE_CUBE_MAP HEX: 8513 +CONSTANT: GL_TEXTURE_BINDING_CUBE_MAP HEX: 8514 +CONSTANT: GL_TEXTURE_CUBE_MAP_POSITIVE_X HEX: 8515 +CONSTANT: GL_TEXTURE_CUBE_MAP_NEGATIVE_X HEX: 8516 +CONSTANT: GL_TEXTURE_CUBE_MAP_POSITIVE_Y HEX: 8517 +CONSTANT: GL_TEXTURE_CUBE_MAP_NEGATIVE_Y HEX: 8518 +CONSTANT: GL_TEXTURE_CUBE_MAP_POSITIVE_Z HEX: 8519 +CONSTANT: GL_TEXTURE_CUBE_MAP_NEGATIVE_Z HEX: 851A +CONSTANT: GL_PROXY_TEXTURE_CUBE_MAP HEX: 851B +CONSTANT: GL_MAX_CUBE_MAP_TEXTURE_SIZE HEX: 851C +CONSTANT: GL_COMBINE HEX: 8570 +CONSTANT: GL_COMBINE_RGB HEX: 8571 +CONSTANT: GL_COMBINE_ALPHA HEX: 8572 +CONSTANT: GL_RGB_SCALE HEX: 8573 +CONSTANT: GL_ADD_SIGNED HEX: 8574 +CONSTANT: GL_INTERPOLATE HEX: 8575 +CONSTANT: GL_CONSTANT HEX: 8576 +CONSTANT: GL_PRIMARY_COLOR HEX: 8577 +CONSTANT: GL_PREVIOUS HEX: 8578 +CONSTANT: GL_SOURCE0_RGB HEX: 8580 +CONSTANT: GL_SOURCE1_RGB HEX: 8581 +CONSTANT: GL_SOURCE2_RGB HEX: 8582 +CONSTANT: GL_SOURCE0_ALPHA HEX: 8588 +CONSTANT: GL_SOURCE1_ALPHA HEX: 8589 +CONSTANT: GL_SOURCE2_ALPHA HEX: 858A +CONSTANT: GL_OPERAND0_RGB HEX: 8590 +CONSTANT: GL_OPERAND1_RGB HEX: 8591 +CONSTANT: GL_OPERAND2_RGB HEX: 8592 +CONSTANT: GL_OPERAND0_ALPHA HEX: 8598 +CONSTANT: GL_OPERAND1_ALPHA HEX: 8599 +CONSTANT: GL_OPERAND2_ALPHA HEX: 859A +CONSTANT: GL_TEXTURE_COMPRESSED_IMAGE_SIZE HEX: 86A0 +CONSTANT: GL_TEXTURE_COMPRESSED HEX: 86A1 +CONSTANT: GL_NUM_COMPRESSED_TEXTURE_FORMATS HEX: 86A2 +CONSTANT: GL_COMPRESSED_TEXTURE_FORMATS HEX: 86A3 +CONSTANT: GL_DOT3_RGB HEX: 86AE +CONSTANT: GL_DOT3_RGBA HEX: 86AF +CONSTANT: GL_MULTISAMPLE_BIT HEX: 20000000 GL-FUNCTION: void glActiveTexture { glActiveTextureARB } ( GLenum texture ) ; GL-FUNCTION: void glClientActiveTexture { glClientActiveTextureARB } ( GLenum texture ) ; @@ -1322,45 +1318,45 @@ GL-FUNCTION: void glSampleCoverage { glSampleCoverageARB } ( GLclampf value, GLb ! OpenGL 1.4 -: GL_BLEND_DST_RGB HEX: 80C8 ; inline -: GL_BLEND_SRC_RGB HEX: 80C9 ; inline -: GL_BLEND_DST_ALPHA HEX: 80CA ; inline -: GL_BLEND_SRC_ALPHA HEX: 80CB ; inline -: GL_POINT_SIZE_MIN HEX: 8126 ; inline -: GL_POINT_SIZE_MAX HEX: 8127 ; inline -: GL_POINT_FADE_THRESHOLD_SIZE HEX: 8128 ; inline -: GL_POINT_DISTANCE_ATTENUATION HEX: 8129 ; inline -: GL_GENERATE_MIPMAP HEX: 8191 ; inline -: GL_GENERATE_MIPMAP_HINT HEX: 8192 ; inline -: GL_DEPTH_COMPONENT16 HEX: 81A5 ; inline -: GL_DEPTH_COMPONENT24 HEX: 81A6 ; inline -: GL_DEPTH_COMPONENT32 HEX: 81A7 ; inline -: GL_MIRRORED_REPEAT HEX: 8370 ; inline -: GL_FOG_COORDINATE_SOURCE HEX: 8450 ; inline -: GL_FOG_COORDINATE HEX: 8451 ; inline -: GL_FRAGMENT_DEPTH HEX: 8452 ; inline -: GL_CURRENT_FOG_COORDINATE HEX: 8453 ; inline -: GL_FOG_COORDINATE_ARRAY_TYPE HEX: 8454 ; inline -: GL_FOG_COORDINATE_ARRAY_STRIDE HEX: 8455 ; inline -: GL_FOG_COORDINATE_ARRAY_POINTER HEX: 8456 ; inline -: GL_FOG_COORDINATE_ARRAY HEX: 8457 ; inline -: GL_COLOR_SUM HEX: 8458 ; inline -: GL_CURRENT_SECONDARY_COLOR HEX: 8459 ; inline -: GL_SECONDARY_COLOR_ARRAY_SIZE HEX: 845A ; inline -: GL_SECONDARY_COLOR_ARRAY_TYPE HEX: 845B ; inline -: GL_SECONDARY_COLOR_ARRAY_STRIDE HEX: 845C ; inline -: GL_SECONDARY_COLOR_ARRAY_POINTER HEX: 845D ; inline -: GL_SECONDARY_COLOR_ARRAY HEX: 845E ; inline -: GL_MAX_TEXTURE_LOD_BIAS HEX: 84FD ; inline -: GL_TEXTURE_FILTER_CONTROL HEX: 8500 ; inline -: GL_TEXTURE_LOD_BIAS HEX: 8501 ; inline -: GL_INCR_WRAP HEX: 8507 ; inline -: GL_DECR_WRAP HEX: 8508 ; inline -: GL_TEXTURE_DEPTH_SIZE HEX: 884A ; inline -: GL_DEPTH_TEXTURE_MODE HEX: 884B ; inline -: GL_TEXTURE_COMPARE_MODE HEX: 884C ; inline -: GL_TEXTURE_COMPARE_FUNC HEX: 884D ; inline -: GL_COMPARE_R_TO_TEXTURE HEX: 884E ; inline +CONSTANT: GL_BLEND_DST_RGB HEX: 80C8 +CONSTANT: GL_BLEND_SRC_RGB HEX: 80C9 +CONSTANT: GL_BLEND_DST_ALPHA HEX: 80CA +CONSTANT: GL_BLEND_SRC_ALPHA HEX: 80CB +CONSTANT: GL_POINT_SIZE_MIN HEX: 8126 +CONSTANT: GL_POINT_SIZE_MAX HEX: 8127 +CONSTANT: GL_POINT_FADE_THRESHOLD_SIZE HEX: 8128 +CONSTANT: GL_POINT_DISTANCE_ATTENUATION HEX: 8129 +CONSTANT: GL_GENERATE_MIPMAP HEX: 8191 +CONSTANT: GL_GENERATE_MIPMAP_HINT HEX: 8192 +CONSTANT: GL_DEPTH_COMPONENT16 HEX: 81A5 +CONSTANT: GL_DEPTH_COMPONENT24 HEX: 81A6 +CONSTANT: GL_DEPTH_COMPONENT32 HEX: 81A7 +CONSTANT: GL_MIRRORED_REPEAT HEX: 8370 +CONSTANT: GL_FOG_COORDINATE_SOURCE HEX: 8450 +CONSTANT: GL_FOG_COORDINATE HEX: 8451 +CONSTANT: GL_FRAGMENT_DEPTH HEX: 8452 +CONSTANT: GL_CURRENT_FOG_COORDINATE HEX: 8453 +CONSTANT: GL_FOG_COORDINATE_ARRAY_TYPE HEX: 8454 +CONSTANT: GL_FOG_COORDINATE_ARRAY_STRIDE HEX: 8455 +CONSTANT: GL_FOG_COORDINATE_ARRAY_POINTER HEX: 8456 +CONSTANT: GL_FOG_COORDINATE_ARRAY HEX: 8457 +CONSTANT: GL_COLOR_SUM HEX: 8458 +CONSTANT: GL_CURRENT_SECONDARY_COLOR HEX: 8459 +CONSTANT: GL_SECONDARY_COLOR_ARRAY_SIZE HEX: 845A +CONSTANT: GL_SECONDARY_COLOR_ARRAY_TYPE HEX: 845B +CONSTANT: GL_SECONDARY_COLOR_ARRAY_STRIDE HEX: 845C +CONSTANT: GL_SECONDARY_COLOR_ARRAY_POINTER HEX: 845D +CONSTANT: GL_SECONDARY_COLOR_ARRAY HEX: 845E +CONSTANT: GL_MAX_TEXTURE_LOD_BIAS HEX: 84FD +CONSTANT: GL_TEXTURE_FILTER_CONTROL HEX: 8500 +CONSTANT: GL_TEXTURE_LOD_BIAS HEX: 8501 +CONSTANT: GL_INCR_WRAP HEX: 8507 +CONSTANT: GL_DECR_WRAP HEX: 8508 +CONSTANT: GL_TEXTURE_DEPTH_SIZE HEX: 884A +CONSTANT: GL_DEPTH_TEXTURE_MODE HEX: 884B +CONSTANT: GL_TEXTURE_COMPARE_MODE HEX: 884C +CONSTANT: GL_TEXTURE_COMPARE_FUNC HEX: 884D +CONSTANT: GL_COMPARE_R_TO_TEXTURE HEX: 884E GL-FUNCTION: void glBlendColor { glBlendColorEXT } ( GLclampf red, GLclampf green, GLclampf blue, GLclampf alpha ) ; GL-FUNCTION: void glBlendEquation { glBlendEquationEXT } ( GLenum mode ) ; @@ -1410,56 +1406,56 @@ GL-FUNCTION: void glWindowPos3sv { glWindowPos3svARB } ( GLshort* p ) ; ! OpenGL 1.5 -: GL_BUFFER_SIZE HEX: 8764 ; inline -: GL_BUFFER_USAGE HEX: 8765 ; inline -: GL_QUERY_COUNTER_BITS HEX: 8864 ; inline -: GL_CURRENT_QUERY HEX: 8865 ; inline -: GL_QUERY_RESULT HEX: 8866 ; inline -: GL_QUERY_RESULT_AVAILABLE HEX: 8867 ; inline -: GL_ARRAY_BUFFER HEX: 8892 ; inline -: GL_ELEMENT_ARRAY_BUFFER HEX: 8893 ; inline -: GL_ARRAY_BUFFER_BINDING HEX: 8894 ; inline -: GL_ELEMENT_ARRAY_BUFFER_BINDING HEX: 8895 ; inline -: GL_VERTEX_ARRAY_BUFFER_BINDING HEX: 8896 ; inline -: GL_NORMAL_ARRAY_BUFFER_BINDING HEX: 8897 ; inline -: GL_COLOR_ARRAY_BUFFER_BINDING HEX: 8898 ; inline -: GL_INDEX_ARRAY_BUFFER_BINDING HEX: 8899 ; inline -: GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING HEX: 889A ; inline -: GL_EDGE_FLAG_ARRAY_BUFFER_BINDING HEX: 889B ; inline -: GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING HEX: 889C ; inline -: GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING HEX: 889D ; inline -: GL_WEIGHT_ARRAY_BUFFER_BINDING HEX: 889E ; inline -: GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING HEX: 889F ; inline -: GL_READ_ONLY HEX: 88B8 ; inline -: GL_WRITE_ONLY HEX: 88B9 ; inline -: GL_READ_WRITE HEX: 88BA ; inline -: GL_BUFFER_ACCESS HEX: 88BB ; inline -: GL_BUFFER_MAPPED HEX: 88BC ; inline -: GL_BUFFER_MAP_POINTER HEX: 88BD ; inline -: GL_STREAM_DRAW HEX: 88E0 ; inline -: GL_STREAM_READ HEX: 88E1 ; inline -: GL_STREAM_COPY HEX: 88E2 ; inline -: GL_STATIC_DRAW HEX: 88E4 ; inline -: GL_STATIC_READ HEX: 88E5 ; inline -: GL_STATIC_COPY HEX: 88E6 ; inline -: GL_DYNAMIC_DRAW HEX: 88E8 ; inline -: GL_DYNAMIC_READ HEX: 88E9 ; inline -: GL_DYNAMIC_COPY HEX: 88EA ; inline -: GL_SAMPLES_PASSED HEX: 8914 ; inline -: GL_FOG_COORD_SRC GL_FOG_COORDINATE_SOURCE ; inline -: GL_FOG_COORD GL_FOG_COORDINATE ; inline -: GL_FOG_COORD_ARRAY GL_FOG_COORDINATE_ARRAY ; inline -: GL_SRC0_RGB GL_SOURCE0_RGB ; inline -: GL_FOG_COORD_ARRAY_POINTER GL_FOG_COORDINATE_ARRAY_POINTER ; inline -: GL_FOG_COORD_ARRAY_TYPE GL_FOG_COORDINATE_ARRAY_TYPE ; inline -: GL_SRC1_ALPHA GL_SOURCE1_ALPHA ; inline -: GL_CURRENT_FOG_COORD GL_CURRENT_FOG_COORDINATE ; inline -: GL_FOG_COORD_ARRAY_STRIDE GL_FOG_COORDINATE_ARRAY_STRIDE ; inline -: GL_SRC0_ALPHA GL_SOURCE0_ALPHA ; inline -: GL_SRC1_RGB GL_SOURCE1_RGB ; inline -: GL_FOG_COORD_ARRAY_BUFFER_BINDING GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING ; inline -: GL_SRC2_ALPHA GL_SOURCE2_ALPHA ; inline -: GL_SRC2_RGB GL_SOURCE2_RGB ; inline +CONSTANT: GL_BUFFER_SIZE HEX: 8764 +CONSTANT: GL_BUFFER_USAGE HEX: 8765 +CONSTANT: GL_QUERY_COUNTER_BITS HEX: 8864 +CONSTANT: GL_CURRENT_QUERY HEX: 8865 +CONSTANT: GL_QUERY_RESULT HEX: 8866 +CONSTANT: GL_QUERY_RESULT_AVAILABLE HEX: 8867 +CONSTANT: GL_ARRAY_BUFFER HEX: 8892 +CONSTANT: GL_ELEMENT_ARRAY_BUFFER HEX: 8893 +CONSTANT: GL_ARRAY_BUFFER_BINDING HEX: 8894 +CONSTANT: GL_ELEMENT_ARRAY_BUFFER_BINDING HEX: 8895 +CONSTANT: GL_VERTEX_ARRAY_BUFFER_BINDING HEX: 8896 +CONSTANT: GL_NORMAL_ARRAY_BUFFER_BINDING HEX: 8897 +CONSTANT: GL_COLOR_ARRAY_BUFFER_BINDING HEX: 8898 +CONSTANT: GL_INDEX_ARRAY_BUFFER_BINDING HEX: 8899 +CONSTANT: GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING HEX: 889A +CONSTANT: GL_EDGE_FLAG_ARRAY_BUFFER_BINDING HEX: 889B +CONSTANT: GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING HEX: 889C +CONSTANT: GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING HEX: 889D +CONSTANT: GL_WEIGHT_ARRAY_BUFFER_BINDING HEX: 889E +CONSTANT: GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING HEX: 889F +CONSTANT: GL_READ_ONLY HEX: 88B8 +CONSTANT: GL_WRITE_ONLY HEX: 88B9 +CONSTANT: GL_READ_WRITE HEX: 88BA +CONSTANT: GL_BUFFER_ACCESS HEX: 88BB +CONSTANT: GL_BUFFER_MAPPED HEX: 88BC +CONSTANT: GL_BUFFER_MAP_POINTER HEX: 88BD +CONSTANT: GL_STREAM_DRAW HEX: 88E0 +CONSTANT: GL_STREAM_READ HEX: 88E1 +CONSTANT: GL_STREAM_COPY HEX: 88E2 +CONSTANT: GL_STATIC_DRAW HEX: 88E4 +CONSTANT: GL_STATIC_READ HEX: 88E5 +CONSTANT: GL_STATIC_COPY HEX: 88E6 +CONSTANT: GL_DYNAMIC_DRAW HEX: 88E8 +CONSTANT: GL_DYNAMIC_READ HEX: 88E9 +CONSTANT: GL_DYNAMIC_COPY HEX: 88EA +CONSTANT: GL_SAMPLES_PASSED HEX: 8914 +ALIAS: GL_FOG_COORD_SRC GL_FOG_COORDINATE_SOURCE +ALIAS: GL_FOG_COORD GL_FOG_COORDINATE +ALIAS: GL_FOG_COORD_ARRAY GL_FOG_COORDINATE_ARRAY +ALIAS: GL_SRC0_RGB GL_SOURCE0_RGB +ALIAS: GL_FOG_COORD_ARRAY_POINTER GL_FOG_COORDINATE_ARRAY_POINTER +ALIAS: GL_FOG_COORD_ARRAY_TYPE GL_FOG_COORDINATE_ARRAY_TYPE +ALIAS: GL_SRC1_ALPHA GL_SOURCE1_ALPHA +ALIAS: GL_CURRENT_FOG_COORD GL_CURRENT_FOG_COORDINATE +ALIAS: GL_FOG_COORD_ARRAY_STRIDE GL_FOG_COORDINATE_ARRAY_STRIDE +ALIAS: GL_SRC0_ALPHA GL_SOURCE0_ALPHA +ALIAS: GL_SRC1_RGB GL_SOURCE1_RGB +ALIAS: GL_FOG_COORD_ARRAY_BUFFER_BINDING GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING +ALIAS: GL_SRC2_ALPHA GL_SOURCE2_ALPHA +ALIAS: GL_SRC2_RGB GL_SOURCE2_RGB TYPEDEF: ptrdiff_t GLsizeiptr TYPEDEF: ptrdiff_t GLintptr @@ -1488,91 +1484,91 @@ GL-FUNCTION: GLboolean glUnmapBuffer { glUnmapBufferARB } ( GLenum target ) ; ! OpenGL 2.0 -: GL_VERTEX_ATTRIB_ARRAY_ENABLED HEX: 8622 ; inline -: GL_VERTEX_ATTRIB_ARRAY_SIZE HEX: 8623 ; inline -: GL_VERTEX_ATTRIB_ARRAY_STRIDE HEX: 8624 ; inline -: GL_VERTEX_ATTRIB_ARRAY_TYPE HEX: 8625 ; inline -: GL_CURRENT_VERTEX_ATTRIB HEX: 8626 ; inline -: GL_VERTEX_PROGRAM_POINT_SIZE HEX: 8642 ; inline -: GL_VERTEX_PROGRAM_TWO_SIDE HEX: 8643 ; inline -: GL_VERTEX_ATTRIB_ARRAY_POINTER HEX: 8645 ; inline -: GL_STENCIL_BACK_FUNC HEX: 8800 ; inline -: GL_STENCIL_BACK_FAIL HEX: 8801 ; inline -: GL_STENCIL_BACK_PASS_DEPTH_FAIL HEX: 8802 ; inline -: GL_STENCIL_BACK_PASS_DEPTH_PASS HEX: 8803 ; inline -: GL_MAX_DRAW_BUFFERS HEX: 8824 ; inline -: GL_DRAW_BUFFER0 HEX: 8825 ; inline -: GL_DRAW_BUFFER1 HEX: 8826 ; inline -: GL_DRAW_BUFFER2 HEX: 8827 ; inline -: GL_DRAW_BUFFER3 HEX: 8828 ; inline -: GL_DRAW_BUFFER4 HEX: 8829 ; inline -: GL_DRAW_BUFFER5 HEX: 882A ; inline -: GL_DRAW_BUFFER6 HEX: 882B ; inline -: GL_DRAW_BUFFER7 HEX: 882C ; inline -: GL_DRAW_BUFFER8 HEX: 882D ; inline -: GL_DRAW_BUFFER9 HEX: 882E ; inline -: GL_DRAW_BUFFER10 HEX: 882F ; inline -: GL_DRAW_BUFFER11 HEX: 8830 ; inline -: GL_DRAW_BUFFER12 HEX: 8831 ; inline -: GL_DRAW_BUFFER13 HEX: 8832 ; inline -: GL_DRAW_BUFFER14 HEX: 8833 ; inline -: GL_DRAW_BUFFER15 HEX: 8834 ; inline -: GL_BLEND_EQUATION_ALPHA HEX: 883D ; inline -: GL_POINT_SPRITE HEX: 8861 ; inline -: GL_COORD_REPLACE HEX: 8862 ; inline -: GL_MAX_VERTEX_ATTRIBS HEX: 8869 ; inline -: GL_VERTEX_ATTRIB_ARRAY_NORMALIZED HEX: 886A ; inline -: GL_MAX_TEXTURE_COORDS HEX: 8871 ; inline -: GL_MAX_TEXTURE_IMAGE_UNITS HEX: 8872 ; inline -: GL_FRAGMENT_SHADER HEX: 8B30 ; inline -: GL_VERTEX_SHADER HEX: 8B31 ; inline -: GL_MAX_FRAGMENT_UNIFORM_COMPONENTS HEX: 8B49 ; inline -: GL_MAX_VERTEX_UNIFORM_COMPONENTS HEX: 8B4A ; inline -: GL_MAX_VARYING_FLOATS HEX: 8B4B ; inline -: GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS HEX: 8B4C ; inline -: GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS HEX: 8B4D ; inline -: GL_SHADER_TYPE HEX: 8B4F ; inline -: GL_FLOAT_VEC2 HEX: 8B50 ; inline -: GL_FLOAT_VEC3 HEX: 8B51 ; inline -: GL_FLOAT_VEC4 HEX: 8B52 ; inline -: GL_INT_VEC2 HEX: 8B53 ; inline -: GL_INT_VEC3 HEX: 8B54 ; inline -: GL_INT_VEC4 HEX: 8B55 ; inline -: GL_BOOL HEX: 8B56 ; inline -: GL_BOOL_VEC2 HEX: 8B57 ; inline -: GL_BOOL_VEC3 HEX: 8B58 ; inline -: GL_BOOL_VEC4 HEX: 8B59 ; inline -: GL_FLOAT_MAT2 HEX: 8B5A ; inline -: GL_FLOAT_MAT3 HEX: 8B5B ; inline -: GL_FLOAT_MAT4 HEX: 8B5C ; inline -: GL_SAMPLER_1D HEX: 8B5D ; inline -: GL_SAMPLER_2D HEX: 8B5E ; inline -: GL_SAMPLER_3D HEX: 8B5F ; inline -: GL_SAMPLER_CUBE HEX: 8B60 ; inline -: GL_SAMPLER_1D_SHADOW HEX: 8B61 ; inline -: GL_SAMPLER_2D_SHADOW HEX: 8B62 ; inline -: GL_DELETE_STATUS HEX: 8B80 ; inline -: GL_COMPILE_STATUS HEX: 8B81 ; inline -: GL_LINK_STATUS HEX: 8B82 ; inline -: GL_VALIDATE_STATUS HEX: 8B83 ; inline -: GL_INFO_LOG_LENGTH HEX: 8B84 ; inline -: GL_ATTACHED_SHADERS HEX: 8B85 ; inline -: GL_ACTIVE_UNIFORMS HEX: 8B86 ; inline -: GL_ACTIVE_UNIFORM_MAX_LENGTH HEX: 8B87 ; inline -: GL_SHADER_SOURCE_LENGTH HEX: 8B88 ; inline -: GL_ACTIVE_ATTRIBUTES HEX: 8B89 ; inline -: GL_ACTIVE_ATTRIBUTE_MAX_LENGTH HEX: 8B8A ; inline -: GL_FRAGMENT_SHADER_DERIVATIVE_HINT HEX: 8B8B ; inline -: GL_SHADING_LANGUAGE_VERSION HEX: 8B8C ; inline -: GL_CURRENT_PROGRAM HEX: 8B8D ; inline -: GL_POINT_SPRITE_COORD_ORIGIN HEX: 8CA0 ; inline -: GL_LOWER_LEFT HEX: 8CA1 ; inline -: GL_UPPER_LEFT HEX: 8CA2 ; inline -: GL_STENCIL_BACK_REF HEX: 8CA3 ; inline -: GL_STENCIL_BACK_VALUE_MASK HEX: 8CA4 ; inline -: GL_STENCIL_BACK_WRITEMASK HEX: 8CA5 ; inline -: GL_BLEND_EQUATION HEX: 8009 ; inline -: GL_BLEND_EQUATION_RGB GL_BLEND_EQUATION ; inline +CONSTANT: GL_VERTEX_ATTRIB_ARRAY_ENABLED HEX: 8622 +CONSTANT: GL_VERTEX_ATTRIB_ARRAY_SIZE HEX: 8623 +CONSTANT: GL_VERTEX_ATTRIB_ARRAY_STRIDE HEX: 8624 +CONSTANT: GL_VERTEX_ATTRIB_ARRAY_TYPE HEX: 8625 +CONSTANT: GL_CURRENT_VERTEX_ATTRIB HEX: 8626 +CONSTANT: GL_VERTEX_PROGRAM_POINT_SIZE HEX: 8642 +CONSTANT: GL_VERTEX_PROGRAM_TWO_SIDE HEX: 8643 +CONSTANT: GL_VERTEX_ATTRIB_ARRAY_POINTER HEX: 8645 +CONSTANT: GL_STENCIL_BACK_FUNC HEX: 8800 +CONSTANT: GL_STENCIL_BACK_FAIL HEX: 8801 +CONSTANT: GL_STENCIL_BACK_PASS_DEPTH_FAIL HEX: 8802 +CONSTANT: GL_STENCIL_BACK_PASS_DEPTH_PASS HEX: 8803 +CONSTANT: GL_MAX_DRAW_BUFFERS HEX: 8824 +CONSTANT: GL_DRAW_BUFFER0 HEX: 8825 +CONSTANT: GL_DRAW_BUFFER1 HEX: 8826 +CONSTANT: GL_DRAW_BUFFER2 HEX: 8827 +CONSTANT: GL_DRAW_BUFFER3 HEX: 8828 +CONSTANT: GL_DRAW_BUFFER4 HEX: 8829 +CONSTANT: GL_DRAW_BUFFER5 HEX: 882A +CONSTANT: GL_DRAW_BUFFER6 HEX: 882B +CONSTANT: GL_DRAW_BUFFER7 HEX: 882C +CONSTANT: GL_DRAW_BUFFER8 HEX: 882D +CONSTANT: GL_DRAW_BUFFER9 HEX: 882E +CONSTANT: GL_DRAW_BUFFER10 HEX: 882F +CONSTANT: GL_DRAW_BUFFER11 HEX: 8830 +CONSTANT: GL_DRAW_BUFFER12 HEX: 8831 +CONSTANT: GL_DRAW_BUFFER13 HEX: 8832 +CONSTANT: GL_DRAW_BUFFER14 HEX: 8833 +CONSTANT: GL_DRAW_BUFFER15 HEX: 8834 +CONSTANT: GL_BLEND_EQUATION_ALPHA HEX: 883D +CONSTANT: GL_POINT_SPRITE HEX: 8861 +CONSTANT: GL_COORD_REPLACE HEX: 8862 +CONSTANT: GL_MAX_VERTEX_ATTRIBS HEX: 8869 +CONSTANT: GL_VERTEX_ATTRIB_ARRAY_NORMALIZED HEX: 886A +CONSTANT: GL_MAX_TEXTURE_COORDS HEX: 8871 +CONSTANT: GL_MAX_TEXTURE_IMAGE_UNITS HEX: 8872 +CONSTANT: GL_FRAGMENT_SHADER HEX: 8B30 +CONSTANT: GL_VERTEX_SHADER HEX: 8B31 +CONSTANT: GL_MAX_FRAGMENT_UNIFORM_COMPONENTS HEX: 8B49 +CONSTANT: GL_MAX_VERTEX_UNIFORM_COMPONENTS HEX: 8B4A +CONSTANT: GL_MAX_VARYING_FLOATS HEX: 8B4B +CONSTANT: GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS HEX: 8B4C +CONSTANT: GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS HEX: 8B4D +CONSTANT: GL_SHADER_TYPE HEX: 8B4F +CONSTANT: GL_FLOAT_VEC2 HEX: 8B50 +CONSTANT: GL_FLOAT_VEC3 HEX: 8B51 +CONSTANT: GL_FLOAT_VEC4 HEX: 8B52 +CONSTANT: GL_INT_VEC2 HEX: 8B53 +CONSTANT: GL_INT_VEC3 HEX: 8B54 +CONSTANT: GL_INT_VEC4 HEX: 8B55 +CONSTANT: GL_BOOL HEX: 8B56 +CONSTANT: GL_BOOL_VEC2 HEX: 8B57 +CONSTANT: GL_BOOL_VEC3 HEX: 8B58 +CONSTANT: GL_BOOL_VEC4 HEX: 8B59 +CONSTANT: GL_FLOAT_MAT2 HEX: 8B5A +CONSTANT: GL_FLOAT_MAT3 HEX: 8B5B +CONSTANT: GL_FLOAT_MAT4 HEX: 8B5C +CONSTANT: GL_SAMPLER_1D HEX: 8B5D +CONSTANT: GL_SAMPLER_2D HEX: 8B5E +CONSTANT: GL_SAMPLER_3D HEX: 8B5F +CONSTANT: GL_SAMPLER_CUBE HEX: 8B60 +CONSTANT: GL_SAMPLER_1D_SHADOW HEX: 8B61 +CONSTANT: GL_SAMPLER_2D_SHADOW HEX: 8B62 +CONSTANT: GL_DELETE_STATUS HEX: 8B80 +CONSTANT: GL_COMPILE_STATUS HEX: 8B81 +CONSTANT: GL_LINK_STATUS HEX: 8B82 +CONSTANT: GL_VALIDATE_STATUS HEX: 8B83 +CONSTANT: GL_INFO_LOG_LENGTH HEX: 8B84 +CONSTANT: GL_ATTACHED_SHADERS HEX: 8B85 +CONSTANT: GL_ACTIVE_UNIFORMS HEX: 8B86 +CONSTANT: GL_ACTIVE_UNIFORM_MAX_LENGTH HEX: 8B87 +CONSTANT: GL_SHADER_SOURCE_LENGTH HEX: 8B88 +CONSTANT: GL_ACTIVE_ATTRIBUTES HEX: 8B89 +CONSTANT: GL_ACTIVE_ATTRIBUTE_MAX_LENGTH HEX: 8B8A +CONSTANT: GL_FRAGMENT_SHADER_DERIVATIVE_HINT HEX: 8B8B +CONSTANT: GL_SHADING_LANGUAGE_VERSION HEX: 8B8C +CONSTANT: GL_CURRENT_PROGRAM HEX: 8B8D +CONSTANT: GL_POINT_SPRITE_COORD_ORIGIN HEX: 8CA0 +CONSTANT: GL_LOWER_LEFT HEX: 8CA1 +CONSTANT: GL_UPPER_LEFT HEX: 8CA2 +CONSTANT: GL_STENCIL_BACK_REF HEX: 8CA3 +CONSTANT: GL_STENCIL_BACK_VALUE_MASK HEX: 8CA4 +CONSTANT: GL_STENCIL_BACK_WRITEMASK HEX: 8CA5 +CONSTANT: GL_BLEND_EQUATION HEX: 8009 +ALIAS: GL_BLEND_EQUATION_RGB GL_BLEND_EQUATION TYPEDEF: char GLchar @@ -1674,23 +1670,23 @@ GL-FUNCTION: void glVertexAttribPointer { glVertexAttribPointerARB } ( GLuint in ! OpenGL 2.1 -: GL_CURRENT_RASTER_SECONDARY_COLOR HEX: 845F ; inline -: GL_PIXEL_PACK_BUFFER HEX: 88EB ; inline -: GL_PIXEL_UNPACK_BUFFER HEX: 88EC ; inline -: GL_PIXEL_PACK_BUFFER_BINDING HEX: 88ED ; inline -: GL_PIXEL_UNPACK_BUFFER_BINDING HEX: 88EF ; inline -: GL_SRGB HEX: 8C40 ; inline -: GL_SRGB8 HEX: 8C41 ; inline -: GL_SRGB_ALPHA HEX: 8C42 ; inline -: GL_SRGB8_ALPHA8 HEX: 8C43 ; inline -: GL_SLUMINANCE_ALPHA HEX: 8C44 ; inline -: GL_SLUMINANCE8_ALPHA8 HEX: 8C45 ; inline -: GL_SLUMINANCE HEX: 8C46 ; inline -: GL_SLUMINANCE8 HEX: 8C47 ; inline -: GL_COMPRESSED_SRGB HEX: 8C48 ; inline -: GL_COMPRESSED_SRGB_ALPHA HEX: 8C49 ; inline -: GL_COMPRESSED_SLUMINANCE HEX: 8C4A ; inline -: GL_COMPRESSED_SLUMINANCE_ALPHA HEX: 8C4B ; inline +CONSTANT: GL_CURRENT_RASTER_SECONDARY_COLOR HEX: 845F +CONSTANT: GL_PIXEL_PACK_BUFFER HEX: 88EB +CONSTANT: GL_PIXEL_UNPACK_BUFFER HEX: 88EC +CONSTANT: GL_PIXEL_PACK_BUFFER_BINDING HEX: 88ED +CONSTANT: GL_PIXEL_UNPACK_BUFFER_BINDING HEX: 88EF +CONSTANT: GL_SRGB HEX: 8C40 +CONSTANT: GL_SRGB8 HEX: 8C41 +CONSTANT: GL_SRGB_ALPHA HEX: 8C42 +CONSTANT: GL_SRGB8_ALPHA8 HEX: 8C43 +CONSTANT: GL_SLUMINANCE_ALPHA HEX: 8C44 +CONSTANT: GL_SLUMINANCE8_ALPHA8 HEX: 8C45 +CONSTANT: GL_SLUMINANCE HEX: 8C46 +CONSTANT: GL_SLUMINANCE8 HEX: 8C47 +CONSTANT: GL_COMPRESSED_SRGB HEX: 8C48 +CONSTANT: GL_COMPRESSED_SRGB_ALPHA HEX: 8C49 +CONSTANT: GL_COMPRESSED_SLUMINANCE HEX: 8C4A +CONSTANT: GL_COMPRESSED_SLUMINANCE_ALPHA HEX: 8C4B GL-FUNCTION: void glUniformMatrix2x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ; GL-FUNCTION: void glUniformMatrix2x4fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ; @@ -1703,57 +1699,57 @@ GL-FUNCTION: void glUniformMatrix4x3fv { } ( GLint location, GLsizei count, GLbo ! GL_EXT_framebuffer_object -: GL_INVALID_FRAMEBUFFER_OPERATION_EXT HEX: 0506 ; inline -: GL_MAX_RENDERBUFFER_SIZE_EXT HEX: 84E8 ; inline -: GL_FRAMEBUFFER_BINDING_EXT HEX: 8CA6 ; inline -: GL_RENDERBUFFER_BINDING_EXT HEX: 8CA7 ; inline -: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT HEX: 8CD0 ; inline -: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT HEX: 8CD1 ; inline -: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT HEX: 8CD2 ; inline -: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT HEX: 8CD3 ; inline -: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT HEX: 8CD4 ; inline -: GL_FRAMEBUFFER_COMPLETE_EXT HEX: 8CD5 ; inline -: GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT HEX: 8CD6 ; inline -: GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT HEX: 8CD7 ; inline -: GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT HEX: 8CD9 ; inline -: GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT HEX: 8CDA ; inline -: GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT HEX: 8CDB ; inline -: GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT HEX: 8CDC ; inline -: GL_FRAMEBUFFER_UNSUPPORTED_EXT HEX: 8CDD ; inline -: GL_MAX_COLOR_ATTACHMENTS_EXT HEX: 8CDF ; inline -: GL_COLOR_ATTACHMENT0_EXT HEX: 8CE0 ; inline -: GL_COLOR_ATTACHMENT1_EXT HEX: 8CE1 ; inline -: GL_COLOR_ATTACHMENT2_EXT HEX: 8CE2 ; inline -: GL_COLOR_ATTACHMENT3_EXT HEX: 8CE3 ; inline -: GL_COLOR_ATTACHMENT4_EXT HEX: 8CE4 ; inline -: GL_COLOR_ATTACHMENT5_EXT HEX: 8CE5 ; inline -: GL_COLOR_ATTACHMENT6_EXT HEX: 8CE6 ; inline -: GL_COLOR_ATTACHMENT7_EXT HEX: 8CE7 ; inline -: GL_COLOR_ATTACHMENT8_EXT HEX: 8CE8 ; inline -: GL_COLOR_ATTACHMENT9_EXT HEX: 8CE9 ; inline -: GL_COLOR_ATTACHMENT10_EXT HEX: 8CEA ; inline -: GL_COLOR_ATTACHMENT11_EXT HEX: 8CEB ; inline -: GL_COLOR_ATTACHMENT12_EXT HEX: 8CEC ; inline -: GL_COLOR_ATTACHMENT13_EXT HEX: 8CED ; inline -: GL_COLOR_ATTACHMENT14_EXT HEX: 8CEE ; inline -: GL_COLOR_ATTACHMENT15_EXT HEX: 8CEF ; inline -: GL_DEPTH_ATTACHMENT_EXT HEX: 8D00 ; inline -: GL_STENCIL_ATTACHMENT_EXT HEX: 8D20 ; inline -: GL_FRAMEBUFFER_EXT HEX: 8D40 ; inline -: GL_RENDERBUFFER_EXT HEX: 8D41 ; inline -: GL_RENDERBUFFER_WIDTH_EXT HEX: 8D42 ; inline -: GL_RENDERBUFFER_HEIGHT_EXT HEX: 8D43 ; inline -: GL_RENDERBUFFER_INTERNAL_FORMAT_EXT HEX: 8D44 ; inline -: GL_STENCIL_INDEX1_EXT HEX: 8D46 ; inline -: GL_STENCIL_INDEX4_EXT HEX: 8D47 ; inline -: GL_STENCIL_INDEX8_EXT HEX: 8D48 ; inline -: GL_STENCIL_INDEX16_EXT HEX: 8D49 ; inline -: GL_RENDERBUFFER_RED_SIZE_EXT HEX: 8D50 ; inline -: GL_RENDERBUFFER_GREEN_SIZE_EXT HEX: 8D51 ; inline -: GL_RENDERBUFFER_BLUE_SIZE_EXT HEX: 8D52 ; inline -: GL_RENDERBUFFER_ALPHA_SIZE_EXT HEX: 8D53 ; inline -: GL_RENDERBUFFER_DEPTH_SIZE_EXT HEX: 8D54 ; inline -: GL_RENDERBUFFER_STENCIL_SIZE_EXT HEX: 8D55 ; inline +CONSTANT: GL_INVALID_FRAMEBUFFER_OPERATION_EXT HEX: 0506 +CONSTANT: GL_MAX_RENDERBUFFER_SIZE_EXT HEX: 84E8 +CONSTANT: GL_FRAMEBUFFER_BINDING_EXT HEX: 8CA6 +CONSTANT: GL_RENDERBUFFER_BINDING_EXT HEX: 8CA7 +CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT HEX: 8CD0 +CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT HEX: 8CD1 +CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT HEX: 8CD2 +CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT HEX: 8CD3 +CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT HEX: 8CD4 +CONSTANT: GL_FRAMEBUFFER_COMPLETE_EXT HEX: 8CD5 +CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT HEX: 8CD6 +CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT HEX: 8CD7 +CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT HEX: 8CD9 +CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT HEX: 8CDA +CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT HEX: 8CDB +CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT HEX: 8CDC +CONSTANT: GL_FRAMEBUFFER_UNSUPPORTED_EXT HEX: 8CDD +CONSTANT: GL_MAX_COLOR_ATTACHMENTS_EXT HEX: 8CDF +CONSTANT: GL_COLOR_ATTACHMENT0_EXT HEX: 8CE0 +CONSTANT: GL_COLOR_ATTACHMENT1_EXT HEX: 8CE1 +CONSTANT: GL_COLOR_ATTACHMENT2_EXT HEX: 8CE2 +CONSTANT: GL_COLOR_ATTACHMENT3_EXT HEX: 8CE3 +CONSTANT: GL_COLOR_ATTACHMENT4_EXT HEX: 8CE4 +CONSTANT: GL_COLOR_ATTACHMENT5_EXT HEX: 8CE5 +CONSTANT: GL_COLOR_ATTACHMENT6_EXT HEX: 8CE6 +CONSTANT: GL_COLOR_ATTACHMENT7_EXT HEX: 8CE7 +CONSTANT: GL_COLOR_ATTACHMENT8_EXT HEX: 8CE8 +CONSTANT: GL_COLOR_ATTACHMENT9_EXT HEX: 8CE9 +CONSTANT: GL_COLOR_ATTACHMENT10_EXT HEX: 8CEA +CONSTANT: GL_COLOR_ATTACHMENT11_EXT HEX: 8CEB +CONSTANT: GL_COLOR_ATTACHMENT12_EXT HEX: 8CEC +CONSTANT: GL_COLOR_ATTACHMENT13_EXT HEX: 8CED +CONSTANT: GL_COLOR_ATTACHMENT14_EXT HEX: 8CEE +CONSTANT: GL_COLOR_ATTACHMENT15_EXT HEX: 8CEF +CONSTANT: GL_DEPTH_ATTACHMENT_EXT HEX: 8D00 +CONSTANT: GL_STENCIL_ATTACHMENT_EXT HEX: 8D20 +CONSTANT: GL_FRAMEBUFFER_EXT HEX: 8D40 +CONSTANT: GL_RENDERBUFFER_EXT HEX: 8D41 +CONSTANT: GL_RENDERBUFFER_WIDTH_EXT HEX: 8D42 +CONSTANT: GL_RENDERBUFFER_HEIGHT_EXT HEX: 8D43 +CONSTANT: GL_RENDERBUFFER_INTERNAL_FORMAT_EXT HEX: 8D44 +CONSTANT: GL_STENCIL_INDEX1_EXT HEX: 8D46 +CONSTANT: GL_STENCIL_INDEX4_EXT HEX: 8D47 +CONSTANT: GL_STENCIL_INDEX8_EXT HEX: 8D48 +CONSTANT: GL_STENCIL_INDEX16_EXT HEX: 8D49 +CONSTANT: GL_RENDERBUFFER_RED_SIZE_EXT HEX: 8D50 +CONSTANT: GL_RENDERBUFFER_GREEN_SIZE_EXT HEX: 8D51 +CONSTANT: GL_RENDERBUFFER_BLUE_SIZE_EXT HEX: 8D52 +CONSTANT: GL_RENDERBUFFER_ALPHA_SIZE_EXT HEX: 8D53 +CONSTANT: GL_RENDERBUFFER_DEPTH_SIZE_EXT HEX: 8D54 +CONSTANT: GL_RENDERBUFFER_STENCIL_SIZE_EXT HEX: 8D55 GL-FUNCTION: void glBindFramebufferEXT { } ( GLenum target, GLuint framebuffer ) ; GL-FUNCTION: void glBindRenderbufferEXT { } ( GLenum target, GLuint renderbuffer ) ; @@ -1777,24 +1773,24 @@ GL-FUNCTION: void glRenderbufferStorageEXT { } ( GLenum target, GLenum internalf ! GL_ARB_texture_float -: GL_RGBA32F_ARB HEX: 8814 ; inline -: GL_RGB32F_ARB HEX: 8815 ; inline -: GL_ALPHA32F_ARB HEX: 8816 ; inline -: GL_INTENSITY32F_ARB HEX: 8817 ; inline -: GL_LUMINANCE32F_ARB HEX: 8818 ; inline -: GL_LUMINANCE_ALPHA32F_ARB HEX: 8819 ; inline -: GL_RGBA16F_ARB HEX: 881A ; inline -: GL_RGB16F_ARB HEX: 881B ; inline -: GL_ALPHA16F_ARB HEX: 881C ; inline -: GL_INTENSITY16F_ARB HEX: 881D ; inline -: GL_LUMINANCE16F_ARB HEX: 881E ; inline -: GL_LUMINANCE_ALPHA16F_ARB HEX: 881F ; inline -: GL_TEXTURE_RED_TYPE_ARB HEX: 8C10 ; inline -: GL_TEXTURE_GREEN_TYPE_ARB HEX: 8C11 ; inline -: GL_TEXTURE_BLUE_TYPE_ARB HEX: 8C12 ; inline -: GL_TEXTURE_ALPHA_TYPE_ARB HEX: 8C13 ; inline -: GL_TEXTURE_LUMINANCE_TYPE_ARB HEX: 8C14 ; inline -: GL_TEXTURE_INTENSITY_TYPE_ARB HEX: 8C15 ; inline -: GL_TEXTURE_DEPTH_TYPE_ARB HEX: 8C16 ; inline -: GL_UNSIGNED_NORMALIZED_ARB HEX: 8C17 ; inline +CONSTANT: GL_RGBA32F_ARB HEX: 8814 +CONSTANT: GL_RGB32F_ARB HEX: 8815 +CONSTANT: GL_ALPHA32F_ARB HEX: 8816 +CONSTANT: GL_INTENSITY32F_ARB HEX: 8817 +CONSTANT: GL_LUMINANCE32F_ARB HEX: 8818 +CONSTANT: GL_LUMINANCE_ALPHA32F_ARB HEX: 8819 +CONSTANT: GL_RGBA16F_ARB HEX: 881A +CONSTANT: GL_RGB16F_ARB HEX: 881B +CONSTANT: GL_ALPHA16F_ARB HEX: 881C +CONSTANT: GL_INTENSITY16F_ARB HEX: 881D +CONSTANT: GL_LUMINANCE16F_ARB HEX: 881E +CONSTANT: GL_LUMINANCE_ALPHA16F_ARB HEX: 881F +CONSTANT: GL_TEXTURE_RED_TYPE_ARB HEX: 8C10 +CONSTANT: GL_TEXTURE_GREEN_TYPE_ARB HEX: 8C11 +CONSTANT: GL_TEXTURE_BLUE_TYPE_ARB HEX: 8C12 +CONSTANT: GL_TEXTURE_ALPHA_TYPE_ARB HEX: 8C13 +CONSTANT: GL_TEXTURE_LUMINANCE_TYPE_ARB HEX: 8C14 +CONSTANT: GL_TEXTURE_INTENSITY_TYPE_ARB HEX: 8C15 +CONSTANT: GL_TEXTURE_DEPTH_TYPE_ARB HEX: 8C16 +CONSTANT: GL_UNSIGNED_NORMALIZED_ARB HEX: 8C17 diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 10f9c57a83..f5868ee7a1 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -6,7 +6,7 @@ USING: alien alien.c-types continuations kernel libc math macros namespaces math.vectors math.constants math.functions math.parser opengl.gl opengl.glu combinators arrays sequences splitting words byte-arrays assocs colors accessors -generalizations locals specialized-arrays.float +generalizations locals fry specialized-arrays.float specialized-arrays.uint ; IN: opengl @@ -154,19 +154,21 @@ MACRO: all-enabled-client-state ( seq quot -- ) : delete-gl-buffer ( id -- ) [ glDeleteBuffers ] (delete-gl-object) ; -: with-gl-buffer ( binding id quot -- ) - -rot dupd glBindBuffer - [ slip ] [ 0 glBindBuffer ] [ ] cleanup ; inline +:: with-gl-buffer ( binding id quot -- ) + binding id glBindBuffer + quot [ binding 0 glBindBuffer ] [ ] cleanup ; inline : with-array-element-buffers ( array-buffer element-buffer quot -- ) - -rot GL_ELEMENT_ARRAY_BUFFER swap [ - swap GL_ARRAY_BUFFER -rot with-gl-buffer + [ GL_ELEMENT_ARRAY_BUFFER ] 2dip '[ + GL_ARRAY_BUFFER swap _ with-gl-buffer ] with-gl-buffer ; inline : ( target data hint -- id ) - pick gen-gl-buffer [ [ - [ dup byte-length swap ] dip glBufferData - ] with-gl-buffer ] keep ; + pick gen-gl-buffer [ + [ + [ [ byte-length ] keep ] dip glBufferData + ] with-gl-buffer + ] keep ; : buffer-offset ( int -- alien ) ; inline diff --git a/basis/opengl/shaders/authors.txt b/basis/opengl/shaders/authors.txt new file mode 100644 index 0000000000..6a0dc7293a --- /dev/null +++ b/basis/opengl/shaders/authors.txt @@ -0,0 +1 @@ +Joe Groff \ No newline at end of file diff --git a/basis/opengl/shaders/shaders-docs.factor b/basis/opengl/shaders/shaders-docs.factor new file mode 100644 index 0000000000..1a10071ddf --- /dev/null +++ b/basis/opengl/shaders/shaders-docs.factor @@ -0,0 +1,101 @@ +USING: help.markup help.syntax io kernel math quotations +opengl.gl multiline assocs strings ; +IN: opengl.shaders + +HELP: gl-shader +{ $class-description { $snippet "gl-shader" } " is a predicate class comprising values returned by OpenGL to represent shader objects. The following words are provided for creating and manipulating these objects:" + { $list + { { $link } " - Compile GLSL code into a shader object" } + { { $link gl-shader-ok? } " - Check whether a shader object compiled successfully" } + { { $link check-gl-shader } " - Throw an error unless a shader object compiled successfully" } + { { $link gl-shader-info-log } " - Retrieve the info log of messages generated by the GLSL compiler" } + { { $link delete-gl-shader } " - Invalidate a shader object" } + } + "The derived predicate classes " { $link vertex-shader } " and " { $link fragment-shader } " are also defined for the two standard kinds of shader defined by the OpenGL specification." } ; + +HELP: vertex-shader +{ $class-description { $snippet "vertex-shader" } " is the predicate class of " { $link gl-shader } " objects that refer to shaders of type " { $snippet "GL_VERTEX_SHADER" } ". In addition to the " { $snippet "gl-shader" } " words, the following vertex shader-specific functions are defined:" + { $list + { { $link } " - Compile GLSL code into a vertex shader object "} + } +} ; + +HELP: fragment-shader +{ $class-description { $snippet "fragment-shader" } " is the predicate class of " { $link gl-shader } " objects that refer to shaders of type " { $snippet "GL_FRAGMENT_SHADER" } ". In addition to the " { $snippet "gl-shader" } " words, the following fragment shader-specific functions are defined:" + { $list + { { $link } " - Compile GLSL code into a fragment shader object "} + } +} ; + +HELP: +{ $values { "source" "The GLSL source code to compile" } { "kind" "The kind of shader to compile, such as " { $snippet "GL_VERTEX_SHADER" } " or " { $snippet "GL_FRAGMENT_SHADER" } } { "shader" "a new " { $link gl-shader } } } +{ $description "Tries to compile the given GLSL source into a shader object. The returned object can be checked for validity by " { $link check-gl-shader } " or " { $link gl-shader-ok? } ". Errors and warnings generated by the GLSL compiler will be collected in the info log, available from " { $link gl-shader-info-log } ".\n\nWhen the shader object is no longer needed, it should be deleted using " { $link delete-gl-shader } " or else be attached to a " { $link gl-program } " object deleted using " { $link delete-gl-program } "." } ; + +HELP: +{ $values { "source" "The GLSL source code to compile" } { "vertex-shader" "a new " { $link vertex-shader } } } +{ $description "Tries to compile the given GLSL source into a vertex shader object. Equivalent to " { $snippet "GL_VERTEX_SHADER " } "." } ; + +HELP: +{ $values { "source" "The GLSL source code to compile" } { "fragment-shader" "a new " { $link fragment-shader } } } +{ $description "Tries to compile the given GLSL source into a fragment shader object. Equivalent to " { $snippet "GL_FRAGMENT_SHADER " } "." } ; + +HELP: gl-shader-ok? +{ $values { "shader" "A " { $link gl-shader } " object" } { "?" "a boolean" } } +{ $description "Returns a boolean value indicating whether the given shader object compiled successfully. Compilation errors and warnings are available in the shader's info log, which can be gotten using " { $link gl-shader-info-log } "." } ; + +HELP: check-gl-shader +{ $values { "shader" "A " { $link gl-shader } " object" } } +{ $description "Throws an error containing the " { $link gl-shader-info-log } " for the shader object if it failed to compile. Otherwise, the shader object is left on the stack." } ; + +HELP: delete-gl-shader +{ $values { "shader" "A " { $link gl-shader } " object" } } +{ $description "Deletes the shader object, invalidating it and releasing any resources allocated for it by the OpenGL implementation." } ; + +HELP: gl-shader-info-log +{ $values { "shader" "A " { $link gl-shader } " object" } { "shader" "a new " { $link gl-shader } } { "log" string } } +{ $description "Retrieves the info log for " { $snippet "shader" } ", including any errors or warnings generated in compiling the shader object." } ; + +HELP: gl-program +{ $class-description { $snippet "gl-program" } " is a predicate class comprising values returned by OpenGL to represent proram objects. The following words are provided for creating and manipulating these objects:" + { $list + { { $link } ", " { $link } " - Link a set of shaders into a GLSL program" } + { { $link gl-program-ok? } " - Check whether a program object linked successfully" } + { { $link check-gl-program } " - Throw an error unless a program object linked successfully" } + { { $link gl-program-info-log } " - Retrieve the info log of messages generated by the GLSL linker" } + { { $link gl-program-shaders } " - Retrieve the set of shader objects composing the GLSL program" } + { { $link delete-gl-program } " - Invalidate a program object and all its attached shaders" } + { { $link with-gl-program } " - Use a program object" } + } +} ; + +HELP: +{ $values { "shaders" "A sequence of " { $link gl-shader } " objects." } { "program" "a new " { $link gl-program } } } +{ $description "Creates a new GLSL program object, attaches all the shader objects in the " { $snippet "shaders" } " sequence, and attempts to link them. The returned object can be checked for validity by " { $link check-gl-program } " or " { $link gl-program-ok? } ". Errors and warnings generated by the GLSL linker will be collected in the info log, available from " { $link gl-program-info-log } ".\n\nWhen the program object and its attached shaders are no longer needed, it should be deleted using " { $link delete-gl-program } "." } ; + +HELP: +{ $values { "vertex-shader-source" "A string containing GLSL vertex shader source" } { "fragment-shader-source" "A string containing GLSL fragment shader source" } { "program" "a new " { $link gl-program } } } +{ $description "Wrapper for " { $link } " for the simple case of compiling a single vertex shader and fragment shader and linking them into a GLSL program. Throws an exception if compiling or linking fails." } ; + +{ } related-words + +HELP: gl-program-ok? +{ $values { "program" "A " { $link gl-program } " object" } { "?" "a boolean" } } +{ $description "Returns a boolean value indicating whether the given program object linked successfully. Link errors and warnings are available in the program's info log, which can be gotten using " { $link gl-program-info-log } "." } ; + +HELP: check-gl-program +{ $values { "program" "A " { $link gl-program } " object" } } +{ $description "Throws an error containing the " { $link gl-program-info-log } " for the program object if it failed to link. Otherwise, the program object is left on the stack." } ; + +HELP: gl-program-info-log +{ $values { "program" "A " { $link gl-program } " object" } { "log" string } } +{ $description "Retrieves the info log for " { $snippet "program" } ", including any errors or warnings generated in linking the program object." } ; + +HELP: delete-gl-program +{ $values { "program" "A " { $link gl-program } " object" } } +{ $description "Deletes the program object, invalidating it and releasing any resources allocated for it by the OpenGL implementation. Any attached " { $link gl-shader } "s are also deleted.\n\nIf the shader objects should be preserved, they should each be detached using " { $link detach-gl-program-shader } ". The program object can then be destroyed alone using " { $link delete-gl-program-only } "." } ; + +HELP: with-gl-program +{ $values { "program" "A " { $link gl-program } " object" } { "quot" "A quotation with stack effect " { $snippet "( program -- )" } } } +{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". " { $snippet "program" } " is left on the top of the stack when " { $snippet "quot" } " is called. The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ; + +ABOUT: "gl-utilities" diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor new file mode 100755 index 0000000000..eb5bbb0ee8 --- /dev/null +++ b/basis/opengl/shaders/shaders.factor @@ -0,0 +1,121 @@ +! Copyright (C) 2008 Joe Groff. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel opengl.gl alien.c-types continuations namespaces +assocs alien alien.strings libc opengl math sequences combinators +macros arrays io.encodings.ascii fry specialized-arrays.uint +destructors accessors ; +IN: opengl.shaders + +: with-gl-shader-source-ptr ( string quot -- ) + swap ascii malloc-string [ swap call ] keep free ; inline + +: ( source kind -- shader ) + glCreateShader dup rot + [ 1 swap f glShaderSource ] with-gl-shader-source-ptr + [ glCompileShader ] keep + gl-error ; + +: (gl-shader?) ( object -- ? ) + dup integer? [ glIsShader c-bool> ] [ drop f ] if ; + +: gl-shader-get-int ( shader enum -- value ) + 0 [ glGetShaderiv ] keep *int ; + +: gl-shader-ok? ( shader -- ? ) + GL_COMPILE_STATUS gl-shader-get-int c-bool> ; + +: ( source -- vertex-shader ) + GL_VERTEX_SHADER ; inline + +: (vertex-shader?) ( object -- ? ) + dup (gl-shader?) + [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ] + [ drop f ] if ; + +: ( source -- fragment-shader ) + GL_FRAGMENT_SHADER ; inline + +: (fragment-shader?) ( object -- ? ) + dup (gl-shader?) + [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ] + [ drop f ] if ; + +: gl-shader-info-log-length ( shader -- log-length ) + GL_INFO_LOG_LENGTH gl-shader-get-int ; inline + +: gl-shader-info-log ( shader -- log ) + dup gl-shader-info-log-length dup [ + 1 calloc &free + [ 0 swap glGetShaderInfoLog ] keep + ascii alien>string + ] with-destructors ; + +: check-gl-shader ( shader -- shader ) + dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ; + +: delete-gl-shader ( shader -- ) glDeleteShader ; inline + +PREDICATE: gl-shader < integer (gl-shader?) ; +PREDICATE: vertex-shader < gl-shader (vertex-shader?) ; +PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; + +! Programs + +: ( shaders -- program ) + glCreateProgram swap + [ dupd glAttachShader ] each + [ glLinkProgram ] keep + gl-error ; + +: (gl-program?) ( object -- ? ) + dup integer? [ glIsProgram c-bool> ] [ drop f ] if ; + +: gl-program-get-int ( program enum -- value ) + 0 [ glGetProgramiv ] keep *int ; + +: gl-program-ok? ( program -- ? ) + GL_LINK_STATUS gl-program-get-int c-bool> ; + +: gl-program-info-log-length ( program -- log-length ) + GL_INFO_LOG_LENGTH gl-program-get-int ; inline + +: gl-program-info-log ( program -- log ) + dup gl-program-info-log-length dup [ + 1 calloc &free + [ 0 swap glGetProgramInfoLog ] keep + ascii alien>string + ] with-destructors ; + +: check-gl-program ( program -- program ) + dup gl-program-ok? [ dup gl-program-info-log throw ] unless ; + +: gl-program-shaders-length ( program -- shaders-length ) + GL_ATTACHED_SHADERS gl-program-get-int ; inline + +: gl-program-shaders ( program -- shaders ) + dup gl-program-shaders-length + 0 + over + [ underlying>> glGetAttachedShaders ] keep ; + +: delete-gl-program-only ( program -- ) + glDeleteProgram ; inline + +: detach-gl-program-shader ( program shader -- ) + glDetachShader ; inline + +: delete-gl-program ( program -- ) + dup gl-program-shaders [ + 2dup detach-gl-program-shader delete-gl-shader + ] each delete-gl-program-only ; + +: with-gl-program ( program quot -- ) + over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline + +PREDICATE: gl-program < integer (gl-program?) ; + +: ( vertex-shader-source fragment-shader-source -- program ) + [ check-gl-shader ] + [ check-gl-shader ] bi* + 2array check-gl-program ; + diff --git a/basis/opengl/shaders/summary.txt b/basis/opengl/shaders/summary.txt new file mode 100644 index 0000000000..c55f76668f --- /dev/null +++ b/basis/opengl/shaders/summary.txt @@ -0,0 +1 @@ +OpenGL Shading Language (GLSL) support \ No newline at end of file diff --git a/basis/opengl/shaders/tags.txt b/basis/opengl/shaders/tags.txt new file mode 100755 index 0000000000..21154b6383 --- /dev/null +++ b/basis/opengl/shaders/tags.txt @@ -0,0 +1,2 @@ +opengl +bindings \ No newline at end of file diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor index 30501a6105..e512e3134c 100644 --- a/basis/openssl/libssl/libssl.factor +++ b/basis/openssl/libssl/libssl.factor @@ -13,64 +13,64 @@ IN: openssl.libssl { [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] } } cond >> -: X509_FILETYPE_PEM 1 ; inline -: X509_FILETYPE_ASN1 2 ; inline -: X509_FILETYPE_DEFAULT 3 ; inline - -: SSL_FILETYPE_ASN1 X509_FILETYPE_ASN1 ; inline -: SSL_FILETYPE_PEM X509_FILETYPE_PEM ; inline - -: SSL_CTRL_NEED_TMP_RSA 1 ; inline -: SSL_CTRL_SET_TMP_RSA 2 ; inline -: SSL_CTRL_SET_TMP_DH 3 ; inline -: SSL_CTRL_SET_TMP_RSA_CB 4 ; inline -: SSL_CTRL_SET_TMP_DH_CB 5 ; inline - -: SSL_CTRL_GET_SESSION_REUSED 6 ; inline -: SSL_CTRL_GET_CLIENT_CERT_REQUEST 7 ; inline -: SSL_CTRL_GET_NUM_RENEGOTIATIONS 8 ; inline -: SSL_CTRL_CLEAR_NUM_RENEGOTIATIONS 9 ; inline -: SSL_CTRL_GET_TOTAL_RENEGOTIATIONS 10 ; inline -: SSL_CTRL_GET_FLAGS 11 ; inline -: SSL_CTRL_EXTRA_CHAIN_CERT 12 ; inline - -: SSL_CTRL_SET_MSG_CALLBACK 13 ; inline -: SSL_CTRL_SET_MSG_CALLBACK_ARG 14 ; inline - -: SSL_CTRL_SESS_NUMBER 20 ; inline -: SSL_CTRL_SESS_CONNECT 21 ; inline -: SSL_CTRL_SESS_CONNECT_GOOD 22 ; inline -: SSL_CTRL_SESS_CONNECT_RENEGOTIATE 23 ; inline -: SSL_CTRL_SESS_ACCEPT 24 ; inline -: SSL_CTRL_SESS_ACCEPT_GOOD 25 ; inline -: SSL_CTRL_SESS_ACCEPT_RENEGOTIATE 26 ; inline -: SSL_CTRL_SESS_HIT 27 ; inline -: SSL_CTRL_SESS_CB_HIT 28 ; inline -: SSL_CTRL_SESS_MISSES 29 ; inline -: SSL_CTRL_SESS_TIMEOUTS 30 ; inline -: SSL_CTRL_SESS_CACHE_FULL 31 ; inline -: SSL_CTRL_OPTIONS 32 ; inline -: SSL_CTRL_MODE 33 ; inline - -: SSL_CTRL_GET_READ_AHEAD 40 ; inline -: SSL_CTRL_SET_READ_AHEAD 41 ; inline -: SSL_CTRL_SET_SESS_CACHE_SIZE 42 ; inline -: SSL_CTRL_GET_SESS_CACHE_SIZE 43 ; inline -: SSL_CTRL_SET_SESS_CACHE_MODE 44 ; inline -: SSL_CTRL_GET_SESS_CACHE_MODE 45 ; inline - -: SSL_CTRL_GET_MAX_CERT_LIST 50 ; inline -: SSL_CTRL_SET_MAX_CERT_LIST 51 ; inline - -: SSL_ERROR_NONE 0 ; inline -: SSL_ERROR_SSL 1 ; inline -: SSL_ERROR_WANT_READ 2 ; inline -: SSL_ERROR_WANT_WRITE 3 ; inline -: SSL_ERROR_WANT_X509_LOOKUP 4 ; inline -: SSL_ERROR_SYSCALL 5 ; inline ! consult errno for details -: SSL_ERROR_ZERO_RETURN 6 ; inline -: SSL_ERROR_WANT_CONNECT 7 ; inline -: SSL_ERROR_WANT_ACCEPT 8 ; inline +CONSTANT: X509_FILETYPE_PEM 1 +CONSTANT: X509_FILETYPE_ASN1 2 +CONSTANT: X509_FILETYPE_DEFAULT 3 + +ALIAS: SSL_FILETYPE_ASN1 X509_FILETYPE_ASN1 +ALIAS: SSL_FILETYPE_PEM X509_FILETYPE_PEM + +CONSTANT: SSL_CTRL_NEED_TMP_RSA 1 +CONSTANT: SSL_CTRL_SET_TMP_RSA 2 +CONSTANT: SSL_CTRL_SET_TMP_DH 3 +CONSTANT: SSL_CTRL_SET_TMP_RSA_CB 4 +CONSTANT: SSL_CTRL_SET_TMP_DH_CB 5 + +CONSTANT: SSL_CTRL_GET_SESSION_REUSED 6 +CONSTANT: SSL_CTRL_GET_CLIENT_CERT_REQUEST 7 +CONSTANT: SSL_CTRL_GET_NUM_RENEGOTIATIONS 8 +CONSTANT: SSL_CTRL_CLEAR_NUM_RENEGOTIATIONS 9 +CONSTANT: SSL_CTRL_GET_TOTAL_RENEGOTIATIONS 10 +CONSTANT: SSL_CTRL_GET_FLAGS 11 +CONSTANT: SSL_CTRL_EXTRA_CHAIN_CERT 12 + +CONSTANT: SSL_CTRL_SET_MSG_CALLBACK 13 +CONSTANT: SSL_CTRL_SET_MSG_CALLBACK_ARG 14 + +CONSTANT: SSL_CTRL_SESS_NUMBER 20 +CONSTANT: SSL_CTRL_SESS_CONNECT 21 +CONSTANT: SSL_CTRL_SESS_CONNECT_GOOD 22 +CONSTANT: SSL_CTRL_SESS_CONNECT_RENEGOTIATE 23 +CONSTANT: SSL_CTRL_SESS_ACCEPT 24 +CONSTANT: SSL_CTRL_SESS_ACCEPT_GOOD 25 +CONSTANT: SSL_CTRL_SESS_ACCEPT_RENEGOTIATE 26 +CONSTANT: SSL_CTRL_SESS_HIT 27 +CONSTANT: SSL_CTRL_SESS_CB_HIT 28 +CONSTANT: SSL_CTRL_SESS_MISSES 29 +CONSTANT: SSL_CTRL_SESS_TIMEOUTS 30 +CONSTANT: SSL_CTRL_SESS_CACHE_FULL 31 +CONSTANT: SSL_CTRL_OPTIONS 32 +CONSTANT: SSL_CTRL_MODE 33 + +CONSTANT: SSL_CTRL_GET_READ_AHEAD 40 +CONSTANT: SSL_CTRL_SET_READ_AHEAD 41 +CONSTANT: SSL_CTRL_SET_SESS_CACHE_SIZE 42 +CONSTANT: SSL_CTRL_GET_SESS_CACHE_SIZE 43 +CONSTANT: SSL_CTRL_SET_SESS_CACHE_MODE 44 +CONSTANT: SSL_CTRL_GET_SESS_CACHE_MODE 45 + +CONSTANT: SSL_CTRL_GET_MAX_CERT_LIST 50 +CONSTANT: SSL_CTRL_SET_MAX_CERT_LIST 51 + +CONSTANT: SSL_ERROR_NONE 0 +CONSTANT: SSL_ERROR_SSL 1 +CONSTANT: SSL_ERROR_WANT_READ 2 +CONSTANT: SSL_ERROR_WANT_WRITE 3 +CONSTANT: SSL_ERROR_WANT_X509_LOOKUP 4 +CONSTANT: SSL_ERROR_SYSCALL 5 ! consult errno for details +CONSTANT: SSL_ERROR_ZERO_RETURN 6 +CONSTANT: SSL_ERROR_WANT_CONNECT 7 +CONSTANT: SSL_ERROR_WANT_ACCEPT 8 ! Error messages table : error-messages ( -- hash ) @@ -157,8 +157,8 @@ FUNCTION: int SSL_read ( SSL* ssl, void* buf, int num ) ; FUNCTION: int SSL_shutdown ( SSL* ssl ) ; -: SSL_SENT_SHUTDOWN 1 ; -: SSL_RECEIVED_SHUTDOWN 2 ; +CONSTANT: SSL_SENT_SHUTDOWN 1 +CONSTANT: SSL_RECEIVED_SHUTDOWN 2 FUNCTION: int SSL_get_shutdown ( SSL* ssl ) ; @@ -172,10 +172,10 @@ FUNCTION: void SSL_SESSION_free ( SSL_SESSION* ses ) ; FUNCTION: int SSL_want ( SSL* ssl ) ; -: SSL_NOTHING 1 ; inline -: SSL_WRITING 2 ; inline -: SSL_READING 3 ; inline -: SSL_X509_LOOKUP 4 ; inline +CONSTANT: SSL_NOTHING 1 +CONSTANT: SSL_WRITING 2 +CONSTANT: SSL_READING 3 +CONSTANT: SSL_X509_LOOKUP 4 FUNCTION: long SSL_get_verify_result ( SSL* ssl ) ; @@ -199,10 +199,10 @@ FUNCTION: int SSL_CTX_load_verify_locations ( SSL_CTX* ctx, char* CAfile, FUNCTION: int SSL_CTX_set_default_verify_paths ( SSL_CTX* ctx ) ; -: SSL_VERIFY_NONE 0 ; inline -: SSL_VERIFY_PEER 1 ; inline -: SSL_VERIFY_FAIL_IF_NO_PEER_CERT 2 ; inline -: SSL_VERIFY_CLIENT_ONCE 4 ; inline +CONSTANT: SSL_VERIFY_NONE 0 +CONSTANT: SSL_VERIFY_PEER 1 +CONSTANT: SSL_VERIFY_FAIL_IF_NO_PEER_CERT 2 +CONSTANT: SSL_VERIFY_CLIENT_ONCE 4 FUNCTION: void SSL_CTX_set_verify ( SSL_CTX* ctx, int mode, void* callback ) ; @@ -242,16 +242,16 @@ FUNCTION: void* BIO_f_ssl ( ) ; : SSL_CTX_set_session_cache_mode ( ctx mode -- n ) [ SSL_CTRL_SET_SESS_CACHE_MODE ] dip f SSL_CTX_ctrl ; -: SSL_SESS_CACHE_OFF HEX: 0000 ; inline -: SSL_SESS_CACHE_CLIENT HEX: 0001 ; inline -: SSL_SESS_CACHE_SERVER HEX: 0002 ; inline +CONSTANT: SSL_SESS_CACHE_OFF HEX: 0000 +CONSTANT: SSL_SESS_CACHE_CLIENT HEX: 0001 +CONSTANT: SSL_SESS_CACHE_SERVER HEX: 0002 : SSL_SESS_CACHE_BOTH ( -- n ) { SSL_SESS_CACHE_CLIENT SSL_SESS_CACHE_SERVER } flags ; inline -: SSL_SESS_CACHE_NO_AUTO_CLEAR HEX: 0080 ; inline -: SSL_SESS_CACHE_NO_INTERNAL_LOOKUP HEX: 0100 ; inline -: SSL_SESS_CACHE_NO_INTERNAL_STORE HEX: 0200 ; inline +CONSTANT: SSL_SESS_CACHE_NO_AUTO_CLEAR HEX: 0080 +CONSTANT: SSL_SESS_CACHE_NO_INTERNAL_LOOKUP HEX: 0100 +CONSTANT: SSL_SESS_CACHE_NO_INTERNAL_STORE HEX: 0200 : SSL_SESS_CACHE_NO_INTERNAL ( -- n ) { SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE } flags ; inline @@ -282,8 +282,9 @@ H{ } clone verify-messages set-global : X509_V_: scan "X509_V_" prepend create-in scan-word - [ 1quotation define-inline ] - [ verify-messages get set-at ] 2bi ; parsing + [ 1quotation (( -- value )) define-inline ] + [ verify-messages get set-at ] + 2bi ; parsing >> @@ -333,4 +334,4 @@ X509_V_: ERR_APPLICATION_VERIFICATION 50 ! obj_mac.h ! =============================================== -: NID_commonName 13 ; inline +CONSTANT: NID_commonName 13 diff --git a/basis/pack/authors.txt b/basis/pack/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/pack/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/pack/pack-tests.factor b/basis/pack/pack-tests.factor new file mode 100755 index 0000000000..999a952174 --- /dev/null +++ b/basis/pack/pack-tests.factor @@ -0,0 +1,54 @@ +USING: io io.streams.string kernel namespaces make +pack strings tools.test pack.private ; +IN: pack.tests + +[ B{ 1 0 2 0 0 3 0 0 0 4 0 0 0 0 0 0 0 5 } ] [ + { 1 2 3 4 5 } + "cstiq" pack-be +] unit-test + +[ { 1 2 3 4 5 } ] [ + { 1 2 3 4 5 } + "cstiq" [ pack-be ] keep unpack-be +] unit-test + +[ B{ 1 2 0 3 0 0 4 0 0 0 5 0 0 0 0 0 0 0 } ] [ + [ + { 1 2 3 4 5 } "cstiq" pack-le + ] with-scope +] unit-test + +[ { 1 2 3 4 5 } ] [ + { 1 2 3 4 5 } + "cstiq" [ pack-le ] keep unpack-le +] unit-test + +[ { -1 -2 -3 -4 -5 } ] [ + { -1 -2 -3 -4 -5 } + "cstiq" [ pack-le ] keep unpack-le +] unit-test + +[ { -1 -2 -3 -4 -5 3.14 } ] [ + { -1 -2 -3 -4 -5 3.14 } + "cstiqd" [ pack-be ] keep unpack-be +] unit-test + +[ { -1 -2 -3 -4 -5 } ] [ + { -1 -2 -3 -4 -5 } + "cstiq" [ pack-native ] keep unpack-native +] unit-test + +[ 9 ] [ "iic" packed-length ] unit-test +[ "iii" read-packed-le ] must-infer +[ "iii" read-packed-be ] must-infer +[ "iii" read-packed-native ] must-infer +[ "iii" unpack-le ] must-infer +[ "iii" unpack-be ] must-infer +[ "iii" unpack-native ] must-infer +[ "iii" pack ] must-infer +[ "iii" unpack ] must-infer + +: test-pack ( str -- ba ) + "iii" pack ; + +[ test-pack ] must-infer diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor new file mode 100755 index 0000000000..aec4414c71 --- /dev/null +++ b/basis/pack/pack.factor @@ -0,0 +1,179 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types arrays assocs byte-arrays io +io.binary io.streams.string kernel math math.parser namespaces +make parser prettyprint quotations sequences strings vectors +words macros math.functions math.bitwise fry generalizations +combinators.smart io.streams.byte-array io.encodings.binary +math.vectors combinators multiline ; +IN: pack + +SYMBOL: big-endian + +: big-endian? ( -- ? ) + 1 *char zero? ; + + + +: >signed ( x n -- y ) + 2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ; + +: >endian ( obj n -- str ) + big-endian get [ >be ] [ >le ] if ; inline + +: unsigned-endian> ( obj -- str ) + big-endian get [ be> ] [ le> ] if ; inline + +: signed-endian> ( obj n -- str ) + [ unsigned-endian> ] dip >signed ; + +GENERIC: >n-byte-array ( obj n -- byte-array ) + +M: integer >n-byte-array ( m n -- byte-array ) >endian ; + +! for doing native, platform-dependent sized values +M: string >n-byte-array ( n string -- byte-array ) heap-size >n-byte-array ; + +: s8>byte-array ( n -- byte-array ) 1 >n-byte-array ; +: u8>byte-array ( n -- byte-array ) 1 >n-byte-array ; +: s16>byte-array ( n -- byte-array ) 2 >n-byte-array ; +: u16>byte-array ( n -- byte-array ) 2 >n-byte-array ; +: s24>byte-array ( n -- byte-array ) 3 >n-byte-array ; +: u24>byte-array ( n -- byte-array ) 3 >n-byte-array ; +: s32>byte-array ( n -- byte-array ) 4 >n-byte-array ; +: u32>byte-array ( n -- byte-array ) 4 >n-byte-array ; +: s64>byte-array ( n -- byte-array ) 8 >n-byte-array ; +: u64>byte-array ( n -- byte-array ) 8 >n-byte-array ; +: s128>byte-array ( n -- byte-array ) 16 >n-byte-array ; +: u128>byte-array ( n -- byte-array ) 16 >n-byte-array ; +: write-float ( n -- byte-array ) float>bits 4 >n-byte-array ; +: write-double ( n -- byte-array ) double>bits 8 >n-byte-array ; +: write-c-string ( byte-array -- byte-array ) { 0 } B{ } append-as ; + +byte-array } + { CHAR: C u8>byte-array } + { CHAR: s s16>byte-array } + { CHAR: S u16>byte-array } + { CHAR: t s24>byte-array } + { CHAR: T u24>byte-array } + { CHAR: i s32>byte-array } + { CHAR: I u32>byte-array } + { CHAR: q s64>byte-array } + { CHAR: Q u64>byte-array } + { CHAR: f write-float } + { CHAR: F write-float } + { CHAR: d write-double } + { CHAR: D write-double } + } + +CONSTANT: unpack-table + H{ + { CHAR: c [ 8 signed-endian> ] } + { CHAR: C [ unsigned-endian> ] } + { CHAR: s [ 16 signed-endian> ] } + { CHAR: S [ unsigned-endian> ] } + { CHAR: t [ 24 signed-endian> ] } + { CHAR: T [ unsigned-endian> ] } + { CHAR: i [ 32 signed-endian> ] } + { CHAR: I [ unsigned-endian> ] } + { CHAR: q [ 64 signed-endian> ] } + { CHAR: Q [ unsigned-endian> ] } + { CHAR: f [ unsigned-endian> bits>float ] } + { CHAR: F [ unsigned-endian> bits>float ] } + { CHAR: d [ unsigned-endian> bits>double ] } + { CHAR: D [ unsigned-endian> bits>double ] } + } + +CONSTANT: packed-length-table + H{ + { CHAR: c 1 } + { CHAR: C 1 } + { CHAR: s 2 } + { CHAR: S 2 } + { CHAR: t 3 } + { CHAR: T 3 } + { CHAR: i 4 } + { CHAR: I 4 } + { CHAR: q 8 } + { CHAR: Q 8 } + { CHAR: f 4 } + { CHAR: F 4 } + { CHAR: d 8 } + { CHAR: D 8 } + } + +MACRO: pack ( str -- quot ) + [ pack-table at '[ _ execute ] ] { } map-as + '[ _ spread ] + '[ _ input + +: ch>packed-length ( ch -- n ) + packed-length-table at ; inline + +: packed-length ( str -- n ) + [ ch>packed-length ] sigma ; + +: pack-native ( seq str -- seq ) + [ set-big-endian pack ] with-scope ; inline + +: pack-be ( seq str -- seq ) + [ big-endian on pack ] with-scope ; inline + +: pack-le ( seq str -- seq ) + [ big-endian off pack ] with-scope ; inline + +packed-length ] { } map-as start/end ] + [ [ unpack-table at '[ @ ] ] { } map-as ] bi + [ '[ [ _ _ ] dip @ ] ] 3map + '[ _ cleave ] '[ _ output>array ] ; + +PRIVATE> + +: unpack-native ( seq str -- seq ) + [ set-big-endian unpack ] with-scope ; inline + +: unpack-be ( seq str -- seq ) + [ big-endian on unpack ] with-scope ; inline + +: unpack-le ( seq str -- seq ) + [ big-endian off unpack ] with-scope ; inline + +ERROR: packed-read-fail str bytes ; + + + +: read-packed ( str quot -- seq ) + [ read-packed-bytes ] swap bi ; inline + +: read-packed-le ( str -- seq ) + [ unpack-le ] read-packed ; inline + +: read-packed-be ( str -- seq ) + [ unpack-be ] read-packed ; inline + +: read-packed-native ( str -- seq ) + [ unpack-native ] read-packed ; inline diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor index 7434ca6a7a..a9fb366812 100644 --- a/basis/peg/parsers/parsers.factor +++ b/basis/peg/parsers/parsers.factor @@ -51,8 +51,7 @@ PRIVATE> dup zero? [ 2drop epsilon ] [ - 2dup exactly-n - -rot 1- at-most-n 2choice + [ exactly-n ] [ 1- at-most-n ] 2bi 2choice ] if ; : at-least-n ( parser n -- parser' ) diff --git a/basis/peg/peg-tests.factor b/basis/peg/peg-tests.factor index 2d7e2a81ac..9a15dd2105 100644 --- a/basis/peg/peg-tests.factor +++ b/basis/peg/peg-tests.factor @@ -2,9 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. ! USING: kernel tools.test strings namespaces make arrays sequences - peg peg.private accessors words math accessors ; + peg peg.private peg.parsers accessors words math accessors ; IN: peg.tests +[ ] [ reset-pegs ] unit-test + [ "endbegin" "begin" token parse ] must-fail @@ -193,4 +195,16 @@ IN: peg.tests "B" [ drop t ] satisfy [ 66 >= ] semantic parse ] unit-test -{ f } [ \ + T{ parser f f f } equal? ] unit-test \ No newline at end of file +{ f } [ \ + T{ parser f f f } equal? ] unit-test + +USE: compiler + +[ ] [ disable-compiler ] unit-test + +[ ] [ "" epsilon parse drop ] unit-test + +[ ] [ enable-compiler ] unit-test + +[ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test + +[ [ ] ] [ "" epsilon [ drop [ [ ] ] ] action [ call ] action parse ] unit-test \ No newline at end of file diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 3fc6fec8ed..206a054d35 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -373,7 +373,7 @@ TUPLE: range-parser min max ; pick empty? [ 3drop f ] [ - pick first -rot between? [ + [ dup first ] 2dip between? [ unclip-slice ] [ drop f diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor index 83c4a196d9..be63d807b9 100644 --- a/basis/persistent/deques/deques.factor +++ b/basis/persistent/deques/deques.factor @@ -1,6 +1,6 @@ ! Copyback (C) 2008 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors math qualified ; +USING: kernel accessors math ; QUALIFIED: sequences IN: persistent.deques @@ -14,7 +14,7 @@ C: cons : each ( list quot: ( elt -- ) -- ) over - [ [ >r car>> r> call ] [ >r cdr>> r> ] 2bi each ] + [ [ [ car>> ] dip call ] [ [ cdr>> ] dip ] 2bi each ] [ 2drop ] if ; inline recursive : reduce ( list start quot -- end ) @@ -27,7 +27,7 @@ C: cons 0 [ drop 1+ ] reduce ; : cut ( list index -- back front-reversed ) - f swap [ >r [ cdr>> ] [ car>> ] bi r> ] times ; + f swap [ [ [ cdr>> ] [ car>> ] bi ] dip ] times ; : split-reverse ( list -- back-reversed front ) dup length 2/ cut [ reverse ] bi@ ; @@ -41,7 +41,7 @@ TUPLE: deque { front read-only } { back read-only } ; [ back>> ] [ front>> ] bi deque boa ; : flipped ( deque quot -- newdeque ) - >r flip r> call flip ; + [ flip ] dip call flip ; PRIVATE> : deque-empty? ( deque -- ? ) diff --git a/basis/persistent/hashtables/nodes/leaf/leaf.factor b/basis/persistent/hashtables/nodes/leaf/leaf.factor index 3419e8387f..94174d5667 100644 --- a/basis/persistent/hashtables/nodes/leaf/leaf.factor +++ b/basis/persistent/hashtables/nodes/leaf/leaf.factor @@ -6,7 +6,8 @@ persistent.hashtables.nodes ; IN: persistent.hashtables.nodes.leaf : matching-key? ( key hashcode leaf-node -- ? ) - tuck hashcode>> eq? [ key>> = ] [ 2drop f ] if ; inline + [ nip ] [ hashcode>> eq? ] 2bi + [ key>> = ] [ 2drop f ] if ; inline M: leaf-node (entry-at) [ matching-key? ] keep and ; diff --git a/basis/persistent/heaps/heaps.factor b/basis/persistent/heaps/heaps.factor index 6381b91dc3..f6d38b5b25 100644 --- a/basis/persistent/heaps/heaps.factor +++ b/basis/persistent/heaps/heaps.factor @@ -32,7 +32,7 @@ PRIVATE> [ >branch< swap remove-left -rot [ ] 2dip rot ] if ; : both-with? ( obj a b quot -- ? ) - swap >r with r> swap both? ; inline + swap [ with ] dip swap both? ; inline GENERIC: sift-down ( value prio left right -- heap ) diff --git a/basis/persistent/sequences/sequences-docs.factor b/basis/persistent/sequences/sequences-docs.factor index 986b16c737..6928d03f55 100644 --- a/basis/persistent/sequences/sequences-docs.factor +++ b/basis/persistent/sequences/sequences-docs.factor @@ -14,7 +14,7 @@ HELP: ppop { $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." } ; ARTICLE: "persistent.sequences" "Persistent sequence protocol" -"The persistent sequence protocol consists of the non-mutating sequence protocol words, such as " { $link length } " and " { $link nth } ", together with the following operations:" +"The persistent sequence protocol consists of the non-mutating sequence protocol words, such as " { $link length } " and " { $link nth } ", together with the following operations:" { $subsection new-nth } { $subsection ppush } { $subsection ppop } diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor index cd8e7c49e0..554db08e70 100644 --- a/basis/persistent/vectors/vectors.factor +++ b/basis/persistent/vectors/vectors.factor @@ -22,9 +22,9 @@ M: persistent-vector length count>> ; : node-size 32 ; inline -: node-mask node-size mod ; inline +: node-mask ( m -- n ) node-size mod ; inline -: node-shift -5 * shift ; inline +: node-shift ( m n -- x ) -5 * shift ; inline : node-nth ( i node -- obj ) [ node-mask ] [ children>> ] bi* nth ; diff --git a/basis/porter-stemmer/authors.txt b/basis/porter-stemmer/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/porter-stemmer/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/porter-stemmer/porter-stemmer-docs.factor b/basis/porter-stemmer/porter-stemmer-docs.factor new file mode 100644 index 0000000000..e16190f861 --- /dev/null +++ b/basis/porter-stemmer/porter-stemmer-docs.factor @@ -0,0 +1,74 @@ +IN: porter-stemmer +USING: help.markup help.syntax ; + +HELP: step1a +{ $values { "str" "a string" } { "newstr" "a new string" } } +{ $description "Gets rid of plurals." } +{ $examples + { $table + { "Input:" "Output:" } + { "caresses" "caress" } + { "ponies" "poni" } + { "ties" "ti" } + { "caress" "caress" } + { "cats" "cat" } + } +} ; + +HELP: step1b +{ $values { "str" "a string" } { "newstr" "a new string" } } +{ $description "Gets rid of \"-ed\" and \"-ing\" suffixes." } +{ $examples + { $table + { "Input:" "Output:" } + { "feed" "feed" } + { "agreed" "agree" } + { "disabled" "disable" } + { "matting" "mat" } + { "mating" "mate" } + { "meeting" "meet" } + { "milling" "mill" } + { "messing" "mess" } + { "meetings" "meet" } + } +} ; + +HELP: step1c +{ $values { "str" "a string" } { "newstr" "a new string" } } +{ $description "Turns a terminal y to i when there is another vowel in the stem." } ; + +HELP: step2 +{ $values { "str" "a string" } { "newstr" "a new string" } } +{ $description "Maps double suffices to single ones. so -ization maps to -ize etc. note that the string before the suffix must give positive " { $link consonant-seq } "." } ; + +HELP: step3 +{ $values { "str" "a string" } { "newstr" "a new string" } } +{ $description "Deals with -c-, -full, -ness, etc. Similar strategy to " { $link step2 } "." } ; + +HELP: step5 +{ $values { "str" "a string" } { "newstr" "a new string" } } +{ $description "Removes a final -e and changes a final -ll to -l if " { $link consonant-seq } " is greater than 1," } ; + +HELP: stem +{ $values { "str" "a string" } { "newstr" "a new string" } } +{ $description "Applies the Porter stemming algorithm to the input string." } ; + +ARTICLE: "porter-stemmer" "Porter stemming algorithm" +"The help system uses the Porter stemming algorithm to normalize words when building the full-text search index." +$nl +"The Factor implementation of the algorithm is based on the Common Lisp version, which was hand-translated from ANSI C by Steven M. Haflich. The original ANSI C was written by Martin Porter." +$nl +"A detailed description of the algorithm, along with implementations in various languages, can be at in " { $url "http://www.tartarus.org/~martin/PorterStemmer" } "." +$nl +"The main word of the algorithm takes an English word as input and outputs its stem:" +{ $subsection stem } +"The algorithm consists of a number of steps:" +{ $subsection step1a } +{ $subsection step1b } +{ $subsection step1c } +{ $subsection step2 } +{ $subsection step3 } +{ $subsection step4 } +{ $subsection step5 } ; + +ABOUT: "porter-stemmer" diff --git a/basis/porter-stemmer/porter-stemmer-tests.factor b/basis/porter-stemmer/porter-stemmer-tests.factor new file mode 100644 index 0000000000..72bf5c0bb5 --- /dev/null +++ b/basis/porter-stemmer/porter-stemmer-tests.factor @@ -0,0 +1,64 @@ +IN: porter-stemmer.tests +USING: arrays io kernel porter-stemmer sequences tools.test +io.files io.encodings.utf8 ; + +[ 0 ] [ "xa" consonant-seq ] unit-test +[ 0 ] [ "xxaa" consonant-seq ] unit-test +[ 1 ] [ "xaxa" consonant-seq ] unit-test +[ 2 ] [ "xaxaxa" consonant-seq ] unit-test +[ 3 ] [ "xaxaxaxa" consonant-seq ] unit-test +[ 3 ] [ "zzzzxaxaxaxaeee" consonant-seq ] unit-test + +[ t ] [ 0 "fish" consonant? ] unit-test +[ f ] [ 0 "and" consonant? ] unit-test +[ t ] [ 0 "yes" consonant? ] unit-test +[ f ] [ 1 "gym" consonant? ] unit-test + +[ t ] [ 5 "splitting" double-consonant? ] unit-test +[ f ] [ 2 "feel" double-consonant? ] unit-test + +[ f ] [ "xxxz" stem-vowel? ] unit-test +[ t ] [ "baobab" stem-vowel? ] unit-test + +[ t ] [ "hop" cvc? ] unit-test +[ t ] [ "cav" cvc? ] unit-test +[ t ] [ "lov" cvc? ] unit-test +[ t ] [ "crim" cvc? ] unit-test +[ f ] [ "show" cvc? ] unit-test +[ f ] [ "box" cvc? ] unit-test +[ f ] [ "tray" cvc? ] unit-test +[ f ] [ "meet" cvc? ] unit-test + +[ "caress" ] [ "caresses" step1a step1b "" like ] unit-test +[ "poni" ] [ "ponies" step1a step1b "" like ] unit-test +[ "ti" ] [ "ties" step1a step1b "" like ] unit-test +[ "caress" ] [ "caress" step1a step1b "" like ] unit-test +[ "cat" ] [ "cats" step1a step1b "" like ] unit-test +[ "feed" ] [ "feed" step1a step1b "" like ] unit-test +[ "agree" ] [ "agreed" step1a step1b "" like ] unit-test +[ "disable" ] [ "disabled" step1a step1b "" like ] unit-test +[ "mat" ] [ "matting" step1a step1b "" like ] unit-test +[ "mate" ] [ "mating" step1a step1b "" like ] unit-test +[ "meet" ] [ "meeting" step1a step1b "" like ] unit-test +[ "mill" ] [ "milling" step1a step1b "" like ] unit-test +[ "mess" ] [ "messing" step1a step1b "" like ] unit-test +[ "meet" ] [ "meetings" step1a step1b "" like ] unit-test + +[ "fishi" ] [ "fishy" step1c ] unit-test +[ "by" ] [ "by" step1c ] unit-test + +[ "realizat" ] [ "realization" step4 ] unit-test +[ "ion" ] [ "ion" step4 ] unit-test +[ "able" ] [ "able" step4 ] unit-test + +[ "fear" ] [ "feare" step5 "" like ] unit-test +[ "mate" ] [ "mate" step5 "" like ] unit-test +[ "hell" ] [ "hell" step5 "" like ] unit-test +[ "mate" ] [ "mate" step5 "" like ] unit-test + +[ { } ] [ + "resource:basis/porter-stemmer/test/voc.txt" utf8 file-lines + [ stem ] map + "resource:basis/porter-stemmer/test/output.txt" utf8 file-lines + [ 2array ] 2map [ first2 = not ] filter +] unit-test diff --git a/basis/porter-stemmer/porter-stemmer.factor b/basis/porter-stemmer/porter-stemmer.factor new file mode 100644 index 0000000000..b6eb0ff464 --- /dev/null +++ b/basis/porter-stemmer/porter-stemmer.factor @@ -0,0 +1,219 @@ +IN: porter-stemmer +USING: kernel math parser sequences combinators splitting ; + +: consonant? ( i str -- ? ) + 2dup nth dup "aeiou" member? [ + 3drop f + ] [ + CHAR: y = [ + over zero? + [ 2drop t ] [ [ 1- ] dip consonant? not ] if + ] [ + 2drop t + ] if + ] if ; + +: skip-vowels ( i str -- i str ) + 2dup bounds-check? [ + 2dup consonant? [ [ 1+ ] dip skip-vowels ] unless + ] when ; + +: skip-consonants ( i str -- i str ) + 2dup bounds-check? [ + 2dup consonant? [ [ 1+ ] dip skip-consonants ] when + ] when ; + +: (consonant-seq) ( n i str -- n ) + skip-vowels + 2dup bounds-check? [ + [ 1+ ] [ 1+ ] [ ] tri* skip-consonants [ 1+ ] dip + (consonant-seq) + ] [ + 2drop + ] if ; + +: consonant-seq ( str -- n ) + 0 0 rot skip-consonants (consonant-seq) ; + +: stem-vowel? ( str -- ? ) + [ length ] keep [ consonant? ] curry all? not ; + +: double-consonant? ( i str -- ? ) + over 1 < [ + 2drop f + ] [ + 2dup nth [ over 1- over nth ] dip = [ + consonant? + ] [ + 2drop f + ] if + ] if ; + +: consonant-end? ( n seq -- ? ) + [ length swap - ] keep consonant? ; + +: last-is? ( str possibilities -- ? ) [ peek ] dip member? ; + +: cvc? ( str -- ? ) + { + { [ dup length 3 < ] [ drop f ] } + { [ 1 over consonant-end? not ] [ drop f ] } + { [ 2 over consonant-end? ] [ drop f ] } + { [ 3 over consonant-end? not ] [ drop f ] } + [ "wxy" last-is? not ] + } cond ; + +: r ( str oldsuffix newsuffix -- str ) + pick consonant-seq 0 > [ nip ] [ drop ] if append ; + +: step1a ( str -- newstr ) + dup peek CHAR: s = [ + { + { [ "sses" ?tail ] [ "ss" append ] } + { [ "ies" ?tail ] [ "i" append ] } + { [ dup "ss" tail? ] [ ] } + { [ "s" ?tail ] [ ] } + [ ] + } cond + ] when ; + +: -eed ( str -- str ) + dup consonant-seq 0 > "ee" "eed" ? append ; + +: -ed ( str -- str ? ) + dup stem-vowel? [ [ "ed" append ] unless ] keep ; + +: -ing ( str -- str ? ) + dup stem-vowel? [ [ "ing" append ] unless ] keep ; + +: -ed/ing ( str -- str ) + { + { [ "at" ?tail ] [ "ate" append ] } + { [ "bl" ?tail ] [ "ble" append ] } + { [ "iz" ?tail ] [ "ize" append ] } + { + [ dup length 1- over double-consonant? ] + [ dup "lsz" last-is? [ but-last-slice ] unless ] + } + { + [ t ] + [ + dup consonant-seq 1 = over cvc? and + [ "e" append ] when + ] + } + } cond ; + +: step1b ( str -- newstr ) + { + { [ "eed" ?tail ] [ -eed ] } + { + [ + { + { [ "ed" ?tail ] [ -ed ] } + { [ "ing" ?tail ] [ -ing ] } + [ f ] + } cond + ] [ -ed/ing ] + } + [ ] + } cond ; + +: step1c ( str -- newstr ) + dup but-last-slice stem-vowel? [ + "y" ?tail [ "i" append ] when + ] when ; + +: step2 ( str -- newstr ) + { + { [ "ational" ?tail ] [ "ational" "ate" r ] } + { [ "tional" ?tail ] [ "tional" "tion" r ] } + { [ "enci" ?tail ] [ "enci" "ence" r ] } + { [ "anci" ?tail ] [ "anci" "ance" r ] } + { [ "izer" ?tail ] [ "izer" "ize" r ] } + { [ "bli" ?tail ] [ "bli" "ble" r ] } + { [ "alli" ?tail ] [ "alli" "al" r ] } + { [ "entli" ?tail ] [ "entli" "ent" r ] } + { [ "eli" ?tail ] [ "eli" "e" r ] } + { [ "ousli" ?tail ] [ "ousli" "ous" r ] } + { [ "ization" ?tail ] [ "ization" "ize" r ] } + { [ "ation" ?tail ] [ "ation" "ate" r ] } + { [ "ator" ?tail ] [ "ator" "ate" r ] } + { [ "alism" ?tail ] [ "alism" "al" r ] } + { [ "iveness" ?tail ] [ "iveness" "ive" r ] } + { [ "fulness" ?tail ] [ "fulness" "ful" r ] } + { [ "ousness" ?tail ] [ "ousness" "ous" r ] } + { [ "aliti" ?tail ] [ "aliti" "al" r ] } + { [ "iviti" ?tail ] [ "iviti" "ive" r ] } + { [ "biliti" ?tail ] [ "biliti" "ble" r ] } + { [ "logi" ?tail ] [ "logi" "log" r ] } + [ ] + } cond ; + +: step3 ( str -- newstr ) + { + { [ "icate" ?tail ] [ "icate" "ic" r ] } + { [ "ative" ?tail ] [ "ative" "" r ] } + { [ "alize" ?tail ] [ "alize" "al" r ] } + { [ "iciti" ?tail ] [ "iciti" "ic" r ] } + { [ "ical" ?tail ] [ "ical" "ic" r ] } + { [ "ful" ?tail ] [ "ful" "" r ] } + { [ "ness" ?tail ] [ "ness" "" r ] } + [ ] + } cond ; + +: -ion ( str -- newstr ) + [ + "ion" + ] [ + dup "st" last-is? [ "ion" append ] unless + ] if-empty ; + +: step4 ( str -- newstr ) + dup { + { [ "al" ?tail ] [ ] } + { [ "ance" ?tail ] [ ] } + { [ "ence" ?tail ] [ ] } + { [ "er" ?tail ] [ ] } + { [ "ic" ?tail ] [ ] } + { [ "able" ?tail ] [ ] } + { [ "ible" ?tail ] [ ] } + { [ "ant" ?tail ] [ ] } + { [ "ement" ?tail ] [ ] } + { [ "ment" ?tail ] [ ] } + { [ "ent" ?tail ] [ ] } + { [ "ion" ?tail ] [ -ion ] } + { [ "ou" ?tail ] [ ] } + { [ "ism" ?tail ] [ ] } + { [ "ate" ?tail ] [ ] } + { [ "iti" ?tail ] [ ] } + { [ "ous" ?tail ] [ ] } + { [ "ive" ?tail ] [ ] } + { [ "ize" ?tail ] [ ] } + [ ] + } cond dup consonant-seq 1 > [ nip ] [ drop ] if ; + +: remove-e? ( str -- ? ) + dup consonant-seq dup 1 > + [ 2drop t ] + [ 1 = [ but-last-slice cvc? not ] [ drop f ] if ] if ; + +: remove-e ( str -- newstr ) + dup peek CHAR: e = [ + dup remove-e? [ but-last-slice ] when + ] when ; + +: ll->l ( str -- newstr ) + { + { [ dup peek CHAR: l = not ] [ ] } + { [ dup length 1- over double-consonant? not ] [ ] } + { [ dup consonant-seq 1 > ] [ but-last-slice ] } + [ ] + } cond ; + +: step5 ( str -- newstr ) remove-e ll->l ; + +: stem ( str -- newstr ) + dup length 2 <= [ + step1a step1b step1c step2 step3 step4 step5 "" like + ] unless ; diff --git a/basis/porter-stemmer/summary.txt b/basis/porter-stemmer/summary.txt new file mode 100644 index 0000000000..dd7746bcee --- /dev/null +++ b/basis/porter-stemmer/summary.txt @@ -0,0 +1 @@ +Porter stemming algorithm diff --git a/basis/porter-stemmer/test/output.txt b/basis/porter-stemmer/test/output.txt new file mode 100644 index 0000000000..595cb676c3 --- /dev/null +++ b/basis/porter-stemmer/test/output.txt @@ -0,0 +1,23531 @@ +a +aaron +abaissiez +abandon +abandon +abas +abash +abat +abat +abat +abat +abat +abbess +abbei +abbei +abbomin +abbot +abbot +abbrevi +ab +abel +aberga +abergavenni +abet +abet +abhomin +abhor +abhorr +abhor +abhor +abhor +abhorson +abid +abid +abil +abil +abject +abjectli +abject +abjur +abjur +abl +abler +aboard +abod +abod +abod +abod +abomin +abomin +abomin +abort +abort +abound +abound +about +abov +abr +abraham +abram +abreast +abridg +abridg +abridg +abridg +abroach +abroad +abrog +abrook +abrupt +abrupt +abruptli +absenc +absent +absei +absolut +absolut +absolv +absolv +abstain +abstemi +abstin +abstract +absurd +absyrtu +abund +abund +abundantli +abu +abus +abus +abus +abus +abus +abut +abi +abysm +ac +academ +academ +accent +accent +accept +accept +accept +accept +accept +access +accessari +access +accid +accid +accident +accident +accid +accit +accit +accit +acclam +accommod +accommod +accommod +accommod +accommodo +accompani +accompani +accompani +accomplic +accomplish +accomplish +accomplish +accomplish +accompt +accord +accord +accord +accordeth +accord +accordingli +accord +accost +accost +account +account +account +account +accoutr +accoutr +accoutr +accru +accumul +accumul +accumul +accur +accurs +accurst +accu +accus +accus +accus +accusativo +accus +accus +accus +accus +accus +accuseth +accus +accustom +accustom +ac +acerb +ach +acheron +ach +achiev +achiev +achiev +achiev +achiev +achiev +achiev +achiev +achil +ach +achitophel +acknowledg +acknowledg +acknowledg +acknowledg +acknown +acold +aconitum +acordo +acorn +acquaint +acquaint +acquaint +acquaint +acquir +acquir +acquisit +acquit +acquitt +acquitt +acquit +acr +acr +across +act +actaeon +act +act +action +action +actium +activ +activ +activ +actor +actor +act +actual +actur +acut +acut +ad +adag +adalla +adam +adam +add +ad +adder +adder +addeth +addict +addict +addict +ad +addit +addit +addl +address +address +addrest +add +adher +adher +adieu +adieu +adjac +adjoin +adjoin +adjourn +adjudg +adjudg +adjunct +administ +administr +admir +admir +admir +admir +admir +admir +admir +admir +admiringli +admiss +admit +admit +admitt +admit +admit +admonish +admonish +admonish +admonish +admonit +ado +adoni +adopt +adopt +adoptedli +adopt +adopti +adopt +ador +ador +ador +ador +ador +ador +adorest +adoreth +ador +adorn +adorn +adorn +adorn +adorn +adown +adramadio +adrian +adriana +adriano +adriat +adsum +adul +adulter +adulter +adulter +adulteress +adulteri +adulter +adulteri +adultress +advanc +advanc +advanc +advanc +advanc +advanc +advanc +advantag +advantag +advantag +advantag +advantag +advantag +advent +adventur +adventur +adventur +adventur +adventur +adventur +adversari +adversari +advers +advers +advers +advers +adverti +advertis +advertis +advertis +advertis +advic +advi +advis +advis +advisedli +advis +advis +advoc +advoc +aeacida +aeacid +aedil +aedil +aegeon +aegion +aegl +aemelia +aemilia +aemiliu +aenea +aeolu +aer +aerial +aeri +aesculapiu +aeson +aesop +aetna +afar +afear +afeard +affabl +affabl +affair +affair +affair +affect +affect +affect +affect +affectedli +affecteth +affect +affect +affection +affection +affect +affect +affeer +affianc +affianc +affianc +affi +affin +affin +affin +affirm +affirm +affirm +afflict +afflict +afflict +afflict +afflict +afford +affordeth +afford +affrai +affright +affright +affright +affront +affront +affi +afield +afir +afloat +afoot +afor +aforehand +aforesaid +afraid +afresh +afric +africa +african +afront +after +afternoon +afterward +afterward +ag +again +against +agamemmon +agamemnon +agat +agaz +ag +ag +agenor +agent +agent +ag +aggrav +aggrief +agil +agincourt +agit +aglet +agniz +ago +agon +agoni +agre +agre +agre +agreement +agre +agrippa +aground +agu +aguecheek +agu +aguefac +agu +ah +aha +ahungri +ai +aialvolio +aiaria +aid +aidanc +aidant +aid +aid +aidless +aid +ail +aim +aim +aimest +aim +aim +ainsi +aio +air +air +airless +air +airi +ajax +akil +al +alabast +alack +alacr +alarbu +alarm +alarm +alarum +alarum +ala +alb +alban +alban +albani +albeit +albion +alchemist +alchemi +alcibiad +alcid +alder +alderman +aldermen +al +alecto +alehous +alehous +alencon +alengon +aleppo +al +alewif +alexand +alexand +alexandria +alexandrian +alexa +alia +alic +alien +aliena +alight +alight +alight +alii +alik +alisand +aliv +all +alla +allai +allai +allai +allay +allay +allai +alleg +alleg +alleg +alleg +allegi +allegi +allei +allei +allhallowma +allianc +allicholi +alli +alli +allig +allig +allon +allot +allot +allot +allotteri +allow +allow +allow +allow +allow +allur +allur +allur +allur +allus +alli +allycholli +almain +almanac +almanack +almanac +almighti +almond +almost +alm +almsman +alo +aloft +alon +along +alonso +aloof +aloud +alphabet +alphabet +alphonso +alp +alreadi +also +alt +altar +altar +alter +alter +alter +alter +althaea +although +altitud +altogeth +alton +alwai +alwai +am +amaimon +amain +amak +amamon +amaz +amaz +amaz +amazedli +amazed +amaz +amaz +amazeth +amaz +amazon +amazonian +amazon +ambassador +ambassador +amber +ambiguid +ambigu +ambigu +ambit +ambit +ambiti +ambiti +ambl +ambl +ambl +ambl +ambo +ambuscado +ambush +amen +amend +amend +amend +amend +amerc +america +am +amiabl +amid +amidst +amien +ami +amiss +amiti +amiti +amnipot +among +amongst +amor +amor +amort +amount +amount +amour +amphimacu +ampl +ampler +amplest +amplifi +amplifi +ampli +ampthil +amurath +amynta +an +anatomiz +anatom +anatomi +ancestor +ancestor +ancestri +anchis +anchor +anchorag +anchor +anchor +anchor +anchovi +ancient +ancientri +ancient +ancu +and +andiron +andpholu +andren +andrew +andromach +andronici +andronicu +anew +ang +angel +angelica +angel +angelo +angel +anger +angerli +anger +ang +angier +angl +anglai +angl +angler +angleterr +anglia +angl +anglish +angrili +angri +anguish +angu +anim +anim +animi +anjou +ankl +anna +annal +ann +annex +annex +annexion +annex +annothan +announc +annoi +annoy +annoi +annual +anoint +anoint +anon +anoth +anselmo +answer +answer +answer +answerest +answer +answer +ant +ant +antenor +antenorid +anteroom +anthem +anthem +anthoni +anthropophagi +anthropophaginian +antiat +antic +anticip +anticip +anticipatest +anticip +anticip +antick +anticli +antic +antidot +antidot +antigonu +antiopa +antipathi +antipholu +antipholus +antipod +antiquari +antiqu +antiqu +antium +antoniad +antonio +antoniu +antoni +antr +anvil +ani +anybodi +anyon +anyth +anywher +ap +apac +apart +apart +apart +ap +apemantu +apennin +ap +apiec +apish +apollinem +apollo +apollodoru +apolog +apoplex +apoplexi +apostl +apostl +apostropha +apoth +apothecari +appal +appal +appal +appal +apparel +apparel +apparel +appar +appar +apparit +apparit +appeach +appeal +appeal +appear +appear +appear +appeareth +appear +appear +appea +appeas +appeas +appel +appel +appele +appel +appelez +appel +appel +appelon +appendix +apperil +appertain +appertain +appertain +appertain +appertin +appertin +appetit +appetit +applaud +applaud +applaud +applaus +applaus +appl +appl +appletart +applianc +applianc +applic +appli +appli +appli +appli +appoint +appoint +appoint +appoint +appoint +apprehend +apprehend +apprehend +apprehens +apprehens +apprehens +apprendr +apprenn +apprenticehood +appri +approach +approach +approach +approacheth +approach +approb +approof +appropri +approv +approv +approv +approv +approv +appurten +appurten +apricock +april +apron +apron +apt +apter +aptest +aptli +apt +aqua +aquilon +aquitain +arabia +arabian +arais +arbitr +arbitr +arbitr +arbitr +arbor +arbour +arc +arch +archbishop +archbishopr +archdeacon +arch +archelau +archer +archer +archeri +archibald +archidamu +architect +arcu +ard +arden +ardent +ardour +ar +argal +argier +argo +argosi +argosi +argu +argu +argu +argu +argu +argument +argument +argu +ariachn +ariadn +ariel +ari +aright +arinado +arini +arion +aris +aris +ariseth +aris +aristod +aristotl +arithmet +arithmetician +ark +arm +arma +armado +armado +armagnac +arm +arm +armenia +armi +armigero +arm +armipot +armor +armour +armour +armour +armour +armouri +arm +armi +arn +aroint +aros +arous +arous +arragon +arraign +arraign +arraign +arraign +arrant +arra +arrai +arrearag +arrest +arrest +arrest +arriv +arriv +arriv +arriv +arriv +arriv +arriv +arrog +arrog +arrog +arrow +arrow +art +artemidoru +arteri +arthur +articl +articl +articul +artific +artifici +artilleri +artir +artist +artist +artless +artoi +art +artu +arviragu +as +asaph +ascaniu +ascend +ascend +ascendeth +ascend +ascens +ascent +ascrib +ascrib +ash +asham +asham +asher +ash +ashford +ashor +ashout +ashi +asia +asid +ask +askanc +ask +asker +asketh +ask +ask +aslant +asleep +asmath +asp +aspect +aspect +aspen +aspers +aspic +aspici +aspic +aspir +aspir +aspir +aspir +asquint +ass +assail +assail +assail +assail +assail +assaileth +assail +assail +assassin +assault +assault +assault +assai +assai +assai +assembl +assembl +assembl +assembl +assembl +assent +ass +assez +assign +assign +assign +assinico +assist +assist +assist +assist +assist +assist +assist +associ +associ +associ +assuag +assubjug +assum +assum +assum +assumpt +assur +assur +assur +assur +assuredli +assur +assyrian +astonish +astonish +astraea +astrai +astrea +astronom +astronom +astronom +astronomi +asund +at +atalanta +at +at +athenian +athenian +athen +athol +athversari +athwart +atla +atomi +atomi +aton +aton +aton +atropo +attach +attach +attach +attain +attaind +attain +attaint +attaint +attaintur +attempt +attempt +attempt +attempt +attempt +attend +attend +attend +attend +attend +attend +attendeth +attend +attend +attent +attent +attent +attentiven +attest +attest +attir +attir +attir +attir +attornei +attornei +attornei +attorneyship +attract +attract +attract +attract +attribut +attribut +attribut +attribut +attribut +atwain +au +aubrei +auburn +aucun +audaci +audaci +audac +audibl +audienc +audi +audit +auditor +auditor +auditori +audr +audrei +aufidiu +aufidius +auger +aught +augment +augment +augment +augment +augur +augur +augur +augur +augur +auguri +august +augustu +auld +aumerl +aunchient +aunt +aunt +auricular +aurora +auspici +aussi +auster +auster +auster +auster +austria +aut +authent +author +author +author +author +author +author +autolycu +autr +autumn +auvergn +avail +avail +avaric +avarici +avaunt +av +aveng +aveng +aveng +aver +avert +av +avez +avi +avoid +avoid +avoid +avoid +avoirdupoi +avouch +avouch +avouch +avouch +avow +aw +await +await +awak +awak +awak +awaken +awaken +awaken +awak +awak +award +award +awasi +awai +aw +aweari +aweless +aw +awhil +awkward +awl +awoo +awork +awri +ax +axl +axletre +ay +ay +ayez +ayli +azur +azur +b +ba +baa +babbl +babbl +babbl +babe +babe +babi +baboon +baboon +babi +babylon +bacar +bacchan +bacchu +bach +bachelor +bachelor +back +backbit +backbitten +back +back +backward +backwardli +backward +bacon +bacon +bad +bade +badg +badg +badg +badli +bad +bae +baffl +baffl +baffl +bag +baggag +bagot +bagpip +bag +bail +bailiff +baillez +baili +baisant +baise +baiser +bait +bait +bait +bait +bait +bajazet +bak +bake +bake +baker +baker +bake +bake +bal +balanc +balanc +balconi +bald +baldrick +bale +bale +balk +ball +ballad +ballad +ballast +ballast +ballet +ballow +ball +balm +balm +balmi +balsam +balsamum +balth +balthasar +balthazar +bame +ban +banburi +band +bandi +band +bandit +banditti +banditto +band +bandi +bandi +bane +bane +bang +bangor +banish +banish +banish +banish +banist +bank +bankrout +bankrupt +bankrupt +bank +banner +banneret +banner +ban +bann +banquet +banquet +banquet +banquet +banquo +ban +baptism +baptista +baptiz +bar +barbarian +barbarian +barbar +barbar +barbari +barbason +barb +barber +barbermong +bard +bardolph +bard +bare +bare +barefac +barefac +barefoot +barehead +bare +bare +bar +bargain +bargain +barg +bargulu +bare +bark +bark +barkloughli +bark +barki +barlei +barm +barn +barnacl +barnardin +barn +barn +barnet +barn +baron +baron +baroni +barr +barraba +barrel +barrel +barren +barrenli +barren +barricado +barricado +barrow +bar +barson +barter +bartholomew +ba +basan +base +baseless +base +base +baser +base +basest +bash +bash +basilisco +basilisk +basilisk +basimecu +basin +basingstok +basin +basi +bask +basket +basket +bass +bassanio +basset +bassianu +basta +bastard +bastard +bastardli +bastard +bastardi +bast +bast +bastinado +bast +bat +batail +batch +bate +bate +bate +bath +bath +bath +bath +bath +bate +batler +bat +batt +battalia +battalion +batten +batter +batter +batter +batteri +battl +battl +battlefield +battlement +battl +batti +baubl +baubl +baubl +baulk +bavin +bawcock +bawd +bawdri +bawd +bawdi +bawl +bawl +bai +bai +baynard +bayonn +bai +be +beach +beach +beachi +beacon +bead +bead +beadl +beadl +bead +beadsmen +beagl +beagl +beak +beak +beam +beam +beam +bean +bean +bear +beard +beard +beardless +beard +bearer +bearer +bearest +beareth +bear +bear +beast +beastliest +beastli +beastli +beast +beat +beat +beaten +beat +beatric +beat +beau +beaufort +beaumond +beaumont +beauteou +beauti +beauti +beautifi +beauti +beautifi +beauti +beaver +beaver +becam +becaus +bechanc +bechanc +bechanc +beck +beckon +beckon +beck +becom +becom +becom +becom +becom +becom +bed +bedabbl +bedash +bedaub +bedazzl +bedchamb +bedcloth +bed +bedeck +bedeck +bedew +bedfellow +bedfellow +bedford +bedlam +bedrench +bedrid +bed +bedtim +bedward +bee +beef +beef +beehiv +been +beer +bee +beest +beetl +beetl +beev +befal +befallen +befal +befel +befit +befit +befit +befor +befor +beforehand +befortun +befriend +befriend +befriend +beg +began +beget +beget +beget +begg +beggar +beggar +beggarli +beggarman +beggar +beggari +beg +begin +beginn +begin +begin +begin +begnawn +begon +begot +begotten +begrim +beg +beguil +beguil +beguil +beguil +beguil +begun +behalf +behalf +behav +behav +behavedst +behavior +behavior +behaviour +behaviour +behead +behead +beheld +behest +behest +behind +behold +behold +behold +beholdest +behold +behold +behoof +behoofful +behoov +behov +behov +behowl +be +bel +belariu +belch +belch +beldam +beldam +beldam +bele +belgia +beli +beli +belief +beliest +believ +believ +believ +believ +believest +believ +belik +bell +bellario +bell +belli +belli +bellman +bellona +bellow +bellow +bellow +bellow +bell +belli +belly +belman +belmont +belock +belong +belong +belong +belong +belov +belov +belov +below +belt +belzebub +bemad +bemet +bemet +bemoan +bemoan +bemock +bemoil +bemonst +ben +bench +bencher +bench +bend +bend +bend +bend +bene +beneath +benedicit +benedick +benedict +benedictu +benefactor +benefic +benefici +benefit +benefit +benefit +benet +benevol +benevol +beni +benison +bennet +bent +bentii +bentivolii +bent +benumb +benvolio +bepaint +beprai +bequeath +bequeath +bequeath +bequest +ber +berard +berattl +berai +bere +bereav +bereav +bereav +bereft +bergamo +bergomask +berhym +berhym +berkelei +bermooth +bernardo +berod +berown +berri +berri +berrord +berri +bertram +berwick +bescreen +beseech +beseech +beseech +beseech +beseek +beseem +beseemeth +beseem +beseem +beset +beshrew +besid +besid +besieg +besieg +besieg +beslubb +besmear +besmear +besmirch +besom +besort +besot +bespak +bespeak +bespic +bespok +bespot +bess +bessi +best +bestain +best +bestial +bestir +bestirr +bestow +bestow +bestow +bestow +bestraught +bestrew +bestrid +bestrid +bestrid +bet +betak +beteem +bethink +bethought +bethroth +bethump +betid +betid +betideth +betim +betim +betoken +betook +betoss +betrai +betrai +betrai +betrai +betrim +betroth +betroth +betroth +bett +bet +better +better +better +better +bet +bettr +between +betwixt +bevel +beverag +bevi +bevi +bewail +bewail +bewail +bewail +bewar +bewast +beweep +bewept +bewet +bewhor +bewitch +bewitch +bewitch +bewrai +beyond +bezonian +bezonian +bianca +bianco +bia +bibbl +bicker +bid +bidden +bid +bid +biddi +bide +bide +bide +bid +bien +bier +bifold +big +bigami +biggen +bigger +big +bigot +bilberri +bilbo +bilbo +bilbow +bill +billet +billet +billiard +bill +billow +billow +bill +bin +bind +bindeth +bind +bind +biondello +birch +bird +bird +birdlim +bird +birnam +birth +birthdai +birthdom +birthplac +birthright +birthright +birth +bi +biscuit +bishop +bishop +bisson +bit +bitch +bite +biter +bite +bite +bit +bitt +bitten +bitter +bitterest +bitterli +bitter +blab +blabb +blab +blab +black +blackamoor +blackamoor +blackberri +blackberri +blacker +blackest +blackfriar +blackheath +blackmer +black +black +bladder +bladder +blade +blade +blade +blain +blam +blame +blame +blame +blameless +blame +blanc +blanca +blanch +blank +blanket +blank +blasphem +blasphem +blasphem +blasphemi +blast +blast +blast +blastment +blast +blaz +blaze +blaze +blaze +blazon +blazon +blazon +bleach +bleach +bleak +blear +blear +bleat +bleat +bleat +bled +bleed +bleedest +bleedeth +bleed +bleed +blemish +blemish +blench +blench +blend +blend +blent +bless +bless +blessedli +blessed +bless +blesseth +bless +bless +blest +blew +blind +blind +blindfold +blind +blindli +blind +blind +blink +blink +bliss +blist +blister +blister +blith +blithild +bloat +block +blockish +block +bloi +blood +blood +bloodhound +bloodi +bloodier +bloodiest +bloodili +bloodless +blood +bloodsh +bloodshed +bloodstain +bloodi +bloom +bloom +blossom +blossom +blossom +blot +blot +blot +blot +blount +blow +blow +blower +blowest +blow +blown +blow +blows +blubb +blubber +blubber +blue +bluecap +bluest +blunt +blunt +blunter +bluntest +blunt +bluntli +blunt +blunt +blur +blurr +blur +blush +blush +blushest +blush +blust +bluster +bluster +bluster +bo +boar +board +board +board +board +boarish +boar +boast +boast +boast +boast +boast +boat +boat +boatswain +bob +bobb +boblibindo +bobtail +bocchu +bode +bode +bodement +bode +bodg +bodi +bodi +bodiless +bodili +bode +bodkin +bodi +bodykin +bog +boggl +boggler +bog +bohemia +bohemian +bohun +boil +boil +boil +boist +boister +boister +boitier +bold +bolden +bolder +boldest +boldli +bold +bold +bolingbrok +bolster +bolt +bolt +bolter +bolter +bolt +bolt +bombard +bombard +bombast +bon +bona +bond +bondag +bond +bondmaid +bondman +bondmen +bond +bondslav +bone +boneless +bone +bonfir +bonfir +bonjour +bonn +bonnet +bonnet +bonni +bono +bonto +bonvil +bood +book +bookish +book +boon +boor +boorish +boor +boot +boot +booti +bootless +boot +booti +bor +bora +borachio +bordeaux +border +border +border +border +bore +borea +bore +bore +born +born +borough +borough +borrow +borrow +borrow +borrow +borrow +bosko +bosko +boski +bosom +bosom +boson +boss +bosworth +botch +botcher +botch +botchi +both +bot +bottl +bottl +bottl +bottom +bottomless +bottom +bouciqualt +boug +bough +bough +bought +bounc +bounc +bound +bound +bounden +boundeth +bound +boundless +bound +bounteou +bounteous +bounti +bounti +bountifulli +bounti +bourbier +bourbon +bourchier +bourdeaux +bourn +bout +bout +bove +bow +bowcas +bow +bowel +bower +bow +bowl +bowler +bowl +bowl +bow +bowsprit +bowstr +box +box +boi +boyet +boyish +boi +brabant +brabantio +brabbl +brabbler +brac +brace +bracelet +bracelet +brach +braci +brag +bragg +braggard +braggard +braggart +braggart +brag +brag +bragless +brag +braid +braid +brain +brain +brainford +brainish +brainless +brain +brainsick +brainsickli +brake +brakenburi +brake +brambl +bran +branch +branch +branchless +brand +brand +brandish +brandon +brand +bra +brass +brassi +brat +brat +brav +brave +brave +brave +braver +braveri +brave +bravest +brave +brawl +brawler +brawl +brawl +brawn +brawn +brai +brai +braz +brazen +brazier +breach +breach +bread +breadth +break +breaker +breakfast +break +break +breast +breast +breast +breastplat +breast +breath +breath +breath +breather +breather +breath +breathest +breath +breathless +breath +brecknock +bred +breech +breech +breech +breed +breeder +breeder +breed +breed +brees +breez +breff +bretagn +brethen +bretheren +brethren +brevi +breviti +brew +brewag +brewer +brewer +brew +brew +briareu +briar +brib +bribe +briber +bribe +brick +bricklay +brick +bridal +bride +bridegroom +bridegroom +bride +bridg +bridgenorth +bridg +bridget +bridl +bridl +brief +briefer +briefest +briefli +brief +brier +brier +brigandin +bright +brighten +brightest +brightli +bright +brim +brim +brim +brimston +brind +brine +bring +bringer +bringeth +bring +bring +bring +brinish +brink +brisk +briski +bristl +bristl +bristli +bristol +bristow +britain +britain +britain +british +briton +briton +brittani +brittl +broach +broach +broad +broader +broadsid +broca +brock +brogu +broil +broil +broil +broke +broken +brokenli +broker +broker +broke +broke +brooch +brooch +brood +brood +brood +brook +brook +broom +broomstaff +broth +brothel +brother +brotherhood +brotherhood +brotherli +brother +broth +brought +brow +brown +browner +brownist +browni +brow +brows +brows +brui +bruis +bruis +bruis +bruis +bruit +bruit +brundusium +brunt +brush +brush +brute +brutish +brutu +bubbl +bubbl +bubbl +bubukl +buck +bucket +bucket +buck +buckingham +buckl +buckl +buckler +buckler +bucklersburi +buckl +buckram +buck +bud +bud +bud +budg +budger +budget +bud +buff +buffet +buffet +buffet +bug +bugbear +bugl +bug +build +build +buildeth +build +build +build +built +bulk +bulk +bull +bullcalf +bullen +bullen +bullet +bullet +bullock +bull +bulli +bulmer +bulwark +bulwark +bum +bumbast +bump +bumper +bum +bunch +bunch +bundl +bung +bunghol +bungl +bunt +buoi +bur +burbolt +burd +burden +burden +burden +burden +burden +burgh +burgher +burgher +burglari +burgomast +burgonet +burgundi +burial +buri +burier +buriest +burli +burn +burn +burnet +burneth +burn +burnish +burn +burnt +burr +burrow +bur +burst +burst +burst +burthen +burthen +burton +buri +buri +bush +bushel +bush +bushi +busi +busili +busin +busi +busi +buskin +buski +buss +buss +buss +bustl +bustl +busi +but +butche +butcher +butcher +butcheri +butcherli +butcher +butcheri +butler +butt +butter +butter +butterfli +butterfli +butterwoman +butteri +buttock +buttock +button +buttonhol +button +buttress +buttri +butt +buxom +bui +buyer +bui +bui +buzz +buzzard +buzzard +buzzer +buzz +by +bye +byzantium +c +ca +cabbag +cabilero +cabin +cabin +cabl +cabl +cackl +cacodemon +caddi +caddiss +cade +cadenc +cadent +cade +cadmu +caduceu +cadwal +cadwallad +caeliu +caelo +caesar +caesarion +caesar +cage +cage +cagion +cain +caith +caitiff +caitiff +caiu +cak +cake +cake +calab +calai +calam +calam +calcha +calcul +calen +calendar +calendar +calf +caliban +caliban +calipoli +caliti +caliv +call +callat +call +callet +call +call +calm +calmest +calmli +calm +calm +calpurnia +calumni +calumni +calumni +calumni +calv +calv +calv +calveskin +calydon +cam +cambio +cambria +cambric +cambric +cambridg +cambys +came +camel +camelot +camel +camest +camillo +camlet +camomil +camp +campeiu +camp +camp +can +canakin +canari +canari +cancel +cancel +cancel +cancel +cancel +cancer +candidatu +candi +candl +candl +candlestick +candi +canidiu +cank +canker +cankerblossom +canker +cannib +cannib +cannon +cannon +cannon +cannot +canon +canoniz +canon +canon +canon +canopi +canopi +canopi +canst +canstick +canterburi +cantl +canton +canu +canva +canvass +canzonet +cap +capabl +capabl +capac +capac +caparison +capdv +cape +capel +capel +caper +caper +capet +caphi +capilet +capitain +capit +capit +capitol +capitul +capocchia +capon +capon +capp +cappadocia +capriccio +caprici +cap +capt +captain +captain +captainship +captiou +captiv +captiv +captiv +captiv +captiv +captiv +captum +capuciu +capulet +capulet +car +carack +carack +carat +carawai +carbonado +carbuncl +carbuncl +carbuncl +carcanet +carcas +carcas +carcass +carcass +card +cardecu +card +carder +cardin +cardin +cardin +cardmak +card +carduu +care +care +career +career +care +carefulli +careless +carelessli +careless +care +caret +cargo +carl +carlisl +carlot +carman +carmen +carnal +carnal +carnarvonshir +carnat +carnat +carol +carou +carous +carous +carous +carous +carp +carpent +carper +carpet +carpet +carp +carriag +carriag +carri +carrier +carrier +carri +carrion +carrion +carri +carri +car +cart +carter +carthag +cart +carv +carv +carv +carver +carv +carv +ca +casa +casaer +casca +case +casement +casement +case +cash +cashier +case +cask +casket +casket +casket +casqu +casqu +cassado +cassandra +cassibelan +cassio +cassiu +cassock +cast +castalion +castawai +castawai +cast +caster +castig +castig +castil +castiliano +cast +castl +castl +cast +casual +casual +casualti +casualti +cat +cataian +catalogu +cataplasm +cataract +catarrh +catastroph +catch +catcher +catch +catch +cate +catechis +catech +catech +cater +caterpillar +cater +caterwaul +cate +catesbi +cathedr +catlik +catl +catl +cato +cat +cattl +caucasu +caudl +cauf +caught +cauldron +cau +caus +caus +causeless +causer +caus +causest +causeth +cautel +cautel +cautel +cauter +caution +caution +cavaleiro +cavaleri +cavali +cave +cavern +cavern +cave +caveto +caviari +cavil +cavil +cawdor +cawdron +caw +ce +cea +ceas +ceas +ceaseth +cedar +cedar +cediu +celebr +celebr +celebr +celebr +celer +celesti +celia +cell +cellar +cellarag +celsa +cement +censer +censor +censorinu +censur +censur +censur +censur +censur +censur +centaur +centaur +centr +cent +centuri +centurion +centurion +centuri +cerberu +cerecloth +cerement +ceremoni +ceremoni +ceremoni +ceremoni +ceremoni +cere +cern +certain +certain +certainli +certainti +certainti +cert +certif +certifi +certifi +certifi +ce +cesario +cess +cess +cestern +cetera +cett +chace +chaf +chafe +chafe +chafe +chaff +chaffless +chafe +chain +chain +chair +chair +chalic +chalic +chalic +chalk +chalk +chalki +challeng +challeng +challeng +challeng +challeng +challeng +cham +chamber +chamber +chamberlain +chamberlain +chambermaid +chambermaid +chamber +chameleon +champ +champagn +champain +champain +champion +champion +chanc +chanc +chanc +chancellor +chanc +chandler +chang +chang +changeabl +chang +chang +changel +changel +changer +chang +changest +chang +channel +channel +chanson +chant +chanticl +chant +chantri +chantri +chant +chao +chap +chape +chapel +chapeless +chapel +chaplain +chaplain +chapless +chaplet +chapmen +chap +chapter +charact +charact +characterless +charact +characteri +charact +charbon +chare +chare +charg +charg +charg +charg +charg +chargeth +charg +chariest +chari +chare +chariot +chariot +charit +charit +chariti +chariti +charlemain +charl +charm +charm +charmer +charmeth +charmian +charm +charmingli +charm +charneco +charnel +charoloi +charon +charter +charter +chartreux +chari +charybdi +cha +chase +chase +chaser +chaseth +chase +chast +chast +chasti +chastis +chastis +chastis +chastiti +chat +chatham +chatillon +chat +chatt +chattel +chatter +chatter +chattl +chaud +chaunt +chaw +chawdron +che +cheap +cheapen +cheaper +cheapest +cheapli +cheapsid +cheat +cheat +cheater +cheater +cheat +cheat +check +check +checker +check +check +cheek +cheek +cheer +cheer +cheerer +cheer +cheerfulli +cheer +cheerless +cheerli +cheer +chees +chequer +cher +cherish +cherish +cherish +cherish +cherish +cherri +cherri +cherrypit +chertsei +cherub +cherubim +cherubin +cherubin +cheshu +chess +chest +chester +chestnut +chestnut +chest +cheta +chev +cheval +chevali +chevali +cheveril +chew +chew +chewet +chew +chez +chi +chick +chicken +chicken +chicurmurco +chid +chidden +chide +chider +chide +chide +chief +chiefest +chiefli +chien +child +child +childer +childhood +childhood +child +childish +childish +childlik +child +children +chill +chill +chime +chime +chimnei +chimneypiec +chimnei +chimurcho +chin +china +chine +chine +chink +chink +chin +chipp +chipper +chip +chiron +chirp +chirrah +chirurgeonli +chisel +chitoph +chivalr +chivalri +choic +choic +choicest +choir +choir +chok +choke +choke +choke +choke +choler +choler +choler +chollor +choos +chooser +choos +chooseth +choos +chop +chopin +choplog +chopp +chop +chop +choppi +chop +chopt +chor +chorist +choru +chose +chosen +chough +chough +chrish +christ +christen +christendom +christendom +christen +christen +christian +christianlik +christian +christma +christom +christoph +christophero +chronicl +chronicl +chronicl +chronicl +chronicl +chrysolit +chuck +chuck +chud +chuff +church +church +churchman +churchmen +churchyard +churchyard +churl +churlish +churlishli +churl +churn +chu +cicatric +cicatric +cice +cicero +cicet +ciel +ciitzen +cilicia +cimber +cimmerian +cinabl +cinctur +cinder +cine +cinna +cinqu +cipher +cipher +circa +circ +circl +circl +circlet +circl +circuit +circum +circumcis +circumfer +circummur +circumscrib +circumscrib +circumscript +circumspect +circumst +circumstanc +circumst +circumstanti +circumv +circumvent +cistern +citadel +cital +cite +cite +cite +citi +cite +citizen +citizen +cittern +citi +civet +civil +civil +civilli +clack +clad +claim +claim +claim +clamb +clamber +clammer +clamor +clamor +clamor +clamour +clamour +clang +clangor +clap +clapp +clap +clapper +clap +clap +clare +clarenc +claret +claribel +clasp +clasp +clatter +claud +claudio +claudiu +claus +claw +claw +claw +claw +clai +clai +clean +cleanliest +cleanli +clean +cleans +cleans +clear +clearer +clearest +clearli +clear +clear +cleav +cleav +clef +cleft +cleitu +clemenc +clement +cleomen +cleopatpa +cleopatra +clepeth +clept +clerestori +clergi +clergyman +clergymen +clerk +clerkli +clerk +clew +client +client +cliff +clifford +clifford +cliff +clifton +climat +climatur +climb +climb +climber +climbeth +climb +climb +clime +cling +clink +clink +clinquant +clip +clipp +clipper +clippeth +clip +clipt +clitu +clo +cloak +cloakbag +cloak +clock +clock +clod +cloddi +clodpol +clog +clog +clog +cloister +cloistress +cloquenc +clo +close +close +close +close +closer +close +closest +closet +close +closur +cloten +cloten +cloth +clothair +clothariu +cloth +cloth +clothier +clothier +cloth +cloth +clotpol +clotpol +cloud +cloud +cloudi +cloud +cloudi +clout +clout +clout +cloven +clover +clove +clovest +clowder +clown +clownish +clown +cloi +cloi +cloi +cloyless +cloyment +cloi +club +club +cluck +clung +clust +cluster +clutch +clyster +cneiu +cnemi +co +coach +coach +coachmak +coact +coactiv +coagul +coal +coal +coars +coars +coast +coast +coast +coat +coat +coat +cobbl +cobbl +cobbler +cobham +cobloaf +cobweb +cobweb +cock +cockatric +cockatric +cockl +cockl +cocknei +cockpit +cock +cocksur +coctu +cocytu +cod +cod +codl +codpiec +codpiec +cod +coelestibu +coesar +coeur +coffer +coffer +coffin +coffin +cog +cog +cogit +cogit +cognit +cogniz +cogscomb +cohabit +coher +coher +coher +coher +cohort +coif +coign +coil +coin +coinag +coiner +coin +coin +col +colbrand +colcho +cold +colder +coldest +coldli +cold +coldspur +colebrook +colic +collar +collar +collater +colleagu +collect +collect +collect +colleg +colleg +colli +collier +collier +collop +collus +colm +colmekil +coloquintida +color +color +colossu +colour +colour +colour +colour +colour +colt +colt +colt +columbin +columbin +colvil +com +comagen +comart +comb +combat +combat +combat +combat +combat +combin +combin +combin +combin +combin +combless +combust +come +comedian +comedian +comedi +comeli +come +comer +comer +come +comest +comet +cometh +comet +comfect +comfit +comfit +comfort +comfort +comfort +comfort +comfort +comfortless +comfort +comic +comic +come +come +cominiu +comma +command +command +command +command +command +command +command +command +command +comm +commenc +commenc +commenc +commenc +commenc +commenc +commend +commend +commend +commend +commend +commend +commend +comment +commentari +comment +comment +commerc +commingl +commiser +commiss +commission +commiss +commit +commit +committ +commit +commit +commix +commix +commixt +commixtur +commodi +commod +commod +common +commonalti +common +common +commonli +common +commonw +commonwealth +commot +commot +commun +communicat +commun +commun +commun +commun +comonti +compact +compani +companion +companion +companionship +compani +compar +compar +compar +compar +compar +comparison +comparison +compartn +compass +compass +compass +compass +compassion +compeer +compel +compel +compel +compel +compel +compens +compet +compet +compet +competitor +competitor +compil +compil +compil +complain +complain +complainest +complain +complain +complain +complaint +complaint +complement +complement +complet +complexion +complexion +complexion +complic +compli +compliment +compliment +compliment +complot +complot +complot +compli +compo +compos +compos +composit +compost +compostur +composur +compound +compound +compound +comprehend +comprehend +comprehend +compremis +compri +compris +compromi +compromis +compt +comptibl +comptrol +compulsatori +compuls +compuls +compuncti +comput +comrad +comrad +comutu +con +concav +concav +conceal +conceal +conceal +conceal +conceal +conceal +conceit +conceit +conceitless +conceit +conceiv +conceiv +conceiv +conceiv +conceiv +concept +concept +concepti +concern +concern +concerneth +concern +concern +concern +conclav +conclud +conclud +conclud +conclud +conclud +conclus +conclus +concolinel +concord +concubin +concupisc +concupi +concur +concur +concur +condemn +condemn +condemn +condemn +condemn +condescend +condign +condit +condition +condit +condol +condol +condol +conduc +conduct +conduct +conduct +conductor +conduit +conduit +conect +conei +confect +confectionari +confect +confederaci +confeder +confeder +confer +confer +conferr +confer +confess +confess +confess +confesseth +confess +confess +confess +confessor +confid +confid +confid +confin +confin +confin +confineless +confin +confin +confin +confirm +confirm +confirm +confirm +confirm +confirm +confirm +confirm +confirm +confisc +confisc +confisc +confix +conflict +conflict +conflict +confluenc +conflux +conform +conform +confound +confound +confound +confound +confront +confront +confu +confus +confusedli +confus +confus +confut +confut +congeal +congeal +congeal +conge +conger +congest +congi +congratul +congre +congreet +congreg +congreg +congreg +congreg +congruent +congru +coni +conjectur +conjectur +conjectur +conjoin +conjoin +conjoin +conjointli +conjunct +conjunct +conjunct +conjur +conjur +conjur +conjur +conjur +conjur +conjur +conjur +conjur +conjuro +conn +connect +conniv +conqu +conquer +conquer +conquer +conqueror +conqueror +conquer +conquest +conquest +conqur +conrad +con +consanguin +consanguin +conscienc +conscienc +conscienc +conscion +consecr +consecr +consecr +consent +consent +consent +consent +consequ +consequ +consequ +conserv +conserv +conserv +consid +consider +consider +consider +consider +consid +consid +consid +consid +consign +consign +consist +consisteth +consist +consistori +consist +consol +consol +conson +conson +consort +consort +consortest +conspectu +conspir +conspiraci +conspir +conspir +conspir +conspir +conspir +conspir +conspir +conspir +constabl +constabl +constanc +constanc +constanc +constant +constantin +constantinopl +constantli +constel +constitut +constrain +constrain +constraineth +constrain +constraint +constr +construct +constru +consul +consul +consulship +consulship +consult +consult +consult +consum +consum +consum +consum +consum +consumm +consumm +consumpt +consumpt +contagion +contagi +contain +contain +contain +contamin +contamin +contemn +contemn +contemn +contemn +contempl +contempl +contempl +contempt +contempt +contempt +contemptu +contemptu +contend +contend +contend +contendon +content +contenta +content +contenteth +content +contenti +contentless +contento +content +contest +contest +contin +contin +contin +contin +continu +continu +continu +continu +continuantli +continu +continu +continu +continu +continu +continu +contract +contract +contract +contract +contradict +contradict +contradict +contradict +contrari +contrarieti +contrarieti +contrari +contrari +contrari +contr +contribut +contributor +contrit +contriv +contriv +contriv +contriv +contriv +contriv +control +control +control +control +control +control +controversi +contumeli +contumeli +contum +contus +conveni +conveni +conveni +conveni +conveni +convent +conventicl +convent +conver +convers +convers +convers +convers +convers +convers +convers +convers +convert +convert +convertest +convert +convertit +convertit +convert +convei +convey +convey +convey +convei +convict +convict +convinc +convinc +convinc +conviv +convoc +convoi +convuls +coni +cook +cookeri +cook +cool +cool +cool +cool +coop +coop +cop +copatain +cope +cophetua +copi +copi +copiou +copper +copperspur +coppic +copul +copul +copi +cor +coragio +coral +coram +corambu +coranto +coranto +corbo +cord +cord +cordelia +cordial +cordi +cord +core +corin +corinth +corinthian +coriolanu +corioli +cork +corki +cormor +corn +cornelia +corneliu +corner +corner +cornerston +cornet +cornish +corn +cornuto +cornwal +corollari +coron +coron +coronet +coronet +corpor +corpor +corpor +corps +corpul +correct +correct +correct +correct +correction +correct +correspond +correspond +correspond +correspons +corrig +corriv +corriv +corrobor +corros +corrupt +corrupt +corrupt +corrupt +corrupt +corrupt +corrupt +corrupt +corruptli +corrupt +cors +cors +corslet +cosmo +cost +costard +costermong +costlier +costli +cost +cot +cote +cote +cotsal +cotsol +cotswold +cottag +cottag +cotu +couch +couch +couch +couch +coud +cough +cough +could +couldst +coulter +council +councillor +council +counsel +counsel +counsellor +counsellor +counselor +counselor +counsel +count +count +countenanc +counten +counten +counter +counterchang +countercheck +counterfeit +counterfeit +counterfeit +counterfeitli +counterfeit +countermand +countermand +countermin +counterpart +counterpoint +counterpoi +counterpois +counter +countervail +countess +countess +counti +count +countless +countri +countrv +countri +countryman +countrymen +count +counti +couper +coupl +coupl +couplement +coupl +couplet +couplet +cour +courag +courag +courag +courag +courier +courier +couronn +cour +cours +cours +courser +courser +cours +cours +court +court +courteou +courteous +courtesan +courtesi +courtesi +courtezan +courtezan +courtier +courtier +courtlik +courtli +courtnei +court +courtship +cousin +cousin +couterfeit +coutum +coven +coven +covent +coventri +cover +cover +cover +coverlet +cover +covert +covertli +covertur +covet +covet +covet +covet +covet +covet +covet +covet +cow +coward +coward +cowardic +cowardli +coward +cowardship +cowish +cowl +cowslip +cowslip +cox +coxcomb +coxcomb +coi +coystril +coz +cozen +cozenag +cozen +cozen +cozen +cozen +cozier +crab +crab +crab +crack +crack +cracker +cracker +crack +crack +cradl +cradl +cradl +craft +craft +crafti +craftier +craftili +craft +craftsmen +crafti +cram +cramm +cramp +cramp +cram +crank +crank +cranmer +cranni +cranni +cranni +crant +crare +crash +crassu +crav +crave +crave +craven +craven +crave +craveth +crave +crawl +crawl +crawl +craz +craze +crazi +creak +cream +creat +creat +creat +creat +creation +creator +creatur +creatur +credenc +credent +credibl +credit +creditor +creditor +credo +credul +credul +creed +creek +creek +creep +creep +creep +crept +crescent +cresciv +cresset +cressid +cressida +cressid +cressi +crest +crest +crestfal +crestless +crest +cretan +crete +crevic +crew +crew +crib +cribb +crib +cricket +cricket +cri +criedst +crier +cri +criest +crieth +crime +crime +crimeless +crime +crimin +crimson +cring +crippl +crisp +crisp +crispian +crispianu +crispin +critic +critic +critic +croak +croak +croak +crocodil +cromer +cromwel +crone +crook +crookback +crook +crook +crop +cropp +crosbi +cross +cross +cross +crossest +cross +cross +crossli +cross +crost +crotchet +crouch +crouch +crow +crowd +crowd +crowd +crowd +crowflow +crow +crowkeep +crown +crown +crowner +crownet +crownet +crown +crown +crow +crudi +cruel +cruell +crueller +cruelli +cruel +cruelti +crum +crumbl +crumb +crupper +crusado +crush +crush +crushest +crush +crust +crust +crusti +crutch +crutch +cry +cry +crystal +crystallin +crystal +cub +cubbert +cubiculo +cubit +cub +cuckold +cuckoldli +cuckold +cuckoo +cucullu +cudgel +cudgel +cudgel +cudgel +cudgel +cue +cue +cuff +cuff +cuiqu +cull +cull +cullion +cullionli +cullion +culpabl +culverin +cum +cumber +cumberland +cun +cunningli +cun +cuor +cup +cupbear +cupboard +cupid +cupid +cuppel +cup +cur +curan +curat +curb +curb +curb +curb +curd +curdi +curd +cure +cure +cureless +curer +cure +curfew +cure +curio +curios +curiou +curious +curl +curl +curl +curl +curranc +currant +current +current +currish +curri +cur +curs +curs +curs +cursi +curs +cursorari +curst +curster +curstest +curst +cursi +curtail +curtain +curtain +curtal +curti +curtl +curtsi +curtsi +curtsi +curvet +curvet +cush +cushion +cushion +custalorum +custard +custodi +custom +customari +custom +custom +custom +custom +custur +cut +cutler +cutpurs +cutpurs +cut +cutter +cut +cuttl +cxsar +cyclop +cydnu +cygnet +cygnet +cym +cymbal +cymbelin +cyme +cynic +cynthia +cypress +cypriot +cypru +cyru +cytherea +d +dabbl +dace +dad +daedalu +daemon +daff +daf +daffest +daffodil +dagger +dagger +dagonet +daili +daintier +dainti +daintiest +daintili +dainti +daintri +dainti +daisi +daisi +daisi +dale +dallianc +dalli +dalli +dalli +dalli +dalmatian +dam +damag +damascu +damask +damask +dame +dame +damm +damn +damnabl +damnabl +damnat +damn +damn +damoisel +damon +damosella +damp +dam +damsel +damson +dan +danc +danc +dancer +danc +danc +dandl +dandi +dane +dang +danger +danger +danger +danger +dangl +daniel +danish +dank +dankish +dansker +daphn +dappl +dappl +dar +dardan +dardanian +dardaniu +dare +dare +dare +dare +darest +dare +dariu +dark +darken +darken +darken +darker +darkest +darkl +darkli +dark +darl +darl +darnel +darraign +dart +dart +darter +dartford +dart +dart +dash +dash +dash +dastard +dastard +dat +datchet +date +date +dateless +date +daub +daughter +daughter +daunt +daunt +dauntless +dauphin +daventri +davi +daw +dawn +dawn +daw +dai +daylight +dai +dazzl +dazzl +dazzl +de +dead +deadli +deaf +deaf +deaf +deaf +deal +dealer +dealer +dealest +deal +deal +deal +dealt +dean +deaneri +dear +dearer +dearest +dearli +dear +dear +dearth +dearth +death +deathb +death +death +deathsman +deathsmen +debar +debas +debat +debat +debat +debateth +debat +debauch +debil +debil +debitor +debonair +deborah +debosh +debt +debt +debtor +debtor +debt +debuti +decai +decai +decay +decai +decai +decea +deceas +deceas +deceit +deceit +deceit +deceiv +deceiv +deceiv +deceiv +deceiv +deceiv +deceiv +deceivest +deceiveth +deceiv +decemb +decent +decepti +decern +decid +decid +decim +deciph +deciph +decis +deciu +deck +deck +deck +deckt +declar +declar +declens +declens +declin +declin +declin +declin +declin +decoct +decorum +decrea +decreas +decreas +decre +decre +decre +decrepit +dedic +dedic +dedic +dedic +deed +deedless +deed +deem +deem +deep +deeper +deepest +deepli +deep +deepvow +deer +deess +defac +defac +defac +defac +defac +defac +defam +default +defeat +defeat +defeat +defeatur +defect +defect +defect +defenc +defenc +defend +defend +defend +defend +defend +defend +defend +defens +defens +defens +defer +deferr +defianc +defici +defi +defi +defil +defil +defil +defil +defil +defin +defin +definit +definit +definit +deflow +deflow +deflow +deform +deform +deform +deform +deftli +defunct +defunct +defus +defi +defi +degener +degrad +degre +degre +deifi +deifi +deign +deign +deiphobu +deiti +deiti +deja +deject +deject +delabreth +delai +delai +delai +delai +delect +deliber +delic +delic +delici +delici +delight +delight +delight +delight +delinqu +deliv +deliv +deliver +deliv +deliv +deliv +deliveri +delpho +delud +delud +delug +delv +delver +delv +demand +demand +demand +demand +demean +demeanor +demeanour +demerit +demesn +demetriu +demi +demigod +demis +demoisel +demon +demonstr +demonstr +demonstr +demonstr +demonstr +demonstr +demur +demur +demur +den +denai +deni +denial +denial +deni +denier +deni +deniest +deni +denmark +denni +denni +denot +denot +denot +denounc +denounc +denounc +den +denunci +deni +deni +deo +depart +depart +departest +depart +departur +depech +depend +depend +depend +depend +depend +depend +depend +depend +depend +depend +depend +depend +deplor +deplor +depopul +depo +depos +depos +depos +depositari +deprav +deprav +deprav +deprav +deprav +depress +depriv +depriv +depth +depth +deput +deput +deput +deputi +deput +deputi +deracin +derbi +derceta +dere +derid +deris +deriv +deriv +deriv +deriv +deriv +deriv +derog +derog +derog +de +desartless +descant +descend +descend +descend +descend +descens +descent +descent +describ +describ +describ +descri +descript +descript +descri +desdemon +desdemona +desert +desert +deserv +deserv +deserv +deservedli +deserv +deserv +deserv +deservest +deserv +deserv +design +design +design +design +desir +desir +desir +desir +desir +desirest +desir +desir +desist +desk +desol +desol +desp +despair +despair +despair +despatch +desper +desper +desper +despi +despis +despis +despis +despiseth +despis +despit +despit +despoil +dest +destin +destin +destini +destini +destitut +destroi +destroi +destroy +destroy +destroi +destroi +destruct +destruct +det +detain +detain +detect +detect +detect +detect +detector +detect +detent +determin +determin +determin +determin +determin +determin +determin +detest +detest +detest +detest +detest +detract +detract +detract +deucalion +deuc +deum +deux +devant +devest +devic +devic +devil +devilish +devil +devi +devis +devis +devis +devis +devoid +devonshir +devot +devot +devot +devour +devour +devour +devour +devour +devout +devoutli +dew +dewberri +dewdrop +dewlap +dewlapp +dew +dewi +dexter +dexteri +dexter +di +diabl +diablo +diadem +dial +dialect +dialogu +dialogu +dial +diamet +diamond +diamond +dian +diana +diaper +dibbl +dic +dice +dicer +dich +dick +dicken +dickon +dicki +dictat +diction +dictynna +did +diddl +didest +dido +didst +die +di +diedst +di +diest +diet +diet +dieter +dieu +diff +differ +differ +differ +differ +differ +differ +differ +difficil +difficult +difficulti +difficulti +diffid +diffid +diffu +diffus +diffusest +dig +digest +digest +digest +digest +digg +dig +dighton +dignifi +dignifi +dignifi +digniti +digniti +digress +digress +digress +dig +digt +dilat +dilat +dilat +dilatori +dild +dildo +dilemma +dilemma +dilig +dilig +diluculo +dim +dimens +dimens +diminish +diminish +diminut +diminut +diminut +dimm +dim +dim +dimpl +dimpl +dim +din +dine +dine +diner +dine +ding +dine +dinner +dinner +dinnertim +dint +diom +diomed +diomed +dion +dip +dipp +dip +dip +dir +dire +direct +direct +direct +direct +direct +directitud +direct +directli +direct +dire +dire +direst +dirg +dirg +dirt +dirti +di +disabl +disabl +disabl +disabl +disadvantag +disagre +disallow +disanim +disannul +disannul +disappoint +disarm +disarm +disarmeth +disarm +disast +disast +disastr +disbench +disbranch +disburden +disbur +disburs +disburs +discandi +discandi +discard +discard +discas +discas +discern +discern +discern +discern +discern +discharg +discharg +discharg +discharg +discipl +discipl +disciplin +disciplin +disciplin +disciplin +disclaim +disclaim +disclaim +disclo +disclos +disclos +disclos +discolour +discolour +discolour +discomfit +discomfit +discomfitur +discomfort +discomfort +discommend +disconsol +discont +discont +discontentedli +discont +discont +discontinu +discontinu +discord +discord +discord +discours +discours +discours +discours +discours +discourtesi +discov +discov +discov +discover +discoveri +discov +discov +discoveri +discredit +discredit +discredit +discreet +discreetli +discret +discret +discuss +disdain +disdain +disdaineth +disdain +disdainfulli +disdain +disdain +disdnguish +disea +diseas +diseas +diseas +disedg +disembark +disfigur +disfigur +disfurnish +disgorg +disgrac +disgrac +disgrac +disgrac +disgrac +disgrac +disgraci +disgui +disguis +disguis +disguis +disguis +disguis +dish +dishabit +dishclout +dishearten +dishearten +dish +dishonest +dishonestli +dishonesti +dishonor +dishonor +dishonor +dishonour +dishonour +dishonour +dishonour +disinherit +disinherit +disjoin +disjoin +disjoin +disjoint +disjunct +dislik +dislik +disliken +dislik +dislimn +disloc +dislodg +disloy +disloyalti +dismal +dismantl +dismantl +dismask +dismai +dismai +dismemb +dismemb +dism +dismiss +dismiss +dismiss +dismiss +dismount +dismount +disnatur +disobedi +disobedi +disobei +disobei +disorb +disord +disord +disorderli +disord +disparag +disparag +disparag +dispark +dispatch +dispens +dispens +dispens +disper +dispers +dispers +dispersedli +dispers +dispit +displac +displac +displac +displant +displant +displai +displai +displea +displeas +displeas +displeas +displeasur +displeasur +dispong +disport +disport +dispo +dispos +dispos +dispos +dispos +disposit +disposit +dispossess +dispossess +disprai +disprais +disprais +dispraisingli +disproperti +disproport +disproport +disprov +disprov +disprov +dispurs +disput +disput +disput +disput +disput +disput +disput +disquant +disquiet +disquietli +disrelish +disrob +disseat +dissembl +dissembl +dissembl +dissembl +dissembl +dissembl +dissens +dissens +dissenti +dissev +dissip +dissolut +dissolut +dissolut +dissolut +dissolv +dissolv +dissolv +dissolv +dissuad +dissuad +distaff +distaff +distain +distain +distanc +distant +distast +distast +distast +distemp +distemp +distemperatur +distemperatur +distemp +distemp +distil +distil +distil +distil +distil +distil +distinct +distinct +distinctli +distingu +distinguish +distinguish +distinguish +distract +distract +distractedli +distract +distract +distract +distrain +distraught +distress +distress +distress +distress +distribut +distribut +distribut +distrust +distrust +disturb +disturb +disturb +disturb +disunit +disvalu +disvouch +dit +ditch +ditcher +ditch +dite +ditti +ditti +diurnal +div +dive +diver +diver +divers +divers +divert +divert +divert +dive +divest +divid +divid +divid +divid +divid +divideth +divin +divin +divin +divin +divin +divin +divin +divinest +divin +divin +divis +divis +divorc +divorc +divorc +divorc +divorc +divulg +divulg +divulg +divulg +dizi +dizzi +do +doat +dobbin +dock +dock +doct +doctor +doctor +doctrin +document +dodg +doe +doer +doer +doe +doest +doff +dog +dogberri +dogfish +dogg +dog +dog +doigt +do +do +doit +doit +dolabella +dole +dole +doll +dollar +dollar +dolor +dolor +dolour +dolour +dolphin +dolt +dolt +domest +domest +domin +domin +domin +domin +domin +domin +domin +dominion +dominion +domitiu +dommelton +don +donalbain +donat +donc +doncast +done +dong +donn +donn +donner +donnerai +doom +doomsdai +door +doorkeep +door +dorca +doreu +doricl +dormous +dorothi +dorset +dorsetshir +dost +dotag +dotant +dotard +dotard +dote +dote +doter +dote +doteth +doth +dote +doubl +doubl +doubl +doubler +doublet +doublet +doubl +doubli +doubt +doubt +doubt +doubtfulli +doubt +doubtless +doubt +doug +dough +doughti +doughi +dougla +dout +dout +dout +dove +dovehous +dover +dove +dow +dowag +dowdi +dower +dowerless +dower +dowla +dowl +down +downfal +downright +down +downstair +downtrod +downward +downward +downi +dowri +dowri +dowsabel +doxi +doze +dozen +dozen +dozi +drab +drab +drab +drachma +drachma +draff +drag +dragg +drag +drag +dragon +dragonish +dragon +drain +drain +drain +drake +dram +dramati +drank +draught +draught +drave +draw +drawbridg +drawer +drawer +draweth +draw +drawl +drawn +draw +drayman +draymen +dread +dread +dread +dreadfulli +dread +dread +dream +dreamer +dreamer +dream +dream +dreamt +drearn +dreari +dreg +dreg +drench +drench +dress +dress +dresser +dress +dress +drest +drew +dribbl +dri +drier +dri +drift +drili +drink +drinketh +drink +drink +drink +driv +drive +drivel +driven +drive +driveth +drive +drizzl +drizzl +drizzl +droit +drolleri +dromio +dromio +drone +drone +droop +droopeth +droop +droop +drop +dropheir +droplet +dropp +dropper +droppeth +drop +drop +drop +dropsi +dropsi +dropsi +dropt +dross +drossi +drought +drove +droven +drovier +drown +drown +drown +drown +drow +drows +drowsili +drowsi +drowsi +drudg +drudgeri +drudg +drug +drugg +drug +drum +drumbl +drummer +drum +drum +drunk +drunkard +drunkard +drunken +drunkenli +drunken +dry +dryness +dst +du +dub +dubb +ducat +ducat +ducdam +duchess +duchi +duchi +duck +duck +duck +dudgeon +due +duellist +duello +duer +due +duff +dug +dug +duke +dukedom +dukedom +duke +dulcet +dulch +dull +dullard +duller +dullest +dull +dull +dull +dulli +dul +duli +dumain +dumb +dumb +dumbl +dumb +dump +dump +dun +duncan +dung +dungeon +dungeon +dunghil +dunghil +dungi +dunnest +dunsinan +dunsmor +dunstabl +dupp +duranc +dure +durst +duski +dust +dust +dusti +dutch +dutchman +duteou +duti +duti +duti +dwarf +dwarfish +dwell +dweller +dwell +dwell +dwelt +dwindl +dy +dye +dy +dyer +dy +e +each +eager +eagerli +eager +eagl +eagl +ean +eanl +ear +ear +earl +earldom +earlier +earliest +earli +earl +earli +earn +earn +earnest +earnestli +earnest +earn +ear +earth +earthen +earthlier +earthli +earthquak +earthquak +earthi +ea +eas +eas +eas +eas +easier +easiest +easiliest +easili +easi +eas +east +eastcheap +easter +eastern +eastward +easi +eat +eaten +eater +eater +eat +eat +eaux +eav +ebb +eb +ebb +ebon +eboni +ebrew +ecc +echapp +echo +echo +eclip +eclips +eclips +ecoli +ecoutez +ecstaci +ecstasi +ecstasi +ecu +eden +edg +edgar +edg +edg +edgeless +edg +edict +edict +edific +edific +edifi +edifi +edit +edm +edmund +edmund +edmundsburi +educ +educ +educ +edward +eel +eel +effect +effect +effectless +effect +effectu +effectu +effemin +effigi +effu +effus +effus +eftest +egal +egal +eget +egeu +egg +egg +eggshel +eglamour +eglantin +egma +ego +egregi +egregi +egress +egypt +egyptian +egyptian +eie +eight +eighteen +eighth +eightpenni +eighti +eisel +either +eject +ek +el +elb +elbow +elbow +eld +elder +elder +eldest +eleanor +elect +elect +elect +eleg +elegi +element +element +eleph +eleph +elev +eleven +eleventh +elf +elflock +eliad +elinor +elizabeth +ell +ell +ellen +elm +eloqu +eloqu +els +elsewher +elsinor +eltham +elv +elvish +eli +elysium +em +embal +embalm +embalm +embark +embark +embarqu +embassad +embassag +embassi +embassi +embattail +embattl +embattl +embai +embellish +ember +emblaz +emblem +emblem +embodi +embold +embolden +emboss +emboss +embound +embowel +embowel +embrac +embrac +embrac +embrac +embrac +embrac +embrac +embrasur +embroid +embroideri +emhrac +emilia +emin +emin +emin +emmanuel +emniti +empal +emper +emperess +emperi +emperor +emperi +emphasi +empir +empir +empiricut +empleach +emploi +emploi +employ +employ +employ +empoison +empress +empti +emptier +empti +empti +empti +empti +emul +emul +emul +emul +emul +en +enact +enact +enact +enactur +enamel +enamel +enamour +enamour +enanmour +encamp +encamp +encav +enceladu +enchaf +enchaf +enchant +enchant +enchant +enchantingli +enchant +enchantress +enchant +encha +encircl +encircl +enclo +enclos +enclos +enclos +encloseth +enclos +encloud +encompass +encompass +encompasseth +encompass +encor +encorpor +encount +encount +encount +encount +encourag +encourag +encourag +encrimson +encroach +encumb +end +endamag +endamag +endang +endart +endear +endear +endeavour +endeavour +end +ender +end +end +endit +endless +endow +endow +endow +endow +end +endu +endu +endur +endur +endur +endur +endur +endur +endymion +enea +enemi +enemi +enerni +enew +enfeebl +enfeebl +enfeoff +enfett +enfold +enforc +enforc +enforc +enforcedli +enforc +enforc +enforcest +enfranch +enfranchi +enfranchis +enfranchis +enfranchis +enfre +enfreedom +engag +engag +engag +engag +engag +engaol +engend +engend +engend +engild +engin +engin +engin +engin +engirt +england +english +englishman +englishmen +englut +englut +engraf +engraft +engraft +engrav +engrav +engross +engross +engrossest +engross +engross +enguard +enigma +enigmat +enjoin +enjoin +enjoi +enjoi +enjoy +enjoi +enjoi +enkindl +enkindl +enlard +enlarg +enlarg +enlarg +enlarg +enlargeth +enlighten +enlink +enmesh +enmiti +enmiti +ennobl +ennobl +enobarb +enobarbu +enon +enorm +enorm +enough +enow +enpatron +enpierc +enquir +enquir +enquir +enrag +enrag +enrag +enrag +enrank +enrapt +enrich +enrich +enrich +enridg +enr +enrob +enrob +enrol +enrol +enroot +enround +enschedul +ensconc +ensconc +enseam +ensear +enseign +enseignez +ensembl +enshelt +enshield +enshrin +ensign +ensign +enski +ensman +ensnar +ensnar +ensnareth +ensteep +ensu +ensu +ensu +ensu +ensu +enswath +ent +entail +entam +entangl +entangl +entendr +enter +enter +enter +enterpris +enterpris +enter +entertain +entertain +entertain +entertain +entertain +entertain +enthral +enthral +enthron +enthron +entic +entic +entic +entir +entir +entitl +entitl +entitl +entomb +entomb +entrail +entranc +entranc +entrap +entrapp +entr +entreat +entreat +entreati +entreat +entreat +entreat +entreati +entrench +entri +entwist +envelop +envenom +envenom +envenom +envi +envi +enviou +envious +environ +environ +envoi +envi +envi +enwheel +enwomb +enwrap +ephesian +ephesian +ephesu +epicur +epicurean +epicur +epicur +epicuru +epidamnum +epidauru +epigram +epilepsi +epilept +epilogu +epilogu +epistl +epistrophu +epitaph +epitaph +epithet +epitheton +epithet +epitom +equal +equal +equal +equal +equal +equal +equal +equinocti +equinox +equipag +equiti +equivoc +equivoc +equivoc +equivoc +equivoc +er +erbear +erbear +erbear +erbeat +erblow +erboard +erborn +ercam +ercast +ercharg +ercharg +ercharg +ercl +ercom +ercov +ercrow +erdo +er +erebu +erect +erect +erect +erect +erect +erewhil +erflourish +erflow +erflow +erflow +erfraught +erga +ergal +erglanc +ergo +ergon +ergrow +ergrown +ergrowth +erhang +erhang +erhasti +erhear +erheard +eringo +erjoi +erleap +erleap +erleaven +erlook +erlook +ermast +ermengar +ermount +ern +ernight +ero +erpaid +erpart +erpast +erpai +erpeer +erperch +erpictur +erpingham +erpost +erpow +erpress +erpress +err +errand +errand +errant +errat +erraught +erreach +er +errest +er +erron +error +error +err +errul +errun +erset +ershad +ershad +ershin +ershot +ersiz +erskip +erslip +erspread +erst +erstar +erstep +erstunk +erswai +erswai +erswel +erta +ertak +erteem +erthrow +erthrown +erthrow +ertook +ertop +ertop +ertrip +erturn +erudit +erupt +erupt +ervalu +erwalk +erwatch +erween +erween +erweigh +erweigh +erwhelm +erwhelm +erworn +es +escalu +escap +escap +escap +escap +eschew +escot +esil +especi +especi +esper +espial +espi +espi +espou +espous +espi +esquir +esquir +essai +essai +essenc +essenti +essenti +ess +essex +est +establish +establish +estat +estat +esteem +esteem +esteemeth +esteem +esteem +estim +estim +estim +estim +estim +estrang +estridg +estridg +et +etc +etcetera +et +etern +etern +etern +etern +eterniz +et +ethiop +ethiop +ethiop +ethiopian +etna +eton +etr +eunuch +eunuch +euphrat +euphroniu +euriphil +europa +europ +ev +evad +evad +evan +evas +evas +ev +even +even +evenli +event +event +event +ever +everlast +everlastingli +evermor +everi +everyon +everyth +everywher +evid +evid +evid +evil +evilli +evil +evit +ew +ewer +ewer +ew +exact +exact +exactest +exact +exact +exact +exactli +exact +exalt +exalt +examin +examin +examin +examin +examin +examin +exampl +exampl +exampl +exampl +exasper +exasper +exce +exceed +exceedeth +exceed +exceedingli +exce +excel +excel +excel +excel +excel +excel +excel +excel +excel +except +except +except +except +except +exceptless +excess +excess +exchang +exchang +exchang +exchequ +exchequ +excit +excit +excit +excit +exclaim +exclaim +exclam +exclam +exclud +excommun +excommun +excrement +excrement +excurs +excurs +excu +excus +excus +excus +excus +excusez +excus +execr +execr +execut +execut +execut +execut +execution +execution +executor +executor +exempt +exempt +exequi +exercis +exercis +exet +exeunt +exhal +exhal +exhal +exhal +exhal +exhaust +exhibit +exhibit +exhibit +exhort +exhort +exig +exil +exil +exil +exion +exist +exist +exit +exit +exorcis +exorc +exorcist +expect +expect +expect +expect +expect +expect +expect +expect +expect +expedi +expedi +expedi +expedit +expediti +expel +expel +expel +expel +expend +expens +expens +experienc +experi +experi +experi +experiment +experi +expert +expert +expiat +expiat +expir +expir +expir +expir +expir +expir +explic +exploit +exploit +expo +expos +expos +exposit +expositor +expostul +expostul +expostur +exposur +expound +expound +express +express +expresseth +express +express +expressli +expressur +expul +expuls +exquisit +exsuffl +extant +extempor +extempor +extempor +extend +extend +extend +extent +extenu +extenu +extenu +extenu +exterior +exteriorli +exterior +extermin +extern +extern +extinct +extinct +extinctur +extinguish +extirp +extirp +extirp +extol +extol +extol +exton +extort +extort +extort +extort +extra +extract +extract +extract +extraordinarili +extraordinari +extraught +extravag +extravag +extrem +extrem +extrem +extremest +extrem +extrem +exuent +exult +exult +ey +eya +eyas +ey +eyebal +eyebal +eyebrow +eyebrow +ei +eyeless +eyelid +eyelid +ey +eyesight +eyestr +ei +eyn +eyri +fa +fabian +fabl +fabl +fabric +fabul +fac +face +face +facer +face +faciant +facil +facil +facineri +face +facit +fact +faction +factionari +faction +factiou +factor +factor +faculti +faculti +fade +fade +fadeth +fadg +fade +fade +fadom +fadom +fagot +fagot +fail +fail +fail +fain +faint +faint +fainter +faint +faintli +faint +faint +fair +fairer +fairest +fairi +fair +fair +fairli +fair +fair +fairwel +fairi +fai +fait +fait +faith +faith +faithful +faithfulli +faithless +faith +faitor +fal +falchion +falcon +falconbridg +falcon +falcon +fall +fallaci +fallen +falleth +falliabl +fallibl +fall +fallow +fallow +fall +falli +falor +fals +falsehood +fals +fals +falser +falsifi +fals +falstaff +falstaff +falter +fam +fame +fame +familiar +familiar +familiarli +familiar +famili +famin +famish +famish +famou +famous +famous +fan +fanat +fanci +fanci +fane +fane +fang +fangl +fangless +fang +fann +fan +fan +fantasi +fantasi +fantast +fantast +fantast +fantastico +fantasi +fap +far +farborough +farc +fardel +fardel +fare +fare +farewel +farewel +farin +fare +farm +farmer +farmhous +farm +farr +farrow +farther +farthest +farth +farthingal +farthingal +farth +fartuou +fa +fashion +fashion +fashion +fashion +fast +fast +fasten +fasten +faster +fastest +fast +fastli +fastolf +fast +fat +fatal +fatal +fate +fate +fate +father +father +fatherless +fatherli +father +fathom +fathomless +fathom +fatig +fat +fat +fat +fatter +fattest +fat +fatuu +fauconbridg +faulconbridg +fault +faulti +faultless +fault +faulti +fauss +faust +faustus +faut +favor +favor +favor +favor +favour +favour +favour +favouredli +favour +favour +favour +favourit +favourit +favour +favout +fawn +fawneth +fawn +fawn +fai +fe +fealti +fear +fear +fearest +fear +fearful +fearfulli +fear +fear +fearless +fear +feast +feast +feast +feast +feat +feat +feater +feather +feather +feather +featli +feat +featur +featur +featur +featureless +featur +februari +feck +fed +fedari +federari +fee +feebl +feebl +feebl +feebl +feebli +feed +feeder +feeder +feedeth +feed +feed +feel +feeler +feel +feelingli +feel +fee +feet +fehement +feign +feign +feign +feil +feith +felicit +felic +fell +fellest +felli +fellow +fellowli +fellow +fellowship +fellowship +fell +felon +feloni +feloni +felt +femal +femal +feminin +fen +fenc +fenc +fencer +fenc +fend +fennel +fenni +fen +fenton +fer +ferdinand +fere +fernse +ferrara +ferrer +ferret +ferri +ferryman +fertil +fertil +fervenc +fervour +feri +fest +fest +fester +festin +festin +festiv +festiv +fet +fetch +fetch +fetch +fetlock +fetlock +fett +fetter +fetter +fetter +fettl +feu +feud +fever +fever +fever +few +fewer +fewest +few +fickl +fickl +fico +fiction +fiddl +fiddler +fiddlestick +fidel +fidelicet +fidel +fidiu +fie +field +field +field +fiend +fiend +fierc +fierc +fierc +fieri +fife +fife +fifteen +fifteen +fifteenth +fifth +fifti +fiftyfold +fig +fight +fighter +fightest +fighteth +fight +fight +figo +fig +figur +figur +figur +figur +figur +fike +fil +filbert +filch +filch +filch +file +file +file +filial +filiu +fill +fill +fillet +fill +fillip +fill +filli +film +fil +filth +filth +filthi +fin +final +finch +find +finder +findeth +find +find +find +fine +fineless +fine +finem +fine +finer +fine +finest +fing +finger +finger +finger +fingr +fingr +finic +finish +finish +finish +finless +finn +fin +finsburi +fir +firago +fire +firebrand +firebrand +fire +fire +firework +firework +fire +firk +firm +firmament +firmli +firm +first +firstl +fish +fisher +fishermen +fisher +fish +fishifi +fishmong +fishpond +fisnomi +fist +fist +fist +fistula +fit +fitchew +fit +fitli +fitment +fit +fit +fit +fitter +fittest +fitteth +fit +fitzwat +five +fivep +five +fix +fix +fix +fixeth +fix +fixtur +fl +flag +flag +flagon +flagon +flag +flail +flake +flaki +flam +flame +flamen +flamen +flame +flame +flaminiu +flander +flannel +flap +flare +flash +flash +flash +flask +flat +flatli +flat +flat +flatt +flatter +flatter +flatter +flatter +flatterest +flatteri +flatter +flatter +flatteri +flaunt +flavio +flaviu +flaw +flaw +flax +flaxen +flai +flai +flea +fleanc +flea +fleck +fled +fledg +flee +fleec +fleec +fleec +fleer +fleer +fleer +fleet +fleeter +fleet +fleme +flemish +flesh +flesh +fleshli +fleshment +fleshmong +flew +flexibl +flexur +flibbertigibbet +flicker +flidg +flier +fli +flieth +flight +flight +flighti +flinch +fling +flint +flint +flinti +flirt +float +float +float +flock +flock +flood +floodgat +flood +floor +flora +florenc +florentin +florentin +florentiu +florizel +flote +floulish +flour +flourish +flourish +flourisheth +flourish +flout +flout +flout +flout +flow +flow +flower +floweret +flower +flow +flown +flow +fluellen +fluent +flung +flush +flush +fluster +flute +flute +flutter +flux +fluxiv +fly +fly +fo +foal +foal +foam +foam +foam +foam +foami +fob +foc +fodder +foe +foeman +foemen +foe +fog +foggi +fog +foh +foi +foil +foil +foil +foin +foin +foin +foi +foison +foison +foist +foix +fold +fold +fold +folio +folk +folk +folli +follow +follow +follow +follow +followest +follow +follow +folli +fond +fonder +fondli +fond +font +fontibel +food +fool +fooleri +fooleri +foolhardi +fool +foolish +foolishli +foolish +fool +foot +footbal +footboi +footboi +foot +footfal +foot +footman +footmen +footpath +footstep +footstool +fopp +fop +fopperi +foppish +fop +for +forag +forag +forbad +forbear +forbear +forbear +forbid +forbidden +forbiddenli +forbid +forbod +forborn +forc +forc +forc +forc +forceless +forc +forcibl +forcibl +forc +ford +fordid +fordo +fordo +fordon +fore +forecast +forefath +forefath +forefing +forego +foregon +forehand +forehead +forehead +forehors +foreign +foreign +foreign +foreknow +foreknowledg +foremost +forenam +forenoon +forerun +forerunn +forerun +forerun +foresaid +foresaw +foresai +forese +forese +forese +foreshow +foreskirt +foresp +forest +forestal +forestal +forest +forest +forest +foretel +foretel +foretel +forethink +forethought +foretold +forev +foreward +forewarn +forewarn +forewarn +forfeit +forfeit +forfeit +forfeit +forfeit +forfeitur +forfeitur +forfend +forfend +forg +forgav +forg +forg +forgeri +forgeri +forg +forget +forget +forget +forget +forget +forget +forgiv +forgiven +forgiv +forgo +forgo +forgon +forgot +forgotten +fork +fork +fork +forlorn +form +formal +formal +form +former +formerli +formless +form +fornic +fornic +fornicatress +forr +forrest +forsak +forsaken +forsaketh +forslow +forsook +forsooth +forspent +forspok +forswear +forswear +forswor +forsworn +fort +fort +forth +forthcom +forthlight +forthright +forthwith +fortif +fortif +fortifi +fortifi +fortifi +fortinbra +fortitud +fortnight +fortress +fortress +fort +fortun +fortuna +fortun +fortun +fortun +fortun +fortun +fortward +forti +forum +forward +forward +forward +forward +forweari +fosset +fost +foster +foster +fought +foughten +foul +fouler +foulest +foulli +foul +found +foundat +foundat +found +founder +fount +fountain +fountain +fount +four +fourscor +fourteen +fourth +foutra +fowl +fowler +fowl +fowl +fox +fox +foxship +fract +fraction +fraction +fragil +fragment +fragment +fragrant +frail +frailer +frailti +frailti +fram +frame +frame +frame +frampold +fran +francai +franc +franc +franchis +franchis +franchis +franchis +francia +franci +francisca +franciscan +francisco +frank +franker +frankfort +franklin +franklin +frankli +frank +frantic +franticli +frateretto +fratrum +fraud +fraud +fraught +fraughtag +fraught +frai +frai +freckl +freckl +freckl +frederick +free +freed +freedom +freedom +freeheart +freelier +freeli +freeman +freemen +freeness +freer +free +freeston +freetown +freez +freez +freez +freez +french +frenchman +frenchmen +frenchwoman +frenzi +frequent +frequent +fresh +fresher +fresh +freshest +freshli +fresh +fret +fret +fret +fret +fretten +fret +friar +friar +fridai +fridai +friend +friend +friend +friendless +friendli +friendli +friend +friendship +friendship +friez +fright +fright +frighten +fright +fright +fright +fring +fring +fripperi +frisk +fritter +frivol +fro +frock +frog +frogmor +froissart +frolic +from +front +front +frontier +frontier +front +frontlet +front +frost +frost +frosti +froth +froward +frown +frown +frowningli +frown +froze +frozen +fructifi +frugal +fruit +fruiter +fruit +fruitfulli +fruit +fruition +fruitless +fruit +frush +frustrat +frutifi +fry +fubb +fuel +fugit +fulfil +fulfil +fulfil +fulfil +full +fullam +fuller +fuller +fullest +full +fulli +ful +fulsom +fulvia +fum +fumbl +fumbl +fumblest +fumbl +fume +fume +fume +fumit +fumitori +fun +function +function +fundament +funer +funer +fur +furbish +furi +furiou +furlong +furnac +furnac +furnish +furnish +furnish +furnitur +furniv +furor +furr +furrow +furrow +furrow +furth +further +further +further +furthermor +furthest +furi +furz +furz +fust +fustian +fustilarian +fusti +fut +futur +futur +g +gabbl +gaberdin +gabriel +gad +gad +gad +gadshil +gag +gage +gage +gagg +gage +gagn +gain +gain +gainer +gaingiv +gain +gainsaid +gainsai +gainsai +gainsai +gainst +gait +gait +galath +gale +galen +gale +gall +gallant +gallantli +gallantri +gallant +gall +galleri +gallei +gallei +gallia +gallian +galliard +galliass +gallimaufri +gall +gallon +gallop +gallop +gallop +gallow +gallowai +gallowglass +gallow +gallows +gall +gallu +gam +gambol +gambold +gambol +gamboi +game +gamer +game +gamesom +gamest +game +gammon +gamut +gan +gangren +ganymed +gaol +gaoler +gaoler +gaol +gap +gape +gape +gape +gar +garb +garbag +garboil +garcon +gard +gard +garden +garden +garden +garden +gardez +gardin +gardon +gargantua +gargrav +garish +garland +garland +garlic +garment +garment +garmet +garner +garner +garnish +garnish +garret +garrison +garrison +gart +garter +garterd +garter +garter +gasconi +gash +gash +gaskin +gasp +gasp +gast +gast +gat +gate +gate +gate +gath +gather +gather +gather +gather +gatori +gatori +gaud +gaudeo +gaudi +gaug +gaul +gaultre +gaunt +gauntlet +gauntlet +gav +gave +gavest +gawd +gawd +gawsei +gai +gay +gaz +gaze +gaze +gazer +gazer +gaze +gazeth +gaze +gear +geck +gees +geffrei +geld +geld +geld +gelida +gelidu +gelt +gem +gemini +gem +gen +gender +gender +gener +gener +gener +gener +gener +gener +generos +gener +genit +genitivo +geniu +gennet +genoa +genoux +gen +gent +gentilhomm +gentil +gentl +gentlefolk +gentleman +gentlemanlik +gentlemen +gentl +gentler +gentl +gentlest +gentlewoman +gentlewomen +gentli +gentri +georg +gerard +germain +germain +german +german +german +germani +gertrud +gest +gest +gestur +gestur +get +getrud +get +getter +get +ghastli +ghost +ghost +ghostli +ghost +gi +giant +giantess +giantlik +giant +gib +gibber +gibbet +gibbet +gibe +giber +gibe +gibe +gibingli +giddili +giddi +giddi +gift +gift +gig +giglet +giglot +gilbert +gild +gild +gild +gilliam +gillian +gill +gillyvor +gilt +gimmal +gimmer +gin +ging +ginger +gingerbread +gingerli +ginn +gin +gioucestershir +gipe +gipsi +gipsi +gird +gird +girdl +girdl +girdl +girdl +girl +girl +girt +girth +gi +giv +give +given +giver +giver +give +givest +giveth +give +give +glad +glad +glad +gladli +glad +glami +glanc +glanc +glanc +glanc +glanc +glander +glansdal +glare +glare +glass +glass +glassi +glaz +glaze +gleam +glean +glean +glean +gleeful +gleek +gleek +gleek +glend +glendow +glib +glide +glide +glide +glideth +glide +glimmer +glimmer +glimmer +glimps +glimps +glist +glisten +glister +glister +glister +glitt +glitter +globe +globe +gloom +gloomi +glori +glorifi +glorifi +gloriou +glorious +glori +glose +gloss +gloss +glou +gloucest +gloucest +gloucestershir +glove +glover +glove +glow +glow +glow +glowworm +gloz +gloze +gloze +glu +glue +glu +glue +glut +glutt +glut +glutton +glutton +gluttoni +gnarl +gnarl +gnat +gnat +gnaw +gnaw +gnawn +gnaw +go +goad +goad +goad +goal +goat +goatish +goat +gobbet +gobbo +goblet +goblet +goblin +goblin +god +god +godden +goddess +goddess +goddild +godfath +godfath +godhead +godlik +godli +godli +godmoth +god +godson +goer +goer +goe +goest +goeth +goff +gog +go +gold +golden +goldenli +goldsmith +goldsmith +golgotha +golias +goliath +gon +gondola +gondoli +gone +goneril +gong +gonzago +gonzalo +good +goodfellow +goodlier +goodliest +goodli +goodman +good +goodnight +goodrig +good +goodwif +goodwil +goodwin +goodwin +goodyear +goodyear +goos +gooseberri +goosequil +goot +gor +gorbelli +gorboduc +gordian +gore +gore +gorg +gorg +gorgeou +gorget +gorg +gorgon +gormand +gormand +gori +gosl +gospel +gospel +goss +gossam +gossip +gossip +gossiplik +gossip +got +goth +goth +gotten +gourd +gout +gout +gouti +govern +govern +govern +gover +govern +governor +governor +govern +gower +gown +gown +grac +grace +grace +grace +gracefulli +graceless +grace +grace +graciou +gracious +gradat +graff +graf +graft +graft +grafter +grain +grain +grain +gramerci +gramerci +grammar +grand +grandam +grandam +grandchild +grand +grandeur +grandfath +grandjuror +grandmoth +grandpr +grandsir +grandsir +grandsir +grang +grant +grant +grant +grant +grape +grape +grappl +grappl +grappl +grasp +grasp +grasp +grass +grasshopp +grassi +grate +grate +grate +grate +gratiano +gratifi +gratii +gratil +grate +grati +gratitud +gratul +grav +grave +gravedigg +gravel +graveless +gravel +grave +graven +grave +graver +grave +gravest +graveston +graviti +graviti +gravi +grai +graymalkin +graz +graze +graze +graze +greas +greas +greasili +greasi +great +greater +greatest +greatli +great +grecian +grecian +gree +greec +greed +greedili +greedi +greedi +gree +greek +greekish +greek +green +greener +greenli +green +greensleev +greenwich +greenwood +greet +greet +greet +greet +greet +greg +gregori +gremio +grew +grei +greybeard +greybeard +greyhound +greyhound +grief +grief +griev +grievanc +grievanc +griev +griev +griev +grievest +griev +grievingli +grievou +grievous +griffin +griffith +grim +grime +grimli +grin +grind +grind +grindston +grin +grip +gripe +gripe +gripe +grise +grisli +grissel +grize +grizzl +grizzl +groan +groan +groan +groat +groat +groin +groom +groom +grop +grope +gro +gross +grosser +grossli +gross +ground +ground +groundl +ground +grove +grovel +grovel +grove +grow +groweth +grow +grown +grow +growth +grub +grubb +grub +grudg +grudg +grudg +grudg +gruel +grumbl +grumblest +grumbl +grumbl +grumio +grund +grunt +gualtier +guard +guardag +guardant +guard +guardian +guardian +guard +guardsman +gud +gudgeon +guerdon +guerra +guess +guess +guessingli +guest +guest +guiana +guichard +guid +guid +guider +guideriu +guid +guid +guidon +guienn +guil +guildenstern +guilder +guildford +guildhal +guil +guil +guil +guilford +guilt +guiltian +guiltier +guiltili +guilti +guiltless +guilt +guilti +guinea +guinev +guis +gul +gule +gulf +gulf +gull +gull +gum +gumm +gum +gun +gunner +gunpowd +gun +gurnet +gurnei +gust +gust +gusti +gut +gutter +gui +guyn +guysor +gypsi +gyve +gyve +gyve +h +ha +haberdash +habili +habili +habit +habit +habit +habit +habitud +hack +hacket +hacknei +hack +had +hadst +haec +haer +hag +hagar +haggard +haggard +haggish +haggl +hag +hail +hail +hailston +hailston +hair +hairless +hair +hairi +hal +halberd +halberd +halcyon +hale +hale +hale +half +halfcan +halfpenc +halfpenni +halfpennyworth +halfwai +halidom +hall +halloa +hallo +hallond +halloo +halloo +hallow +hallow +hallowma +hallown +hal +halt +halter +halter +halt +halt +halv +ham +hame +hamlet +hammer +hammer +hammer +hammer +hamper +hampton +ham +hamstr +hand +hand +hand +handicraft +handicraftsmen +hand +handiwork +handkerch +handkerch +handkerchief +handl +handl +handl +handless +handlest +handl +handmaid +handmaid +hand +handsaw +handsom +handsom +handsom +handwrit +handi +hang +hang +hanger +hangeth +hang +hang +hangman +hangmen +hang +hannib +hap +hapless +hapli +happ +happen +happen +happier +happi +happiest +happili +happi +happi +hap +harbing +harbing +harbor +harbour +harbourag +harbour +harbour +harcourt +hard +harder +hardest +hardiest +hardiment +hardi +hardli +hard +hardock +hardi +hare +harelip +hare +harfleur +hark +harlot +harlotri +harlot +harm +harm +harm +harm +harmless +harmoni +harmoni +harm +har +harp +harper +harpier +harp +harpi +harri +harrow +harrow +harri +harsh +harshli +harsh +hart +hart +harum +harvest +ha +hast +hast +hast +hasten +hast +hastili +hast +hast +hasti +hat +hatch +hatch +hatchet +hatch +hatchment +hate +hate +hate +hater +hater +hate +hateth +hatfield +hath +hate +hatr +hat +haud +hauf +haught +haughti +haughti +haunch +haunch +haunt +haunt +haunt +haunt +hautboi +hautboi +have +haven +haven +haver +have +have +havior +haviour +havoc +hawk +hawk +hawk +hawthorn +hawthorn +hai +hazard +hazard +hazard +hazel +hazelnut +he +head +headborough +head +headier +head +headland +headless +headlong +head +headsman +headstrong +headi +heal +heal +heal +heal +health +health +health +healthsom +healthi +heap +heap +heap +hear +heard +hearer +hearer +hearest +heareth +hear +hear +heark +hearken +hearken +hear +hearsai +hears +hears +hearst +heart +heartach +heartbreak +heartbreak +heart +hearten +hearth +hearth +heartili +hearti +heartless +heartl +heartli +heart +heartsick +heartstr +hearti +heat +heat +heath +heathen +heathenish +heat +heat +heauti +heav +heav +heav +heaven +heavenli +heaven +heav +heavier +heaviest +heavili +heavi +heav +heav +heavi +hebona +hebrew +hecat +hectic +hector +hector +hecuba +hedg +hedg +hedgehog +hedgehog +hedg +heed +heed +heed +heedful +heedfulli +heedless +heel +heel +heft +heft +heifer +heifer +heigh +height +heighten +heinou +heinous +heir +heiress +heirless +heir +held +helen +helena +helenu +helia +helicon +hell +hellespont +hellfir +hellish +helm +helm +helmet +helmet +helm +help +helper +helper +help +help +helpless +help +helter +hem +heme +hemlock +hemm +hemp +hempen +hem +hen +henc +henceforth +henceforward +henchman +henri +henricu +henri +hen +hent +henton +her +herald +heraldri +herald +herb +herbert +herblet +herb +herculean +hercul +herd +herd +herdsman +herdsmen +here +hereabout +hereabout +hereaft +herebi +hereditari +hereford +herefordshir +herein +hereof +heresi +heresi +heret +heret +hereto +hereupon +heritag +heriti +herm +hermia +hermion +hermit +hermitag +hermit +hern +hero +herod +herod +hero +heroic +heroic +her +her +her +herself +hesperid +hesperu +hest +hest +heur +heureux +hew +hewgh +hew +hewn +hew +hei +heydai +hibocr +hic +hiccup +hick +hid +hidden +hide +hideou +hideous +hideous +hide +hidest +hide +hie +hi +hiem +hi +hig +high +higher +highest +highli +highmost +high +hight +highwai +highwai +hild +hild +hill +hillo +hilloa +hill +hilt +hilt +hili +him +himself +hinc +hincklei +hind +hinder +hinder +hinder +hindmost +hind +hing +hing +hing +hint +hip +hipp +hipparchu +hippolyta +hip +hir +hire +hire +hiren +hirtiu +hi +hisperia +hiss +hiss +hiss +hist +histor +histori +hit +hither +hitherto +hitherward +hitherward +hit +hit +hive +hive +hizz +ho +hoa +hoar +hoard +hoard +hoard +hoar +hoars +hoari +hob +hobbidid +hobbi +hobbyhors +hobgoblin +hobnail +hoc +hod +hodg +hog +hog +hogshead +hogshead +hoi +hois +hoist +hoist +hoist +holborn +hold +holden +holder +holdeth +holdfast +hold +hold +hole +hole +holidam +holidam +holidai +holidai +holier +holiest +holili +holi +holla +holland +holland +holland +holloa +holloa +hollow +hollowli +hollow +holli +holmedon +holofern +holp +holi +homag +homag +home +home +home +homespun +homeward +homeward +homicid +homicid +homili +hominem +homm +homo +honest +honest +honestest +honestli +honesti +honei +honeycomb +honei +honeyless +honeysuckl +honeysuckl +honi +honneur +honor +honor +honor +honorato +honorificabilitudinitatibu +honor +honour +honour +honour +honour +honourest +honour +honour +honour +hoo +hood +hood +hoodman +hood +hoodwink +hoof +hoof +hook +hook +hook +hoop +hoop +hoot +hoot +hoot +hoot +hop +hope +hope +hopeless +hope +hopest +hope +hopkin +hopped +hor +horac +horatio +horizon +horn +hornbook +horn +horner +horn +hornpip +horn +horolog +horribl +horribl +horrid +horrid +horridli +horror +horror +hor +hors +horseback +hors +horsehair +horseman +horsemanship +horsemen +hors +horsewai +hors +hortensio +hortensiu +horum +hose +hospit +hospit +hospit +host +hostag +hostag +hostess +hostil +hostil +hostiliu +host +hot +hotli +hotspur +hotter +hottest +hound +hound +hour +hourli +hour +hou +hous +household +household +household +household +housekeep +housekeep +housekeep +houseless +hous +housewif +housewiferi +housew +hovel +hover +hover +hover +hover +how +howbeit +how +howeer +howev +howl +howl +howlet +howl +howl +howso +howsoev +howsom +hox +hoi +hoydai +hubert +huddl +huddl +hue +hu +hue +hug +huge +huge +huge +hugg +hugger +hugh +hug +huju +hulk +hulk +hull +hull +hullo +hum +human +human +human +human +humbl +humbl +humbl +humbler +humbl +humblest +humbl +humbl +hume +humh +humid +humil +hum +humor +humor +humor +humour +humourist +humour +humphrei +humphri +hum +hundr +hundr +hundredth +hung +hungarian +hungari +hunger +hungerford +hungerli +hungri +hunt +hunt +hunter +hunter +hunteth +hunt +huntington +huntress +hunt +huntsman +huntsmen +hurdl +hurl +hurl +hurl +hurli +hurlyburli +hurricano +hurricano +hurri +hurri +hurri +hurt +hurt +hurtl +hurtless +hurtl +hurt +husband +husband +husbandless +husbandri +husband +hush +hush +husht +husk +huswif +huswif +hutch +hybla +hydra +hyen +hymen +hymenaeu +hymn +hymn +hyperbol +hyperbol +hyperion +hypocrisi +hypocrit +hypocrit +hyrcan +hyrcania +hyrcanian +hyssop +hysterica +i +iachimo +iaculi +iago +iament +ibat +icaru +ic +iceland +ici +icicl +icicl +ici +idea +idea +idem +iden +id +idiot +idiot +idl +idl +idl +idli +idol +idolatr +idolatri +ield +if +if +igni +ignobl +ignobl +ignomini +ignomini +ignomi +ignor +ignor +ii +iii +iiii +il +ilbow +ild +ilion +ilium +ill +illegitim +illiter +ill +illo +ill +illum +illumin +illumin +illumineth +illus +illus +illustr +illustr +illustri +illyria +illyrian +il +im +imag +imageri +imag +imagin +imaginari +imagin +imagin +imagin +imagin +imagin +imbar +imbecil +imbru +imitari +imit +imit +imit +imit +immacul +imman +immask +immateri +immediaci +immedi +immedi +immin +immin +immoder +immoder +immodest +immoment +immort +immortaliz +immort +immur +immur +immur +imogen +imp +impaint +impair +impair +impal +impal +impanel +impart +impart +imparti +impart +impart +impast +impati +impati +impati +impawn +impeach +impeach +impeach +impeach +imped +impedi +impedi +impenetr +imper +imperceiver +imperfect +imperfect +imperfect +imperfectli +imperi +imperi +imperi +impertin +impertin +impetico +impetuos +impetu +impieti +impieti +impiou +implac +implement +impli +implor +implor +implor +implor +implor +impon +import +import +import +import +importantli +import +importeth +import +importless +import +importun +importunaci +importun +importun +importun +importun +impo +impos +impos +imposit +imposit +imposs +imposs +imposs +imposthum +impostor +impostor +impot +impot +impound +impregn +impres +impress +impress +impressest +impress +impressur +imprimendum +imprimi +imprint +imprint +imprison +imprison +imprison +imprison +improb +improp +improv +improvid +impud +impud +impud +impud +impudiqu +impugn +impugn +impur +imput +imput +in +inaccess +inaid +inaud +inauspici +incag +incant +incap +incardin +incarnadin +incarn +incarn +incen +incens +incens +incens +incens +incens +incertain +incertainti +incertainti +incess +incessantli +incest +incestu +inch +incharit +inch +incid +incid +incis +incit +incit +incivil +incivil +inclin +inclin +inclin +inclin +inclin +inclin +inclin +inclip +includ +includ +includ +inclus +incompar +incomprehens +inconsider +inconst +inconst +incontin +incontin +incontin +inconveni +inconveni +inconveni +inconi +incorpor +incorp +incorrect +increa +increas +increas +increaseth +increas +incred +incredul +incur +incur +incurr +incur +incurs +ind +ind +indebt +inde +indent +indent +indentur +indentur +index +index +india +indian +indict +indict +indict +indi +indiffer +indiffer +indiffer +indig +indigest +indigest +indign +indign +indign +indign +indign +indign +indirect +indirect +indirect +indirectli +indiscreet +indiscret +indispo +indisposit +indissolubl +indistinct +indistinguish +indistinguish +indit +individ +indrench +indu +indubit +induc +induc +induc +induc +induct +induct +indu +indu +indu +indulg +indulg +indulg +indur +industri +industri +industri +inequ +inestim +inevit +inexecr +inexor +inexplic +infal +infal +infamon +infam +infami +infanc +infant +infant +infect +infect +infect +infect +infect +infecti +infecti +infect +infer +infer +inferior +inferior +infern +inferr +inferreth +infer +infest +infidel +infidel +infinit +infinit +infinit +infirm +infirm +infirm +infix +infix +inflam +inflam +inflam +inflamm +inflict +inflict +influenc +influenc +infold +inform +inform +inform +inform +inform +inform +inform +infortun +infr +infring +infring +infu +infus +infus +infus +infus +ingen +ingeni +ingeni +inglori +ingot +ingraf +ingraft +ingrat +ingrat +ingrat +ingratitud +ingratitud +ingredi +ingredi +ingross +inhabit +inhabit +inhabit +inhabit +inhabit +inhears +inhears +inher +inherit +inherit +inherit +inherit +inheritor +inheritor +inheritrix +inherit +inhibit +inhibit +inhoop +inhuman +iniqu +iniqu +initi +injoint +injunct +injunct +injur +injur +injur +injuri +injuri +injuri +injustic +ink +inkhorn +inkl +inkl +inkl +inki +inlaid +inland +inlai +inli +inmost +inn +inner +innkeep +innoc +innoc +innoc +innoc +innov +innov +inn +innumer +inocul +inordin +inprimi +inquir +inquir +inquiri +inquisit +inquisit +inroad +insan +insani +insati +insconc +inscrib +inscript +inscript +inscrol +inscrut +insculp +insculptur +insens +insepar +insepar +insert +insert +inset +inshel +inshipp +insid +insinew +insinu +insinuateth +insinu +insinu +insist +insist +insistur +insoci +insol +insol +insomuch +inspir +inspir +inspir +inspir +inspir +instal +instal +instal +instanc +instanc +instant +instantli +instat +instead +insteep +instig +instig +instig +instig +instig +instinct +instinct +institut +institut +instruct +instruct +instruct +instruct +instruct +instrument +instrument +instrument +insubstanti +insuffici +insuffici +insult +insult +insult +insult +insult +insupport +insuppress +insurrect +insurrect +int +integ +integrita +integr +intellect +intellect +intellectu +intellig +intelligenc +intelligenc +intellig +intelligi +intelligo +intemper +intemper +intend +intend +intendeth +intend +intend +intend +inten +intent +intent +intent +intent +inter +intercept +intercept +intercept +intercept +intercept +intercess +intercessor +interchain +interchang +interchang +interchang +interchang +interchang +interdict +interest +interim +interim +interior +interject +interjoin +interlud +intermingl +intermiss +intermiss +intermit +intermix +intermix +interpos +interpos +interpos +interpret +interpret +interpret +interpret +interpret +interpret +interr +inter +interrogatori +interrupt +interrupt +interrupt +interruptest +interrupt +interrupt +intertissu +intervallum +interview +intest +intestin +intil +intim +intim +intitl +intitul +into +intoler +intox +intreasur +intreat +intrench +intrench +intric +intrins +intrins +intrud +intrud +intrud +intrus +inund +inur +inurn +invad +invad +invas +invas +invect +invect +inveigl +invent +invent +invent +invent +inventor +inventori +inventori +inventor +inventori +inver +invert +invest +invest +invest +invest +inveter +invinc +inviol +invis +invis +invit +invit +invit +invit +invit +inviti +invoc +invoc +invok +invok +invulner +inward +inwardli +inward +inward +ionia +ionian +ips +ipswich +ira +ira +ira +ir +ir +ireland +iri +irish +irishman +irishmen +irk +irksom +iron +iron +irreconcil +irrecover +irregular +irregul +irreligi +irremov +irrepar +irresolut +irrevoc +is +isabel +isabella +isbel +isbel +iscariot +is +ish +isidor +isi +island +island +island +island +isl +isl +israel +issu +issu +issu +issueless +issu +issu +ist +ista +it +italian +itali +itch +itch +itch +item +item +iter +ithaca +it +itself +itshal +iv +ivori +ivi +iwi +ix +j +jacet +jack +jackanap +jack +jacksauc +jackslav +jacob +jade +jade +jade +jail +jake +jamani +jame +jami +jane +jangl +jangl +januari +janu +japhet +jaquenetta +jaqu +jar +jar +jar +jarteer +jason +jaunc +jaunc +jaundic +jaundi +jaw +jawbon +jaw +jai +jai +jc +je +jealou +jealousi +jealousi +jeer +jeer +jelli +jenni +jeopardi +jephtha +jephthah +jerkin +jerkin +jerk +jeronimi +jerusalem +jeshu +jess +jessica +jest +jest +jester +jester +jest +jest +jesu +jesu +jet +jet +jew +jewel +jewel +jewel +jewess +jewish +jewri +jew +jezebel +jig +jig +jill +jill +jingl +joan +job +jockei +jocund +jog +jog +john +john +join +joinder +join +joiner +joineth +join +joint +joint +joint +jointli +jointress +joint +jointur +jolliti +jolli +jolt +jolthead +jordan +joseph +joshua +jot +jour +jourdain +journal +journei +journei +journeyman +journeymen +journei +jove +jovem +jovial +jowl +jowl +joi +joi +joy +joyfulli +joyless +joyou +joi +juan +jud +juda +judas +jude +judg +judg +judg +judgement +judg +judgest +judg +judgment +judgment +judici +jug +juggl +juggl +juggler +juggler +juggl +jug +juic +juic +jul +jule +julia +juliet +julietta +julio +juliu +juli +jump +jumpeth +jump +jump +june +june +junior +juniu +junket +juno +jupit +jure +jurement +jurisdict +juror +juror +juri +jurymen +just +justeiu +justest +justic +justic +justic +justic +justif +justifi +justifi +justl +justl +justl +justl +justli +just +just +jut +jutti +juven +kam +kate +kate +kate +katharin +katherina +katherin +kecksi +keech +keel +keel +keen +keen +keep +keepdown +keeper +keeper +keepest +keep +keep +keiser +ken +kendal +kennel +kent +kentish +kentishman +kentishmen +kept +kerchief +kere +kern +kernal +kernel +kernel +kern +kersei +kettl +kettledrum +kettledrum +kei +kei +kibe +kibe +kick +kick +kickshaw +kickshaws +kicki +kid +kidnei +kike +kildar +kill +kill +killer +killeth +kill +killingworth +kill +kiln +kimbolton +kin +kind +kinder +kindest +kindl +kindl +kindless +kindlier +kindl +kindli +kind +kind +kindr +kindr +kind +kine +king +kingdom +kingdom +kingli +king +kinr +kin +kinsman +kinsmen +kinswoman +kirtl +kirtl +kiss +kiss +kiss +kiss +kitchen +kitchen +kite +kite +kitten +kj +kl +klll +knack +knack +knapp +knav +knave +knaveri +knaveri +knave +knavish +knead +knead +knead +knee +kneel +kneel +kneel +knee +knell +knew +knewest +knife +knight +knight +knighthood +knighthood +knightli +knight +knit +knit +knitter +knitteth +knive +knob +knock +knock +knock +knog +knoll +knot +knot +knot +knotti +know +knower +knowest +know +knowingli +know +knowledg +known +know +l +la +laban +label +label +labienu +labio +labor +labor +labor +labour +labour +labour +labour +labour +labour +laboursom +labra +labyrinth +lac +lace +lace +lacedaemon +lace +laci +lack +lackbeard +lack +lackei +lackei +lackei +lack +lack +lad +ladder +ladder +lade +laden +ladi +lade +lad +ladi +ladybird +ladyship +ladyship +laer +laert +lafeu +lag +lag +laid +lain +laissez +lake +lake +lakin +lam +lamb +lambert +lambkin +lambkin +lamb +lame +lame +lame +lament +lament +lament +lament +lament +lament +lament +lament +lament +lame +lame +lamma +lammastid +lamound +lamp +lampass +lamp +lanc +lancast +lanc +lanc +lanceth +lanch +land +land +land +landless +landlord +landmen +land +lane +lane +langag +langlei +langton +languag +languageless +languag +langu +languish +languish +languish +languish +languish +languish +languor +lank +lantern +lantern +lanthorn +lap +lapi +lapland +lapp +lap +laps +laps +laps +lapw +laquai +lard +larder +lard +lard +larg +larg +larg +larger +largess +largest +lark +lark +larron +lartiu +larum +larum +la +lascivi +lash +lass +lass +last +last +last +lastli +last +latch +latch +late +late +late +later +latest +lath +latin +latten +latter +lattic +laud +laudabl +laudi +laugh +laughabl +laugh +laugher +laughest +laugh +laugh +laughter +launc +launcelot +launc +launch +laund +laundress +laundri +laur +laura +laurel +laurel +laurenc +lau +lavach +lave +lave +lavend +lavina +lavinia +lavish +lavishli +lavolt +lavolta +law +law +lawfulli +lawless +lawlessli +lawn +lawn +lawrenc +law +lawyer +lawyer +lai +layer +layest +lai +lai +lazar +lazar +lazaru +lazi +lc +ld +ldst +le +lead +leaden +leader +leader +leadest +lead +lead +leaf +leagu +leagu +leagu +leaguer +leagu +leah +leak +leaki +lean +leander +leaner +lean +lean +lean +leap +leap +leap +leap +leapt +lear +learn +learn +learnedli +learn +learn +learn +learnt +lea +leas +leas +leash +leas +least +leather +leathern +leav +leav +leaven +leaven +leaver +leav +leav +leavi +lecher +lecher +lecher +lecheri +lecon +lectur +lectur +led +leda +leech +leech +leek +leek +leer +leer +lee +lees +leet +leet +left +leg +legaci +legaci +legat +legatin +lege +leger +lege +legg +legion +legion +legitim +legitim +leg +leicest +leicestershir +leiger +leiger +leisur +leisur +leisur +leman +lemon +lena +lend +lender +lend +lend +lend +length +lengthen +lengthen +length +leniti +lennox +lent +lenten +lentu +leo +leon +leonardo +leonati +leonato +leonatu +leont +leopard +leopard +leper +leper +lepidu +leprosi +lequel +ler +le +less +lessen +lessen +lesser +lesson +lesson +lesson +lest +lestrak +let +lethargi +lethargi +lethargi +leth +let +lett +letter +letter +let +lettuc +leur +leve +level +level +level +level +leven +lever +leviathan +leviathan +levi +levi +leviti +levi +levi +lewd +lewdli +lewd +lewdster +lewi +liabl +liar +liar +libbard +libel +libel +liber +liber +libert +liberti +libertin +libertin +liberti +librari +libya +licenc +licen +licens +licenti +licha +licio +lick +lick +licker +lictor +lid +lid +lie +li +lief +liefest +lieg +liegeman +liegemen +lien +li +liest +lieth +lieu +lieuten +lieutenantri +lieuten +liev +life +lifeblood +lifeless +lifel +lift +lift +lifter +lifteth +lift +lift +lig +ligariu +liggen +light +light +lighten +lighten +lighter +lightest +lightli +light +lightn +lightn +light +lik +like +like +likeliest +likelihood +likelihood +like +like +liker +like +likest +likewis +like +like +lili +lili +lim +limand +limb +limbeck +limbeck +limber +limbo +limb +lime +lime +limehous +limekiln +limit +limit +limit +limit +limn +limp +limp +limp +lin +lincoln +lincolnshir +line +lineal +lineal +lineament +lineament +line +linen +linen +line +ling +lingar +linger +linger +linger +linguist +line +link +link +linsei +linstock +linta +lion +lionel +lioness +lion +lip +lipp +lip +lipsburi +liquid +liquor +liquorish +liquor +lirra +lisbon +lisp +lisp +list +listen +listen +list +literatur +lither +litter +littl +littlest +liv +live +live +liveli +livelihood +livelong +live +liver +liveri +liver +liveri +live +livest +liveth +livia +live +live +lizard +lizard +ll +lll +llou +lnd +lo +loa +loach +load +loaden +load +load +loaf +loam +loan +loath +loath +loath +loather +loath +loath +loathli +loath +loathsom +loathsom +loathsomest +loav +lob +lobbi +lobbi +local +lochab +lock +lock +lock +lockram +lock +locust +lode +lodg +lodg +lodg +lodger +lodg +lodg +lodg +lodovico +lodowick +lofti +log +logger +loggerhead +loggerhead +logget +logic +log +loin +loiter +loiter +loiter +loiter +loll +loll +lombardi +london +london +lone +loneli +lone +long +longavil +longboat +long +longer +longest +longeth +long +long +longli +long +longtail +loo +loof +look +look +looker +looker +lookest +look +look +loon +loop +loo +loos +loos +loos +loosen +loos +lop +lopp +loquitur +lord +lord +lord +lord +lordli +lordli +lord +lordship +lordship +lorenzo +lorn +lorrain +lorship +lo +lose +loser +loser +lose +losest +loseth +lose +loss +loss +lost +lot +lot +lott +lotteri +loud +louder +loudli +lour +loureth +lour +lous +lous +lousi +lout +lout +lout +louvr +lov +love +love +lovedst +lovel +loveli +loveli +lovel +love +lover +lover +lover +love +lovest +loveth +love +lovingli +low +low +lower +lowest +low +lowli +lowli +lown +low +loyal +loyal +loyalti +loyalti +lozel +lt +lubber +lubberli +luc +luccico +luce +lucentio +luce +lucetta +luciana +lucianu +lucif +lucifi +luciliu +lucina +lucio +luciu +luck +luckier +luckiest +luckili +luckless +lucki +lucr +lucrec +lucretia +luculliu +lucullu +luci +lud +ludlow +lug +lugg +luggag +luke +lukewarm +lull +lulla +lullabi +lull +lumbert +lump +lumpish +luna +lunaci +lunaci +lunat +lunat +lune +lung +luperc +lurch +lure +lurk +lurketh +lurk +lurk +lusciou +lush +lust +lust +luster +lust +lustier +lustiest +lustig +lustihood +lustili +lustr +lustrou +lust +lusti +lute +lute +lutestr +lutheran +luxuri +luxuri +luxuri +ly +lycaonia +lycurgus +lydia +lye +lyen +ly +lym +lymog +lynn +lysand +m +ma +maan +mab +macbeth +maccabaeu +macdonwald +macduff +mace +macedon +mace +machiavel +machin +machin +machin +mack +macmorri +macul +macul +mad +madam +madam +madam +madcap +mad +mad +made +madeira +madli +madman +madmen +mad +madonna +madrig +mad +maecena +maggot +maggot +magic +magic +magician +magistr +magistr +magnanim +magnanim +magni +magnifi +magnific +magnific +magnifico +magnifico +magnu +mahomet +mahu +maid +maiden +maidenhead +maidenhead +maidenhood +maidenhood +maidenliest +maidenli +maiden +maidhood +maid +mail +mail +mail +maim +maim +maim +main +maincours +main +mainli +mainmast +main +maintain +maintain +maintain +mainten +mai +maison +majesta +majeste +majest +majest +majest +majesti +majesti +major +major +mak +make +makeless +maker +maker +make +makest +maketh +make +make +mal +mala +maladi +maladi +malapert +malcolm +malcont +malcont +male +maledict +malefact +malefactor +malefactor +male +malevol +malevol +malhecho +malic +malici +malici +malign +malign +malign +malignantli +malkin +mall +mallard +mallet +mallow +malmsei +malt +maltworm +malvolio +mamilliu +mammer +mammet +mammet +mammock +man +manacl +manacl +manag +manag +manag +manag +manakin +manchu +mandat +mandragora +mandrak +mandrak +mane +manent +mane +manet +manfulli +mangl +mangl +mangl +mangl +mangi +manhood +manhood +manifest +manifest +manifest +manifold +manifoldli +manka +mankind +manlik +manli +mann +manna +manner +mannerli +manner +manningtre +mannish +manor +manor +man +mansion +mansionri +mansion +manslaught +mantl +mantl +mantl +mantua +mantuan +manual +manur +manur +manu +mani +map +mapp +map +mar +marbl +marbl +marcad +marcellu +march +march +marcheth +march +marchio +marchpan +marcian +marciu +marcu +mardian +mare +mare +marg +margarelon +margaret +marg +margent +margeri +maria +marian +mariana +mari +marigold +marin +marin +maritim +marjoram +mark +mark +market +market +marketplac +market +mark +markman +mark +marl +marl +marmoset +marquess +marqui +marr +marriag +marriag +marri +marri +mar +marrow +marrowless +marrow +marri +marri +mar +marseil +marsh +marshal +marshalsea +marshalship +mart +mart +martem +martext +martial +martin +martino +martiu +martlema +martlet +mart +martyr +martyr +marullu +marv +marvel +marvel +marvel +marvel +marvel +mari +ma +masculin +masham +mask +mask +masker +masker +mask +mask +mason +masonri +mason +masqu +masquer +masqu +masqu +mass +massacr +massacr +mass +massi +mast +mastcr +master +masterdom +masterest +masterless +masterli +masterpiec +master +mastership +mastic +mastiff +mastiff +mast +match +match +matcheth +match +matchless +mate +mate +mater +materi +mate +mathemat +matin +matron +matron +matter +matter +matthew +mattock +mattress +matur +matur +maud +maudlin +maugr +maul +maund +mauri +mauritania +mauvai +maw +maw +maxim +mai +maydai +mayest +mayor +maypol +mayst +maz +maze +maze +maze +mazzard +me +meacock +mead +meadow +meadow +mead +meagr +meal +meal +meali +mean +meander +meaner +meanest +meaneth +mean +mean +meanli +mean +meant +meantim +meanwhil +measl +measur +measur +measur +measur +measureless +measur +measur +meat +meat +mechan +mechan +mechan +mechan +mechant +med +medal +meddl +meddler +meddl +mede +medea +media +mediat +mediat +medic +medicin +medicin +medicin +medit +medit +medit +medit +medit +mediterranean +mediterraneum +medlar +medlar +meed +meed +meek +meekli +meek +meet +meeter +meetest +meet +meet +meetli +meet +meet +meg +mehercl +meilleur +meini +meisen +melancholi +melancholi +melford +mell +melliflu +mellow +mellow +melodi +melodi +melt +melt +melteth +melt +melt +melun +member +member +memento +memor +memorandum +memori +memori +memori +memoriz +memor +memori +memphi +men +menac +menac +menac +menaphon +mena +mend +mend +mender +mend +mend +menecr +menelau +meneniu +mental +menteith +mention +menti +menton +mephostophilu +mer +mercatant +mercatio +mercenari +mercenari +mercer +merchandis +merchand +merchant +merchant +merci +merci +mercifulli +merciless +mercuri +mercuri +mercuri +mercutio +merci +mere +mere +mere +merest +meridian +merit +merit +meritori +merit +merlin +mermaid +mermaid +merop +merrier +merriest +merrili +merriman +merriment +merriment +merri +merri +mervail +me +mesh +mesh +mesopotamia +mess +messag +messag +messala +messalin +messeng +messeng +mess +messina +met +metal +metal +metamorphi +metamorphos +metaphor +metaphys +metaphys +mete +metellu +meteor +meteor +meteyard +metheglin +metheglin +methink +methink +method +method +methought +methought +metr +metr +metropoli +mett +mettl +mettl +meu +mew +mew +mewl +mexico +mi +mice +michael +michaelma +micher +mich +mickl +microcosm +mid +mida +middest +middl +middleham +midnight +midriff +midst +midsumm +midwai +midwif +midwiv +mienn +might +might +mightier +mightiest +mightili +mighti +mightst +mighti +milan +milch +mild +milder +mildest +mildew +mildew +mildli +mild +mile +mile +milford +militarist +militari +milk +milk +milkmaid +milk +milksop +milki +mill +mill +miller +millin +million +million +million +mill +millston +milo +mimic +minc +minc +minc +minc +mind +mind +mind +mindless +mind +mine +miner +miner +minerva +mine +mingl +mingl +mingl +minikin +minim +minim +minimo +minimu +mine +minion +minion +minist +minist +minist +ministr +minnow +minnow +minola +minor +mino +minotaur +minstrel +minstrel +minstrelsi +mint +mint +minut +minut +minut +minx +mio +mir +mirabl +miracl +miracl +miracul +miranda +mire +mirror +mirror +mirth +mirth +miri +mi +misadventur +misadventur +misanthropo +misappli +misbecam +misbecom +misbecom +misbegot +misbegotten +misbeliev +misbeliev +misbhav +miscal +miscal +miscarri +miscarri +miscarri +miscarri +mischanc +mischanc +mischief +mischief +mischiev +misconceiv +misconst +misconst +misconstruct +misconstru +misconstru +miscreant +miscreat +misde +misde +misdemean +misdemeanour +misdoubt +misdoubteth +misdoubt +misenum +miser +miser +miser +misericord +miseri +miser +miseri +misfortun +misfortun +misgiv +misgiv +misgiv +misgovern +misgovern +misgraf +misguid +mishap +mishap +misheard +misinterpret +mislead +mislead +mislead +mislead +misl +mislik +misord +misplac +misplac +misplac +mispri +mispris +mispris +mispriz +misproud +misquot +misreport +miss +miss +miss +misshap +misshapen +missheath +miss +missingli +mission +missiv +missiv +misspok +mist +mista +mistak +mistak +mistaken +mistak +mistaketh +mistak +mistak +mistemp +mistemp +misterm +mist +misthink +misthought +mistleto +mistook +mistread +mistress +mistress +mistresss +mistriship +mistrust +mistrust +mistrust +mistrust +mist +misti +misu +misus +misus +misus +mite +mithrid +mitig +mitig +mix +mix +mixtur +mixtur +mm +mnd +moan +moan +moat +moat +mobl +mock +mockabl +mocker +mockeri +mocker +mockeri +mock +mock +mockvat +mockwat +model +modena +moder +moder +moder +modern +modest +modesti +modestli +modesti +modicum +modo +modul +moe +moi +moieti +moist +moisten +moistur +moldwarp +mole +molehil +mole +molest +molest +mollif +molli +molten +molto +mome +moment +momentari +mome +mon +monachum +monarch +monarchi +monarch +monarcho +monarch +monarchi +monast +monasteri +monast +mondai +mond +monei +monei +mong +monger +monger +mong +mongrel +mongrel +mongst +monk +monkei +monkei +monk +monmouth +monopoli +mon +monsieur +monsieur +monster +monster +monstrou +monstrous +monstrous +monstruos +montacut +montag +montagu +montagu +montano +montant +montez +montferrat +montgomeri +month +monthli +month +montjoi +monument +monument +monument +mood +mood +moodi +moon +moonbeam +moonish +moonlight +moon +moonshin +moonshin +moor +moorfield +moor +moorship +mop +mope +mope +mop +mopsa +moral +moral +moral +moral +mordak +more +moreov +more +morgan +mori +morisco +morn +morn +morn +morocco +morri +morrow +morrow +morsel +morsel +mort +mortal +mortal +mortal +mortal +mortar +mortgag +mortifi +mortifi +mortim +mortim +morti +mortis +morton +mose +moss +mossgrown +most +mote +moth +mother +mother +moth +motion +motionless +motion +motiv +motiv +motlei +mot +mought +mould +mould +mouldeth +mould +mouldi +moult +moulten +mounch +mounseur +mounsieur +mount +mountain +mountain +mountain +mountain +mountain +mountant +mountanto +mountebank +mountebank +mount +mounteth +mount +mount +mourn +mourn +mourner +mourner +mourn +mournfulli +mourn +mourningli +mourn +mourn +mou +mous +mousetrap +mous +mouth +mouth +mouth +mov +movabl +move +moveabl +moveabl +move +mover +mover +move +moveth +move +movingli +movousu +mow +mowbrai +mower +mow +mow +moi +moi +moys +mr +much +muck +mud +mud +muddi +muddi +muffin +muffl +muffl +muffl +muffler +muffl +mugger +mug +mulberri +mulberri +mule +mule +mulet +mulier +mulier +muliteu +mull +mulmutiu +multipli +multipli +multipli +multipot +multitud +multitud +multitudin +mum +mumbl +mumbl +mummer +mummi +mun +munch +muniment +munit +murd +murder +murder +murder +murder +murder +murder +murder +mure +murk +murkiest +murki +murmur +murmur +murmur +murrain +murrai +murrion +murther +murther +murther +murther +murther +murther +mu +muscadel +muscovit +muscovit +muscovi +muse +muse +mush +mushroom +music +music +musician +musician +music +muse +muse +musk +musket +musket +musko +muss +mussel +mussel +must +mustachio +mustard +mustardse +muster +muster +muster +musti +mutabl +mutabl +mutat +mutat +mute +mute +mutest +mutin +mutin +mutin +mutin +mutini +mutin +mutini +mutiu +mutter +mutter +mutton +mutton +mutual +mutual +mutual +muzzl +muzzl +muzzl +mv +mww +my +mynheer +myrmidon +myrmidon +myrtl +myself +myst +mysteri +mysteri +n +nag +nage +nag +naiad +nail +nail +nak +nake +naked +nal +nam +name +name +nameless +name +name +namest +name +nan +nanc +nap +nape +nape +napkin +napkin +napl +napless +nap +nap +narbon +narcissu +narin +narrow +narrowli +naso +nasti +nathaniel +natif +nation +nation +nativ +nativ +natur +natur +natur +natur +natur +natur +natur +natu +naught +naughtili +naughti +navarr +nave +navel +navig +navi +nai +nayward +nayword +nazarit +ne +neaf +neamnoin +neanmoin +neapolitan +neapolitan +near +nearer +nearest +nearli +near +neat +neatli +neb +nebour +nebuchadnezzar +nec +necessari +necessarili +necessari +necess +necess +necess +neck +necklac +neck +nectar +ned +nedar +need +need +needer +need +needful +need +needl +needl +needless +needli +need +needi +neer +neez +nefa +negat +neg +neg +neglect +neglect +neglect +neglectingli +neglect +neglig +neglig +negoti +negoti +negro +neigh +neighbor +neighbour +neighbourhood +neighbour +neighbourli +neighbour +neigh +neigh +neither +nell +nemean +nemesi +neoptolemu +nephew +nephew +neptun +ner +nereid +nerissa +nero +nero +ner +nerv +nerv +nervii +nervi +nessu +nest +nestor +nest +net +nether +netherland +net +nettl +nettl +nettl +neuter +neutral +nev +never +nevil +nevil +new +newborn +newer +newest +newgat +newli +new +new +newsmong +newt +newt +next +nibbl +nicanor +nice +nice +nice +nicer +niceti +nichola +nick +nicknam +nick +niec +niec +niggard +niggard +niggardli +nigh +night +nightcap +nightcap +night +nightgown +nightingal +nightingal +nightli +nightmar +night +nightwork +nihil +nile +nill +nilu +nimbl +nimbl +nimbler +nimbl +nine +nineteen +ning +ningli +ninni +ninth +ninu +niob +niob +nip +nipp +nip +nippl +nip +nit +nly +nnight +nnight +no +noah +nob +nobil +nobi +nobl +nobleman +noblemen +nobl +nobler +nobl +nobless +noblest +nobli +nobodi +noce +nod +nod +nod +noddl +noddl +noddi +nod +noe +noint +noi +nois +noiseless +noisemak +nois +noisom +nole +nomin +nomin +nomin +nominativo +non +nonag +nonc +none +nonino +nonni +nonpareil +nonsuit +noni +nook +nook +noon +noondai +noontid +nor +norberi +norfolk +norman +normandi +norman +north +northampton +northamptonshir +northerli +northern +northgat +northumberland +northumberland +northward +norwai +norwai +norwegian +norweyan +no +nose +nosegai +noseless +nose +noster +nostra +nostril +nostril +not +notabl +notabl +notari +notch +note +notebook +note +notedli +note +notest +noteworthi +noth +noth +notic +notifi +note +notion +notori +notori +notr +notwithstand +nought +noun +noun +nourish +nourish +nourish +nourish +nourisheth +nourish +nourish +nou +novel +novelti +novelti +noverb +novi +novic +novic +novum +now +nowher +noyanc +ns +nt +nubibu +numa +numb +number +number +number +numberless +number +numb +nun +nuncio +nuncl +nunneri +nun +nuntiu +nuptial +nur +nurs +nurs +nurser +nurseri +nurs +nurseth +nursh +nurs +nurtur +nurtur +nut +nuthook +nutmeg +nutmeg +nutriment +nut +nutshel +ny +nym +nymph +nymph +o +oak +oaken +oak +oar +oar +oatcak +oaten +oath +oathabl +oath +oat +ob +obduraci +obdur +obedi +obedi +obeis +oberon +obei +obei +obei +obei +obidicut +object +object +object +object +oblat +oblat +oblig +oblig +oblig +obliqu +oblivion +oblivi +obloqui +obscen +obscen +obscur +obscur +obscur +obscur +obscur +obscur +obscur +obsequi +obsequi +obsequi +observ +observ +observ +observ +observ +observ +observ +observ +observ +observ +observ +observ +observingli +obsqu +obstacl +obstacl +obstinaci +obstin +obstin +obstruct +obstruct +obstruct +obtain +obtain +obtain +occas +occas +occid +occident +occult +occupat +occup +occup +occupi +occupi +occupi +occurr +occurr +occurr +ocean +ocean +octavia +octaviu +ocular +od +odd +oddest +oddli +odd +od +od +odiou +odorifer +odor +odour +odour +od +oeillad +oe +oeuvr +of +ofephesu +off +offal +offenc +offenc +offenc +offend +offend +offendendo +offend +offend +offendeth +offend +offendress +offend +offens +offenseless +offens +offens +offer +offer +offer +offer +offer +offert +offic +offic +offic +offic +offic +offic +offici +offici +offspr +oft +often +often +oftentim +oh +oil +oil +oili +old +oldcastl +olden +older +oldest +old +oliv +oliv +oliv +oliv +olivia +olympian +olympu +oman +oman +omen +omin +omiss +omit +omitt +omit +omit +omn +omn +omnipot +on +onc +on +on +oney +ongl +onion +onion +onli +onset +onward +onward +oo +ooz +ooz +oozi +op +opal +op +open +open +open +openli +open +open +oper +oper +oper +oper +oper +op +oph +ophelia +opinion +opinion +opportun +opportun +opportun +oppo +oppos +oppos +opposeless +oppos +oppos +oppos +oppos +opposit +opposit +opposit +opposit +oppress +oppress +oppress +oppresseth +oppress +oppress +oppressor +opprest +opprobri +oppugn +opul +opul +or +oracl +oracl +orang +orat +orat +orat +oratori +orb +orb +orb +orchard +orchard +ord +ordain +ordain +ordain +order +order +order +orderless +orderli +order +ordin +ordin +ordinari +ordinari +ordnanc +ord +ordur +or +organ +organ +orgil +orient +orifex +origin +origin +orison +ork +orlando +orld +orlean +ornament +ornament +orod +orphan +orphan +orpheu +orsino +ort +orthographi +ort +oscorbidulcho +osier +osier +osprei +osr +osric +ossa +ost +ostent +ostentar +ostent +ostent +ostler +ostler +ostrich +osw +oswald +othello +other +otherg +other +otherwher +otherwhil +otherwis +otter +ottoman +ottomit +oubli +ouch +ought +oui +ounc +ounc +ouph +our +our +ourself +ourselv +ousel +out +outbid +outbrav +outbrav +outbreak +outcast +outcri +outcri +outdar +outdar +outdar +outdon +outfac +outfac +outfac +outfac +outfli +outfrown +outgo +outgo +outgrown +outjest +outlaw +outlawri +outlaw +outliv +outliv +outliv +outliv +outlook +outlustr +outpriz +outrag +outrag +outrag +outran +outright +outroar +outrun +outrun +outrun +outscold +outscorn +outsel +outsel +outsid +outsid +outspeak +outsport +outstar +outstai +outstood +outstretch +outstretch +outstrik +outstrip +outstrip +outswear +outvenom +outward +outwardli +outward +outwear +outweigh +outwent +outworn +outworth +oven +over +overaw +overbear +overblown +overboard +overbold +overborn +overbulk +overbui +overcam +overcast +overcharg +overcharg +overcom +overcom +overdon +overearnest +overfar +overflow +overflown +overgl +overgo +overgon +overgorg +overgrown +overhead +overhear +overheard +overhold +overjoi +overkind +overland +overleath +overl +overlook +overlook +overlook +overmast +overmount +overmuch +overpass +overp +overp +overplu +overrul +overrun +overscutch +overset +overshad +overshin +overshin +overshot +oversight +overspread +overstain +overswear +overt +overta +overtak +overtaketh +overthrow +overthrown +overthrow +overtook +overtopp +overtur +overturn +overwatch +overween +overween +overweigh +overwhelm +overwhelm +overworn +ovid +ovidiu +ow +ow +ow +owedst +owen +ow +owest +oweth +ow +owl +owl +own +owner +owner +own +own +owi +ox +oxen +oxford +oxfordshir +oxlip +oy +oyster +p +pabbl +pabylon +pac +pace +pace +pace +pacifi +pacifi +pace +pack +packet +packet +packhors +pack +pack +pack +packthread +pacoru +paction +pad +paddl +paddl +paddock +padua +pagan +pagan +page +pageant +pageant +page +pah +paid +pail +pail +pail +pain +pain +pain +painfulli +pain +paint +paint +painter +paint +paint +paint +pair +pair +pair +pajock +pal +palabra +palac +palac +palamed +palat +palat +palatin +palat +pale +pale +pale +paler +pale +palestin +palfrei +palfrei +palisado +pall +pallabri +palla +pallet +palm +palmer +palmer +palm +palmi +palpabl +palsi +palsi +palsi +palt +palter +paltri +pali +pamp +pamper +pamphlet +pan +pancack +pancak +pancak +pandar +pandar +pandaru +pander +panderli +pander +pandulph +panel +pang +pang +pang +pannier +pannonian +pansa +pansi +pant +pantaloon +pant +pantheon +panther +panthino +pant +pantingli +pantler +pantri +pant +pap +papal +paper +paper +paphlagonia +papho +papist +pap +par +parabl +paracelsu +paradis +paradox +paradox +paragon +paragon +parallel +parallel +paramour +paramour +parapet +paraquito +parasit +parasit +parca +parcel +parcel +parcel +parch +parch +parch +parchment +pard +pardon +pardona +pardon +pardon +pardon +pardonn +pardonn +pardonnez +pardon +pare +pare +parel +parent +parentag +parent +parfect +pare +pare +pari +parish +parishion +parisian +paritor +park +park +parl +parler +parl +parlei +parlez +parliament +parlor +parlour +parlou +parmac +parol +parricid +parricid +parrot +parrot +parslei +parson +part +partak +partaken +partak +partak +part +parthia +parthian +parthian +parti +partial +partial +partial +particip +particip +particl +particular +particular +particular +particularli +particular +parti +part +partisan +partisan +partit +partizan +partlet +partli +partner +partner +partridg +part +parti +pa +pash +pash +pash +pass +passabl +passado +passag +passag +passant +pass +passeng +passeng +pass +passeth +pass +passio +passion +passion +passion +passion +passiv +passport +passi +past +past +pastern +pasti +pastim +pastim +pastor +pastor +pastor +pastri +pastur +pastur +pasti +pat +patai +patch +patcheri +patch +pate +pate +patent +patent +patern +pate +path +pathet +path +pathwai +pathwai +patienc +patient +patient +patient +patin +patrician +patrician +patrick +patrimoni +patroclu +patron +patronag +patro +patron +patrum +patter +pattern +pattern +pattl +pauca +pauca +paul +paulina +paunch +paunch +paus +pauser +paus +pausingli +pauvr +pav +pave +pavement +pavilion +pavilion +pavin +paw +pawn +pawn +paw +pax +pai +payest +pai +payment +payment +pai +paysan +paysan +pe +peac +peaceabl +peaceabl +peac +peacemak +peac +peach +peach +peacock +peacock +peak +peak +peal +peal +pear +peard +pearl +pearl +pear +pea +peasant +peasantri +peasant +peascod +peas +peaseblossom +peat +peaten +peat +pebbl +pebbl +pebbl +peck +peck +peculiar +pecu +pedant +pedant +pedascul +pede +pedest +pedigre +pedlar +pedlar +pedro +ped +peel +peep +peep +peep +peep +peer +peereth +peer +peerless +peer +peesel +peevish +peevishli +peflur +peg +pegasu +peg +peis +peis +peiz +pelf +pelican +pelion +pell +pella +pellet +peloponnesu +pelt +pelt +pembrok +pen +penalti +penalti +penanc +penc +pencil +pencil +pencil +pendant +pendent +pendragon +pendul +penelop +penetr +penetr +penetr +penit +penit +penitenti +penit +penit +penker +penknif +penn +pen +pen +pennon +penni +pennyworth +pennyworth +pen +pens +pension +pension +pensiv +pensiv +pensiv +pent +pentecost +penthesilea +penthous +penuri +penuri +peopl +peopl +peopl +peopl +pepin +pepper +peppercorn +pepper +per +peradventur +peradventur +perceiv +perceiv +perceiv +perceiv +perceiveth +perch +perchanc +perci +percuss +perci +perdi +perdita +perdit +perdonato +perdu +perdur +perdur +perdi +pere +peregrin +peremptorili +peremptori +perfect +perfect +perfect +perfectest +perfect +perfect +perfectli +perfect +perfidi +perfidi +perforc +perform +perform +perform +perform +perform +perform +perform +perform +perfum +perfum +perfum +perfum +perfum +perg +perhap +periapt +perigort +perigouna +peril +peril +peril +period +period +perish +perish +perishest +perisheth +perish +periwig +perjur +perjur +perjur +perjuri +perjuri +perk +perk +permafoi +perman +permiss +permiss +permit +permit +pernici +pernici +peror +perpend +perpendicular +perpendicularli +perpetu +perpetu +perpetu +perplex +perplex +perplex +per +persecut +persecut +persecutor +perseu +persev +persever +persev +persia +persian +persist +persist +persist +persist +persist +person +persona +personag +personag +person +person +person +person +person +person +person +perspect +perspect +perspect +perspicu +persuad +persuad +persuad +persuad +persuas +persuas +pert +pertain +pertain +pertain +pertaunt +pertin +pertli +perturb +perturb +perturb +perturb +peru +perus +perus +perus +perus +pervers +pervers +pervers +pervert +pervert +peseech +pest +pester +pestifer +pestil +pestil +pet +petar +peter +petit +petit +petitionari +petition +petition +petit +peto +petrarch +petruchio +petter +petticoat +petticoat +petti +pettish +pettito +petti +peu +pew +pewter +pewter +phaethon +phaeton +phantasim +phantasim +phantasma +pharamond +pharaoh +pharsalia +pheasant +pheazar +phebe +phebe +pheebu +pheez +phibbu +philadelpho +philario +philarmonu +philemon +philip +philippan +philipp +philippi +phillida +philo +philomel +philomela +philosoph +philosoph +philosoph +philosophi +philostr +philotu +phlegmat +phoeb +phoebu +phoenicia +phoenician +phoenix +phorbu +photinu +phrase +phraseless +phrase +phrygia +phrygian +phrynia +physic +physic +physician +physician +physic +pia +pibbl +pibl +picardi +pick +pickax +pickax +pickbon +pick +picker +pick +pickl +picklock +pickpurs +pick +pickt +pickthank +pictur +pictur +pictur +pictur +pid +pie +piec +piec +piec +piec +pi +pied +pier +pierc +pierc +pierc +pierc +pierceth +pierc +pierci +pier +pi +pieti +pig +pigeon +pigeon +pight +pigmi +pigrogromitu +pike +pike +pil +pilat +pilat +pilcher +pile +pile +pilf +pilfer +pilgrim +pilgrimag +pilgrim +pill +pillag +pillag +pillar +pillar +pillicock +pillori +pillow +pillow +pill +pilot +pilot +pimpernel +pin +pinch +pinch +pinch +pinch +pindaru +pine +pine +pine +pinfold +pine +pinion +pink +pinn +pinnac +pin +pins +pint +pintpot +pion +pioneer +pioner +pioner +piou +pip +pipe +piper +piper +pipe +pipe +pippin +pippin +pirat +pirat +pisa +pisanio +pish +pismir +piss +piss +pistol +pistol +pit +pitch +pitch +pitcher +pitcher +pitchi +piteou +piteous +pitfal +pith +pithless +pithi +piti +piti +piti +piti +pitifulli +pitiless +pit +pittanc +pitti +pittikin +piti +piti +piu +plac +place +place +placentio +place +placeth +placid +place +plack +placket +placket +plagu +plagu +plagu +plagu +plagu +plagui +plain +plainer +plainest +plain +plain +plainli +plain +plain +plainsong +plaint +plaintiff +plaintiff +plaint +planch +planet +planetari +planet +plank +plant +plantag +plantagenet +plantagenet +plantain +plantat +plant +planteth +plant +plash +plashi +plast +plaster +plaster +plat +plate +plate +plate +platform +platform +plat +plat +plausibl +plausiv +plautu +plai +plai +player +player +playeth +playfellow +playfellow +playhous +plai +plai +plea +pleach +pleach +plead +plead +pleader +pleader +plead +plead +plea +pleasanc +pleasant +pleasantli +pleas +pleas +pleaser +pleaser +pleas +pleasest +pleaseth +pleas +pleasur +pleasur +plebeian +plebeii +pleb +pledg +pledg +plein +plenitud +plenteou +plenteous +plenti +plenti +plentifulli +plenti +pless +pless +pless +pliant +pli +pli +plight +plight +plighter +plod +plod +plodder +plod +plod +plood +ploodi +plot +plot +plot +plotter +plough +plough +ploughman +ploughmen +plow +plow +pluck +pluck +plucker +pluck +pluck +plue +plum +plume +plume +plume +plummet +plump +plumpi +plum +plung +plung +plung +plural +plurisi +plu +pluto +plutu +ply +po +pocket +pocket +pocket +pocki +podi +poem +poesi +poet +poetic +poetri +poet +poictier +poinard +poin +point +pointblank +point +point +point +poi +pois +pois +poison +poison +poison +poison +poison +poison +poke +poke +pol +polack +polack +poland +pold +pole +poleax +polecat +polecat +polemon +pole +poli +polici +polici +polish +polish +polit +politician +politician +politicli +polixen +poll +pollut +pollut +poloniu +poltroon +polus +polydamu +polydor +polyxena +pomand +pomegran +pomewat +pomfret +pomgarnet +pommel +pomp +pompeiu +pompei +pompion +pompou +pomp +pond +ponder +ponder +pond +poniard +poniard +pont +pontic +pontif +ponton +pooh +pool +pool +poop +poor +poorer +poorest +poorli +pop +pope +popedom +popiliu +popingai +popish +popp +poppi +pop +popular +popular +popul +porch +porch +pore +pore +pork +porn +porpentin +porridg +porring +port +portabl +portag +portal +portanc +portculli +portend +portend +portent +portent +portent +porter +porter +portia +portion +portli +portotartarossa +portrait +portraitur +port +portug +pose +posi +posi +posit +posit +posit +poss +possess +possess +possess +possesseth +possess +possess +possess +possessor +posset +posset +possibl +possibl +possibl +possibl +possit +post +post +post +posterior +posterior +poster +postern +postern +poster +posthors +posthors +posthumu +post +postmast +post +postscript +postur +postur +posi +pot +potabl +potat +potato +potato +potch +potenc +potent +potent +potenti +potent +potent +pothecari +pother +potion +potion +potpan +pot +potter +pot +pottl +pouch +poulter +poultic +poultnei +pouncet +pound +pound +pour +pourest +pour +pourquoi +pour +pout +poverti +pow +powd +powder +power +power +powerfulli +powerless +power +pox +poi +poysam +prabbl +practic +practic +practic +practic +practic +practic +practi +practis +practis +practis +practis +practis +practis +praeclarissimu +praemunir +praetor +praetor +prag +pragu +prain +prain +prai +prais +prais +prais +praisest +praiseworthi +prais +pranc +prank +prank +prat +prate +prate +prater +prate +prattl +prattler +prattl +prave +prawl +prawn +prai +prayer +prayer +prai +prai +pre +preach +preach +preacher +preach +preach +preachment +pread +preambul +preced +preced +preced +precept +precepti +precept +precinct +preciou +precious +precipic +precipit +precipit +precis +precis +precis +precisian +precor +precurs +precursor +predeceas +predecessor +predecessor +predestin +predica +predict +predict +predict +predomin +predomin +predomin +preech +preemin +prefac +prefer +prefer +prefer +preferr +preferreth +prefer +prefer +prefigur +prefix +prefix +preform +pregnanc +pregnant +pregnantli +prejud +prejudic +prejudici +prelat +premedit +premedit +premis +premis +prenez +prenomin +prentic +prentic +preordin +prepar +prepar +prepar +prepar +prepar +preparedli +prepar +prepar +prepost +preposter +preposter +prerogatif +prerog +prerogativ +presag +presag +presag +presageth +presag +prescienc +prescrib +prescript +prescript +prescript +prescript +presenc +presenc +present +present +present +present +present +presenteth +present +present +present +present +preserv +preserv +preserv +preserv +preserv +preserv +preserv +preserv +presid +press +press +presser +press +press +pressur +pressur +prest +prester +presum +presum +presum +presumpt +presumptu +presuppo +pret +pretenc +pretenc +pretend +pretend +pretend +pretens +pretext +pretia +prettier +prettiest +prettili +pretti +pretti +prevail +prevail +prevaileth +prevail +prevail +prevail +prevent +prevent +prevent +prevent +prevent +prei +prey +prei +priam +priami +priamu +pribbl +price +prick +prick +pricket +prick +prick +pricksong +pride +pride +pridg +prie +pri +prief +pri +priest +priesthood +priest +prig +primal +prime +primer +primero +primest +primit +primo +primogen +primros +primros +primi +princ +princ +princ +princess +princip +princip +princip +principl +principl +princox +pring +print +print +print +printless +print +prioress +priori +prioriti +priori +priscian +prison +prison +prison +prison +prisonni +prison +pristin +prith +prithe +privaci +privat +privat +privat +privilag +privileg +privileg +privileg +privileg +privilegio +privili +priviti +privi +priz +prize +prize +prizer +prize +prizest +prize +pro +probabl +probal +probat +proce +proceed +proceed +proceed +proceed +proce +process +process +proclaim +proclaim +proclaimeth +proclaim +proclam +proclam +proconsul +procrastin +procreant +procreant +procreat +procru +proculeiu +procur +procur +procur +procur +procur +procur +prodig +prodig +prodig +prodig +prodigi +prodigi +prodigi +prodigi +proditor +produc +produc +produc +produc +produc +profac +profan +profan +profan +profan +profan +profan +profan +profan +profess +profess +profess +profess +profess +professor +proffer +proffer +proffer +proffer +profici +profit +profit +profit +profit +profit +profitless +profit +profound +profoundest +profoundli +progenitor +progeni +progn +prognost +prognost +progress +progress +prohibit +prohibit +project +project +project +prolixi +prolix +prologu +prologu +prolong +prolong +promethean +prometheu +promi +promis +promis +promis +promiseth +promis +promontori +promot +promot +prompt +prompt +promptement +prompter +prompt +prompt +promptur +promulg +prone +prononc +prononcez +pronoun +pronounc +pronounc +pronounc +pronounc +pronoun +proof +proof +prop +propag +propag +propend +propens +proper +proper +properli +properti +properti +properti +propheci +propheci +prophesi +prophesi +prophesi +prophesi +prophet +prophetess +prophet +prophet +prophet +propinqu +propont +proport +proportion +proport +propo +propos +propos +propos +propos +propos +proposit +proposit +propound +propp +propr +proprieti +prop +propugn +prorogu +prorogu +proscript +proscript +prose +prosecut +prosecut +proselyt +proserpina +prosp +prospect +prosper +prosper +prospero +prosper +prosper +prosper +prostitut +prostrat +protect +protect +protect +protector +protector +protectorship +protectress +protect +protest +protest +protest +protest +protest +protest +protest +proteu +protheu +protract +protract +proud +prouder +proudest +proudlier +proudli +proud +prov +provand +prove +prove +provend +proverb +proverb +prove +proveth +provid +provid +provid +provid +provid +provid +provid +provinc +provinc +provinci +prove +provis +proviso +provoc +provok +provok +provok +provok +provok +provoketh +provok +provost +prowess +prudenc +prudent +prun +prune +prune +prune +pry +pry +psalm +psalmist +psalm +psalteri +ptolemi +ptolemi +public +publican +public +publicli +publicola +publish +publish +publish +publish +publiu +pucel +puck +pudder +pud +pud +puddl +puddl +pudenc +pueritia +puff +puf +puff +pug +pui +puissanc +puissant +puke +puke +pulcher +pule +pull +puller +pullet +pull +pull +pulpit +pulpit +pulpit +puls +pulsidg +pump +pumpion +pump +pun +punch +punish +punish +punish +punish +punish +punk +punto +puni +pupil +pupil +puppet +puppet +puppi +puppi +pur +purblind +purcha +purchas +purchas +purchas +purchaseth +purchas +pure +pure +purer +purest +purg +purgat +purg +purgatori +purg +purg +purger +purg +purifi +purifi +puritan +puriti +purlieu +purpl +purpl +purpl +purport +purpo +purpos +purpos +purpos +purpos +purposeth +purpos +purr +pur +purs +pursent +purs +pursu +pursu +pursu +pursuer +pursu +pursuest +pursueth +pursu +pursuit +pursuiv +pursuiv +pursi +puru +purveyor +push +push +pusillanim +put +putrefi +putrifi +put +putter +put +puttock +puzzel +puzzl +puzzl +puzzl +py +pygmalion +pygmi +pygmi +pyramid +pyramid +pyramid +pyrami +pyramis +pyramu +pyrenean +pyrrhu +pythagora +qu +quadrangl +quae +quaff +quaf +quagmir +quail +quail +quail +quaint +quaintli +quak +quak +quak +qualif +qualifi +qualifi +qualifi +qualifi +qualit +qualiti +qualiti +qualm +qualmish +quam +quand +quando +quantiti +quantiti +quar +quarrel +quarrel +quarrel +quarrel +quarrel +quarrel +quarrelsom +quarri +quarri +quart +quarter +quarter +quarter +quarter +quart +quasi +quat +quatch +quai +que +quean +quea +queasi +queasi +queen +queen +quell +queller +quench +quench +quench +quenchless +quern +quest +questant +question +question +question +question +questionless +question +questrist +quest +queubu +qui +quick +quicken +quicken +quicker +quicklier +quickli +quick +quicksand +quicksand +quicksilverr +quid +quidditi +quiddit +quier +quiet +quieter +quietli +quiet +quietu +quill +quillet +quill +quilt +quinapalu +quinc +quinc +quintain +quintess +quintu +quip +quip +quir +quir +quirk +quirk +qui +quit +quit +quit +quittanc +quit +quit +quiver +quiver +quiver +quo +quod +quoif +quoint +quoit +quoit +quondam +quoniam +quot +quot +quot +quoth +quotidian +r +rabbit +rabbl +rabblement +race +rack +racker +racket +racket +rack +rack +radianc +radiant +radish +rafe +raft +rag +rage +rage +rageth +ragg +rag +ragged +rage +ragozin +rag +rah +rail +rail +railer +railest +raileth +rail +rail +raiment +rain +rainbow +raineth +rain +rainold +rain +raini +rai +rais +rais +rais +rais +raisin +rak +rake +raker +rake +ral +rald +ralph +ram +rambur +ramm +rampallian +rampant +ramp +rampir +ramp +ram +ramsei +ramston +ran +ranc +rancor +rancor +rancour +random +rang +rang +rang +ranger +rang +rang +rank +ranker +rankest +rank +rankl +rankli +rank +rank +ransack +ransack +ransom +ransom +ransom +ransomless +ransom +rant +rant +rap +rape +rape +rapier +rapier +rapin +rap +rapt +raptur +raptur +rar +rare +rare +rare +rarer +rarest +rariti +rariti +rascal +rascalliest +rascal +rascal +rase +rash +rasher +rashli +rash +rat +ratcatch +ratcliff +rate +rate +rate +rate +rather +ratherest +ratifi +ratifi +ratifi +rate +ration +ratolorum +rat +ratsban +rattl +rattl +rattl +ratur +raught +rav +rave +ravel +raven +raven +raven +raven +ravenspurgh +rave +ravin +rave +ravish +ravish +ravish +ravish +ravish +raw +rawer +rawli +raw +rai +rai +rai +raz +raze +raze +raze +razeth +raze +razor +razor +razor +razur +re +reach +reach +reacheth +reach +read +reader +readiest +readili +readi +read +readin +read +readi +real +realli +realm +realm +reap +reaper +reap +reap +rear +rear +rearward +reason +reason +reason +reason +reason +reasonless +reason +reav +rebat +rebato +rebeck +rebel +rebel +rebel +rebellion +rebelli +rebel +rebound +rebuk +rebuk +rebuk +rebuk +rebuk +rebu +recal +recant +recant +recant +recant +receipt +receipt +receiv +receiv +receiv +receiv +receiv +receivest +receiveth +receiv +receptacl +rechat +reciproc +reciproc +recit +recit +reciterai +reck +reck +reckless +reckon +reckon +reckon +reckon +reck +reclaim +reclaim +reclus +recogniz +recogniz +recoil +recoil +recollect +recomfort +recomfortur +recommend +recommend +recommend +recompen +recompens +reconcil +reconcil +reconcil +reconcil +reconcil +reconcil +reconcili +record +record +record +record +record +record +recount +recount +recount +recount +recount +recours +recov +recov +recover +recov +recoveri +recov +recoveri +recreant +recreant +recreat +recreat +rectifi +rector +rectorship +recur +recur +red +redbreast +redder +reddest +rede +redeem +redeem +redeem +redeem +redeem +redeliv +redempt +redim +red +redoubl +redoubt +redound +redress +redress +redress +reduc +reechi +reed +reed +reek +reek +reek +reeki +reel +reeleth +reel +reel +refel +refer +refer +referr +refer +refigur +refin +refin +reflect +reflect +reflect +reflex +reform +reform +reform +refractori +refrain +refresh +refresh +reft +reft +refug +refu +refus +refus +refus +refusest +refus +reg +regal +regalia +regan +regard +regard +regard +regardfulli +regard +regard +regener +regent +regentship +regia +regiment +regiment +regina +region +region +regist +regist +regist +regreet +regreet +regress +reguerdon +regular +rehear +rehears +rehears +reign +reign +reignier +reign +reign +rein +reinforc +reinforc +reinforc +rein +reiter +reject +reject +rejoic +rejoic +rejoic +rejoiceth +rejoic +rejoicingli +rejoindur +rejourn +rel +relaps +relat +relat +relat +relat +rel +relea +releas +releas +releas +relent +relent +relent +relianc +relic +relief +reliev +reliev +reliev +reliev +reliev +religion +religion +religi +religi +relinquish +reliqu +reliquit +relish +relum +reli +reli +remain +remaind +remaind +remain +remaineth +remain +remain +remark +remark +remedi +remedi +remedi +remedi +rememb +rememb +rememb +rememb +remembr +remembranc +remembr +remercimen +remiss +remiss +remiss +remit +remnant +remnant +remonstr +remors +remors +remorseless +remot +remot +remov +remov +remov +removed +remov +remov +remov +remuner +remuner +renc +rend +render +render +render +rendezv +renegado +reneg +reneg +renew +renew +renewest +renounc +renounc +renounc +renowm +renown +renown +rent +rent +repaid +repair +repair +repair +repair +repass +repast +repastur +repai +repai +repai +repeal +repeal +repeal +repeat +repeat +repeat +repeat +repel +repent +repent +repent +repent +repent +repent +repetit +repetit +repin +repin +repin +replant +replenish +replenish +replet +replic +repli +repli +repliest +repli +repli +report +report +report +reportest +report +reportingli +report +repos +repos +reposeth +repos +repossess +reprehend +reprehend +reprehend +repres +repres +repriev +repriev +repris +reproach +reproach +reproach +reproachfulli +reprob +reprob +reproof +reprov +reprov +reprov +reprov +reprov +repugn +repugn +repugn +repuls +repuls +repurcha +repur +reput +reput +reput +reputeless +reput +reput +request +request +request +request +requiem +requir +requir +requir +requir +requireth +requir +requisit +requisit +requit +requit +requit +requit +requit +rer +rere +rer +rescu +rescu +rescu +rescu +rescu +resembl +resembl +resembl +resembl +resembleth +resembl +reserv +reserv +reserv +reserv +reserv +resid +resid +resid +resid +resid +residu +resign +resign +resist +resist +resist +resist +resist +resolut +resolut +resolut +resolut +resolv +resolv +resolv +resolvedli +resolv +resolveth +resort +resort +resound +resound +respeak +respect +respect +respect +respect +respect +respect +respic +respit +respit +respons +respos +ress +rest +rest +resteth +rest +rest +restitut +restless +restor +restor +restor +restor +restor +restor +restor +restrain +restrain +restrain +restrain +restraint +rest +resti +resum +resum +resum +resurrect +retail +retail +retain +retain +retain +retel +retent +retent +retinu +retir +retir +retir +retir +retir +retir +retold +retort +retort +retourn +retract +retreat +retrograd +ret +return +return +returnest +returneth +return +return +revania +reveal +reveal +revel +revel +revel +revel +revel +revel +revelri +revel +reveng +reveng +reveng +reveng +reveng +reveng +reveng +reveng +reveng +revengingli +revenu +revenu +reverb +reverber +reverb +reverenc +rever +reverend +rever +rever +rever +revers +revers +revert +review +reviewest +revil +revil +revisit +reviv +reviv +reviv +reviv +revok +revok +revok +revolt +revolt +revolt +revolt +revolut +revolut +revolv +revolv +reward +reward +reward +reward +reward +reword +reword +rex +rei +reynaldo +rford +rful +rfull +rhapsodi +rheim +rhenish +rhesu +rhetor +rheum +rheumat +rheum +rheumi +rhinocero +rhode +rhodop +rhubarb +rhym +rhyme +rhymer +rhyme +rhyme +rialto +rib +ribald +riband +riband +ribaudr +ribb +rib +ribbon +ribbon +rib +rice +rich +richard +richer +rich +richest +richli +richmond +richmond +rid +riddanc +ridden +riddl +riddl +riddl +ride +rider +rider +ride +ridest +rideth +ridg +ridg +ridicul +ride +rid +rien +ri +rifl +rift +rift +rig +rigg +riggish +right +righteou +righteous +right +rightfulli +rightli +right +rigol +rigor +rigor +rigour +ril +rim +rin +rinaldo +rind +ring +ring +ringlead +ringlet +ring +ringwood +riot +rioter +riot +riotou +riot +rip +ripe +ripe +ripen +ripen +ripe +ripen +ripen +riper +ripest +ripe +ripp +rip +rise +risen +rise +riseth +rish +rise +rite +rite +rivag +rival +rival +rival +rival +rive +rive +rivel +river +river +rivet +rivet +rivet +rivo +rj +rless +road +road +roam +roam +roan +roar +roar +roarer +roar +roar +roast +roast +rob +roba +roba +robb +rob +robber +robber +robberi +rob +robe +robe +robert +robe +robin +rob +robusti +rochest +rochford +rock +rock +rocki +rod +rode +roderigo +rod +roe +roe +roger +rogero +rogu +rogueri +rogu +roguish +roi +roist +roll +roll +roll +roll +rom +romag +roman +romano +romano +roman +rome +romeo +romish +rondur +ronyon +rood +roof +roof +rook +rook +rooki +room +room +root +root +rootedli +rooteth +root +root +rope +roperi +rope +rope +ro +rosalind +rosalinda +rosalind +rosalin +rosciu +rose +rose +rosemari +rosencrantz +rose +ross +rosi +rot +rote +rote +rother +rotherham +rot +rot +rotten +rotten +rot +rotund +rouen +rough +rougher +roughest +roughli +rough +round +round +roundel +rounder +roundest +round +roundli +round +roundur +rou +rous +rous +rousillon +rousli +roussi +rout +rout +rout +rove +rover +row +rowel +rowland +rowland +roi +royal +royal +royal +royalti +royalti +roynish +rs +rt +rub +rubb +rub +rubbish +rubi +rubiou +rub +rubi +rud +rudand +rudder +ruddi +ruddock +ruddi +rude +rude +rude +ruder +rudesbi +rudest +rudiment +rue +ru +ruff +ruffian +ruffian +ruffl +ruffl +ruff +rug +rugbi +rugemount +rug +ruin +ruinat +ruin +ruin +ruinou +ruin +rul +rule +rule +ruler +ruler +rule +rule +rumbl +ruminai +ruminat +rumin +rumin +rumin +rumin +rumor +rumour +rumour +rumour +rump +run +runag +runag +runawai +runawai +rung +runn +runner +runner +run +run +ruptur +ruptur +rural +rush +rush +rush +rushl +rushi +russet +russia +russian +russian +rust +rust +rustic +rustic +rustic +rustl +rustl +rust +rusti +rut +ruth +ruth +ruthless +rutland +ruttish +ry +rye +ryth +s +sa +saba +sabbath +sabl +sabl +sack +sackbut +sackcloth +sack +sackerson +sack +sacrament +sacr +sacrif +sacrific +sacrific +sacrific +sacrifici +sacrif +sacrilegi +sacr +sad +sadder +saddest +saddl +saddler +saddl +sadli +sad +saf +safe +safeguard +safe +safer +safest +safeti +safeti +saffron +sag +sage +sagittari +said +saidst +sail +sail +sailmak +sailor +sailor +sail +sain +saint +saint +saintlik +saint +saith +sake +sake +sala +salad +salamand +salari +sale +salerio +salicam +saliqu +salisburi +sall +sallet +sallet +salli +sallow +salli +salmon +salmon +salt +salter +saltier +salt +saltpetr +salut +salut +salut +salut +salut +saluteth +salv +salvat +salv +salv +same +samingo +samp +sampir +sampl +sampler +sampson +samson +samson +sancta +sanctifi +sanctifi +sanctifi +sanctimoni +sanctimoni +sanctimoni +sanctiti +sanctiti +sanctuar +sanctuari +sand +sandal +sandbag +sand +sand +sandi +sandi +sang +sanguin +sangui +saniti +san +santrail +sap +sapient +sapit +sapless +sapl +sapphir +sapphir +saracen +sarcenet +sard +sardian +sardinia +sardi +sarum +sat +satan +satchel +sate +sate +satiat +satieti +satin +satir +satir +sati +satisfact +satisfi +satisfi +satisfi +satisfi +saturdai +saturdai +saturn +saturnin +saturninu +satyr +satyr +sauc +sauc +sauc +saucer +sauc +saucili +sauci +sauci +sauf +saunder +sav +savag +savag +savag +savageri +savag +save +save +save +save +saviour +savori +savour +savour +savour +savouri +savoi +saw +saw +sawest +sawn +sawpit +saw +sawyer +saxon +saxoni +saxton +sai +sayest +sai +sai +sai +sayst +sblood +sc +scab +scabbard +scab +scaffold +scaffoldag +scal +scald +scald +scald +scale +scale +scale +scale +scall +scalp +scalp +scali +scambl +scambl +scamel +scan +scandal +scandaliz +scandal +scandi +scann +scant +scant +scanter +scant +scantl +scant +scap +scape +scape +scape +scapeth +scar +scarc +scarc +scarciti +scare +scarecrow +scarecrow +scarf +scarf +scarf +scare +scarlet +scarr +scarr +scar +scaru +scath +scath +scath +scatt +scatter +scatter +scatter +scatter +scelera +scelerisqu +scene +scene +scent +scent +scept +scepter +sceptr +sceptr +sceptr +schedul +schedul +scholar +scholarli +scholar +school +schoolboi +schoolboi +schoolfellow +school +schoolmast +schoolmast +school +sciatica +sciatica +scienc +scienc +scimitar +scion +scion +scissor +scoff +scoffer +scof +scoff +scoggin +scold +scold +scold +sconc +scone +scope +scope +scorch +scorch +score +score +score +score +scorn +scorn +scorn +scornfulli +scorn +scorn +scorpion +scorpion +scot +scotch +scotch +scotland +scot +scottish +scoundrel +scour +scour +scourg +scourg +scour +scout +scout +scowl +scrap +scrape +scrape +scrap +scratch +scratch +scratch +scream +scream +screech +screech +screen +screen +screw +screw +scribbl +scribbl +scribe +scribe +scrimer +scrip +scrippag +scriptur +scriptur +scriven +scroll +scroll +scroop +scrowl +scroyl +scrub +scrupl +scrupl +scrupul +scuffl +scuffl +scullion +scull +scum +scurril +scurril +scurril +scurvi +scuse +scut +scutcheon +scutcheon +scylla +scyth +scyth +scythia +scythian +sdeath +se +sea +seacoal +seafar +seal +seal +seal +seal +seam +seamen +seami +seaport +sear +searc +search +searcher +search +searcheth +search +sear +sea +seasick +seasid +season +season +season +seat +seat +seat +sebastian +second +secondarili +secondari +second +second +secreci +secret +secretari +secretari +secretli +secret +sect +sectari +sect +secundo +secur +secur +secur +secur +sedg +sedg +sedg +sedgi +sedit +sediti +seduc +seduc +seduc +seduc +seduc +see +seed +seed +seed +seed +seedsman +seein +see +seek +seek +seek +seel +seel +seeli +seem +seem +seemer +seemest +seemeth +seem +seemingli +seemli +seem +seen +seer +see +sees +seest +seeth +seeth +seeth +seet +segreg +seigneur +seigneur +seiz +seiz +seiz +seiz +seizeth +seiz +seizur +seld +seldom +select +seleucu +self +selfsam +sell +seller +sell +sell +selv +semblabl +semblabl +semblanc +semblanc +sembl +semi +semicircl +semirami +semper +semproniu +senat +senat +senat +send +sender +sendeth +send +send +seneca +senior +seniori +seni +sennet +senoi +sens +senseless +sens +sensibl +sensibl +sensual +sensual +sent +sentenc +sentenc +sentenc +sententi +sentinel +sentinel +separ +separ +separ +separ +separ +septentrion +sepulchr +sepulchr +sepulchr +sequel +sequenc +sequent +sequest +sequest +sequestr +sere +sereni +serg +sergeant +seriou +serious +sermon +sermon +serpent +serpentin +serpent +serpigo +serv +servant +servant +servant +serv +serv +server +serv +serveth +servic +servic +servic +servil +servil +serviliu +serv +servingman +servingmen +serviteur +servitor +servitor +servitud +sessa +session +session +sesto +set +setebo +set +setter +set +settl +settl +settlest +settl +sev +seven +sevenfold +sevennight +seventeen +seventh +seventi +sever +sever +sever +sever +sever +sever +sever +severest +sever +sever +severn +sever +sew +seward +sewer +sew +sex +sex +sexton +sextu +seymour +seyton +sfoot +sh +shackl +shackl +shade +shade +shadow +shadow +shadow +shadow +shadowi +shadi +shafalu +shaft +shaft +shag +shak +shake +shake +shaken +shake +shake +shale +shall +shalleng +shallow +shallowest +shallowli +shallow +shalt +sham +shambl +shame +shame +shame +shamefulli +shameless +shame +shamest +shame +shank +shank +shap +shape +shape +shapeless +shapen +shape +shape +shar +shard +shard +shard +share +share +sharer +share +share +shark +sharp +sharpen +sharpen +sharpen +sharper +sharpest +sharpli +sharp +sharp +shatter +shav +shave +shaven +shaw +she +sheaf +sheal +shear +shearer +shear +shearman +shear +sheath +sheath +sheath +sheath +sheath +sheav +sheav +shed +shed +shed +sheen +sheep +sheepcot +sheepcot +sheep +sheepskin +sheer +sheet +sheet +sheet +sheffield +shelf +shell +shell +shelt +shelter +shelter +shelv +shelv +shelvi +shent +shepherd +shepherd +shepherdess +shepherdess +shepherd +sher +sheriff +sherri +she +sheweth +shield +shield +shield +shift +shift +shift +shift +shill +shill +shin +shine +shine +shineth +shine +shin +shini +ship +shipboard +shipman +shipmast +shipmen +shipp +ship +ship +ship +shipt +shipwreck +shipwreck +shipwright +shipwright +shire +shirlei +shirt +shirt +shive +shiver +shiver +shiver +shoal +shoal +shock +shock +shod +shoe +shoe +shoemak +shoe +shog +shone +shook +shoon +shoot +shooter +shooti +shoot +shoot +shop +shop +shore +shore +shorn +short +shortcak +shorten +shorten +shorten +shorter +shortli +short +shot +shotten +shough +should +shoulder +shoulder +shoulder +shouldst +shout +shout +shout +shout +shov +shove +shovel +shovel +show +show +shower +shower +showest +show +shown +show +shred +shrew +shrewd +shrewdli +shrewd +shrewish +shrewishli +shrewish +shrew +shrewsburi +shriek +shriek +shriek +shriev +shrift +shrill +shriller +shrill +shrilli +shrimp +shrine +shrink +shrink +shrink +shriv +shrive +shriver +shrive +shrive +shroud +shroud +shroud +shroud +shrove +shrow +shrow +shrub +shrub +shrug +shrug +shrunk +shudd +shudder +shuffl +shuffl +shuffl +shuffl +shun +shunless +shunn +shun +shun +shun +shut +shut +shuttl +shy +shylock +si +sibyl +sibylla +sibyl +sicil +sicilia +sicilian +siciliu +sicil +sicili +siciniu +sick +sicken +sicken +sicker +sickl +sicklemen +sickli +sickli +sickli +sick +sicl +sicyon +side +side +side +sieg +sieg +sienna +si +siev +sift +sift +sigeia +sigh +sigh +sigh +sigh +sight +sight +sightless +sightli +sight +sign +signal +signet +signieur +signific +signific +signifi +signifi +signifi +signifi +signior +signiori +signior +signiori +signor +signori +sign +signum +silenc +silenc +silenc +silenc +silent +silent +siliu +silk +silken +silkman +silk +silliest +silli +sill +silli +silva +silver +silver +silverli +silvia +silviu +sima +simil +simil +simoi +simon +simoni +simp +simpcox +simpl +simpl +simpler +simpl +simplic +simpli +simular +simul +sin +sinc +sincer +sincer +sincer +sinel +sinew +sinew +sinew +sinewi +sin +sinfulli +sing +sing +sing +singer +sing +singeth +sing +singl +singl +singl +singli +sing +singular +singularit +singular +singular +singul +sinist +sink +sink +sink +sinn +sinner +sinner +sin +sinon +sin +sip +sip +sir +sire +siren +sirrah +sir +sist +sister +sisterhood +sisterli +sister +sit +sith +sithenc +sit +sit +situat +situat +situat +siward +six +sixpenc +sixpenc +sixpenni +sixteen +sixth +sixti +siz +size +size +sizzl +skain +skambl +skein +skelter +ski +skil +skilfulli +skill +skilless +skillet +skill +skill +skim +skimbl +skin +skinker +skinni +skin +skip +skipp +skipper +skip +skirmish +skirmish +skirr +skirt +skirt +skittish +skulk +skull +skull +sky +skyei +skyish +slab +slack +slackli +slack +slain +slake +sland +slander +slander +slander +slander +slander +slander +slander +slash +slaught +slaughter +slaughter +slaughter +slaughterman +slaughtermen +slaughter +slaughter +slave +slaver +slaveri +slave +slavish +slai +slayeth +slai +slai +sleav +sled +sleek +sleekli +sleep +sleeper +sleeper +sleepest +sleep +sleep +sleepi +sleev +sleev +sleid +sleid +sleight +sleight +slender +slender +slenderli +slept +slew +slewest +slice +slid +slide +slide +slide +slight +slight +slightest +slightli +slight +slight +slili +slime +slimi +sling +slink +slip +slipp +slipper +slipper +slipperi +slip +slish +slit +sliver +slobb +slomber +slop +slope +slop +sloth +sloth +slough +slovenli +slovenri +slow +slower +slowli +slow +slubber +slug +sluggard +sluggardiz +sluggish +sluic +slumb +slumber +slumber +slumberi +slunk +slut +slut +slutteri +sluttish +sluttish +sly +sly +smack +smack +smack +small +smaller +smallest +small +smalu +smart +smart +smartli +smatch +smatter +smear +smell +smell +smell +smelt +smil +smile +smile +smile +smilest +smilet +smile +smilingli +smirch +smirch +smit +smite +smite +smith +smithfield +smock +smock +smok +smoke +smoke +smoke +smoke +smoki +smooth +smooth +smooth +smoothli +smooth +smooth +smote +smoth +smother +smother +smother +smug +smulkin +smutch +snaffl +snail +snail +snake +snake +snaki +snap +snapp +snapper +snar +snare +snare +snarl +snarleth +snarl +snatch +snatcher +snatch +snatch +sneak +sneak +sneap +sneap +sneck +snip +snipe +snipt +snore +snore +snore +snort +snout +snow +snowbal +snow +snowi +snuff +snuff +snug +so +soak +soak +soak +soar +soar +soar +sob +sob +sober +soberli +sobrieti +sob +sociabl +societi +societi +sock +socrat +sod +sodden +soe +soever +soft +soften +soften +softer +softest +softli +soft +soil +soil +soilur +soit +sojourn +sol +sola +solac +solanio +sold +soldat +solder +soldest +soldier +soldier +soldiership +sole +sole +solem +solemn +solem +solemn +solemn +solemniz +solemn +solemn +solemnli +sole +solicit +solicit +solicit +solicit +solicit +solicitor +solicit +solid +solidar +solid +solinu +solitari +solomon +solon +solum +solu +solyman +some +somebodi +someon +somerset +somervil +someth +sometim +sometim +somev +somewhat +somewher +somewhith +somm +son +sonanc +song +song +sonnet +sonnet +sonnet +son +sont +sonti +soon +sooner +soonest +sooth +sooth +soother +sooth +soothsai +soothsay +sooti +sop +sophist +sophist +sophi +sop +sorcer +sorcer +sorceress +sorceri +sorceri +sore +sorel +sore +sorer +sore +sorrier +sorriest +sorrow +sorrow +sorrowest +sorrow +sorrow +sorrow +sorri +sort +sortanc +sort +sort +sort +sossiu +sot +soto +sot +sottish +soud +sought +soul +sould +soulless +soul +sound +sound +sounder +soundest +sound +soundless +soundli +sound +soundpost +sound +sour +sourc +sourc +sourest +sourli +sour +sou +sous +south +southam +southampton +southerli +southern +southward +southwark +southwel +souviendrai +sov +sovereign +sovereignest +sovereignli +sovereignti +sovereignvour +sow +sow +sowl +sowter +space +space +spaciou +spade +spade +spain +spak +spake +spakest +span +spangl +spangl +spaniard +spaniel +spaniel +spanish +spann +span +spar +spare +spare +spare +sparingli +spark +sparkl +sparkl +sparkl +spark +sparrow +sparrow +sparta +spartan +spavin +spavin +spawn +speak +speaker +speaker +speakest +speaketh +speak +speak +spear +speargrass +spear +special +special +special +specialti +specialti +specifi +specious +spectacl +spectacl +spectacl +spectat +spectatorship +specul +specul +specul +sped +speech +speech +speechless +speed +speed +speedier +speediest +speedili +speedi +speed +speed +speedi +speen +spell +spell +spell +spelt +spencer +spend +spendest +spend +spend +spendthrift +spent +sperato +sperm +spero +sperr +spher +sphere +sphere +sphere +spheric +spheri +sphinx +spice +spice +spiceri +spice +spider +spider +spi +spi +spieth +spightfulli +spigot +spill +spill +spill +spilt +spilth +spin +spinii +spinner +spinster +spinster +spire +spirit +spirit +spiritless +spirit +spiritu +spiritualti +spirt +spit +spital +spite +spite +spite +spite +spit +spit +spit +splai +spleen +spleen +spleen +spleeni +splendour +splenit +splinter +splinter +split +split +split +split +spoil +spoil +spok +spoke +spoken +spoke +spokesman +spong +spongi +spoon +spoon +sport +sport +sport +sportiv +sport +spot +spotless +spot +spot +spousal +spous +spout +spout +spout +sprag +sprang +sprat +sprawl +sprai +sprai +spread +spread +spread +spright +spright +sprightli +sprig +spring +spring +spring +springeth +springhalt +spring +spring +springtim +sprinkl +sprinkl +sprite +sprite +sprite +sprite +sprite +sprout +spruce +sprung +spun +spur +spurio +spurn +spurn +spurr +spurrer +spur +spur +spy +spy +squabbl +squadron +squadron +squand +squar +squar +squarer +squar +squash +squeak +squeak +squeal +squeal +squeez +squeez +squel +squier +squint +squini +squir +squir +squirrel +st +stab +stabb +stab +stab +stabl +stabl +stabl +stablish +stablish +stab +stack +staff +stafford +stafford +staffordshir +stag +stage +stage +stagger +stagger +stagger +stag +staid +staider +stain +stain +stain +staineth +stain +stainless +stain +stair +stair +stake +stake +stale +stale +stalk +stalk +stalk +stall +stall +stall +stamford +stammer +stamp +stamp +stamp +stanch +stanchless +stand +standard +standard +stander +stander +standest +standeth +stand +stand +staniel +stanlei +stanz +stanzo +stanzo +stapl +stapl +star +stare +stare +stare +stare +stare +stark +starkli +starlight +starl +starr +starri +star +start +start +start +startingli +startl +startl +start +starv +starv +starv +starvelackei +starvel +starveth +starv +state +stateli +state +state +statesman +statesmen +statiliu +station +statist +statist +statu +statu +statur +statur +statut +statut +stave +stave +stai +stai +stayest +stai +stai +stead +stead +steadfast +steadier +stead +steal +stealer +stealer +steal +steal +stealth +stealthi +steed +steed +steel +steel +steeli +steep +steep +steepl +steepl +steep +steepi +steer +steerag +steer +steer +stell +stem +stem +stench +step +stepdam +stephano +stephen +stepmoth +stepp +step +step +steril +steril +sterl +stern +sternag +sterner +sternest +stern +steterat +stew +steward +steward +stewardship +stew +stew +stick +stick +stickler +stick +stiff +stiffen +stiffli +stifl +stifl +stifl +stigmat +stigmat +stile +still +stiller +stillest +still +stilli +sting +sting +stingless +sting +stink +stink +stinkingli +stink +stint +stint +stint +stir +stirr +stir +stirrer +stirrer +stirreth +stir +stirrup +stirrup +stir +stitcheri +stitch +stithi +stithi +stoccado +stoccata +stock +stockfish +stock +stock +stockish +stock +stog +stog +stoic +stokesli +stol +stole +stolen +stolest +stomach +stomach +stomach +stomach +ston +stone +stonecutt +stone +stonish +stoni +stood +stool +stool +stoop +stoop +stoop +stop +stope +stopp +stop +stop +stop +stor +store +storehous +storehous +store +stori +storm +storm +storm +storm +stormi +stori +stoup +stoup +stout +stouter +stoutli +stout +stover +stow +stowag +stow +strachi +straggler +straggl +straight +straightest +straightwai +strain +strain +strain +strain +strait +strait +straiter +straitli +strait +strait +strand +strang +strang +strang +stranger +stranger +strangest +strangl +strangl +strangler +strangl +strangl +strappado +strap +stratagem +stratagem +stratford +strato +straw +strawberri +strawberri +straw +strawi +strai +strai +strai +streak +streak +stream +streamer +stream +stream +strech +street +street +strength +strengthen +strengthen +strengthless +strength +stretch +stretch +stretch +stretch +strew +strew +strew +strewment +stricken +strict +stricter +strictest +strictli +strictur +stride +stride +stride +strife +strife +strik +strike +striker +strike +strikest +strike +string +stringless +string +strip +stripe +stripl +stripl +stripp +strip +striv +strive +strive +strive +strok +stroke +stroke +strond +strond +strong +stronger +strongest +strongli +strook +strosser +strove +strown +stroi +struck +strucken +struggl +struggl +struggl +strumpet +strumpet +strumpet +strung +strut +strut +strut +strut +stubbl +stubborn +stubbornest +stubbornli +stubborn +stuck +stud +student +student +studi +studi +studiou +studious +stud +studi +studi +stuff +stuf +stuff +stumbl +stumbl +stumblest +stumbl +stump +stump +stung +stupefi +stupid +stupifi +stuprum +sturdi +sty +styga +stygian +styl +style +styx +su +sub +subcontract +subdu +subdu +subdu +subduement +subdu +subdu +subject +subject +subject +subject +submerg +submiss +submiss +submit +submit +submit +suborn +suborn +suborn +subscrib +subscrib +subscrib +subscrib +subscript +subsequ +subsidi +subsidi +subsist +subsist +substanc +substanc +substanti +substitut +substitut +substitut +substitut +subtil +subtilli +subtl +subtleti +subtleti +subtli +subtractor +suburb +subvers +subvert +succed +succe +succeed +succeed +succeed +succe +success +successantli +success +success +successfulli +success +success +success +successor +successor +succour +succour +such +suck +sucker +sucker +suck +suckl +suck +sudden +suddenli +sue +su +suerli +sue +sueth +suff +suffer +suffer +suffer +suffer +suffer +suffer +suffic +suffic +suffic +suffic +sufficeth +suffici +suffici +suffici +suffic +sufficit +suffig +suffoc +suffoc +suffoc +suffolk +suffrag +suffrag +sug +sugar +sugarsop +suggest +suggest +suggest +suggest +suggest +suggest +sui +suit +suitabl +suit +suit +suitor +suitor +suit +suivez +sullen +sullen +sulli +sulli +sulli +sulph +sulpher +sulphur +sulphur +sultan +sultri +sum +sumless +summ +summa +summari +summer +summer +summit +summon +summon +summon +sumpter +sumptuou +sumptuous +sum +sun +sunbeam +sunburn +sunburnt +sund +sundai +sundai +sunder +sunder +sundri +sung +sunk +sunken +sunni +sunris +sun +sunset +sunshin +sup +super +superfici +superfici +superflu +superflu +superflu +superflux +superior +supern +supernatur +superprais +superscript +superscript +superservic +superstit +superstiti +superstiti +supersubtl +supervis +supervisor +supp +supper +supper +suppertim +sup +supplant +suppl +suppler +supplianc +suppliant +suppliant +supplic +supplic +supplic +suppli +suppli +suppli +suppliest +suppli +supplyant +suppli +supplyment +support +support +support +support +support +support +support +supportor +suppo +suppos +suppos +suppos +suppos +supposest +suppos +supposit +suppress +suppress +suppresseth +supremaci +suprem +sup +sur +suranc +surceas +surd +sure +surecard +sure +surer +surest +sureti +sureti +surfeit +surfeit +surfeit +surfeit +surfeit +surg +surgeon +surgeon +surger +surgeri +surg +surli +surmi +surmis +surmis +surmis +surmount +surmount +surmount +surnam +surnam +surnam +surpasseth +surpass +surplic +surplu +surpri +surpris +surpris +surrend +surrei +surrei +survei +surveyest +survei +surveyor +surveyor +survei +surviv +surviv +survivor +susan +suspect +suspect +suspect +suspect +suspend +suspens +suspicion +suspicion +suspici +suspir +suspir +sust +sustain +sustain +sutler +sutton +suum +swabber +swaddl +swag +swagg +swagger +swagger +swagger +swagger +swain +swain +swallow +swallow +swallow +swallow +swam +swan +swan +sward +sware +swarm +swarm +swart +swarth +swarth +swarthi +swasher +swash +swath +swath +swathl +swai +swai +swai +swear +swearer +swearer +swearest +swear +swear +swear +sweat +sweaten +sweat +sweat +sweati +sweep +sweeper +sweep +sweet +sweeten +sweeten +sweeter +sweetest +sweetheart +sweet +sweetli +sweetmeat +sweet +sweet +swell +swell +swell +swell +swelter +sweno +swept +swerv +swerver +swerv +swift +swifter +swiftest +swiftli +swift +swill +swill +swim +swimmer +swimmer +swim +swim +swine +swineherd +swing +swing +swinish +swinstead +switch +swit +switzer +swol +swoll +swoln +swoon +swoon +swoon +swoon +swoop +swoopstak +swor +sword +sworder +sword +swore +sworn +swound +swound +swum +swung +sy +sycamor +sycorax +sylla +syllabl +syllabl +syllog +symbol +sympathis +sympathiz +sympath +sympath +sympathi +synagogu +synod +synod +syracus +syracusian +syracusian +syria +syrup +t +ta +taber +tabl +tabl +tabl +tablet +tabor +tabor +tabor +tabourin +taciturn +tack +tackl +tackl +tackl +tackl +tackl +taddl +tadpol +taffeta +taffeti +tag +tagrag +tah +tail +tailor +tailor +tail +taint +taint +taint +taint +taintur +tak +take +taken +taker +take +takest +taketh +take +tal +talbot +talbotit +talbot +tale +talent +talent +taleport +tale +talk +talk +talker +talker +talkest +talk +talk +tall +taller +tallest +talli +tallow +talli +talon +tam +tambourin +tame +tame +tame +tame +tamer +tame +tame +tamora +tamworth +tan +tang +tangl +tangl +tank +tanl +tann +tan +tanner +tanquam +tanta +tantaen +tap +tape +taper +taper +tapestri +tapestri +taphous +tapp +tapster +tapster +tar +tardi +tardili +tardi +tardi +tarentum +targ +targ +target +target +tarpeian +tarquin +tarquin +tarr +tarr +tarrianc +tarri +tarri +tarri +tarri +tart +tartar +tartar +tartli +tart +task +tasker +task +task +tassel +tast +tast +tast +tast +tatt +tatter +tatter +tatter +tattl +tattl +tattl +taught +taunt +taunt +taunt +tauntingli +taunt +tauru +tavern +tavern +tavi +tawdri +tawni +tax +taxat +taxat +tax +tax +tc +te +teach +teacher +teacher +teach +teachest +teacheth +teach +team +tear +tear +tear +tear +tearsheet +teat +tediou +tedious +tedious +teem +teem +teem +teen +teeth +teipsum +telamon +telamoniu +tell +teller +tell +tell +tellu +temp +temper +temper +temper +temper +temper +temper +tempest +tempest +tempestu +templ +templ +tempor +temporari +temporiz +tempor +tempor +temp +tempt +temptat +temptat +tempt +tempter +tempter +tempteth +tempt +tempt +ten +tenabl +tenant +tenantiu +tenantless +tenant +tench +tend +tendanc +tend +tender +tender +tenderli +tender +tender +tend +tend +tenedo +tenement +tenement +tenfold +tenni +tenour +tenour +ten +tent +tent +tenth +tenth +tent +tenur +tenur +tercel +tereu +term +termag +term +termin +termless +term +terra +terrac +terram +terra +terr +terren +terrestri +terribl +terribl +territori +territori +terror +terror +tertian +tertio +test +testament +test +tester +testern +testifi +testimoni +testimoni +testimoni +testi +testril +testi +tetchi +tether +tetter +tevil +tewksburi +text +tgv +th +thae +thame +than +thane +thane +thank +thank +thank +thankfulli +thank +thank +thank +thankless +thank +thanksgiv +thaso +that +thatch +thaw +thaw +thaw +the +theatr +theban +thebe +thee +theft +theft +thein +their +their +theis +them +theme +theme +themselv +then +thenc +thenceforth +theoric +there +thereabout +thereabout +thereaft +thereat +therebi +therefor +therein +thereof +thereon +thereto +thereunto +thereupon +therewith +therewith +thersit +these +theseu +thessalian +thessali +theti +thew +thei +thick +thicken +thicken +thicker +thickest +thicket +thickskin +thief +thieveri +thiev +thievish +thigh +thigh +thimbl +thimbl +thin +thine +thing +thing +think +thinkest +think +think +think +thinkst +thinli +third +thirdli +third +thirst +thirst +thirst +thirsti +thirteen +thirti +thirtieth +thirti +thi +thisbi +thisn +thistl +thistl +thither +thitherward +thoa +thoma +thorn +thorn +thorni +thorough +thoroughli +those +thou +though +thought +thought +thought +thousand +thousand +thracian +thraldom +thrall +thrall +thrall +thrash +thrason +thread +threadbar +threaden +thread +threat +threaten +threaten +threaten +threatest +threat +three +threefold +threepenc +threepil +three +threescor +thresher +threshold +threw +thrice +thrift +thriftless +thrift +thrifti +thrill +thrill +thrill +thrive +thrive +thriver +thrive +thrive +throat +throat +throb +throb +throca +throe +throe +thromuldo +thron +throne +throne +throne +throng +throng +throng +throstl +throttl +through +throughfar +throughfar +throughli +throughout +throw +thrower +throwest +throw +thrown +throw +thrum +thrumm +thrush +thrust +thrusteth +thrust +thrust +thumb +thumb +thump +thund +thunder +thunderbolt +thunderbolt +thunder +thunder +thunderston +thunderstrok +thurio +thursdai +thu +thwack +thwart +thwart +thwart +thwart +thy +thyme +thymu +thyreu +thyself +ti +tib +tiber +tiberio +tibei +tice +tick +tickl +tickl +tickl +tickl +tickl +ticklish +tiddl +tide +tide +tide +tidi +tie +ti +ti +tiff +tiger +tiger +tight +tightli +tike +til +tile +till +tillag +tilli +tilt +tilter +tilth +tilt +tilt +tiltyard +tim +timandra +timber +time +timeless +timeli +time +time +timon +timor +timor +timor +tinct +tinctur +tinctur +tinder +tingl +tinker +tinker +tinsel +tini +tip +tipp +tippl +tip +tipsi +tipto +tir +tire +tire +tire +tirest +tire +tirra +tirrit +ti +tish +tisick +tissu +titan +titania +tith +tith +tith +titiniu +titl +titl +titleless +titl +tittl +tittl +titular +titu +tn +to +toad +toad +toadstool +toast +toast +toast +toast +toaz +tobi +tock +tod +todai +todpol +tod +toe +toe +tofor +toge +toge +togeth +toil +toil +toil +toil +token +token +told +toledo +toler +toll +toll +tom +tomb +tomb +tomb +tombless +tomboi +tomb +tomorrow +tomyri +ton +tong +tongu +tongu +tongu +tongueless +tongu +tonight +too +took +tool +tool +tooth +toothach +toothpick +toothpick +top +topa +top +topgal +topless +topmast +topp +top +toppl +toppl +top +topsail +topsi +torch +torchbear +torchbear +torcher +torch +torchlight +tore +torment +tormenta +torment +torment +torment +tormentor +torment +torn +torrent +tortiv +tortois +tortur +tortur +tortur +tortur +tortur +tortur +torturest +tortur +toryn +toss +toss +tosseth +toss +tot +total +total +tott +totter +totter +tou +touch +touch +touch +toucheth +touch +touchston +tough +tougher +tough +tourain +tournament +tour +tou +tout +touz +tow +toward +towardli +toward +tower +tower +tower +town +town +township +townsman +townsmen +towton +toi +toi +trace +trace +track +tract +tractabl +trade +trade +trader +trade +tradesman +tradesmen +trade +tradit +tradit +traduc +traduc +traduc +traffic +traffick +traffic +tragedian +tragedian +tragedi +tragedi +tragic +tragic +trail +train +train +train +train +trait +traitor +traitorli +traitor +traitor +traitor +traitress +traject +trammel +trampl +trampl +trampl +tranc +tranc +tranio +tranquil +tranquil +transcend +transcend +transfer +transfigur +transfix +transform +transform +transform +transform +transgress +transgress +transgress +transgress +translat +translat +translat +translat +transmigr +transmut +transpar +transport +transport +transport +transport +transport +transpos +transshap +trap +trapp +trap +trap +trash +travail +travail +travel +travel +travel +travel +travel +travel +travel +travellest +travel +travel +traver +travers +trai +treacher +treacher +treacher +treacheri +tread +tread +tread +treason +treason +treason +treason +treasur +treasur +treasur +treasuri +treasuri +treat +treati +treatis +treat +treati +trebl +trebl +trebl +treboniu +tree +tree +trembl +trembl +trembl +tremblest +trembl +tremblingli +tremor +trempl +trench +trenchant +trench +trencher +trencher +trencherman +trencher +trench +trench +trent +tre +trespass +trespass +tressel +tress +trei +trial +trial +trib +tribe +tribe +tribul +tribun +tribun +tribun +tributari +tributari +tribut +tribut +trice +trick +trick +trickl +trick +tricksi +trident +tri +trier +trifl +trifl +trifler +trifl +trifl +trigon +trill +trim +trimli +trimm +trim +trim +trim +trinculo +trinculo +trinket +trip +tripartit +tripe +tripl +triplex +tripoli +tripoli +tripp +trip +trippingli +trip +trist +triton +triumph +triumphant +triumphantli +triumpher +triumpher +triumph +triumph +triumvir +triumvir +triumvir +triumviri +trivial +troat +trod +trodden +troiant +troien +troilu +troilus +trojan +trojan +troll +tromperi +trompet +troop +troop +troop +trop +trophi +trophi +tropic +trot +troth +troth +troth +trot +trot +troubl +troubl +troubler +troubl +troublesom +troublest +troublou +trough +trout +trout +trovato +trow +trowel +trowest +troi +troyan +troyan +truant +truce +truckl +trudg +true +trueborn +truepenni +truer +truest +truie +trull +trull +truli +trump +trumperi +trumpet +trumpet +trumpet +trumpet +truncheon +truncheon +trundl +trunk +trunk +trust +trust +truster +truster +trust +trust +trusti +truth +truth +try +ts +tu +tuae +tub +tubal +tub +tuck +tucket +tuesdai +tuft +tuft +tug +tugg +tug +tuition +tullu +tulli +tumbl +tumbl +tumbler +tumbl +tumult +tumultu +tun +tune +tuneabl +tune +tuner +tune +tuni +tun +tup +turban +turban +turbul +turbul +turd +turf +turfi +turk +turkei +turkei +turkish +turk +turlygod +turmoil +turmoil +turn +turnbul +turncoat +turncoat +turn +turneth +turn +turnip +turn +turph +turpitud +turquois +turret +turret +turtl +turtl +turvi +tuscan +tush +tut +tutor +tutor +tutor +tutto +twain +twang +twangl +twa +twai +tweak +tween +twelfth +twelv +twelvemonth +twentieth +twenti +twere +twice +twig +twiggen +twig +twilight +twill +twill +twin +twine +twink +twinkl +twinkl +twinkl +twinn +twin +twire +twist +twist +twit +twit +twit +twixt +two +twofold +twopenc +twopenc +two +twould +tyb +tybalt +tybalt +tyburn +ty +tyke +tymbria +type +type +typhon +tyrann +tyrann +tyrann +tyrann +tyranni +tyrant +tyrant +tyrian +tyrrel +u +ubiqu +udder +udg +ud +uglier +ugliest +ugli +ulcer +ulcer +ulyss +um +umber +umbra +umbrag +umfrevil +umpir +umpir +un +unabl +unaccommod +unaccompani +unaccustom +unach +unacquaint +unact +unadvi +unadvis +unadvisedli +unagre +unanel +unansw +unappea +unapprov +unapt +unapt +unarm +unarm +unarm +unassail +unassail +unattaint +unattempt +unattend +unauspici +unauthor +unavoid +unawar +unback +unbak +unband +unbar +unbarb +unbash +unbat +unbatt +unbecom +unbefit +unbegot +unbegotten +unbeliev +unbend +unbent +unbewail +unbid +unbidden +unbind +unbind +unbit +unbless +unblest +unbloodi +unblown +unbodi +unbolt +unbolt +unbonnet +unbookish +unborn +unbosom +unbound +unbound +unbow +unbow +unbrac +unbrac +unbraid +unbreath +unbr +unbreech +unbridl +unbrok +unbrui +unbruis +unbuckl +unbuckl +unbuckl +unbuild +unburden +unburden +unburi +unburnt +unburthen +unbutton +unbutton +uncap +uncap +uncas +uncas +uncaught +uncertain +uncertainti +unchain +unchang +uncharg +uncharg +uncharit +unchari +unchast +uncheck +unchild +uncivil +unclaim +unclasp +uncl +unclean +uncleanli +uncleanli +unclean +uncl +unclew +unclog +uncoin +uncolt +uncomeli +uncomfort +uncompassion +uncomprehens +unconfin +unconfirm +unconfirm +unconqu +unconqu +unconsid +unconst +unconstrain +unconstrain +uncontemn +uncontrol +uncorrect +uncount +uncoupl +uncourt +uncouth +uncov +uncov +uncrop +uncross +uncrown +unction +unctuou +uncuckold +uncur +uncurb +uncurb +uncurl +uncurr +uncurs +undaunt +undeaf +undeck +undeed +under +underbear +underborn +undercrest +underfoot +undergo +undergo +undergo +undergon +underground +underhand +underl +undermin +undermin +underneath +underpr +underprop +understand +understandeth +understand +understand +understand +understood +underta +undertak +undertak +undertak +undertak +undertak +undertak +undertook +undervalu +undervalu +underw +underwrit +underwrit +undescri +undeserv +undeserv +undeserv +undeserv +undetermin +undid +undint +undiscern +undiscov +undishonour +undispo +undistinguish +undistinguish +undivid +undivid +undivulg +undo +undo +undo +undon +undoubt +undoubtedli +undream +undress +undress +undrown +undut +unduti +un +unear +unearn +unearthli +uneasin +uneasi +uneath +uneduc +uneffectu +unelect +unequ +uneven +unexamin +unexecut +unexpect +unexperienc +unexperi +unexpress +unfair +unfaith +unfal +unfam +unfashion +unfasten +unfath +unfath +unf +unfe +unfeel +unfeign +unfeignedli +unfellow +unfelt +unfenc +unfili +unfil +unfinish +unfirm +unfit +unfit +unfix +unfledg +unfold +unfold +unfoldeth +unfold +unfold +unfool +unforc +unforc +unforfeit +unfortifi +unfortun +unfought +unfrequ +unfriend +unfurnish +ungain +ungal +ungart +ungart +ungenitur +ungentl +ungentl +ungent +ungird +ungodli +ungor +ungot +ungotten +ungovern +ungraci +ungrat +ungrav +ungrown +unguard +unguem +unguid +unhack +unhair +unhallow +unhallow +unhand +unhandl +unhandsom +unhang +unhappi +unhappili +unhappi +unhappi +unharden +unharm +unhatch +unheard +unheart +unheed +unheedfulli +unheedi +unhelp +unhidden +unholi +unhop +unhopefullest +unhors +unhospit +unhou +unhous +unhurt +unicorn +unicorn +unimprov +uninhabit +uninhabit +unintellig +union +union +unit +unit +uniti +univers +univers +univers +univers +unjoint +unjust +unjustic +unjustli +unkennel +unkept +unkind +unkindest +unkindli +unkind +unk +unkinglik +unkiss +unknit +unknow +unknown +unlac +unlaid +unlaw +unlawfulli +unlearn +unlearn +unless +unlesson +unlett +unlett +unlick +unlik +unlik +unlimit +unlin +unlink +unload +unload +unload +unload +unlock +unlock +unlook +unlook +unloo +unloos +unlov +unlov +unluckili +unlucki +unmad +unmak +unmanli +unmann +unmann +unmannerd +unmannerli +unmarri +unmask +unmask +unmask +unmask +unmast +unmatch +unmatch +unmatch +unmeasur +unmeet +unmellow +unmerci +unmerit +unmerit +unmind +unmindful +unmingl +unmitig +unmitig +unmix +unmoan +unmov +unmov +unmov +unmuffl +unmuffl +unmus +unmuzzl +unmuzzl +unnatur +unnatur +unnatur +unnecessarili +unnecessari +unneighbourli +unnerv +unnobl +unnot +unnumb +unnumb +unow +unpack +unpaid +unparagon +unparallel +unparti +unpath +unpav +unpai +unpeac +unpeg +unpeopl +unpeopl +unperfect +unperfect +unpick +unpin +unpink +unpiti +unpitifulli +unplagu +unplaus +unplea +unpleas +unpleas +unpolici +unpolish +unpolish +unpollut +unpossess +unpossess +unposs +unpracti +unpregn +unpremedit +unprepar +unprepar +unpress +unprevail +unprev +unpriz +unpriz +unprofit +unprofit +unprop +unproperli +unproport +unprovid +unprovid +unprovid +unprovok +unprun +unprun +unpublish +unpurg +unpurpo +unqual +unqueen +unquest +unquestion +unquiet +unquietli +unquiet +unrais +unrak +unread +unreadi +unreal +unreason +unreason +unreclaim +unreconcil +unreconcili +unrecount +unrecur +unregard +unregist +unrel +unremov +unremov +unrepriev +unresolv +unrespect +unrespect +unrest +unrestor +unrestrain +unreveng +unreverend +unrever +unrev +unreward +unright +unright +unrip +unripp +unrival +unrol +unroof +unroost +unroot +unrough +unruli +unsaf +unsalut +unsanctifi +unsatisfi +unsavouri +unsai +unscal +unscann +unscarr +unschool +unscorch +unscour +unscratch +unseal +unseam +unsearch +unseason +unseason +unseason +unseason +unsecond +unsecret +unseduc +unse +unseem +unseemli +unseen +unseminar +unsepar +unservic +unset +unsettl +unsettl +unsev +unsex +unshak +unshak +unshaken +unshap +unshap +unsheath +unsheath +unshorn +unshout +unshown +unshrink +unshrubb +unshunn +unshunn +unsift +unsightli +unsinew +unsist +unskil +unskilfulli +unskil +unslip +unsmirch +unsoil +unsolicit +unsort +unsought +unsound +unsound +unspeak +unspeak +unspeak +unspher +unspok +unspoken +unspot +unsquar +unstabl +unstaid +unstain +unstain +unstanch +unstat +unsteadfast +unstoop +unstring +unstuff +unsubstanti +unsuit +unsuit +unsulli +unsunn +unsur +unsur +unsuspect +unswai +unsway +unswai +unswear +unswept +unsworn +untaint +untalk +untangl +untangl +untast +untaught +untemp +untend +untent +untent +unthank +unthank +unthink +unthought +unthread +unthrift +unthrift +unthrifti +unti +unti +until +untimb +untim +untir +untir +untir +untitl +unto +untold +untouch +untoward +untowardli +untrad +untrain +untrain +untread +untreasur +untri +untrim +untrod +untrodden +untroubl +untru +untruss +untruth +untruth +untuck +untun +untun +untun +untutor +untutor +untwin +unurg +unu +unus +unusu +unvalu +unvanquish +unvarnish +unveil +unveil +unvener +unvex +unviol +unvirtu +unvisit +unvulner +unwar +unwarili +unwash +unwatch +unweari +unw +unwedg +unweed +unweigh +unweigh +unwelcom +unwept +unwhipp +unwholesom +unwieldi +unwil +unwillingli +unwilling +unwind +unwip +unwis +unwis +unwish +unwish +unwit +unwittingli +unwont +unwoo +unworthi +unworthiest +unworthili +unworthi +unworthi +unwrung +unyok +unyok +up +upbraid +upbraid +upbraid +upbraid +uphoard +uphold +upholdeth +uphold +uphold +uplift +uplift +upmost +upon +upper +uprear +uprear +upright +upright +upright +upris +upris +uproar +uproar +uprou +upshoot +upshot +upsid +upspr +upstair +upstart +upturn +upward +upward +urchin +urchinfield +urchin +urg +urg +urg +urgent +urg +urgest +urg +urin +urin +urin +urn +urn +ur +ursa +urslei +ursula +urswick +us +usag +usanc +usanc +us +us +us +useless +user +us +usest +useth +usher +usher +usher +usher +us +usual +usual +usur +usur +usuri +usur +usurp +usurp +usurp +usurp +usurp +usurp +usurpingli +usurp +usuri +ut +utensil +utensil +util +utmost +utt +utter +utter +utter +uttereth +utter +utterli +uttermost +utter +uy +v +va +vacanc +vacant +vacat +vade +vagabond +vagabond +vagram +vagrom +vail +vail +vail +vaillant +vain +vainer +vainglori +vainli +vain +vai +valanc +valanc +vale +valenc +valentin +valentinu +valentio +valeria +valeriu +vale +valiant +valiantli +valiant +valid +vallant +vallei +vallei +valli +valor +valor +valor +valour +valu +valuat +valu +valu +valueless +valu +valu +vane +vanish +vanish +vanish +vanishest +vanish +vaniti +vaniti +vanquish +vanquish +vanquish +vanquishest +vanquisheth +vant +vantag +vantag +vantbrac +vapian +vapor +vapor +vapour +vapour +vara +variabl +varianc +variat +variat +vari +variest +varieti +varld +varlet +varletri +varlet +varletto +varnish +varriu +varro +vari +vari +vassal +vassalag +vassal +vast +vastid +vasti +vat +vater +vaudemont +vaughan +vault +vaultag +vault +vault +vault +vaulti +vaumond +vaunt +vaunt +vaunter +vaunt +vauntingli +vaunt +vauvado +vaux +vaward +ve +veal +vede +vehem +vehem +vehement +vehor +veil +veil +veil +vein +vein +vell +velur +velutu +velvet +vendibl +vener +vener +venetia +venetian +venetian +venei +veng +vengeanc +vengeanc +veng +veni +venial +venic +venison +venit +venom +venom +venom +vent +ventag +vent +ventidiu +ventricl +vent +ventur +ventur +ventur +ventur +ventur +ventur +venu +venu +venuto +ver +verb +verba +verbal +verbatim +verbos +verdict +verdun +verdur +vere +verefor +verg +verg +verger +verg +verier +veriest +verifi +verifi +verili +verit +verit +veriti +veriti +vermilion +vermin +vernon +verona +veronesa +versal +vers +vers +vers +vert +veri +vesper +vessel +vessel +vestal +vestment +vestur +vetch +vetch +veux +vex +vexat +vexat +vex +vex +vexest +vexeth +vex +vi +via +vial +vial +viand +viand +vic +vicar +vice +viceger +vicentio +viceroi +viceroi +vice +vici +viciou +vicious +vict +victim +victor +victoress +victori +victori +victor +victori +victual +victual +victual +videlicet +video +vide +videsn +vidi +vie +vi +vienna +view +viewest +vieweth +view +viewless +view +vigil +vigil +vigil +vigit +vigour +vii +viii +vile +vile +vile +viler +vilest +vill +villag +villag +villageri +villag +villain +villaini +villain +villain +villain +villaini +villani +villan +villani +villiago +villian +villianda +villian +vinaigr +vincentio +vincer +vindic +vine +vinegar +vine +vineyard +vineyard +vint +vintner +viol +viola +violat +violat +violat +violat +violat +violenc +violent +violenta +violenteth +violent +violet +violet +viper +viper +viper +vir +virgilia +virgin +virgin +virginal +virgin +virginiu +virgin +virgo +virtu +virtu +virtuou +virtuous +visag +visag +visag +visard +viscount +visibl +visibl +vision +vision +visit +visit +visit +visit +visit +visit +visitor +visitor +visit +visor +vita +vita +vital +vitement +vitruvio +vitx +viva +vivant +vive +vixen +viz +vizament +vizard +vizard +vizard +vizor +vlout +vocat +vocativo +vocatur +voce +voic +voic +voic +void +void +void +voke +volabl +volant +volivorco +vollei +volquessen +volsc +volsc +volscian +volscian +volt +voltemand +volubl +volubl +volum +volum +volumnia +volumniu +voluntari +voluntari +voluptu +voluptu +vomiss +vomit +vomit +vor +vore +vortnight +vot +votari +votarist +votarist +votari +votr +vouch +voucher +voucher +vouch +vouch +vouchsaf +vouchsaf +vouchsaf +vouchsaf +vouchsaf +voudrai +vour +vou +voutsaf +vow +vow +vowel +vowel +vow +vow +vox +voyag +voyag +vraiment +vulcan +vulgar +vulgarli +vulgar +vulgo +vulner +vultur +vultur +vurther +w +wad +waddl +wade +wade +wafer +waft +waftag +waft +waft +wag +wage +wager +wager +wage +wag +waggish +waggl +waggon +waggon +wagon +wagon +wag +wagtail +wail +wail +wail +wail +wain +wainrop +wainscot +waist +wait +wait +waiter +waiteth +wait +wait +wak +wake +wake +wakefield +waken +waken +wake +wakest +wake +wale +walk +walk +walk +walk +wall +wall +wallet +wallet +wallon +walloon +wallow +wall +walnut +walter +wan +wand +wander +wander +wander +wander +wander +wand +wane +wane +wane +wane +wann +want +want +wanteth +want +wanton +wantonli +wanton +wanton +want +wappen +war +warbl +warbl +ward +ward +warden +warder +warder +wardrob +wardrop +ward +ware +ware +warili +warkworth +warlik +warm +warm +warmer +warm +warm +warmth +warn +warn +warn +warn +warn +warp +warp +warr +warrant +warrant +warranteth +warrantis +warrant +warrant +warranti +warren +warren +war +warrior +warrior +war +wart +warwick +warwickshir +wari +wa +wash +wash +washer +wash +washford +wash +wasp +waspish +wasp +wassail +wassail +wast +wast +wast +wast +waster +wast +wast +wat +watch +watch +watcher +watch +watch +watch +watch +watchman +watchmen +watchword +water +waterdrop +water +waterfli +waterford +water +waterish +waterpot +waterrug +water +waterton +wateri +wav +wave +wave +waver +waver +waver +wave +wave +waw +wawl +wax +wax +waxen +wax +wax +wai +waylaid +waylai +wai +wayward +wayward +wayward +we +weak +weaken +weaken +weaker +weakest +weakl +weakli +weak +weal +wealsmen +wealth +wealthiest +wealthili +wealthi +wealtlli +wean +weapon +weapon +wear +wearer +wearer +weari +weari +weariest +wearili +weari +wear +wearisom +wear +weari +weasel +weather +weathercock +weather +weav +weav +weaver +weaver +weav +weav +web +wed +wed +wed +wedg +wedg +wedg +wedlock +wednesdai +weed +weed +weeder +weed +weed +weedi +week +week +weekli +week +ween +ween +weep +weeper +weep +weepingli +weep +weep +weet +weigh +weigh +weigh +weigh +weight +weightier +weightless +weight +weighti +weird +welcom +welcom +welcom +welcom +welcomest +welfar +welkin +well +well +welsh +welshman +welshmen +welshwomen +wench +wench +wench +wend +went +wept +weradai +were +wert +west +western +westminst +westmoreland +westward +wet +wether +wet +wezand +whale +whale +wharf +wharf +what +whate +whatev +whatso +whatsoev +whatsom +whe +wheat +wheaten +wheel +wheel +wheel +wheer +wheeson +wheez +whelk +whelk +whelm +whelp +whelp +whelp +when +whena +whenc +whencesoev +whene +whenev +whensoev +where +whereabout +wherea +whereat +wherebi +wherefor +wherein +whereinto +whereof +whereon +whereout +whereso +whereso +wheresoev +wheresom +whereto +whereuntil +whereunto +whereupon +wherev +wherewith +wherewith +whet +whether +whetston +whet +whew +whei +which +whiff +whiffler +while +while +whilst +whin +whine +whine +whinid +whine +whip +whipp +whipper +whip +whip +whipster +whipstock +whipt +whirl +whirl +whirligig +whirl +whirlpool +whirl +whirlwind +whirlwind +whisp +whisper +whisper +whisper +whisper +whist +whistl +whistl +whistl +whit +white +whitehal +white +white +whiter +white +whitest +whither +white +whitmor +whitster +whitsun +whittl +whizz +who +whoa +whoe +whoever +whole +wholesom +wholesom +wholli +whom +whoobub +whoop +whoop +whor +whore +whoremast +whoremasterli +whoremong +whore +whoreson +whoreson +whore +whorish +whose +whoso +whoso +whosoev +why +wi +wick +wick +wickedn +wicked +wicket +wicki +wid +wide +widen +wider +widow +widow +widow +widowhood +widow +wield +wife +wight +wight +wild +wildcat +wilder +wilder +wildest +wildfir +wildli +wild +wild +wile +wil +wilful +wilfulli +wilfuln +wil +will +will +willer +willeth +william +william +will +willingli +willing +willoughbi +willow +will +wilt +wiltshir +wimpl +win +winc +winch +winchest +wincot +wind +wind +windgal +wind +windlass +windmil +window +window +windpip +wind +windsor +windi +wine +wing +wing +wingfield +wingham +wing +wink +wink +wink +winner +winner +win +winnow +winnow +winnow +win +winter +winterli +winter +wip +wipe +wipe +wipe +wipe +wire +wire +wiri +wisdom +wisdom +wise +wiseli +wise +wiser +wisest +wish +wish +wisher +wisher +wish +wishest +wisheth +wish +wish +wishtli +wisp +wist +wit +witb +witch +witchcraft +witch +witch +with +withal +withdraw +withdraw +withdrawn +withdrew +wither +wither +wither +wither +withheld +withhold +withhold +within +withold +without +withstand +withstand +withstood +witless +wit +wit +witnesseth +wit +wit +wit +wittenberg +wittiest +wittili +wit +wittingli +wittol +wittolli +witti +wiv +wive +wive +wive +wive +wizard +wizard +wo +woe +woeful +woeful +woefullest +woe +woful +wolf +wolfish +wolsei +wolv +wolvish +woman +womanhood +womanish +womankind +womanli +womb +womb +wombi +women +won +woncot +wond +wonder +wonder +wonder +wonderfulli +wonder +wonder +wondrou +wondrous +wont +wont +woo +wood +woodbin +woodcock +woodcock +wooden +woodland +woodman +woodmong +wood +woodstock +woodvil +woo +wooer +wooer +wooe +woof +woo +wooingli +wool +woollen +woolli +woolsack +woolsei +woolward +woo +wor +worcest +word +word +wore +worin +work +worker +work +work +workman +workmanli +workmanship +workmen +work +worki +world +worldl +worldli +world +worm +worm +wormwood +wormi +worn +worri +worri +worri +worri +wors +worser +worship +worship +worshipfulli +worshipp +worshipp +worshipp +worshippest +worship +worst +worst +wort +worth +worthi +worthier +worthi +worthiest +worthili +worthi +worthless +worth +worthi +wort +wot +wot +wot +wouid +would +wouldest +wouldst +wound +wound +wound +wound +woundless +wound +woun +woven +wow +wrack +wrack +wrangl +wrangler +wrangler +wrangl +wrap +wrapp +wrap +wrapt +wrath +wrath +wrathfulli +wrath +wreak +wreak +wreak +wreath +wreath +wreathen +wreath +wreck +wreck +wreck +wren +wrench +wrench +wren +wrest +wrest +wrest +wrestl +wrestl +wrestler +wrestl +wretch +wretchcd +wretch +wretched +wretch +wring +wringer +wring +wring +wrinkl +wrinkl +wrinkl +wrist +wrist +writ +write +writer +writer +write +writhl +write +write +writ +written +wrong +wrong +wronger +wrong +wrongfulli +wrong +wrongli +wrong +wronk +wrote +wroth +wrought +wrung +wry +wry +wt +wul +wye +x +xanthipp +xi +xii +xiii +xiv +xv +y +yard +yard +yare +yare +yarn +yaughan +yaw +yawn +yawn +yclepe +yclipe +ye +yea +yead +year +yearli +yearn +yearn +year +yea +yeast +yedward +yell +yellow +yellow +yellow +yellow +yellow +yell +yelp +yeoman +yeomen +yerk +ye +yesterdai +yesterdai +yesternight +yesti +yet +yew +yicld +yield +yield +yielder +yielder +yield +yield +yok +yoke +yoke +yokefellow +yoke +yoketh +yon +yond +yonder +yongrei +yore +yorick +york +yorkist +york +yorkshir +you +young +younger +youngest +youngl +youngl +youngli +younker +your +your +yourself +yourselv +youth +youth +youth +youtli +zani +zani +zeal +zealou +zeal +zed +zenelophon +zenith +zephyr +zir +zo +zodiac +zodiac +zone +zound +zwagger diff --git a/basis/porter-stemmer/test/voc.txt b/basis/porter-stemmer/test/voc.txt new file mode 100644 index 0000000000..604ef4083a --- /dev/null +++ b/basis/porter-stemmer/test/voc.txt @@ -0,0 +1,23531 @@ +a +aaron +abaissiez +abandon +abandoned +abase +abash +abate +abated +abatement +abatements +abates +abbess +abbey +abbeys +abbominable +abbot +abbots +abbreviated +abed +abel +aberga +abergavenny +abet +abetting +abhominable +abhor +abhorr +abhorred +abhorring +abhors +abhorson +abide +abides +abilities +ability +abject +abjectly +abjects +abjur +abjure +able +abler +aboard +abode +aboded +abodements +aboding +abominable +abominably +abominations +abortive +abortives +abound +abounding +about +above +abr +abraham +abram +abreast +abridg +abridge +abridged +abridgment +abroach +abroad +abrogate +abrook +abrupt +abruption +abruptly +absence +absent +absey +absolute +absolutely +absolv +absolver +abstains +abstemious +abstinence +abstract +absurd +absyrtus +abundance +abundant +abundantly +abus +abuse +abused +abuser +abuses +abusing +abutting +aby +abysm +ac +academe +academes +accent +accents +accept +acceptable +acceptance +accepted +accepts +access +accessary +accessible +accidence +accident +accidental +accidentally +accidents +accite +accited +accites +acclamations +accommodate +accommodated +accommodation +accommodations +accommodo +accompanied +accompany +accompanying +accomplices +accomplish +accomplished +accomplishing +accomplishment +accompt +accord +accordant +accorded +accordeth +according +accordingly +accords +accost +accosted +account +accountant +accounted +accounts +accoutred +accoutrement +accoutrements +accrue +accumulate +accumulated +accumulation +accurs +accursed +accurst +accus +accusation +accusations +accusative +accusativo +accuse +accused +accuser +accusers +accuses +accuseth +accusing +accustom +accustomed +ace +acerb +ache +acheron +aches +achiev +achieve +achieved +achievement +achievements +achiever +achieves +achieving +achilles +aching +achitophel +acknowledg +acknowledge +acknowledged +acknowledgment +acknown +acold +aconitum +acordo +acorn +acquaint +acquaintance +acquainted +acquaints +acquir +acquire +acquisition +acquit +acquittance +acquittances +acquitted +acre +acres +across +act +actaeon +acted +acting +action +actions +actium +active +actively +activity +actor +actors +acts +actual +acture +acute +acutely +ad +adage +adallas +adam +adamant +add +added +adder +adders +addeth +addict +addicted +addiction +adding +addition +additions +addle +address +addressing +addrest +adds +adhere +adheres +adieu +adieus +adjacent +adjoin +adjoining +adjourn +adjudg +adjudged +adjunct +administer +administration +admir +admirable +admiral +admiration +admire +admired +admirer +admiring +admiringly +admission +admit +admits +admittance +admitted +admitting +admonish +admonishing +admonishment +admonishments +admonition +ado +adonis +adopt +adopted +adoptedly +adoption +adoptious +adopts +ador +adoration +adorations +adore +adorer +adores +adorest +adoreth +adoring +adorn +adorned +adornings +adornment +adorns +adown +adramadio +adrian +adriana +adriano +adriatic +adsum +adulation +adulterate +adulterates +adulterers +adulteress +adulteries +adulterous +adultery +adultress +advanc +advance +advanced +advancement +advancements +advances +advancing +advantage +advantageable +advantaged +advantageous +advantages +advantaging +advent +adventur +adventure +adventures +adventuring +adventurous +adventurously +adversaries +adversary +adverse +adversely +adversities +adversity +advertis +advertise +advertised +advertisement +advertising +advice +advis +advise +advised +advisedly +advises +advisings +advocate +advocation +aeacida +aeacides +aedile +aediles +aegeon +aegion +aegles +aemelia +aemilia +aemilius +aeneas +aeolus +aer +aerial +aery +aesculapius +aeson +aesop +aetna +afar +afear +afeard +affability +affable +affair +affaire +affairs +affect +affectation +affectations +affected +affectedly +affecteth +affecting +affection +affectionate +affectionately +affections +affects +affeer +affianc +affiance +affianced +affied +affin +affined +affinity +affirm +affirmation +affirmatives +afflict +afflicted +affliction +afflictions +afflicts +afford +affordeth +affords +affray +affright +affrighted +affrights +affront +affronted +affy +afield +afire +afloat +afoot +afore +aforehand +aforesaid +afraid +afresh +afric +africa +african +afront +after +afternoon +afterward +afterwards +ag +again +against +agamemmon +agamemnon +agate +agaz +age +aged +agenor +agent +agents +ages +aggravate +aggrief +agile +agincourt +agitation +aglet +agnize +ago +agone +agony +agree +agreed +agreeing +agreement +agrees +agrippa +aground +ague +aguecheek +agued +agueface +agues +ah +aha +ahungry +ai +aialvolio +aiaria +aid +aidance +aidant +aided +aiding +aidless +aids +ail +aim +aimed +aimest +aiming +aims +ainsi +aio +air +aired +airless +airs +airy +ajax +akilling +al +alabaster +alack +alacrity +alarbus +alarm +alarms +alarum +alarums +alas +alb +alban +albans +albany +albeit +albion +alchemist +alchemy +alcibiades +alcides +alder +alderman +aldermen +ale +alecto +alehouse +alehouses +alencon +alengon +aleppo +ales +alewife +alexander +alexanders +alexandria +alexandrian +alexas +alias +alice +alien +aliena +alight +alighted +alights +aliis +alike +alisander +alive +all +alla +allay +allayed +allaying +allayment +allayments +allays +allegation +allegations +allege +alleged +allegiance +allegiant +alley +alleys +allhallowmas +alliance +allicholy +allied +allies +alligant +alligator +allons +allot +allots +allotted +allottery +allow +allowance +allowed +allowing +allows +allur +allure +allurement +alluring +allusion +ally +allycholly +almain +almanac +almanack +almanacs +almighty +almond +almost +alms +almsman +aloes +aloft +alone +along +alonso +aloof +aloud +alphabet +alphabetical +alphonso +alps +already +also +alt +altar +altars +alter +alteration +altered +alters +althaea +although +altitude +altogether +alton +alway +always +am +amaimon +amain +amaking +amamon +amaz +amaze +amazed +amazedly +amazedness +amazement +amazes +amazeth +amazing +amazon +amazonian +amazons +ambassador +ambassadors +amber +ambiguides +ambiguities +ambiguous +ambition +ambitions +ambitious +ambitiously +amble +ambled +ambles +ambling +ambo +ambuscadoes +ambush +amen +amend +amended +amendment +amends +amerce +america +ames +amiable +amid +amidst +amiens +amis +amiss +amities +amity +amnipotent +among +amongst +amorous +amorously +amort +amount +amounts +amour +amphimacus +ample +ampler +amplest +amplified +amplify +amply +ampthill +amurath +amyntas +an +anatomiz +anatomize +anatomy +ancestor +ancestors +ancestry +anchises +anchor +anchorage +anchored +anchoring +anchors +anchovies +ancient +ancientry +ancients +ancus +and +andirons +andpholus +andren +andrew +andromache +andronici +andronicus +anew +ang +angel +angelica +angelical +angelo +angels +anger +angerly +angers +anges +angiers +angl +anglais +angle +angler +angleterre +angliae +angling +anglish +angrily +angry +anguish +angus +animal +animals +animis +anjou +ankle +anna +annals +anne +annex +annexed +annexions +annexment +annothanize +announces +annoy +annoyance +annoying +annual +anoint +anointed +anon +another +anselmo +answer +answerable +answered +answerest +answering +answers +ant +ante +antenor +antenorides +anteroom +anthem +anthems +anthony +anthropophagi +anthropophaginian +antiates +antic +anticipate +anticipates +anticipatest +anticipating +anticipation +antick +anticly +antics +antidote +antidotes +antigonus +antiopa +antipathy +antipholus +antipholuses +antipodes +antiquary +antique +antiquity +antium +antoniad +antonio +antonius +antony +antres +anvil +any +anybody +anyone +anything +anywhere +ap +apace +apart +apartment +apartments +ape +apemantus +apennines +apes +apiece +apish +apollinem +apollo +apollodorus +apology +apoplex +apoplexy +apostle +apostles +apostrophas +apoth +apothecary +appal +appall +appalled +appals +apparel +apparell +apparelled +apparent +apparently +apparition +apparitions +appeach +appeal +appeals +appear +appearance +appeared +appeareth +appearing +appears +appeas +appease +appeased +appelant +appele +appelee +appeles +appelez +appellant +appellants +appelons +appendix +apperil +appertain +appertaining +appertainings +appertains +appertinent +appertinents +appetite +appetites +applaud +applauded +applauding +applause +applauses +apple +apples +appletart +appliance +appliances +applications +applied +applies +apply +applying +appoint +appointed +appointment +appointments +appoints +apprehend +apprehended +apprehends +apprehension +apprehensions +apprehensive +apprendre +apprenne +apprenticehood +appris +approach +approachers +approaches +approacheth +approaching +approbation +approof +appropriation +approv +approve +approved +approvers +approves +appurtenance +appurtenances +apricocks +april +apron +aprons +apt +apter +aptest +aptly +aptness +aqua +aquilon +aquitaine +arabia +arabian +araise +arbitrate +arbitrating +arbitrator +arbitrement +arbors +arbour +arc +arch +archbishop +archbishopric +archdeacon +arched +archelaus +archer +archers +archery +archibald +archidamus +architect +arcu +arde +arden +ardent +ardour +are +argal +argier +argo +argosies +argosy +argu +argue +argued +argues +arguing +argument +arguments +argus +ariachne +ariadne +ariel +aries +aright +arinado +arinies +arion +arise +arises +ariseth +arising +aristode +aristotle +arithmetic +arithmetician +ark +arm +arma +armado +armadoes +armagnac +arme +armed +armenia +armies +armigero +arming +armipotent +armor +armour +armourer +armourers +armours +armoury +arms +army +arn +aroint +arose +arouse +aroused +arragon +arraign +arraigned +arraigning +arraignment +arrant +arras +array +arrearages +arrest +arrested +arrests +arriv +arrival +arrivance +arrive +arrived +arrives +arriving +arrogance +arrogancy +arrogant +arrow +arrows +art +artemidorus +arteries +arthur +article +articles +articulate +artificer +artificial +artillery +artire +artist +artists +artless +artois +arts +artus +arviragus +as +asaph +ascanius +ascend +ascended +ascendeth +ascends +ascension +ascent +ascribe +ascribes +ash +asham +ashamed +asher +ashes +ashford +ashore +ashouting +ashy +asia +aside +ask +askance +asked +asker +asketh +asking +asks +aslant +asleep +asmath +asp +aspect +aspects +aspen +aspersion +aspic +aspicious +aspics +aspir +aspiration +aspire +aspiring +asquint +ass +assail +assailable +assailant +assailants +assailed +assaileth +assailing +assails +assassination +assault +assaulted +assaults +assay +assaying +assays +assemblance +assemble +assembled +assemblies +assembly +assent +asses +assez +assign +assigned +assigns +assinico +assist +assistance +assistances +assistant +assistants +assisted +assisting +associate +associated +associates +assuage +assubjugate +assum +assume +assumes +assumption +assur +assurance +assure +assured +assuredly +assures +assyrian +astonish +astonished +astraea +astray +astrea +astronomer +astronomers +astronomical +astronomy +asunder +at +atalanta +ate +ates +athenian +athenians +athens +athol +athversary +athwart +atlas +atomies +atomy +atone +atonement +atonements +atropos +attach +attached +attachment +attain +attainder +attains +attaint +attainted +attainture +attempt +attemptable +attempted +attempting +attempts +attend +attendance +attendant +attendants +attended +attendents +attendeth +attending +attends +attent +attention +attentive +attentivenes +attest +attested +attir +attire +attired +attires +attorney +attorneyed +attorneys +attorneyship +attract +attraction +attractive +attracts +attribute +attributed +attributes +attribution +attributive +atwain +au +aubrey +auburn +aucun +audacious +audaciously +audacity +audible +audience +audis +audit +auditor +auditors +auditory +audre +audrey +aufidius +aufidiuses +auger +aught +augment +augmentation +augmented +augmenting +augurer +augurers +augures +auguring +augurs +augury +august +augustus +auld +aumerle +aunchient +aunt +aunts +auricular +aurora +auspicious +aussi +austere +austerely +austereness +austerity +austria +aut +authentic +author +authorities +authority +authorized +authorizing +authors +autolycus +autre +autumn +auvergne +avail +avails +avarice +avaricious +avaunt +ave +aveng +avenge +avenged +averring +avert +aves +avez +avis +avoid +avoided +avoiding +avoids +avoirdupois +avouch +avouched +avouches +avouchment +avow +aw +await +awaits +awak +awake +awaked +awaken +awakened +awakens +awakes +awaking +award +awards +awasy +away +awe +aweary +aweless +awful +awhile +awkward +awl +awooing +awork +awry +axe +axle +axletree +ay +aye +ayez +ayli +azur +azure +b +ba +baa +babbl +babble +babbling +babe +babes +babies +baboon +baboons +baby +babylon +bacare +bacchanals +bacchus +bach +bachelor +bachelors +back +backbite +backbitten +backing +backs +backward +backwardly +backwards +bacon +bacons +bad +bade +badge +badged +badges +badly +badness +baes +baffl +baffle +baffled +bag +baggage +bagot +bagpipe +bags +bail +bailiff +baillez +baily +baisant +baisees +baiser +bait +baited +baiting +baitings +baits +bajazet +bak +bake +baked +baker +bakers +bakes +baking +bal +balanc +balance +balcony +bald +baldrick +bale +baleful +balk +ball +ballad +ballads +ballast +ballasting +ballet +ballow +balls +balm +balms +balmy +balsam +balsamum +balth +balthasar +balthazar +bames +ban +banbury +band +bandied +banding +bandit +banditti +banditto +bands +bandy +bandying +bane +banes +bang +bangor +banish +banished +banishers +banishment +banister +bank +bankrout +bankrupt +bankrupts +banks +banner +bannerets +banners +banning +banns +banquet +banqueted +banqueting +banquets +banquo +bans +baptism +baptista +baptiz +bar +barbarian +barbarians +barbarism +barbarous +barbary +barbason +barbed +barber +barbermonger +bard +bardolph +bards +bare +bared +barefac +barefaced +barefoot +bareheaded +barely +bareness +barful +bargain +bargains +barge +bargulus +baring +bark +barking +barkloughly +barks +barky +barley +barm +barn +barnacles +barnardine +barne +barnes +barnet +barns +baron +barons +barony +barr +barrabas +barrel +barrels +barren +barrenly +barrenness +barricado +barricadoes +barrow +bars +barson +barter +bartholomew +bas +basan +base +baseless +basely +baseness +baser +bases +basest +bashful +bashfulness +basilisco +basilisk +basilisks +basimecu +basin +basingstoke +basins +basis +bask +basket +baskets +bass +bassanio +basset +bassianus +basta +bastard +bastardizing +bastardly +bastards +bastardy +basted +bastes +bastinado +basting +bat +batailles +batch +bate +bated +bates +bath +bathe +bathed +bathing +baths +bating +batler +bats +batt +battalia +battalions +batten +batter +battering +batters +battery +battle +battled +battlefield +battlements +battles +batty +bauble +baubles +baubling +baulk +bavin +bawcock +bawd +bawdry +bawds +bawdy +bawl +bawling +bay +baying +baynard +bayonne +bays +be +beach +beached +beachy +beacon +bead +beaded +beadle +beadles +beads +beadsmen +beagle +beagles +beak +beaks +beam +beamed +beams +bean +beans +bear +beard +bearded +beardless +beards +bearer +bearers +bearest +beareth +bearing +bears +beast +beastliest +beastliness +beastly +beasts +beat +beated +beaten +beating +beatrice +beats +beau +beaufort +beaumond +beaumont +beauteous +beautied +beauties +beautified +beautiful +beautify +beauty +beaver +beavers +became +because +bechanc +bechance +bechanced +beck +beckon +beckons +becks +becom +become +becomed +becomes +becoming +becomings +bed +bedabbled +bedash +bedaub +bedazzled +bedchamber +bedclothes +bedded +bedeck +bedecking +bedew +bedfellow +bedfellows +bedford +bedlam +bedrench +bedrid +beds +bedtime +bedward +bee +beef +beefs +beehives +been +beer +bees +beest +beetle +beetles +beeves +befall +befallen +befalls +befell +befits +befitted +befitting +befor +before +beforehand +befortune +befriend +befriended +befriends +beg +began +beget +begets +begetting +begg +beggar +beggared +beggarly +beggarman +beggars +beggary +begging +begin +beginners +beginning +beginnings +begins +begnawn +begone +begot +begotten +begrimed +begs +beguil +beguile +beguiled +beguiles +beguiling +begun +behalf +behalfs +behav +behaved +behavedst +behavior +behaviors +behaviour +behaviours +behead +beheaded +beheld +behest +behests +behind +behold +beholder +beholders +beholdest +beholding +beholds +behoof +behooffull +behooves +behove +behoves +behowls +being +bel +belarius +belch +belching +beldam +beldame +beldams +belee +belgia +belie +belied +belief +beliest +believ +believe +believed +believes +believest +believing +belike +bell +bellario +belle +bellied +bellies +bellman +bellona +bellow +bellowed +bellowing +bellows +bells +belly +bellyful +belman +belmont +belock +belong +belonging +belongings +belongs +belov +beloved +beloving +below +belt +belzebub +bemadding +bemet +bemete +bemoan +bemoaned +bemock +bemoil +bemonster +ben +bench +bencher +benches +bend +bended +bending +bends +bene +beneath +benedicite +benedick +benediction +benedictus +benefactors +benefice +beneficial +benefit +benefited +benefits +benetted +benevolence +benevolences +benied +benison +bennet +bent +bentii +bentivolii +bents +benumbed +benvolio +bepaint +bepray +bequeath +bequeathed +bequeathing +bequest +ber +berard +berattle +beray +bere +bereave +bereaved +bereaves +bereft +bergamo +bergomask +berhym +berhyme +berkeley +bermoothes +bernardo +berod +berowne +berri +berries +berrord +berry +bertram +berwick +bescreen +beseech +beseeched +beseechers +beseeching +beseek +beseem +beseemeth +beseeming +beseems +beset +beshrew +beside +besides +besieg +besiege +besieged +beslubber +besmear +besmeared +besmirch +besom +besort +besotted +bespake +bespeak +bespice +bespoke +bespotted +bess +bessy +best +bestained +bested +bestial +bestir +bestirr +bestow +bestowed +bestowing +bestows +bestraught +bestrew +bestrid +bestride +bestrides +bet +betake +beteem +bethink +bethought +bethrothed +bethump +betid +betide +betideth +betime +betimes +betoken +betook +betossed +betray +betrayed +betraying +betrays +betrims +betroth +betrothed +betroths +bett +betted +better +bettered +bettering +betters +betting +bettre +between +betwixt +bevel +beverage +bevis +bevy +bewail +bewailed +bewailing +bewails +beware +bewasted +beweep +bewept +bewet +bewhored +bewitch +bewitched +bewitchment +bewray +beyond +bezonian +bezonians +bianca +bianco +bias +bibble +bickerings +bid +bidden +bidding +biddings +biddy +bide +bides +biding +bids +bien +bier +bifold +big +bigamy +biggen +bigger +bigness +bigot +bilberry +bilbo +bilboes +bilbow +bill +billeted +billets +billiards +billing +billow +billows +bills +bin +bind +bindeth +binding +binds +biondello +birch +bird +birding +birdlime +birds +birnam +birth +birthday +birthdom +birthplace +birthright +birthrights +births +bis +biscuit +bishop +bishops +bisson +bit +bitch +bite +biter +bites +biting +bits +bitt +bitten +bitter +bitterest +bitterly +bitterness +blab +blabb +blabbing +blabs +black +blackamoor +blackamoors +blackberries +blackberry +blacker +blackest +blackfriars +blackheath +blackmere +blackness +blacks +bladder +bladders +blade +bladed +blades +blains +blam +blame +blamed +blameful +blameless +blames +blanc +blanca +blanch +blank +blanket +blanks +blaspheme +blaspheming +blasphemous +blasphemy +blast +blasted +blasting +blastments +blasts +blaz +blaze +blazes +blazing +blazon +blazoned +blazoning +bleach +bleaching +bleak +blear +bleared +bleat +bleated +bleats +bled +bleed +bleedest +bleedeth +bleeding +bleeds +blemish +blemishes +blench +blenches +blend +blended +blent +bless +blessed +blessedly +blessedness +blesses +blesseth +blessing +blessings +blest +blew +blind +blinded +blindfold +blinding +blindly +blindness +blinds +blink +blinking +bliss +blist +blister +blisters +blithe +blithild +bloat +block +blockish +blocks +blois +blood +blooded +bloodhound +bloodied +bloodier +bloodiest +bloodily +bloodless +bloods +bloodshed +bloodshedding +bloodstained +bloody +bloom +blooms +blossom +blossoming +blossoms +blot +blots +blotted +blotting +blount +blow +blowed +blowers +blowest +blowing +blown +blows +blowse +blubb +blubber +blubbering +blue +bluecaps +bluest +blunt +blunted +blunter +bluntest +blunting +bluntly +bluntness +blunts +blur +blurr +blurs +blush +blushes +blushest +blushing +blust +bluster +blusterer +blusters +bo +boar +board +boarded +boarding +boards +boarish +boars +boast +boasted +boastful +boasting +boasts +boat +boats +boatswain +bob +bobb +boblibindo +bobtail +bocchus +bode +boded +bodements +bodes +bodg +bodied +bodies +bodiless +bodily +boding +bodkin +body +bodykins +bog +boggle +boggler +bogs +bohemia +bohemian +bohun +boil +boiling +boils +boist +boisterous +boisterously +boitier +bold +bolden +bolder +boldest +boldly +boldness +bolds +bolingbroke +bolster +bolt +bolted +bolter +bolters +bolting +bolts +bombard +bombards +bombast +bon +bona +bond +bondage +bonded +bondmaid +bondman +bondmen +bonds +bondslave +bone +boneless +bones +bonfire +bonfires +bonjour +bonne +bonnet +bonneted +bonny +bonos +bonto +bonville +bood +book +bookish +books +boon +boor +boorish +boors +boot +booted +booties +bootless +boots +booty +bor +bora +borachio +bordeaux +border +bordered +borderers +borders +bore +boreas +bores +boring +born +borne +borough +boroughs +borrow +borrowed +borrower +borrowing +borrows +bosko +boskos +bosky +bosom +bosoms +boson +boss +bosworth +botch +botcher +botches +botchy +both +bots +bottle +bottled +bottles +bottom +bottomless +bottoms +bouciqualt +bouge +bough +boughs +bought +bounce +bouncing +bound +bounded +bounden +boundeth +bounding +boundless +bounds +bounteous +bounteously +bounties +bountiful +bountifully +bounty +bourbier +bourbon +bourchier +bourdeaux +bourn +bout +bouts +bove +bow +bowcase +bowed +bowels +bower +bowing +bowl +bowler +bowling +bowls +bows +bowsprit +bowstring +box +boxes +boy +boyet +boyish +boys +brabant +brabantio +brabble +brabbler +brac +brace +bracelet +bracelets +brach +bracy +brag +bragg +braggardism +braggards +braggart +braggarts +bragged +bragging +bragless +brags +braid +braided +brain +brained +brainford +brainish +brainless +brains +brainsick +brainsickly +brake +brakenbury +brakes +brambles +bran +branch +branches +branchless +brand +branded +brandish +brandon +brands +bras +brass +brassy +brat +brats +brav +brave +braved +bravely +braver +bravery +braves +bravest +braving +brawl +brawler +brawling +brawls +brawn +brawns +bray +braying +braz +brazen +brazier +breach +breaches +bread +breadth +break +breaker +breakfast +breaking +breaks +breast +breasted +breasting +breastplate +breasts +breath +breathe +breathed +breather +breathers +breathes +breathest +breathing +breathless +breaths +brecknock +bred +breech +breeches +breeching +breed +breeder +breeders +breeding +breeds +breese +breeze +breff +bretagne +brethen +bretheren +brethren +brevis +brevity +brew +brewage +brewer +brewers +brewing +brews +briareus +briars +brib +bribe +briber +bribes +brick +bricklayer +bricks +bridal +bride +bridegroom +bridegrooms +brides +bridge +bridgenorth +bridges +bridget +bridle +bridled +brief +briefer +briefest +briefly +briefness +brier +briers +brigandine +bright +brighten +brightest +brightly +brightness +brim +brimful +brims +brimstone +brinded +brine +bring +bringer +bringeth +bringing +bringings +brings +brinish +brink +brisk +brisky +bristle +bristled +bristly +bristol +bristow +britain +britaine +britaines +british +briton +britons +brittany +brittle +broach +broached +broad +broader +broadsides +brocas +brock +brogues +broil +broiling +broils +broke +broken +brokenly +broker +brokers +brokes +broking +brooch +brooches +brood +brooded +brooding +brook +brooks +broom +broomstaff +broth +brothel +brother +brotherhood +brotherhoods +brotherly +brothers +broths +brought +brow +brown +browner +brownist +browny +brows +browse +browsing +bruis +bruise +bruised +bruises +bruising +bruit +bruited +brundusium +brunt +brush +brushes +brute +brutish +brutus +bubble +bubbles +bubbling +bubukles +buck +bucket +buckets +bucking +buckingham +buckle +buckled +buckler +bucklers +bucklersbury +buckles +buckram +bucks +bud +budded +budding +budge +budger +budget +buds +buff +buffet +buffeting +buffets +bug +bugbear +bugle +bugs +build +builded +buildeth +building +buildings +builds +built +bulk +bulks +bull +bullcalf +bullen +bullens +bullet +bullets +bullocks +bulls +bully +bulmer +bulwark +bulwarks +bum +bumbast +bump +bumper +bums +bunch +bunches +bundle +bung +bunghole +bungle +bunting +buoy +bur +burbolt +burd +burden +burdened +burdening +burdenous +burdens +burgh +burgher +burghers +burglary +burgomasters +burgonet +burgundy +burial +buried +burier +buriest +burly +burn +burned +burnet +burneth +burning +burnish +burns +burnt +burr +burrows +burs +burst +bursting +bursts +burthen +burthens +burton +bury +burying +bush +bushels +bushes +bushy +busied +busily +busines +business +businesses +buskin +busky +buss +busses +bussing +bustle +bustling +busy +but +butcheed +butcher +butchered +butcheries +butcherly +butchers +butchery +butler +butt +butter +buttered +butterflies +butterfly +butterwoman +buttery +buttock +buttocks +button +buttonhole +buttons +buttress +buttry +butts +buxom +buy +buyer +buying +buys +buzz +buzzard +buzzards +buzzers +buzzing +by +bye +byzantium +c +ca +cabbage +cabileros +cabin +cabins +cable +cables +cackling +cacodemon +caddis +caddisses +cade +cadence +cadent +cades +cadmus +caduceus +cadwal +cadwallader +caelius +caelo +caesar +caesarion +caesars +cage +caged +cagion +cain +caithness +caitiff +caitiffs +caius +cak +cake +cakes +calaber +calais +calamities +calamity +calchas +calculate +calen +calendar +calendars +calf +caliban +calibans +calipolis +cality +caliver +call +callat +called +callet +calling +calls +calm +calmest +calmly +calmness +calms +calpurnia +calumniate +calumniating +calumnious +calumny +calve +calved +calves +calveskins +calydon +cam +cambio +cambria +cambric +cambrics +cambridge +cambyses +came +camel +camelot +camels +camest +camillo +camlet +camomile +camp +campeius +camping +camps +can +canakin +canaries +canary +cancel +cancell +cancelled +cancelling +cancels +cancer +candidatus +candied +candle +candles +candlesticks +candy +canidius +cank +canker +cankerblossom +cankers +cannibally +cannibals +cannon +cannoneer +cannons +cannot +canon +canoniz +canonize +canonized +canons +canopied +canopies +canopy +canst +canstick +canterbury +cantle +cantons +canus +canvas +canvass +canzonet +cap +capability +capable +capacities +capacity +caparison +capdv +cape +capel +capels +caper +capers +capet +caphis +capilet +capitaine +capital +capite +capitol +capitulate +capocchia +capon +capons +capp +cappadocia +capriccio +capricious +caps +capt +captain +captains +captainship +captious +captivate +captivated +captivates +captive +captives +captivity +captum +capucius +capulet +capulets +car +carack +caracks +carat +caraways +carbonado +carbuncle +carbuncled +carbuncles +carcanet +carcase +carcases +carcass +carcasses +card +cardecue +carded +carders +cardinal +cardinally +cardinals +cardmaker +cards +carduus +care +cared +career +careers +careful +carefully +careless +carelessly +carelessness +cares +caret +cargo +carl +carlisle +carlot +carman +carmen +carnal +carnally +carnarvonshire +carnation +carnations +carol +carous +carouse +caroused +carouses +carousing +carp +carpenter +carper +carpet +carpets +carping +carriage +carriages +carried +carrier +carriers +carries +carrion +carrions +carry +carrying +cars +cart +carters +carthage +carts +carv +carve +carved +carver +carves +carving +cas +casa +casaer +casca +case +casement +casements +cases +cash +cashier +casing +cask +casket +casketed +caskets +casque +casques +cassado +cassandra +cassibelan +cassio +cassius +cassocks +cast +castalion +castaway +castaways +casted +caster +castigate +castigation +castile +castiliano +casting +castle +castles +casts +casual +casually +casualties +casualty +cat +cataian +catalogue +cataplasm +cataracts +catarrhs +catastrophe +catch +catcher +catches +catching +cate +catechising +catechism +catechize +cater +caterpillars +caters +caterwauling +cates +catesby +cathedral +catlike +catling +catlings +cato +cats +cattle +caucasus +caudle +cauf +caught +cauldron +caus +cause +caused +causeless +causer +causes +causest +causeth +cautel +cautelous +cautels +cauterizing +caution +cautions +cavaleiro +cavalery +cavaliers +cave +cavern +caverns +caves +caveto +caviary +cavil +cavilling +cawdor +cawdron +cawing +ce +ceas +cease +ceases +ceaseth +cedar +cedars +cedius +celebrate +celebrated +celebrates +celebration +celerity +celestial +celia +cell +cellar +cellarage +celsa +cement +censer +censor +censorinus +censur +censure +censured +censurers +censures +censuring +centaur +centaurs +centre +cents +centuries +centurion +centurions +century +cerberus +cerecloth +cerements +ceremonial +ceremonies +ceremonious +ceremoniously +ceremony +ceres +cerns +certain +certainer +certainly +certainties +certainty +certes +certificate +certified +certifies +certify +ces +cesario +cess +cesse +cestern +cetera +cette +chaces +chaf +chafe +chafed +chafes +chaff +chaffless +chafing +chain +chains +chair +chairs +chalic +chalice +chalices +chalk +chalks +chalky +challeng +challenge +challenged +challenger +challengers +challenges +cham +chamber +chamberers +chamberlain +chamberlains +chambermaid +chambermaids +chambers +chameleon +champ +champagne +champain +champains +champion +champions +chanc +chance +chanced +chancellor +chances +chandler +chang +change +changeable +changed +changeful +changeling +changelings +changer +changes +changest +changing +channel +channels +chanson +chant +chanticleer +chanting +chantries +chantry +chants +chaos +chap +chape +chapel +chapeless +chapels +chaplain +chaplains +chapless +chaplet +chapmen +chaps +chapter +character +charactered +characterless +characters +charactery +characts +charbon +chare +chares +charg +charge +charged +chargeful +charges +chargeth +charging +chariest +chariness +charing +chariot +chariots +charitable +charitably +charities +charity +charlemain +charles +charm +charmed +charmer +charmeth +charmian +charming +charmingly +charms +charneco +charnel +charolois +charon +charter +charters +chartreux +chary +charybdis +chas +chase +chased +chaser +chaseth +chasing +chaste +chastely +chastis +chastise +chastised +chastisement +chastity +chat +chatham +chatillon +chats +chatt +chattels +chatter +chattering +chattles +chaud +chaunted +chaw +chawdron +che +cheap +cheapen +cheaper +cheapest +cheaply +cheapside +cheat +cheated +cheater +cheaters +cheating +cheats +check +checked +checker +checking +checks +cheek +cheeks +cheer +cheered +cheerer +cheerful +cheerfully +cheering +cheerless +cheerly +cheers +cheese +chequer +cher +cherish +cherished +cherisher +cherishes +cherishing +cherries +cherry +cherrypit +chertsey +cherub +cherubims +cherubin +cherubins +cheshu +chess +chest +chester +chestnut +chestnuts +chests +chetas +chev +cheval +chevalier +chevaliers +cheveril +chew +chewed +chewet +chewing +chez +chi +chick +chicken +chickens +chicurmurco +chid +chidden +chide +chiders +chides +chiding +chief +chiefest +chiefly +chien +child +childed +childeric +childhood +childhoods +childing +childish +childishness +childlike +childness +children +chill +chilling +chime +chimes +chimney +chimneypiece +chimneys +chimurcho +chin +china +chine +chines +chink +chinks +chins +chipp +chipper +chips +chiron +chirping +chirrah +chirurgeonly +chisel +chitopher +chivalrous +chivalry +choice +choicely +choicest +choir +choirs +chok +choke +choked +chokes +choking +choler +choleric +cholers +chollors +choose +chooser +chooses +chooseth +choosing +chop +chopine +choplogic +chopp +chopped +chopping +choppy +chops +chopt +chor +choristers +chorus +chose +chosen +chough +choughs +chrish +christ +christen +christendom +christendoms +christening +christenings +christian +christianlike +christians +christmas +christom +christopher +christophero +chronicle +chronicled +chronicler +chroniclers +chronicles +chrysolite +chuck +chucks +chud +chuffs +church +churches +churchman +churchmen +churchyard +churchyards +churl +churlish +churlishly +churls +churn +chus +cicatrice +cicatrices +cicely +cicero +ciceter +ciel +ciitzens +cilicia +cimber +cimmerian +cinable +cincture +cinders +cine +cinna +cinque +cipher +ciphers +circa +circe +circle +circled +circlets +circling +circuit +circum +circumcised +circumference +circummur +circumscrib +circumscribed +circumscription +circumspect +circumstance +circumstanced +circumstances +circumstantial +circumvent +circumvention +cistern +citadel +cital +cite +cited +cites +cities +citing +citizen +citizens +cittern +city +civet +civil +civility +civilly +clack +clad +claim +claiming +claims +clamb +clamber +clammer +clamor +clamorous +clamors +clamour +clamours +clang +clangor +clap +clapp +clapped +clapper +clapping +claps +clare +clarence +claret +claribel +clasp +clasps +clatter +claud +claudio +claudius +clause +claw +clawed +clawing +claws +clay +clays +clean +cleanliest +cleanly +cleans +cleanse +cleansing +clear +clearer +clearest +clearly +clearness +clears +cleave +cleaving +clef +cleft +cleitus +clemency +clement +cleomenes +cleopatpa +cleopatra +clepeth +clept +clerestories +clergy +clergyman +clergymen +clerk +clerkly +clerks +clew +client +clients +cliff +clifford +cliffords +cliffs +clifton +climate +climature +climb +climbed +climber +climbeth +climbing +climbs +clime +cling +clink +clinking +clinquant +clip +clipp +clipper +clippeth +clipping +clipt +clitus +clo +cloak +cloakbag +cloaks +clock +clocks +clod +cloddy +clodpole +clog +clogging +clogs +cloister +cloistress +cloquence +clos +close +closed +closely +closeness +closer +closes +closest +closet +closing +closure +cloten +clotens +cloth +clothair +clotharius +clothe +clothes +clothier +clothiers +clothing +cloths +clotpoles +clotpoll +cloud +clouded +cloudiness +clouds +cloudy +clout +clouted +clouts +cloven +clover +cloves +clovest +clowder +clown +clownish +clowns +cloy +cloyed +cloying +cloyless +cloyment +cloys +club +clubs +cluck +clung +clust +clusters +clutch +clyster +cneius +cnemies +co +coach +coaches +coachmakers +coact +coactive +coagulate +coal +coals +coarse +coarsely +coast +coasting +coasts +coat +coated +coats +cobble +cobbled +cobbler +cobham +cobloaf +cobweb +cobwebs +cock +cockatrice +cockatrices +cockle +cockled +cockney +cockpit +cocks +cocksure +coctus +cocytus +cod +codding +codling +codpiece +codpieces +cods +coelestibus +coesar +coeur +coffer +coffers +coffin +coffins +cog +cogging +cogitation +cogitations +cognition +cognizance +cogscomb +cohabitants +coher +cohere +coherence +coherent +cohorts +coif +coign +coil +coin +coinage +coiner +coining +coins +col +colbrand +colchos +cold +colder +coldest +coldly +coldness +coldspur +colebrook +colic +collar +collars +collateral +colleagued +collect +collected +collection +college +colleges +collied +collier +colliers +collop +collusion +colme +colmekill +coloquintida +color +colors +colossus +colour +colourable +coloured +colouring +colours +colt +colted +colts +columbine +columbines +colville +com +comagene +comart +comb +combat +combatant +combatants +combated +combating +combin +combinate +combination +combine +combined +combless +combustion +come +comedian +comedians +comedy +comeliness +comely +comer +comers +comes +comest +comet +cometh +comets +comfect +comfit +comfits +comfort +comfortable +comforted +comforter +comforting +comfortless +comforts +comic +comical +coming +comings +cominius +comma +command +commande +commanded +commander +commanders +commanding +commandment +commandments +commands +comme +commenc +commence +commenced +commencement +commences +commencing +commend +commendable +commendation +commendations +commended +commending +commends +comment +commentaries +commenting +comments +commerce +commingled +commiseration +commission +commissioners +commissions +commit +commits +committ +committed +committing +commix +commixed +commixtion +commixture +commodious +commodities +commodity +common +commonalty +commoner +commoners +commonly +commons +commonweal +commonwealth +commotion +commotions +commune +communicat +communicate +communication +communities +community +comonty +compact +companies +companion +companions +companionship +company +compar +comparative +compare +compared +comparing +comparison +comparisons +compartner +compass +compasses +compassing +compassion +compassionate +compeers +compel +compell +compelled +compelling +compels +compensation +competence +competency +competent +competitor +competitors +compil +compile +compiled +complain +complainer +complainest +complaining +complainings +complains +complaint +complaints +complement +complements +complete +complexion +complexioned +complexions +complices +complies +compliment +complimental +compliments +complot +complots +complotted +comply +compos +compose +composed +composition +compost +composture +composure +compound +compounded +compounds +comprehend +comprehended +comprehends +compremises +compris +comprising +compromis +compromise +compt +comptible +comptrollers +compulsatory +compulsion +compulsive +compunctious +computation +comrade +comrades +comutual +con +concave +concavities +conceal +concealed +concealing +concealment +concealments +conceals +conceit +conceited +conceitless +conceits +conceiv +conceive +conceived +conceives +conceiving +conception +conceptions +conceptious +concern +concernancy +concerneth +concerning +concernings +concerns +conclave +conclud +conclude +concluded +concludes +concluding +conclusion +conclusions +concolinel +concord +concubine +concupiscible +concupy +concur +concurring +concurs +condemn +condemnation +condemned +condemning +condemns +condescend +condign +condition +conditionally +conditions +condole +condolement +condoling +conduce +conduct +conducted +conducting +conductor +conduit +conduits +conected +coney +confection +confectionary +confections +confederacy +confederate +confederates +confer +conference +conferr +conferring +confess +confessed +confesses +confesseth +confessing +confession +confessions +confessor +confidence +confident +confidently +confin +confine +confined +confineless +confiners +confines +confining +confirm +confirmation +confirmations +confirmed +confirmer +confirmers +confirming +confirmities +confirms +confiscate +confiscated +confiscation +confixed +conflict +conflicting +conflicts +confluence +conflux +conform +conformable +confound +confounded +confounding +confounds +confront +confronted +confus +confused +confusedly +confusion +confusions +confutation +confutes +congeal +congealed +congealment +congee +conger +congest +congied +congratulate +congreeing +congreeted +congregate +congregated +congregation +congregations +congruent +congruing +conies +conjectural +conjecture +conjectures +conjoin +conjoined +conjoins +conjointly +conjunct +conjunction +conjunctive +conjur +conjuration +conjurations +conjure +conjured +conjurer +conjurers +conjures +conjuring +conjuro +conn +connected +connive +conqu +conquer +conquered +conquering +conqueror +conquerors +conquers +conquest +conquests +conquring +conrade +cons +consanguineous +consanguinity +conscienc +conscience +consciences +conscionable +consecrate +consecrated +consecrations +consent +consented +consenting +consents +consequence +consequences +consequently +conserve +conserved +conserves +consider +considerance +considerate +consideration +considerations +considered +considering +considerings +considers +consign +consigning +consist +consisteth +consisting +consistory +consists +consolate +consolation +consonancy +consonant +consort +consorted +consortest +conspectuities +conspir +conspiracy +conspirant +conspirator +conspirators +conspire +conspired +conspirers +conspires +conspiring +constable +constables +constance +constancies +constancy +constant +constantine +constantinople +constantly +constellation +constitution +constrain +constrained +constraineth +constrains +constraint +constring +construction +construe +consul +consuls +consulship +consulships +consult +consulting +consults +consum +consume +consumed +consumes +consuming +consummate +consummation +consumption +consumptions +contagion +contagious +contain +containing +contains +contaminate +contaminated +contemn +contemned +contemning +contemns +contemplate +contemplation +contemplative +contempt +contemptible +contempts +contemptuous +contemptuously +contend +contended +contending +contendon +content +contenta +contented +contenteth +contention +contentious +contentless +contento +contents +contest +contestation +continence +continency +continent +continents +continu +continual +continually +continuance +continuantly +continuate +continue +continued +continuer +continues +continuing +contract +contracted +contracting +contraction +contradict +contradicted +contradiction +contradicts +contraries +contrarieties +contrariety +contrarious +contrariously +contrary +contre +contribution +contributors +contrite +contriv +contrive +contrived +contriver +contrives +contriving +control +controll +controller +controlling +controlment +controls +controversy +contumelious +contumeliously +contumely +contusions +convenience +conveniences +conveniency +convenient +conveniently +convented +conventicles +convents +convers +conversant +conversation +conversations +converse +conversed +converses +conversing +conversion +convert +converted +convertest +converting +convertite +convertites +converts +convey +conveyance +conveyances +conveyers +conveying +convict +convicted +convince +convinced +convinces +convive +convocation +convoy +convulsions +cony +cook +cookery +cooks +cool +cooled +cooling +cools +coop +coops +cop +copatain +cope +cophetua +copied +copies +copious +copper +copperspur +coppice +copulation +copulatives +copy +cor +coragio +coral +coram +corambus +coranto +corantos +corbo +cord +corded +cordelia +cordial +cordis +cords +core +corin +corinth +corinthian +coriolanus +corioli +cork +corky +cormorant +corn +cornelia +cornelius +corner +corners +cornerstone +cornets +cornish +corns +cornuto +cornwall +corollary +coronal +coronation +coronet +coronets +corporal +corporals +corporate +corpse +corpulent +correct +corrected +correcting +correction +correctioner +corrects +correspondence +correspondent +corresponding +corresponsive +corrigible +corrival +corrivals +corroborate +corrosive +corrupt +corrupted +corrupter +corrupters +corruptible +corruptibly +corrupting +corruption +corruptly +corrupts +corse +corses +corslet +cosmo +cost +costard +costermongers +costlier +costly +costs +cot +cote +coted +cotsall +cotsole +cotswold +cottage +cottages +cotus +couch +couched +couching +couchings +coude +cough +coughing +could +couldst +coulter +council +councillor +councils +counsel +counsell +counsellor +counsellors +counselor +counselors +counsels +count +counted +countenanc +countenance +countenances +counter +counterchange +countercheck +counterfeit +counterfeited +counterfeiting +counterfeitly +counterfeits +countermand +countermands +countermines +counterpart +counterpoints +counterpois +counterpoise +counters +countervail +countess +countesses +counties +counting +countless +countries +countrv +country +countryman +countrymen +counts +county +couper +couple +coupled +couplement +couples +couplet +couplets +cour +courage +courageous +courageously +courages +courier +couriers +couronne +cours +course +coursed +courser +coursers +courses +coursing +court +courted +courteous +courteously +courtesan +courtesies +courtesy +courtezan +courtezans +courtier +courtiers +courtlike +courtly +courtney +courts +courtship +cousin +cousins +couterfeit +coutume +covenant +covenants +covent +coventry +cover +covered +covering +coverlet +covers +covert +covertly +coverture +covet +coveted +coveting +covetings +covetous +covetously +covetousness +covets +cow +coward +cowarded +cowardice +cowardly +cowards +cowardship +cowish +cowl +cowslip +cowslips +cox +coxcomb +coxcombs +coy +coystrill +coz +cozen +cozenage +cozened +cozener +cozeners +cozening +coziers +crab +crabbed +crabs +crack +cracked +cracker +crackers +cracking +cracks +cradle +cradled +cradles +craft +crafted +craftied +craftier +craftily +crafts +craftsmen +crafty +cram +cramm +cramp +cramps +crams +cranking +cranks +cranmer +crannied +crannies +cranny +crants +crare +crash +crassus +crav +crave +craved +craven +cravens +craves +craveth +craving +crawl +crawling +crawls +craz +crazed +crazy +creaking +cream +create +created +creates +creating +creation +creator +creature +creatures +credence +credent +credible +credit +creditor +creditors +credo +credulity +credulous +creed +creek +creeks +creep +creeping +creeps +crept +crescent +crescive +cressets +cressid +cressida +cressids +cressy +crest +crested +crestfall +crestless +crests +cretan +crete +crevice +crew +crews +crib +cribb +cribs +cricket +crickets +cried +criedst +crier +cries +criest +crieth +crime +crimeful +crimeless +crimes +criminal +crimson +cringe +cripple +crisp +crisped +crispian +crispianus +crispin +critic +critical +critics +croak +croaking +croaks +crocodile +cromer +cromwell +crone +crook +crookback +crooked +crooking +crop +cropp +crosby +cross +crossed +crosses +crossest +crossing +crossings +crossly +crossness +crost +crotchets +crouch +crouching +crow +crowd +crowded +crowding +crowds +crowflowers +crowing +crowkeeper +crown +crowned +crowner +crownet +crownets +crowning +crowns +crows +crudy +cruel +cruell +crueller +cruelly +cruels +cruelty +crum +crumble +crumbs +crupper +crusadoes +crush +crushed +crushest +crushing +crust +crusts +crusty +crutch +crutches +cry +crying +crystal +crystalline +crystals +cub +cubbert +cubiculo +cubit +cubs +cuckold +cuckoldly +cuckolds +cuckoo +cucullus +cudgel +cudgeled +cudgell +cudgelling +cudgels +cue +cues +cuff +cuffs +cuique +cull +culling +cullion +cullionly +cullions +culpable +culverin +cum +cumber +cumberland +cunning +cunningly +cunnings +cuore +cup +cupbearer +cupboarding +cupid +cupids +cuppele +cups +cur +curan +curate +curb +curbed +curbing +curbs +curd +curdied +curds +cure +cured +cureless +curer +cures +curfew +curing +curio +curiosity +curious +curiously +curl +curled +curling +curls +currance +currants +current +currents +currish +curry +curs +curse +cursed +curses +cursies +cursing +cursorary +curst +curster +curstest +curstness +cursy +curtail +curtain +curtains +curtal +curtis +curtle +curtsied +curtsies +curtsy +curvet +curvets +cushes +cushion +cushions +custalorum +custard +custody +custom +customary +customed +customer +customers +customs +custure +cut +cutler +cutpurse +cutpurses +cuts +cutter +cutting +cuttle +cxsar +cyclops +cydnus +cygnet +cygnets +cym +cymbals +cymbeline +cyme +cynic +cynthia +cypress +cypriot +cyprus +cyrus +cytherea +d +dabbled +dace +dad +daedalus +daemon +daff +daffed +daffest +daffodils +dagger +daggers +dagonet +daily +daintier +dainties +daintiest +daintily +daintiness +daintry +dainty +daisied +daisies +daisy +dale +dalliance +dallied +dallies +dally +dallying +dalmatians +dam +damage +damascus +damask +damasked +dame +dames +damm +damn +damnable +damnably +damnation +damned +damns +damoiselle +damon +damosella +damp +dams +damsel +damsons +dan +danc +dance +dancer +dances +dancing +dandle +dandy +dane +dang +danger +dangerous +dangerously +dangers +dangling +daniel +danish +dank +dankish +danskers +daphne +dappled +dapples +dar +dardan +dardanian +dardanius +dare +dared +dareful +dares +darest +daring +darius +dark +darken +darkening +darkens +darker +darkest +darkling +darkly +darkness +darling +darlings +darnel +darraign +dart +darted +darter +dartford +darting +darts +dash +dashes +dashing +dastard +dastards +dat +datchet +date +dated +dateless +dates +daub +daughter +daughters +daunt +daunted +dauntless +dauphin +daventry +davy +daw +dawn +dawning +daws +day +daylight +days +dazzle +dazzled +dazzling +de +dead +deadly +deaf +deafing +deafness +deafs +deal +dealer +dealers +dealest +dealing +dealings +deals +dealt +dean +deanery +dear +dearer +dearest +dearly +dearness +dears +dearth +dearths +death +deathbed +deathful +deaths +deathsman +deathsmen +debarred +debase +debate +debated +debatement +debateth +debating +debauch +debile +debility +debitor +debonair +deborah +debosh +debt +debted +debtor +debtors +debts +debuty +decay +decayed +decayer +decaying +decays +deceas +decease +deceased +deceit +deceitful +deceits +deceiv +deceivable +deceive +deceived +deceiver +deceivers +deceives +deceivest +deceiveth +deceiving +december +decent +deceptious +decerns +decide +decides +decimation +decipher +deciphers +decision +decius +deck +decking +decks +deckt +declare +declares +declension +declensions +declin +decline +declined +declines +declining +decoct +decorum +decreas +decrease +decreasing +decree +decreed +decrees +decrepit +dedicate +dedicated +dedicates +dedication +deed +deedless +deeds +deem +deemed +deep +deeper +deepest +deeply +deeps +deepvow +deer +deesse +defac +deface +defaced +defacer +defacers +defacing +defam +default +defeat +defeated +defeats +defeatures +defect +defective +defects +defence +defences +defend +defendant +defended +defender +defenders +defending +defends +defense +defensible +defensive +defer +deferr +defiance +deficient +defied +defies +defil +defile +defiler +defiles +defiling +define +definement +definite +definitive +definitively +deflow +deflower +deflowered +deform +deformed +deformities +deformity +deftly +defunct +defunction +defuse +defy +defying +degenerate +degraded +degree +degrees +deified +deifying +deign +deigned +deiphobus +deities +deity +deja +deject +dejected +delabreth +delay +delayed +delaying +delays +delectable +deliberate +delicate +delicates +delicious +deliciousness +delight +delighted +delightful +delights +delinquents +deliv +deliver +deliverance +delivered +delivering +delivers +delivery +delphos +deluded +deluding +deluge +delve +delver +delves +demand +demanded +demanding +demands +demean +demeanor +demeanour +demerits +demesnes +demetrius +demi +demigod +demise +demoiselles +demon +demonstrable +demonstrate +demonstrated +demonstrating +demonstration +demonstrative +demure +demurely +demuring +den +denay +deni +denial +denials +denied +denier +denies +deniest +denis +denmark +dennis +denny +denote +denoted +denotement +denounc +denounce +denouncing +dens +denunciation +deny +denying +deo +depart +departed +departest +departing +departure +depeche +depend +dependant +dependants +depended +dependence +dependences +dependency +dependent +dependents +depender +depending +depends +deplore +deploring +depopulate +depos +depose +deposed +deposing +depositaries +deprav +depravation +deprave +depraved +depraves +depress +depriv +deprive +depth +depths +deputation +depute +deputed +deputies +deputing +deputy +deracinate +derby +dercetas +dere +derides +derision +deriv +derivation +derivative +derive +derived +derives +derogate +derogately +derogation +des +desartless +descant +descend +descended +descending +descends +descension +descent +descents +describe +described +describes +descried +description +descriptions +descry +desdemon +desdemona +desert +deserts +deserv +deserve +deserved +deservedly +deserver +deservers +deserves +deservest +deserving +deservings +design +designment +designments +designs +desir +desire +desired +desirers +desires +desirest +desiring +desirous +desist +desk +desolate +desolation +desp +despair +despairing +despairs +despatch +desperate +desperately +desperation +despis +despise +despised +despiser +despiseth +despising +despite +despiteful +despoiled +dest +destin +destined +destinies +destiny +destitute +destroy +destroyed +destroyer +destroyers +destroying +destroys +destruction +destructions +det +detain +detains +detect +detected +detecting +detection +detector +detects +detention +determin +determinate +determination +determinations +determine +determined +determines +detest +detestable +detested +detesting +detests +detract +detraction +detractions +deucalion +deuce +deum +deux +devant +devesting +device +devices +devil +devilish +devils +devis +devise +devised +devises +devising +devoid +devonshire +devote +devoted +devotion +devour +devoured +devourers +devouring +devours +devout +devoutly +dew +dewberries +dewdrops +dewlap +dewlapp +dews +dewy +dexter +dexteriously +dexterity +di +diable +diablo +diadem +dial +dialect +dialogue +dialogued +dials +diameter +diamond +diamonds +dian +diana +diaper +dibble +dic +dice +dicers +dich +dick +dickens +dickon +dicky +dictator +diction +dictynna +did +diddle +didest +dido +didst +die +died +diedst +dies +diest +diet +dieted +dieter +dieu +diff +differ +difference +differences +differency +different +differing +differs +difficile +difficult +difficulties +difficulty +diffidence +diffidences +diffus +diffused +diffusest +dig +digest +digested +digestion +digestions +digg +digging +dighton +dignified +dignifies +dignify +dignities +dignity +digress +digressing +digression +digs +digt +dilate +dilated +dilations +dilatory +dild +dildos +dilemma +dilemmas +diligence +diligent +diluculo +dim +dimension +dimensions +diminish +diminishing +diminution +diminutive +diminutives +dimm +dimmed +dimming +dimpled +dimples +dims +din +dine +dined +diner +dines +ding +dining +dinner +dinners +dinnertime +dint +diomed +diomede +diomedes +dion +dip +dipp +dipping +dips +dir +dire +direct +directed +directing +direction +directions +directitude +directive +directly +directs +direful +direness +direst +dirge +dirges +dirt +dirty +dis +disability +disable +disabled +disabling +disadvantage +disagree +disallow +disanimates +disannul +disannuls +disappointed +disarm +disarmed +disarmeth +disarms +disaster +disasters +disastrous +disbench +disbranch +disburdened +disburs +disburse +disbursed +discandy +discandying +discard +discarded +discase +discased +discern +discerner +discerning +discernings +discerns +discharg +discharge +discharged +discharging +discipled +disciples +disciplin +discipline +disciplined +disciplines +disclaim +disclaiming +disclaims +disclos +disclose +disclosed +discloses +discolour +discoloured +discolours +discomfit +discomfited +discomfiture +discomfort +discomfortable +discommend +disconsolate +discontent +discontented +discontentedly +discontenting +discontents +discontinue +discontinued +discord +discordant +discords +discourse +discoursed +discourser +discourses +discoursive +discourtesy +discov +discover +discovered +discoverers +discoveries +discovering +discovers +discovery +discredit +discredited +discredits +discreet +discreetly +discretion +discretions +discuss +disdain +disdained +disdaineth +disdainful +disdainfully +disdaining +disdains +disdnguish +diseas +disease +diseased +diseases +disedg +disembark +disfigure +disfigured +disfurnish +disgorge +disgrac +disgrace +disgraced +disgraceful +disgraces +disgracing +disgracious +disguis +disguise +disguised +disguiser +disguises +disguising +dish +dishabited +dishclout +dishearten +disheartens +dishes +dishonest +dishonestly +dishonesty +dishonor +dishonorable +dishonors +dishonour +dishonourable +dishonoured +dishonours +disinherit +disinherited +disjoin +disjoining +disjoins +disjoint +disjunction +dislik +dislike +disliken +dislikes +dislimns +dislocate +dislodg +disloyal +disloyalty +dismal +dismantle +dismantled +dismask +dismay +dismayed +dismemb +dismember +dismes +dismiss +dismissed +dismissing +dismission +dismount +dismounted +disnatur +disobedience +disobedient +disobey +disobeys +disorb +disorder +disordered +disorderly +disorders +disparage +disparagement +disparagements +dispark +dispatch +dispensation +dispense +dispenses +dispers +disperse +dispersed +dispersedly +dispersing +dispiteous +displac +displace +displaced +displant +displanting +display +displayed +displeas +displease +displeased +displeasing +displeasure +displeasures +disponge +disport +disports +dispos +dispose +disposed +disposer +disposing +disposition +dispositions +dispossess +dispossessing +disprais +dispraise +dispraising +dispraisingly +dispropertied +disproportion +disproportioned +disprov +disprove +disproved +dispursed +disputable +disputation +disputations +dispute +disputed +disputes +disputing +disquantity +disquiet +disquietly +disrelish +disrobe +disseat +dissemble +dissembled +dissembler +dissemblers +dissembling +dissembly +dissension +dissensions +dissentious +dissever +dissipation +dissolute +dissolutely +dissolution +dissolutions +dissolv +dissolve +dissolved +dissolves +dissuade +dissuaded +distaff +distaffs +distain +distains +distance +distant +distaste +distasted +distasteful +distemp +distemper +distemperature +distemperatures +distempered +distempering +distil +distill +distillation +distilled +distills +distilment +distinct +distinction +distinctly +distingue +distinguish +distinguishes +distinguishment +distract +distracted +distractedly +distraction +distractions +distracts +distrain +distraught +distress +distressed +distresses +distressful +distribute +distributed +distribution +distrust +distrustful +disturb +disturbed +disturbers +disturbing +disunite +disvalued +disvouch +dit +ditch +ditchers +ditches +dites +ditties +ditty +diurnal +div +dive +diver +divers +diversely +diversity +divert +diverted +diverts +dives +divest +dividable +dividant +divide +divided +divides +divideth +divin +divination +divine +divinely +divineness +diviner +divines +divinest +divining +divinity +division +divisions +divorc +divorce +divorced +divorcement +divorcing +divulg +divulge +divulged +divulging +dizy +dizzy +do +doating +dobbin +dock +docks +doct +doctor +doctors +doctrine +document +dodge +doe +doer +doers +does +doest +doff +dog +dogberry +dogfish +dogg +dogged +dogs +doigts +doing +doings +doit +doits +dolabella +dole +doleful +doll +dollar +dollars +dolor +dolorous +dolour +dolours +dolphin +dolt +dolts +domestic +domestics +dominance +dominations +dominator +domine +domineer +domineering +dominical +dominion +dominions +domitius +dommelton +don +donalbain +donation +donc +doncaster +done +dong +donn +donne +donner +donnerai +doom +doomsday +door +doorkeeper +doors +dorcas +doreus +doricles +dormouse +dorothy +dorset +dorsetshire +dost +dotage +dotant +dotard +dotards +dote +doted +doters +dotes +doteth +doth +doting +double +doubled +doubleness +doubler +doublet +doublets +doubling +doubly +doubt +doubted +doubtful +doubtfully +doubting +doubtless +doubts +doug +dough +doughty +doughy +douglas +dout +doute +douts +dove +dovehouse +dover +doves +dow +dowager +dowdy +dower +dowerless +dowers +dowlas +dowle +down +downfall +downright +downs +downstairs +downtrod +downward +downwards +downy +dowries +dowry +dowsabel +doxy +dozed +dozen +dozens +dozy +drab +drabbing +drabs +drachma +drachmas +draff +drag +dragg +dragged +dragging +dragon +dragonish +dragons +drain +drained +drains +drake +dram +dramatis +drank +draught +draughts +drave +draw +drawbridge +drawer +drawers +draweth +drawing +drawling +drawn +draws +drayman +draymen +dread +dreaded +dreadful +dreadfully +dreading +dreads +dream +dreamer +dreamers +dreaming +dreams +dreamt +drearning +dreary +dreg +dregs +drench +drenched +dress +dressed +dresser +dressing +dressings +drest +drew +dribbling +dried +drier +dries +drift +drily +drink +drinketh +drinking +drinkings +drinks +driv +drive +drivelling +driven +drives +driveth +driving +drizzle +drizzled +drizzles +droit +drollery +dromio +dromios +drone +drones +droop +droopeth +drooping +droops +drop +dropheir +droplets +dropp +dropper +droppeth +dropping +droppings +drops +dropsied +dropsies +dropsy +dropt +dross +drossy +drought +drove +droven +drovier +drown +drowned +drowning +drowns +drows +drowse +drowsily +drowsiness +drowsy +drudge +drudgery +drudges +drug +drugg +drugs +drum +drumble +drummer +drumming +drums +drunk +drunkard +drunkards +drunken +drunkenly +drunkenness +dry +dryness +dst +du +dub +dubb +ducat +ducats +ducdame +duchess +duchies +duchy +duck +ducking +ducks +dudgeon +due +duellist +duello +duer +dues +duff +dug +dugs +duke +dukedom +dukedoms +dukes +dulcet +dulche +dull +dullard +duller +dullest +dulling +dullness +dulls +dully +dulness +duly +dumain +dumb +dumbe +dumbly +dumbness +dump +dumps +dun +duncan +dung +dungeon +dungeons +dunghill +dunghills +dungy +dunnest +dunsinane +dunsmore +dunstable +dupp +durance +during +durst +dusky +dust +dusted +dusty +dutch +dutchman +duteous +duties +dutiful +duty +dwarf +dwarfish +dwell +dwellers +dwelling +dwells +dwelt +dwindle +dy +dye +dyed +dyer +dying +e +each +eager +eagerly +eagerness +eagle +eagles +eaning +eanlings +ear +earing +earl +earldom +earlier +earliest +earliness +earls +early +earn +earned +earnest +earnestly +earnestness +earns +ears +earth +earthen +earthlier +earthly +earthquake +earthquakes +earthy +eas +ease +eased +easeful +eases +easier +easiest +easiliest +easily +easiness +easing +east +eastcheap +easter +eastern +eastward +easy +eat +eaten +eater +eaters +eating +eats +eaux +eaves +ebb +ebbing +ebbs +ebon +ebony +ebrew +ecce +echapper +echo +echoes +eclips +eclipse +eclipses +ecolier +ecoutez +ecstacy +ecstasies +ecstasy +ecus +eden +edg +edgar +edge +edged +edgeless +edges +edict +edicts +edifice +edifices +edified +edifies +edition +edm +edmund +edmunds +edmundsbury +educate +educated +education +edward +eel +eels +effect +effected +effectless +effects +effectual +effectually +effeminate +effigies +effus +effuse +effusion +eftest +egal +egally +eget +egeus +egg +eggs +eggshell +eglamour +eglantine +egma +ego +egregious +egregiously +egress +egypt +egyptian +egyptians +eie +eight +eighteen +eighth +eightpenny +eighty +eisel +either +eject +eke +el +elbe +elbow +elbows +eld +elder +elders +eldest +eleanor +elect +elected +election +elegancy +elegies +element +elements +elephant +elephants +elevated +eleven +eleventh +elf +elflocks +eliads +elinor +elizabeth +ell +elle +ellen +elm +eloquence +eloquent +else +elsewhere +elsinore +eltham +elves +elvish +ely +elysium +em +emballing +embalm +embalms +embark +embarked +embarquements +embassade +embassage +embassies +embassy +embattailed +embattl +embattle +embay +embellished +embers +emblaze +emblem +emblems +embodied +embold +emboldens +emboss +embossed +embounded +embowel +embowell +embrac +embrace +embraced +embracement +embracements +embraces +embracing +embrasures +embroider +embroidery +emhracing +emilia +eminence +eminent +eminently +emmanuel +emnity +empale +emperal +emperess +emperial +emperor +empery +emphasis +empire +empirics +empiricutic +empleached +employ +employed +employer +employment +employments +empoison +empress +emptied +emptier +empties +emptiness +empty +emptying +emulate +emulation +emulations +emulator +emulous +en +enact +enacted +enacts +enactures +enamell +enamelled +enamour +enamoured +enanmour +encamp +encamped +encave +enceladus +enchaf +enchafed +enchant +enchanted +enchanting +enchantingly +enchantment +enchantress +enchants +enchas +encircle +encircled +enclos +enclose +enclosed +encloses +encloseth +enclosing +enclouded +encompass +encompassed +encompasseth +encompassment +encore +encorporal +encount +encounter +encountered +encounters +encourage +encouraged +encouragement +encrimsoned +encroaching +encumb +end +endamage +endamagement +endanger +endart +endear +endeared +endeavour +endeavours +ended +ender +ending +endings +endite +endless +endow +endowed +endowments +endows +ends +endu +endue +endur +endurance +endure +endured +endures +enduring +endymion +eneas +enemies +enemy +enernies +enew +enfeebled +enfeebles +enfeoff +enfetter +enfoldings +enforc +enforce +enforced +enforcedly +enforcement +enforces +enforcest +enfranched +enfranchis +enfranchise +enfranchised +enfranchisement +enfreed +enfreedoming +engag +engage +engaged +engagements +engaging +engaol +engend +engender +engenders +engilds +engine +engineer +enginer +engines +engirt +england +english +englishman +englishmen +engluts +englutted +engraffed +engraft +engrafted +engrav +engrave +engross +engrossed +engrossest +engrossing +engrossments +enguard +enigma +enigmatical +enjoin +enjoined +enjoy +enjoyed +enjoyer +enjoying +enjoys +enkindle +enkindled +enlard +enlarg +enlarge +enlarged +enlargement +enlargeth +enlighten +enlink +enmesh +enmities +enmity +ennoble +ennobled +enobarb +enobarbus +enon +enormity +enormous +enough +enow +enpatron +enpierced +enquir +enquire +enquired +enrag +enrage +enraged +enrages +enrank +enrapt +enrich +enriched +enriches +enridged +enrings +enrob +enrobe +enroll +enrolled +enrooted +enrounded +enschedul +ensconce +ensconcing +enseamed +ensear +enseigne +enseignez +ensemble +enshelter +enshielded +enshrines +ensign +ensigns +enskied +ensman +ensnare +ensnared +ensnareth +ensteep +ensu +ensue +ensued +ensues +ensuing +enswathed +ent +entail +entame +entangled +entangles +entendre +enter +entered +entering +enterprise +enterprises +enters +entertain +entertained +entertainer +entertaining +entertainment +entertainments +enthrall +enthralled +enthron +enthroned +entice +enticements +enticing +entire +entirely +entitle +entitled +entitling +entomb +entombed +entrails +entrance +entrances +entrap +entrapp +entre +entreat +entreated +entreaties +entreating +entreatments +entreats +entreaty +entrench +entry +entwist +envelop +envenom +envenomed +envenoms +envied +envies +envious +enviously +environ +environed +envoy +envy +envying +enwheel +enwombed +enwraps +ephesian +ephesians +ephesus +epicure +epicurean +epicures +epicurism +epicurus +epidamnum +epidaurus +epigram +epilepsy +epileptic +epilogue +epilogues +epistles +epistrophus +epitaph +epitaphs +epithet +epitheton +epithets +epitome +equal +equalities +equality +equall +equally +equalness +equals +equinoctial +equinox +equipage +equity +equivocal +equivocate +equivocates +equivocation +equivocator +er +erbear +erbearing +erbears +erbeat +erblows +erboard +erborne +ercame +ercast +ercharg +ercharged +ercharging +ercles +ercome +ercover +ercrows +erdoing +ere +erebus +erect +erected +erecting +erection +erects +erewhile +erflourish +erflow +erflowing +erflows +erfraught +erga +ergalled +erglanced +ergo +ergone +ergrow +ergrown +ergrowth +erhang +erhanging +erhasty +erhear +erheard +eringoes +erjoy +erleap +erleaps +erleavens +erlook +erlooking +ermaster +ermengare +ermount +ern +ernight +eros +erpaid +erparted +erpast +erpays +erpeer +erperch +erpicturing +erpingham +erposting +erpow +erpress +erpressed +err +errand +errands +errant +errate +erraught +erreaches +erred +errest +erring +erroneous +error +errors +errs +errule +errun +erset +ershade +ershades +ershine +ershot +ersized +erskip +erslips +erspreads +erst +erstare +erstep +erstunk +ersway +ersways +erswell +erta +ertake +erteemed +erthrow +erthrown +erthrows +ertook +ertop +ertopping +ertrip +erturn +erudition +eruption +eruptions +ervalues +erwalk +erwatch +erween +erweens +erweigh +erweighs +erwhelm +erwhelmed +erworn +es +escalus +escap +escape +escaped +escapes +eschew +escoted +esill +especial +especially +esperance +espials +espied +espies +espous +espouse +espy +esquire +esquires +essay +essays +essence +essential +essentially +esses +essex +est +establish +established +estate +estates +esteem +esteemed +esteemeth +esteeming +esteems +estimable +estimate +estimation +estimations +estime +estranged +estridge +estridges +et +etc +etceteras +ete +eternal +eternally +eterne +eternity +eterniz +etes +ethiop +ethiope +ethiopes +ethiopian +etna +eton +etre +eunuch +eunuchs +euphrates +euphronius +euriphile +europa +europe +ev +evade +evades +evans +evasion +evasions +eve +even +evening +evenly +event +eventful +events +ever +everlasting +everlastingly +evermore +every +everyone +everything +everywhere +evidence +evidences +evident +evil +evilly +evils +evitate +ewe +ewer +ewers +ewes +exact +exacted +exactest +exacting +exaction +exactions +exactly +exacts +exalt +exalted +examin +examination +examinations +examine +examined +examines +exampl +example +exampled +examples +exasperate +exasperates +exceed +exceeded +exceedeth +exceeding +exceedingly +exceeds +excel +excelled +excellence +excellencies +excellency +excellent +excellently +excelling +excels +except +excepted +excepting +exception +exceptions +exceptless +excess +excessive +exchang +exchange +exchanged +exchequer +exchequers +excite +excited +excitements +excites +exclaim +exclaims +exclamation +exclamations +excludes +excommunicate +excommunication +excrement +excrements +excursion +excursions +excus +excusable +excuse +excused +excuses +excusez +excusing +execrable +execrations +execute +executed +executing +execution +executioner +executioners +executor +executors +exempt +exempted +exequies +exercise +exercises +exeter +exeunt +exhal +exhalation +exhalations +exhale +exhales +exhaust +exhibit +exhibiters +exhibition +exhort +exhortation +exigent +exil +exile +exiled +exion +exist +exists +exit +exits +exorciser +exorcisms +exorcist +expect +expectance +expectancy +expectation +expectations +expected +expecters +expecting +expects +expedience +expedient +expediently +expedition +expeditious +expel +expell +expelling +expels +expend +expense +expenses +experienc +experience +experiences +experiment +experimental +experiments +expert +expertness +expiate +expiation +expir +expiration +expire +expired +expires +expiring +explication +exploit +exploits +expos +expose +exposing +exposition +expositor +expostulate +expostulation +exposture +exposure +expound +expounded +express +expressed +expresseth +expressing +expressive +expressly +expressure +expuls +expulsion +exquisite +exsufflicate +extant +extemporal +extemporally +extempore +extend +extended +extends +extent +extenuate +extenuated +extenuates +extenuation +exterior +exteriorly +exteriors +extermin +extern +external +extinct +extincted +extincture +extinguish +extirp +extirpate +extirped +extol +extoll +extolment +exton +extort +extorted +extortion +extortions +extra +extract +extracted +extracting +extraordinarily +extraordinary +extraught +extravagancy +extravagant +extreme +extremely +extremes +extremest +extremities +extremity +exuent +exult +exultation +ey +eyas +eyases +eye +eyeball +eyeballs +eyebrow +eyebrows +eyed +eyeless +eyelid +eyelids +eyes +eyesight +eyestrings +eying +eyne +eyrie +fa +fabian +fable +fables +fabric +fabulous +fac +face +faced +facere +faces +faciant +facile +facility +facinerious +facing +facit +fact +faction +factionary +factions +factious +factor +factors +faculties +faculty +fade +faded +fadeth +fadge +fading +fadings +fadom +fadoms +fagot +fagots +fail +failing +fails +fain +faint +fainted +fainter +fainting +faintly +faintness +faints +fair +fairer +fairest +fairies +fairing +fairings +fairly +fairness +fairs +fairwell +fairy +fais +fait +faites +faith +faithful +faithfull +faithfully +faithless +faiths +faitors +fal +falchion +falcon +falconbridge +falconer +falconers +fall +fallacy +fallen +falleth +falliable +fallible +falling +fallow +fallows +falls +fally +falorous +false +falsehood +falsely +falseness +falser +falsify +falsing +falstaff +falstaffs +falter +fam +fame +famed +familiar +familiarity +familiarly +familiars +family +famine +famish +famished +famous +famoused +famously +fan +fanatical +fancies +fancy +fane +fanes +fang +fangled +fangless +fangs +fann +fanning +fans +fantasied +fantasies +fantastic +fantastical +fantastically +fantasticoes +fantasy +fap +far +farborough +farced +fardel +fardels +fare +fares +farewell +farewells +fariner +faring +farm +farmer +farmhouse +farms +farre +farrow +farther +farthest +farthing +farthingale +farthingales +farthings +fartuous +fas +fashion +fashionable +fashioning +fashions +fast +fasted +fasten +fastened +faster +fastest +fasting +fastly +fastolfe +fasts +fat +fatal +fatally +fate +fated +fates +father +fathered +fatherless +fatherly +fathers +fathom +fathomless +fathoms +fatigate +fatness +fats +fatted +fatter +fattest +fatting +fatuus +fauconbridge +faulconbridge +fault +faultiness +faultless +faults +faulty +fausse +fauste +faustuses +faut +favor +favorable +favorably +favors +favour +favourable +favoured +favouredly +favourer +favourers +favouring +favourite +favourites +favours +favout +fawn +fawneth +fawning +fawns +fay +fe +fealty +fear +feared +fearest +fearful +fearfull +fearfully +fearfulness +fearing +fearless +fears +feast +feasted +feasting +feasts +feat +feated +feater +feather +feathered +feathers +featly +feats +featur +feature +featured +featureless +features +february +fecks +fed +fedary +federary +fee +feeble +feebled +feebleness +feebling +feebly +feed +feeder +feeders +feedeth +feeding +feeds +feel +feeler +feeling +feelingly +feels +fees +feet +fehemently +feign +feigned +feigning +feil +feith +felicitate +felicity +fell +fellest +fellies +fellow +fellowly +fellows +fellowship +fellowships +fells +felon +felonious +felony +felt +female +females +feminine +fen +fenc +fence +fencer +fencing +fends +fennel +fenny +fens +fenton +fer +ferdinand +fere +fernseed +ferrara +ferrers +ferret +ferry +ferryman +fertile +fertility +fervency +fervour +fery +fest +feste +fester +festinate +festinately +festival +festivals +fet +fetch +fetches +fetching +fetlock +fetlocks +fett +fetter +fettering +fetters +fettle +feu +feud +fever +feverous +fevers +few +fewer +fewest +fewness +fickle +fickleness +fico +fiction +fiddle +fiddler +fiddlestick +fidele +fidelicet +fidelity +fidius +fie +field +fielded +fields +fiend +fiends +fierce +fiercely +fierceness +fiery +fife +fifes +fifteen +fifteens +fifteenth +fifth +fifty +fiftyfold +fig +fight +fighter +fightest +fighteth +fighting +fights +figo +figs +figur +figure +figured +figures +figuring +fike +fil +filberts +filch +filches +filching +file +filed +files +filial +filius +fill +filled +fillet +filling +fillip +fills +filly +film +fils +filth +filths +filthy +fin +finally +finch +find +finder +findeth +finding +findings +finds +fine +fineless +finely +finem +fineness +finer +fines +finest +fing +finger +fingering +fingers +fingre +fingres +finical +finish +finished +finisher +finless +finn +fins +finsbury +fir +firago +fire +firebrand +firebrands +fired +fires +firework +fireworks +firing +firk +firm +firmament +firmly +firmness +first +firstlings +fish +fisher +fishermen +fishers +fishes +fishified +fishmonger +fishpond +fisnomy +fist +fisting +fists +fistula +fit +fitchew +fitful +fitly +fitment +fitness +fits +fitted +fitter +fittest +fitteth +fitting +fitzwater +five +fivepence +fives +fix +fixed +fixes +fixeth +fixing +fixture +fl +flag +flagging +flagon +flagons +flags +flail +flakes +flaky +flam +flame +flamen +flamens +flames +flaming +flaminius +flanders +flannel +flap +flaring +flash +flashes +flashing +flask +flat +flatly +flatness +flats +flatt +flatter +flattered +flatterer +flatterers +flatterest +flatteries +flattering +flatters +flattery +flaunts +flavio +flavius +flaw +flaws +flax +flaxen +flay +flaying +flea +fleance +fleas +flecked +fled +fledge +flee +fleec +fleece +fleeces +fleer +fleering +fleers +fleet +fleeter +fleeting +fleming +flemish +flesh +fleshes +fleshly +fleshment +fleshmonger +flew +flexible +flexure +flibbertigibbet +flickering +flidge +fliers +flies +flieth +flight +flights +flighty +flinch +fling +flint +flints +flinty +flirt +float +floated +floating +flock +flocks +flood +floodgates +floods +floor +flora +florence +florentine +florentines +florentius +florizel +flote +floulish +flour +flourish +flourishes +flourisheth +flourishing +flout +flouted +flouting +flouts +flow +flowed +flower +flowerets +flowers +flowing +flown +flows +fluellen +fluent +flung +flush +flushing +fluster +flute +flutes +flutter +flux +fluxive +fly +flying +fo +foal +foals +foam +foamed +foaming +foams +foamy +fob +focative +fodder +foe +foeman +foemen +foes +fog +foggy +fogs +foh +foi +foil +foiled +foils +foin +foining +foins +fois +foison +foisons +foist +foix +fold +folded +folds +folio +folk +folks +follies +follow +followed +follower +followers +followest +following +follows +folly +fond +fonder +fondly +fondness +font +fontibell +food +fool +fooleries +foolery +foolhardy +fooling +foolish +foolishly +foolishness +fools +foot +football +footboy +footboys +footed +footfall +footing +footman +footmen +footpath +footsteps +footstool +fopp +fopped +foppery +foppish +fops +for +forage +foragers +forbade +forbear +forbearance +forbears +forbid +forbidden +forbiddenly +forbids +forbod +forborne +forc +force +forced +forceful +forceless +forces +forcible +forcibly +forcing +ford +fordid +fordo +fordoes +fordone +fore +forecast +forefather +forefathers +forefinger +forego +foregone +forehand +forehead +foreheads +forehorse +foreign +foreigner +foreigners +foreknowing +foreknowledge +foremost +forenamed +forenoon +forerun +forerunner +forerunning +foreruns +foresaid +foresaw +foresay +foresee +foreseeing +foresees +foreshow +foreskirt +forespent +forest +forestall +forestalled +forester +foresters +forests +foretell +foretelling +foretells +forethink +forethought +foretold +forever +foreward +forewarn +forewarned +forewarning +forfeit +forfeited +forfeiters +forfeiting +forfeits +forfeiture +forfeitures +forfend +forfended +forg +forgave +forge +forged +forgeries +forgery +forges +forget +forgetful +forgetfulness +forgetive +forgets +forgetting +forgive +forgiven +forgiveness +forgo +forgoing +forgone +forgot +forgotten +fork +forked +forks +forlorn +form +formal +formally +formed +former +formerly +formless +forms +fornication +fornications +fornicatress +forres +forrest +forsake +forsaken +forsaketh +forslow +forsook +forsooth +forspent +forspoke +forswear +forswearing +forswore +forsworn +fort +forted +forth +forthcoming +forthlight +forthright +forthwith +fortification +fortifications +fortified +fortifies +fortify +fortinbras +fortitude +fortnight +fortress +fortresses +forts +fortun +fortuna +fortunate +fortunately +fortune +fortuned +fortunes +fortward +forty +forum +forward +forwarding +forwardness +forwards +forwearied +fosset +fost +foster +fostered +fought +foughten +foul +fouler +foulest +foully +foulness +found +foundation +foundations +founded +founder +fount +fountain +fountains +founts +four +fourscore +fourteen +fourth +foutra +fowl +fowler +fowling +fowls +fox +foxes +foxship +fracted +fraction +fractions +fragile +fragment +fragments +fragrant +frail +frailer +frailties +frailty +fram +frame +framed +frames +frampold +fran +francais +france +frances +franchise +franchised +franchisement +franchises +franciae +francis +francisca +franciscan +francisco +frank +franker +frankfort +franklin +franklins +frankly +frankness +frantic +franticly +frateretto +fratrum +fraud +fraudful +fraught +fraughtage +fraughting +fray +frays +freckl +freckled +freckles +frederick +free +freed +freedom +freedoms +freehearted +freelier +freely +freeman +freemen +freeness +freer +frees +freestone +freetown +freeze +freezes +freezing +freezings +french +frenchman +frenchmen +frenchwoman +frenzy +frequent +frequents +fresh +fresher +freshes +freshest +freshly +freshness +fret +fretful +frets +fretted +fretten +fretting +friar +friars +friday +fridays +friend +friended +friending +friendless +friendliness +friendly +friends +friendship +friendships +frieze +fright +frighted +frightened +frightful +frighting +frights +fringe +fringed +frippery +frisk +fritters +frivolous +fro +frock +frog +frogmore +froissart +frolic +from +front +fronted +frontier +frontiers +fronting +frontlet +fronts +frost +frosts +frosty +froth +froward +frown +frowning +frowningly +frowns +froze +frozen +fructify +frugal +fruit +fruiterer +fruitful +fruitfully +fruitfulness +fruition +fruitless +fruits +frush +frustrate +frutify +fry +fubb +fuel +fugitive +fulfil +fulfill +fulfilling +fulfils +full +fullam +fuller +fullers +fullest +fullness +fully +fulness +fulsome +fulvia +fum +fumble +fumbles +fumblest +fumbling +fume +fumes +fuming +fumiter +fumitory +fun +function +functions +fundamental +funeral +funerals +fur +furbish +furies +furious +furlongs +furnace +furnaces +furnish +furnished +furnishings +furniture +furnival +furor +furr +furrow +furrowed +furrows +furth +further +furtherance +furtherer +furthermore +furthest +fury +furze +furzes +fust +fustian +fustilarian +fusty +fut +future +futurity +g +gabble +gaberdine +gabriel +gad +gadding +gads +gadshill +gag +gage +gaged +gagg +gaging +gagne +gain +gained +gainer +gaingiving +gains +gainsaid +gainsay +gainsaying +gainsays +gainst +gait +gaited +galathe +gale +galen +gales +gall +gallant +gallantly +gallantry +gallants +galled +gallery +galley +galleys +gallia +gallian +galliard +galliasses +gallimaufry +galling +gallons +gallop +galloping +gallops +gallow +galloway +gallowglasses +gallows +gallowses +galls +gallus +gam +gambol +gambold +gambols +gamboys +game +gamers +games +gamesome +gamester +gaming +gammon +gamut +gan +gangren +ganymede +gaol +gaoler +gaolers +gaols +gap +gape +gapes +gaping +gar +garb +garbage +garboils +garcon +gard +garde +garden +gardener +gardeners +gardens +gardez +gardiner +gardon +gargantua +gargrave +garish +garland +garlands +garlic +garment +garments +garmet +garner +garners +garnish +garnished +garret +garrison +garrisons +gart +garter +garterd +gartering +garters +gascony +gash +gashes +gaskins +gasp +gasping +gasted +gastness +gat +gate +gated +gates +gath +gather +gathered +gathering +gathers +gatories +gatory +gaud +gaudeo +gaudy +gauge +gaul +gaultree +gaunt +gauntlet +gauntlets +gav +gave +gavest +gawded +gawds +gawsey +gay +gayness +gaz +gaze +gazed +gazer +gazers +gazes +gazeth +gazing +gear +geck +geese +geffrey +geld +gelded +gelding +gelida +gelidus +gelt +gem +geminy +gems +gen +gender +genders +general +generally +generals +generation +generations +generative +generosity +generous +genitive +genitivo +genius +gennets +genoa +genoux +gens +gent +gentilhomme +gentility +gentle +gentlefolks +gentleman +gentlemanlike +gentlemen +gentleness +gentler +gentles +gentlest +gentlewoman +gentlewomen +gently +gentry +george +gerard +germaines +germains +german +germane +germans +germany +gertrude +gest +gests +gesture +gestures +get +getrude +gets +getter +getting +ghastly +ghost +ghosted +ghostly +ghosts +gi +giant +giantess +giantlike +giants +gib +gibber +gibbet +gibbets +gibe +giber +gibes +gibing +gibingly +giddily +giddiness +giddy +gift +gifts +gig +giglets +giglot +gilbert +gild +gilded +gilding +gilliams +gillian +gills +gillyvors +gilt +gimmal +gimmers +gin +ging +ginger +gingerbread +gingerly +ginn +gins +gioucestershire +gipes +gipsies +gipsy +gird +girded +girdle +girdled +girdles +girdling +girl +girls +girt +girth +gis +giv +give +given +giver +givers +gives +givest +giveth +giving +givings +glad +gladded +gladding +gladly +gladness +glamis +glanc +glance +glanced +glances +glancing +glanders +glansdale +glare +glares +glass +glasses +glassy +glaz +glazed +gleams +glean +gleaned +gleaning +gleeful +gleek +gleeking +gleeks +glend +glendower +glib +glide +glided +glides +glideth +gliding +glimmer +glimmering +glimmers +glimpse +glimpses +glist +glistening +glister +glistering +glisters +glitt +glittering +globe +globes +glooming +gloomy +glories +glorified +glorify +glorious +gloriously +glory +glose +gloss +glosses +glou +glouceste +gloucester +gloucestershire +glove +glover +gloves +glow +glowed +glowing +glowworm +gloz +gloze +glozes +glu +glue +glued +glues +glut +glutt +glutted +glutton +gluttoning +gluttony +gnarled +gnarling +gnat +gnats +gnaw +gnawing +gnawn +gnaws +go +goad +goaded +goads +goal +goat +goatish +goats +gobbets +gobbo +goblet +goblets +goblin +goblins +god +godded +godden +goddess +goddesses +goddild +godfather +godfathers +godhead +godlike +godliness +godly +godmother +gods +godson +goer +goers +goes +goest +goeth +goffe +gogs +going +gold +golden +goldenly +goldsmith +goldsmiths +golgotha +goliases +goliath +gon +gondola +gondolier +gone +goneril +gong +gonzago +gonzalo +good +goodfellow +goodlier +goodliest +goodly +goodman +goodness +goodnight +goodrig +goods +goodwife +goodwill +goodwin +goodwins +goodyear +goodyears +goose +gooseberry +goosequills +goot +gor +gorbellied +gorboduc +gordian +gore +gored +gorg +gorge +gorgeous +gorget +gorging +gorgon +gormandize +gormandizing +gory +gosling +gospel +gospels +goss +gossamer +gossip +gossiping +gossiplike +gossips +got +goth +goths +gotten +gourd +gout +gouts +gouty +govern +governance +governed +governess +government +governor +governors +governs +gower +gown +gowns +grac +grace +graced +graceful +gracefully +graceless +graces +gracing +gracious +graciously +gradation +graff +graffing +graft +grafted +grafters +grain +grained +grains +gramercies +gramercy +grammar +grand +grandam +grandame +grandchild +grande +grandeur +grandfather +grandjurors +grandmother +grandpre +grandsir +grandsire +grandsires +grange +grant +granted +granting +grants +grape +grapes +grapple +grapples +grappling +grasp +grasped +grasps +grass +grasshoppers +grassy +grate +grated +grateful +grates +gratiano +gratify +gratii +gratillity +grating +gratis +gratitude +gratulate +grav +grave +gravediggers +gravel +graveless +gravell +gravely +graven +graveness +graver +graves +gravest +gravestone +gravities +gravity +gravy +gray +graymalkin +graz +graze +grazed +grazing +grease +greases +greasily +greasy +great +greater +greatest +greatly +greatness +grecian +grecians +gree +greece +greed +greedily +greediness +greedy +greeing +greek +greekish +greeks +green +greener +greenly +greens +greensleeves +greenwich +greenwood +greet +greeted +greeting +greetings +greets +greg +gregory +gremio +grew +grey +greybeard +greybeards +greyhound +greyhounds +grief +griefs +griev +grievance +grievances +grieve +grieved +grieves +grievest +grieving +grievingly +grievous +grievously +griffin +griffith +grim +grime +grimly +grin +grind +grinding +grindstone +grinning +grip +gripe +gripes +griping +grise +grisly +grissel +grize +grizzle +grizzled +groan +groaning +groans +groat +groats +groin +groom +grooms +grop +groping +gros +gross +grosser +grossly +grossness +ground +grounded +groundlings +grounds +grove +grovel +grovelling +groves +grow +groweth +growing +grown +grows +growth +grub +grubb +grubs +grudge +grudged +grudges +grudging +gruel +grumble +grumblest +grumbling +grumblings +grumio +grund +grunt +gualtier +guard +guardage +guardant +guarded +guardian +guardians +guards +guardsman +gud +gudgeon +guerdon +guerra +guess +guesses +guessingly +guest +guests +guiana +guichard +guide +guided +guider +guiderius +guides +guiding +guidon +guienne +guil +guildenstern +guilders +guildford +guildhall +guile +guiled +guileful +guilfords +guilt +guiltian +guiltier +guiltily +guiltiness +guiltless +guilts +guilty +guinea +guinever +guise +gul +gules +gulf +gulfs +gull +gulls +gum +gumm +gums +gun +gunner +gunpowder +guns +gurnet +gurney +gust +gusts +gusty +guts +gutter +guy +guynes +guysors +gypsy +gyve +gyved +gyves +h +ha +haberdasher +habiliment +habiliments +habit +habitation +habited +habits +habitude +hack +hacket +hackney +hacks +had +hadst +haec +haeres +hag +hagar +haggard +haggards +haggish +haggled +hags +hail +hailed +hailstone +hailstones +hair +hairless +hairs +hairy +hal +halberd +halberds +halcyon +hale +haled +hales +half +halfcan +halfpence +halfpenny +halfpennyworth +halfway +halidom +hall +halloa +halloing +hallond +halloo +hallooing +hallow +hallowed +hallowmas +hallown +hals +halt +halter +halters +halting +halts +halves +ham +hames +hamlet +hammer +hammered +hammering +hammers +hamper +hampton +hams +hamstring +hand +handed +handful +handicraft +handicraftsmen +handing +handiwork +handkercher +handkerchers +handkerchief +handle +handled +handles +handless +handlest +handling +handmaid +handmaids +hands +handsaw +handsome +handsomely +handsomeness +handwriting +handy +hang +hanged +hangers +hangeth +hanging +hangings +hangman +hangmen +hangs +hannibal +hap +hapless +haply +happ +happen +happened +happier +happies +happiest +happily +happiness +happy +haps +harbinger +harbingers +harbor +harbour +harbourage +harbouring +harbours +harcourt +hard +harder +hardest +hardiest +hardiment +hardiness +hardly +hardness +hardocks +hardy +hare +harelip +hares +harfleur +hark +harlot +harlotry +harlots +harm +harmed +harmful +harming +harmless +harmonious +harmony +harms +harness +harp +harper +harpier +harping +harpy +harried +harrow +harrows +harry +harsh +harshly +harshness +hart +harts +harum +harvest +has +hast +haste +hasted +hasten +hastes +hastily +hasting +hastings +hasty +hat +hatch +hatches +hatchet +hatching +hatchment +hate +hated +hateful +hater +haters +hates +hateth +hatfield +hath +hating +hatred +hats +haud +hauf +haught +haughtiness +haughty +haunch +haunches +haunt +haunted +haunting +haunts +hautboy +hautboys +have +haven +havens +haver +having +havings +havior +haviour +havoc +hawk +hawking +hawks +hawthorn +hawthorns +hay +hazard +hazarded +hazards +hazel +hazelnut +he +head +headborough +headed +headier +heading +headland +headless +headlong +heads +headsman +headstrong +heady +heal +healed +healing +heals +health +healthful +healths +healthsome +healthy +heap +heaping +heaps +hear +heard +hearer +hearers +hearest +heareth +hearing +hearings +heark +hearken +hearkens +hears +hearsay +hearse +hearsed +hearst +heart +heartache +heartbreak +heartbreaking +hearted +hearten +hearth +hearths +heartily +heartiness +heartless +heartlings +heartly +hearts +heartsick +heartstrings +hearty +heat +heated +heath +heathen +heathenish +heating +heats +heauties +heav +heave +heaved +heaven +heavenly +heavens +heaves +heavier +heaviest +heavily +heaviness +heaving +heavings +heavy +hebona +hebrew +hecate +hectic +hector +hectors +hecuba +hedg +hedge +hedgehog +hedgehogs +hedges +heed +heeded +heedful +heedfull +heedfully +heedless +heel +heels +hefted +hefts +heifer +heifers +heigh +height +heighten +heinous +heinously +heir +heiress +heirless +heirs +held +helen +helena +helenus +helias +helicons +hell +hellespont +hellfire +hellish +helm +helmed +helmet +helmets +helms +help +helper +helpers +helpful +helping +helpless +helps +helter +hem +heme +hemlock +hemm +hemp +hempen +hems +hen +hence +henceforth +henceforward +henchman +henri +henricus +henry +hens +hent +henton +her +herald +heraldry +heralds +herb +herbert +herblets +herbs +herculean +hercules +herd +herds +herdsman +herdsmen +here +hereabout +hereabouts +hereafter +hereby +hereditary +hereford +herefordshire +herein +hereof +heresies +heresy +heretic +heretics +hereto +hereupon +heritage +heritier +hermes +hermia +hermione +hermit +hermitage +hermits +herne +hero +herod +herods +heroes +heroic +heroical +herring +herrings +hers +herself +hesperides +hesperus +hest +hests +heure +heureux +hew +hewgh +hewing +hewn +hews +hey +heyday +hibocrates +hic +hiccups +hick +hid +hidden +hide +hideous +hideously +hideousness +hides +hidest +hiding +hie +hied +hiems +hies +hig +high +higher +highest +highly +highmost +highness +hight +highway +highways +hilding +hildings +hill +hillo +hilloa +hills +hilt +hilts +hily +him +himself +hinc +hinckley +hind +hinder +hindered +hinders +hindmost +hinds +hing +hinge +hinges +hint +hip +hipp +hipparchus +hippolyta +hips +hir +hire +hired +hiren +hirtius +his +hisperia +hiss +hisses +hissing +hist +historical +history +hit +hither +hitherto +hitherward +hitherwards +hits +hitting +hive +hives +hizzing +ho +hoa +hoar +hoard +hoarded +hoarding +hoars +hoarse +hoary +hob +hobbididence +hobby +hobbyhorse +hobgoblin +hobnails +hoc +hod +hodge +hog +hogs +hogshead +hogsheads +hois +hoise +hoist +hoisted +hoists +holborn +hold +holden +holder +holdeth +holdfast +holding +holds +hole +holes +holidam +holidame +holiday +holidays +holier +holiest +holily +holiness +holla +holland +hollander +hollanders +holloa +holloaing +hollow +hollowly +hollowness +holly +holmedon +holofernes +holp +holy +homage +homager +home +homely +homes +homespuns +homeward +homewards +homicide +homicides +homily +hominem +hommes +homo +honest +honester +honestest +honestly +honesty +honey +honeycomb +honeying +honeyless +honeysuckle +honeysuckles +honi +honneur +honor +honorable +honorably +honorato +honorificabilitudinitatibus +honors +honour +honourable +honourably +honoured +honourest +honourible +honouring +honours +hoo +hood +hooded +hoodman +hoods +hoodwink +hoof +hoofs +hook +hooking +hooks +hoop +hoops +hoot +hooted +hooting +hoots +hop +hope +hopeful +hopeless +hopes +hopest +hoping +hopkins +hoppedance +hor +horace +horatio +horizon +horn +hornbook +horned +horner +horning +hornpipes +horns +horologe +horrible +horribly +horrid +horrider +horridly +horror +horrors +hors +horse +horseback +horsed +horsehairs +horseman +horsemanship +horsemen +horses +horseway +horsing +hortensio +hortensius +horum +hose +hospitable +hospital +hospitality +host +hostage +hostages +hostess +hostile +hostility +hostilius +hosts +hot +hotly +hotspur +hotter +hottest +hound +hounds +hour +hourly +hours +hous +house +household +householder +householders +households +housekeeper +housekeepers +housekeeping +houseless +houses +housewife +housewifery +housewives +hovel +hover +hovered +hovering +hovers +how +howbeit +howe +howeer +however +howl +howled +howlet +howling +howls +howsoe +howsoever +howsome +hoxes +hoy +hoyday +hubert +huddled +huddling +hue +hued +hues +hug +huge +hugely +hugeness +hugg +hugger +hugh +hugs +hujus +hulk +hulks +hull +hulling +hullo +hum +human +humane +humanely +humanity +humble +humbled +humbleness +humbler +humbles +humblest +humbling +humbly +hume +humh +humidity +humility +humming +humor +humorous +humors +humour +humourists +humours +humphrey +humphry +hums +hundred +hundreds +hundredth +hung +hungarian +hungary +hunger +hungerford +hungerly +hungry +hunt +hunted +hunter +hunters +hunteth +hunting +huntington +huntress +hunts +huntsman +huntsmen +hurdle +hurl +hurling +hurls +hurly +hurlyburly +hurricano +hurricanoes +hurried +hurries +hurry +hurt +hurting +hurtled +hurtless +hurtling +hurts +husband +husbanded +husbandless +husbandry +husbands +hush +hushes +husht +husks +huswife +huswifes +hutch +hybla +hydra +hyen +hymen +hymenaeus +hymn +hymns +hyperboles +hyperbolical +hyperion +hypocrisy +hypocrite +hypocrites +hyrcan +hyrcania +hyrcanian +hyssop +hysterica +i +iachimo +iaculis +iago +iament +ibat +icarus +ice +iceland +ici +icicle +icicles +icy +idea +ideas +idem +iden +ides +idiot +idiots +idle +idleness +idles +idly +idol +idolatrous +idolatry +ield +if +ifs +ignis +ignoble +ignobly +ignominious +ignominy +ignomy +ignorance +ignorant +ii +iii +iiii +il +ilbow +ild +ilion +ilium +ill +illegitimate +illiterate +illness +illo +ills +illume +illumin +illuminate +illumineth +illusion +illusions +illustrate +illustrated +illustrious +illyria +illyrian +ils +im +image +imagery +images +imagin +imaginary +imagination +imaginations +imagine +imagining +imaginings +imbar +imbecility +imbrue +imitari +imitate +imitated +imitation +imitations +immaculate +immanity +immask +immaterial +immediacy +immediate +immediately +imminence +imminent +immoderate +immoderately +immodest +immoment +immortal +immortaliz +immortally +immur +immured +immures +imogen +imp +impaint +impair +impairing +impale +impaled +impanelled +impart +imparted +impartial +impartment +imparts +impasted +impatience +impatient +impatiently +impawn +impeach +impeached +impeachment +impeachments +impedes +impediment +impediments +impenetrable +imperator +imperceiverant +imperfect +imperfection +imperfections +imperfectly +imperial +imperious +imperiously +impertinency +impertinent +impeticos +impetuosity +impetuous +impieties +impiety +impious +implacable +implements +implies +implor +implorators +implore +implored +imploring +impon +import +importance +importancy +important +importantly +imported +importeth +importing +importless +imports +importun +importunacy +importunate +importune +importunes +importunity +impos +impose +imposed +imposition +impositions +impossibilities +impossibility +impossible +imposthume +impostor +impostors +impotence +impotent +impounded +impregnable +imprese +impress +impressed +impressest +impression +impressure +imprimendum +imprimis +imprint +imprinted +imprison +imprisoned +imprisoning +imprisonment +improbable +improper +improve +improvident +impudence +impudency +impudent +impudently +impudique +impugn +impugns +impure +imputation +impute +in +inaccessible +inaidable +inaudible +inauspicious +incaged +incantations +incapable +incardinate +incarnadine +incarnate +incarnation +incens +incense +incensed +incensement +incenses +incensing +incertain +incertainties +incertainty +incessant +incessantly +incest +incestuous +inch +incharitable +inches +incidency +incident +incision +incite +incites +incivil +incivility +inclin +inclinable +inclination +incline +inclined +inclines +inclining +inclips +include +included +includes +inclusive +incomparable +incomprehensible +inconsiderate +inconstancy +inconstant +incontinency +incontinent +incontinently +inconvenience +inconveniences +inconvenient +incony +incorporate +incorps +incorrect +increas +increase +increases +increaseth +increasing +incredible +incredulous +incur +incurable +incurr +incurred +incursions +ind +inde +indebted +indeed +indent +indented +indenture +indentures +index +indexes +india +indian +indict +indicted +indictment +indies +indifferency +indifferent +indifferently +indigent +indigest +indigested +indign +indignation +indignations +indigne +indignities +indignity +indirect +indirection +indirections +indirectly +indiscreet +indiscretion +indispos +indisposition +indissoluble +indistinct +indistinguish +indistinguishable +indited +individable +indrench +indu +indubitate +induc +induce +induced +inducement +induction +inductions +indue +indued +indues +indulgence +indulgences +indulgent +indurance +industrious +industriously +industry +inequality +inestimable +inevitable +inexecrable +inexorable +inexplicable +infallible +infallibly +infamonize +infamous +infamy +infancy +infant +infants +infect +infected +infecting +infection +infections +infectious +infectiously +infects +infer +inference +inferior +inferiors +infernal +inferr +inferreth +inferring +infest +infidel +infidels +infinite +infinitely +infinitive +infirm +infirmities +infirmity +infixed +infixing +inflam +inflame +inflaming +inflammation +inflict +infliction +influence +influences +infold +inform +informal +information +informations +informed +informer +informs +infortunate +infring +infringe +infringed +infus +infuse +infused +infusing +infusion +ingener +ingenious +ingeniously +inglorious +ingots +ingraffed +ingraft +ingrate +ingrated +ingrateful +ingratitude +ingratitudes +ingredient +ingredients +ingross +inhabit +inhabitable +inhabitants +inhabited +inhabits +inhearse +inhearsed +inherent +inherit +inheritance +inherited +inheriting +inheritor +inheritors +inheritrix +inherits +inhibited +inhibition +inhoop +inhuman +iniquities +iniquity +initiate +injointed +injunction +injunctions +injur +injure +injurer +injuries +injurious +injury +injustice +ink +inkhorn +inkle +inkles +inkling +inky +inlaid +inland +inlay +inly +inmost +inn +inner +innkeeper +innocence +innocency +innocent +innocents +innovation +innovator +inns +innumerable +inoculate +inordinate +inprimis +inquir +inquire +inquiry +inquisition +inquisitive +inroads +insane +insanie +insatiate +insconce +inscrib +inscription +inscriptions +inscroll +inscrutable +insculp +insculpture +insensible +inseparable +inseparate +insert +inserted +inset +inshell +inshipp +inside +insinewed +insinuate +insinuateth +insinuating +insinuation +insisted +insisting +insisture +insociable +insolence +insolent +insomuch +inspir +inspiration +inspirations +inspire +inspired +install +installed +instalment +instance +instances +instant +instantly +instate +instead +insteeped +instigate +instigated +instigation +instigations +instigator +instinct +instinctively +institute +institutions +instruct +instructed +instruction +instructions +instructs +instrument +instrumental +instruments +insubstantial +insufficience +insufficiency +insult +insulted +insulting +insultment +insults +insupportable +insuppressive +insurrection +insurrections +int +integer +integritas +integrity +intellect +intellects +intellectual +intelligence +intelligencer +intelligencing +intelligent +intelligis +intelligo +intemperance +intemperate +intend +intended +intendeth +intending +intendment +intends +intenible +intent +intention +intentively +intents +inter +intercept +intercepted +intercepter +interception +intercepts +intercession +intercessors +interchained +interchang +interchange +interchangeably +interchangement +interchanging +interdiction +interest +interim +interims +interior +interjections +interjoin +interlude +intermingle +intermission +intermissive +intermit +intermix +intermixed +interpose +interposer +interposes +interpret +interpretation +interpreted +interpreter +interpreters +interprets +interr +interred +interrogatories +interrupt +interrupted +interrupter +interruptest +interruption +interrupts +intertissued +intervallums +interview +intestate +intestine +intil +intimate +intimation +intitled +intituled +into +intolerable +intoxicates +intreasured +intreat +intrench +intrenchant +intricate +intrinse +intrinsicate +intrude +intruder +intruding +intrusion +inundation +inure +inurn +invade +invades +invasion +invasive +invectively +invectives +inveigled +invent +invented +invention +inventions +inventor +inventorially +inventoried +inventors +inventory +inverness +invert +invest +invested +investing +investments +inveterate +invincible +inviolable +invised +invisible +invitation +invite +invited +invites +inviting +invitis +invocate +invocation +invoke +invoked +invulnerable +inward +inwardly +inwardness +inwards +ionia +ionian +ipse +ipswich +ira +irae +iras +ire +ireful +ireland +iris +irish +irishman +irishmen +irks +irksome +iron +irons +irreconcil +irrecoverable +irregular +irregulous +irreligious +irremovable +irreparable +irresolute +irrevocable +is +isabel +isabella +isbel +isbels +iscariot +ise +ish +isidore +isis +island +islander +islanders +islands +isle +isles +israel +issu +issue +issued +issueless +issues +issuing +ist +ista +it +italian +italy +itch +itches +itching +item +items +iteration +ithaca +its +itself +itshall +iv +ivory +ivy +iwis +ix +j +jacet +jack +jackanapes +jacks +jacksauce +jackslave +jacob +jade +jaded +jades +jail +jakes +jamany +james +jamy +jane +jangled +jangling +january +janus +japhet +jaquenetta +jaques +jar +jarring +jars +jarteer +jasons +jaunce +jauncing +jaundice +jaundies +jaw +jawbone +jaws +jay +jays +jc +je +jealous +jealousies +jealousy +jeer +jeering +jelly +jenny +jeopardy +jephtha +jephthah +jerkin +jerkins +jerks +jeronimy +jerusalem +jeshu +jesses +jessica +jest +jested +jester +jesters +jesting +jests +jesu +jesus +jet +jets +jew +jewel +jeweller +jewels +jewess +jewish +jewry +jews +jezebel +jig +jigging +jill +jills +jingling +joan +job +jockey +jocund +jog +jogging +john +johns +join +joinder +joined +joiner +joineth +joins +joint +jointed +jointing +jointly +jointress +joints +jointure +jollity +jolly +jolt +joltheads +jordan +joseph +joshua +jot +jour +jourdain +journal +journey +journeying +journeyman +journeymen +journeys +jove +jovem +jovial +jowl +jowls +joy +joyed +joyful +joyfully +joyless +joyous +joys +juan +jud +judas +judases +jude +judg +judge +judged +judgement +judges +judgest +judging +judgment +judgments +judicious +jug +juggle +juggled +juggler +jugglers +juggling +jugs +juice +juiced +jul +jule +julia +juliet +julietta +julio +julius +july +jump +jumpeth +jumping +jumps +june +junes +junior +junius +junkets +juno +jupiter +jure +jurement +jurisdiction +juror +jurors +jury +jurymen +just +justeius +justest +justice +justicer +justicers +justices +justification +justified +justify +justle +justled +justles +justling +justly +justness +justs +jutting +jutty +juvenal +kam +kate +kated +kates +katharine +katherina +katherine +kecksies +keech +keel +keels +keen +keenness +keep +keepdown +keeper +keepers +keepest +keeping +keeps +keiser +ken +kendal +kennel +kent +kentish +kentishman +kentishmen +kept +kerchief +kerely +kern +kernal +kernel +kernels +kerns +kersey +kettle +kettledrum +kettledrums +key +keys +kibe +kibes +kick +kicked +kickshaws +kickshawses +kicky +kid +kidney +kikely +kildare +kill +killed +killer +killeth +killing +killingworth +kills +kiln +kimbolton +kin +kind +kinder +kindest +kindle +kindled +kindless +kindlier +kindling +kindly +kindness +kindnesses +kindred +kindreds +kinds +kine +king +kingdom +kingdoms +kingly +kings +kinred +kins +kinsman +kinsmen +kinswoman +kirtle +kirtles +kiss +kissed +kisses +kissing +kitchen +kitchens +kite +kites +kitten +kj +kl +klll +knack +knacks +knapp +knav +knave +knaveries +knavery +knaves +knavish +knead +kneaded +kneading +knee +kneel +kneeling +kneels +knees +knell +knew +knewest +knife +knight +knighted +knighthood +knighthoods +knightly +knights +knit +knits +knitters +knitteth +knives +knobs +knock +knocking +knocks +knog +knoll +knot +knots +knotted +knotty +know +knower +knowest +knowing +knowingly +knowings +knowledge +known +knows +l +la +laban +label +labell +labienus +labio +labor +laboring +labors +labour +laboured +labourer +labourers +labouring +labours +laboursome +labras +labyrinth +lac +lace +laced +lacedaemon +laces +lacies +lack +lackbeard +lacked +lackey +lackeying +lackeys +lacking +lacks +lad +ladder +ladders +lade +laden +ladies +lading +lads +lady +ladybird +ladyship +ladyships +laer +laertes +lafeu +lag +lagging +laid +lain +laissez +lake +lakes +lakin +lam +lamb +lambert +lambkin +lambkins +lambs +lame +lamely +lameness +lament +lamentable +lamentably +lamentation +lamentations +lamented +lamenting +lamentings +laments +lames +laming +lammas +lammastide +lamound +lamp +lampass +lamps +lanc +lancaster +lance +lances +lanceth +lanch +land +landed +landing +landless +landlord +landmen +lands +lane +lanes +langage +langley +langton +language +languageless +languages +langues +languish +languished +languishes +languishing +languishings +languishment +languor +lank +lantern +lanterns +lanthorn +lap +lapis +lapland +lapp +laps +lapse +lapsed +lapsing +lapwing +laquais +larded +larder +larding +lards +large +largely +largeness +larger +largess +largest +lark +larks +larron +lartius +larum +larums +las +lascivious +lash +lass +lasses +last +lasted +lasting +lastly +lasts +latch +latches +late +lated +lately +later +latest +lath +latin +latten +latter +lattice +laud +laudable +laudis +laugh +laughable +laughed +laugher +laughest +laughing +laughs +laughter +launce +launcelot +launces +launch +laund +laundress +laundry +laur +laura +laurel +laurels +laurence +laus +lavache +lave +lavee +lavender +lavina +lavinia +lavish +lavishly +lavolt +lavoltas +law +lawful +lawfully +lawless +lawlessly +lawn +lawns +lawrence +laws +lawyer +lawyers +lay +layer +layest +laying +lays +lazar +lazars +lazarus +lazy +lc +ld +ldst +le +lead +leaden +leader +leaders +leadest +leading +leads +leaf +leagu +league +leagued +leaguer +leagues +leah +leak +leaky +lean +leander +leaner +leaning +leanness +leans +leap +leaped +leaping +leaps +leapt +lear +learn +learned +learnedly +learning +learnings +learns +learnt +leas +lease +leases +leash +leasing +least +leather +leathern +leav +leave +leaven +leavening +leaver +leaves +leaving +leavy +lecher +lecherous +lechers +lechery +lecon +lecture +lectures +led +leda +leech +leeches +leek +leeks +leer +leers +lees +leese +leet +leets +left +leg +legacies +legacy +legate +legatine +lege +legerity +leges +legg +legion +legions +legitimate +legitimation +legs +leicester +leicestershire +leiger +leigers +leisure +leisurely +leisures +leman +lemon +lena +lend +lender +lending +lendings +lends +length +lengthen +lengthens +lengths +lenity +lennox +lent +lenten +lentus +leo +leon +leonardo +leonati +leonato +leonatus +leontes +leopard +leopards +leper +leperous +lepidus +leprosy +lequel +lers +les +less +lessen +lessens +lesser +lesson +lessoned +lessons +lest +lestrake +let +lethargied +lethargies +lethargy +lethe +lets +lett +letter +letters +letting +lettuce +leur +leve +level +levell +levelled +levels +leven +levers +leviathan +leviathans +levied +levies +levity +levy +levying +lewd +lewdly +lewdness +lewdsters +lewis +liable +liar +liars +libbard +libelling +libels +liberal +liberality +liberte +liberties +libertine +libertines +liberty +library +libya +licence +licens +license +licentious +lichas +licio +lick +licked +licker +lictors +lid +lids +lie +lied +lief +liefest +liege +liegeman +liegemen +lien +lies +liest +lieth +lieu +lieutenant +lieutenantry +lieutenants +lieve +life +lifeblood +lifeless +lifelings +lift +lifted +lifter +lifteth +lifting +lifts +lig +ligarius +liggens +light +lighted +lighten +lightens +lighter +lightest +lightly +lightness +lightning +lightnings +lights +lik +like +liked +likeliest +likelihood +likelihoods +likely +likeness +liker +likes +likest +likewise +liking +likings +lilies +lily +lim +limander +limb +limbeck +limbecks +limber +limbo +limbs +lime +limed +limehouse +limekilns +limit +limitation +limited +limits +limn +limp +limping +limps +lin +lincoln +lincolnshire +line +lineal +lineally +lineament +lineaments +lined +linen +linens +lines +ling +lingare +linger +lingered +lingers +linguist +lining +link +links +linsey +linstock +linta +lion +lionel +lioness +lions +lip +lipp +lips +lipsbury +liquid +liquor +liquorish +liquors +lirra +lisbon +lisp +lisping +list +listen +listening +lists +literatured +lither +litter +little +littlest +liv +live +lived +livelier +livelihood +livelong +lively +liver +liveries +livers +livery +lives +livest +liveth +livia +living +livings +lizard +lizards +ll +lll +llous +lnd +lo +loa +loach +load +loaden +loading +loads +loaf +loam +loan +loath +loathe +loathed +loather +loathes +loathing +loathly +loathness +loathsome +loathsomeness +loathsomest +loaves +lob +lobbies +lobby +local +lochaber +lock +locked +locking +lockram +locks +locusts +lode +lodg +lodge +lodged +lodgers +lodges +lodging +lodgings +lodovico +lodowick +lofty +log +logger +loggerhead +loggerheads +loggets +logic +logs +loins +loiter +loiterer +loiterers +loitering +lolling +lolls +lombardy +london +londoners +lone +loneliness +lonely +long +longaville +longboat +longed +longer +longest +longeth +longing +longings +longly +longs +longtail +loo +loof +look +looked +looker +lookers +lookest +looking +looks +loon +loop +loos +loose +loosed +loosely +loosen +loosing +lop +lopp +loquitur +lord +lorded +lording +lordings +lordliness +lordly +lords +lordship +lordships +lorenzo +lorn +lorraine +lorship +los +lose +loser +losers +loses +losest +loseth +losing +loss +losses +lost +lot +lots +lott +lottery +loud +louder +loudly +lour +loureth +louring +louse +louses +lousy +lout +louted +louts +louvre +lov +love +loved +lovedst +lovel +lovelier +loveliness +lovell +lovely +lover +lovered +lovers +loves +lovest +loveth +loving +lovingly +low +lowe +lower +lowest +lowing +lowliness +lowly +lown +lowness +loyal +loyally +loyalties +loyalty +lozel +lt +lubber +lubberly +luc +luccicos +luce +lucentio +luces +lucetta +luciana +lucianus +lucifer +lucifier +lucilius +lucina +lucio +lucius +luck +luckier +luckiest +luckily +luckless +lucky +lucre +lucrece +lucretia +lucullius +lucullus +lucy +lud +ludlow +lug +lugg +luggage +luke +lukewarm +lull +lulla +lullaby +lulls +lumbert +lump +lumpish +luna +lunacies +lunacy +lunatic +lunatics +lunes +lungs +lupercal +lurch +lure +lurk +lurketh +lurking +lurks +luscious +lush +lust +lusted +luster +lustful +lustier +lustiest +lustig +lustihood +lustily +lustre +lustrous +lusts +lusty +lute +lutes +lutestring +lutheran +luxurious +luxuriously +luxury +ly +lycaonia +lycurguses +lydia +lye +lyen +lying +lym +lymoges +lynn +lysander +m +ma +maan +mab +macbeth +maccabaeus +macdonwald +macduff +mace +macedon +maces +machiavel +machination +machinations +machine +mack +macmorris +maculate +maculation +mad +madam +madame +madams +madcap +madded +madding +made +madeira +madly +madman +madmen +madness +madonna +madrigals +mads +maecenas +maggot +maggots +magic +magical +magician +magistrate +magistrates +magnanimity +magnanimous +magni +magnifi +magnificence +magnificent +magnifico +magnificoes +magnus +mahomet +mahu +maid +maiden +maidenhead +maidenheads +maidenhood +maidenhoods +maidenliest +maidenly +maidens +maidhood +maids +mail +mailed +mails +maim +maimed +maims +main +maincourse +maine +mainly +mainmast +mains +maintain +maintained +maintains +maintenance +mais +maison +majestas +majestee +majestic +majestical +majestically +majesties +majesty +major +majority +mak +make +makeless +maker +makers +makes +makest +maketh +making +makings +mal +mala +maladies +malady +malapert +malcolm +malcontent +malcontents +male +maledictions +malefactions +malefactor +malefactors +males +malevolence +malevolent +malhecho +malice +malicious +maliciously +malign +malignancy +malignant +malignantly +malkin +mall +mallard +mallet +mallows +malmsey +malt +maltworms +malvolio +mamillius +mammering +mammet +mammets +mammock +man +manacle +manacles +manage +managed +manager +managing +manakin +manchus +mandate +mandragora +mandrake +mandrakes +mane +manent +manes +manet +manfully +mangle +mangled +mangles +mangling +mangy +manhood +manhoods +manifest +manifested +manifests +manifold +manifoldly +manka +mankind +manlike +manly +mann +manna +manner +mannerly +manners +manningtree +mannish +manor +manors +mans +mansion +mansionry +mansions +manslaughter +mantle +mantled +mantles +mantua +mantuan +manual +manure +manured +manus +many +map +mapp +maps +mar +marble +marbled +marcade +marcellus +march +marches +marcheth +marching +marchioness +marchpane +marcians +marcius +marcus +mardian +mare +mares +marg +margarelon +margaret +marge +margent +margery +maria +marian +mariana +maries +marigold +mariner +mariners +maritime +marjoram +mark +marked +market +marketable +marketplace +markets +marking +markman +marks +marl +marle +marmoset +marquess +marquis +marr +marriage +marriages +married +marries +marring +marrow +marrowless +marrows +marry +marrying +mars +marseilles +marsh +marshal +marshalsea +marshalship +mart +marted +martem +martext +martial +martin +martino +martius +martlemas +martlet +marts +martyr +martyrs +marullus +marv +marvel +marvell +marvellous +marvellously +marvels +mary +mas +masculine +masham +mask +masked +masker +maskers +masking +masks +mason +masonry +masons +masque +masquers +masques +masquing +mass +massacre +massacres +masses +massy +mast +mastcr +master +masterdom +masterest +masterless +masterly +masterpiece +masters +mastership +mastic +mastiff +mastiffs +masts +match +matches +matcheth +matching +matchless +mate +mated +mater +material +mates +mathematics +matin +matron +matrons +matter +matters +matthew +mattock +mattress +mature +maturity +maud +maudlin +maugre +maul +maund +mauri +mauritania +mauvais +maw +maws +maxim +may +mayday +mayest +mayor +maypole +mayst +maz +maze +mazed +mazes +mazzard +me +meacock +mead +meadow +meadows +meads +meagre +meal +meals +mealy +mean +meanders +meaner +meanest +meaneth +meaning +meanings +meanly +means +meant +meantime +meanwhile +measles +measur +measurable +measure +measured +measureless +measures +measuring +meat +meats +mechanic +mechanical +mechanicals +mechanics +mechante +med +medal +meddle +meddler +meddling +mede +medea +media +mediation +mediators +medice +medicinal +medicine +medicines +meditate +meditates +meditating +meditation +meditations +mediterranean +mediterraneum +medlar +medlars +meed +meeds +meek +meekly +meekness +meet +meeter +meetest +meeting +meetings +meetly +meetness +meets +meg +mehercle +meilleur +meiny +meisen +melancholies +melancholy +melford +mell +mellifluous +mellow +mellowing +melodious +melody +melt +melted +melteth +melting +melts +melun +member +members +memento +memorable +memorandums +memorial +memorials +memories +memoriz +memorize +memory +memphis +men +menac +menace +menaces +menaphon +menas +mend +mended +mender +mending +mends +menecrates +menelaus +menenius +mental +menteith +mention +mentis +menton +mephostophilus +mer +mercatante +mercatio +mercenaries +mercenary +mercer +merchandise +merchandized +merchant +merchants +mercies +merciful +mercifully +merciless +mercurial +mercuries +mercury +mercutio +mercy +mere +mered +merely +merest +meridian +merit +merited +meritorious +merits +merlin +mermaid +mermaids +merops +merrier +merriest +merrily +merriman +merriment +merriments +merriness +merry +mervailous +mes +mesh +meshes +mesopotamia +mess +message +messages +messala +messaline +messenger +messengers +messes +messina +met +metal +metals +metamorphis +metamorphoses +metaphor +metaphysical +metaphysics +mete +metellus +meteor +meteors +meteyard +metheglin +metheglins +methink +methinks +method +methods +methought +methoughts +metre +metres +metropolis +mette +mettle +mettled +meus +mew +mewed +mewling +mexico +mi +mice +michael +michaelmas +micher +miching +mickle +microcosm +mid +midas +middest +middle +middleham +midnight +midriff +midst +midsummer +midway +midwife +midwives +mienne +might +mightful +mightier +mightiest +mightily +mightiness +mightst +mighty +milan +milch +mild +milder +mildest +mildew +mildews +mildly +mildness +mile +miles +milford +militarist +military +milk +milking +milkmaid +milks +milksops +milky +mill +mille +miller +milliner +million +millioned +millions +mills +millstones +milo +mimic +minc +mince +minces +mincing +mind +minded +minding +mindless +minds +mine +mineral +minerals +minerva +mines +mingle +mingled +mingling +minikin +minim +minime +minimo +minimus +mining +minion +minions +minist +minister +ministers +ministration +minnow +minnows +minola +minority +minos +minotaurs +minstrel +minstrels +minstrelsy +mint +mints +minute +minutely +minutes +minx +mio +mir +mirable +miracle +miracles +miraculous +miranda +mire +mirror +mirrors +mirth +mirthful +miry +mis +misadventur +misadventure +misanthropos +misapplied +misbecame +misbecom +misbecome +misbegot +misbegotten +misbeliever +misbelieving +misbhav +miscall +miscalled +miscarried +miscarries +miscarry +miscarrying +mischance +mischances +mischief +mischiefs +mischievous +misconceived +misconst +misconster +misconstruction +misconstrued +misconstrues +miscreant +miscreate +misdeed +misdeeds +misdemean +misdemeanours +misdoubt +misdoubteth +misdoubts +misenum +miser +miserable +miserably +misericorde +miseries +misers +misery +misfortune +misfortunes +misgive +misgives +misgiving +misgoverned +misgovernment +misgraffed +misguide +mishap +mishaps +misheard +misinterpret +mislead +misleader +misleaders +misleading +misled +mislike +misord +misplac +misplaced +misplaces +mispris +misprised +misprision +misprizing +misproud +misquote +misreport +miss +missed +misses +misshap +misshapen +missheathed +missing +missingly +missions +missive +missives +misspoke +mist +mista +mistak +mistake +mistaken +mistakes +mistaketh +mistaking +mistakings +mistemp +mistempered +misterm +mistful +misthink +misthought +mistletoe +mistook +mistreadings +mistress +mistresses +mistresss +mistriship +mistrust +mistrusted +mistrustful +mistrusting +mists +misty +misus +misuse +misused +misuses +mites +mithridates +mitigate +mitigation +mix +mixed +mixture +mixtures +mm +mnd +moan +moans +moat +moated +mobled +mock +mockable +mocker +mockeries +mockers +mockery +mocking +mocks +mockvater +mockwater +model +modena +moderate +moderately +moderation +modern +modest +modesties +modestly +modesty +modicums +modo +module +moe +moi +moiety +moist +moisten +moisture +moldwarp +mole +molehill +moles +molest +molestation +mollification +mollis +molten +molto +mome +moment +momentary +moming +mon +monachum +monarch +monarchies +monarchize +monarcho +monarchs +monarchy +monast +monastery +monastic +monday +monde +money +moneys +mong +monger +mongers +monging +mongrel +mongrels +mongst +monk +monkey +monkeys +monks +monmouth +monopoly +mons +monsieur +monsieurs +monster +monsters +monstrous +monstrously +monstrousness +monstruosity +montacute +montage +montague +montagues +montano +montant +montez +montferrat +montgomery +month +monthly +months +montjoy +monument +monumental +monuments +mood +moods +moody +moon +moonbeams +moonish +moonlight +moons +moonshine +moonshines +moor +moorfields +moors +moorship +mop +mope +moping +mopping +mopsa +moral +moraler +morality +moralize +mordake +more +moreover +mores +morgan +mori +morisco +morn +morning +mornings +morocco +morris +morrow +morrows +morsel +morsels +mort +mortal +mortality +mortally +mortals +mortar +mortgaged +mortified +mortifying +mortimer +mortimers +mortis +mortise +morton +mose +moss +mossgrown +most +mote +moth +mother +mothers +moths +motion +motionless +motions +motive +motives +motley +mots +mought +mould +moulded +mouldeth +moulds +mouldy +moult +moulten +mounch +mounseur +mounsieur +mount +mountain +mountaineer +mountaineers +mountainous +mountains +mountant +mountanto +mountebank +mountebanks +mounted +mounteth +mounting +mounts +mourn +mourned +mourner +mourners +mournful +mournfully +mourning +mourningly +mournings +mourns +mous +mouse +mousetrap +mousing +mouth +mouthed +mouths +mov +movables +move +moveable +moveables +moved +mover +movers +moves +moveth +moving +movingly +movousus +mow +mowbray +mower +mowing +mows +moy +moys +moyses +mrs +much +muck +mud +mudded +muddied +muddy +muffins +muffl +muffle +muffled +muffler +muffling +mugger +mugs +mulberries +mulberry +mule +mules +muleteers +mulier +mulieres +muliteus +mull +mulmutius +multiplied +multiply +multiplying +multipotent +multitude +multitudes +multitudinous +mum +mumble +mumbling +mummers +mummy +mun +munch +muniments +munition +murd +murder +murdered +murderer +murderers +murdering +murderous +murders +mure +murk +murkiest +murky +murmur +murmurers +murmuring +murrain +murray +murrion +murther +murtherer +murtherers +murthering +murtherous +murthers +mus +muscadel +muscovites +muscovits +muscovy +muse +muses +mush +mushrooms +music +musical +musician +musicians +musics +musing +musings +musk +musket +muskets +muskos +muss +mussel +mussels +must +mustachio +mustard +mustardseed +muster +mustering +musters +musty +mutability +mutable +mutation +mutations +mute +mutes +mutest +mutine +mutineer +mutineers +mutines +mutinies +mutinous +mutiny +mutius +mutter +muttered +mutton +muttons +mutual +mutualities +mutually +muzzl +muzzle +muzzled +mv +mww +my +mynheers +myrmidon +myrmidons +myrtle +myself +myst +mysteries +mystery +n +nag +nage +nags +naiads +nail +nails +nak +naked +nakedness +nal +nam +name +named +nameless +namely +names +namest +naming +nan +nance +nap +nape +napes +napkin +napkins +naples +napless +napping +naps +narbon +narcissus +narines +narrow +narrowly +naso +nasty +nathaniel +natifs +nation +nations +native +nativity +natur +natural +naturalize +naturally +nature +natured +natures +natus +naught +naughtily +naughty +navarre +nave +navel +navigation +navy +nay +nayward +nayword +nazarite +ne +neaf +neamnoins +neanmoins +neapolitan +neapolitans +near +nearer +nearest +nearly +nearness +neat +neatly +neb +nebour +nebuchadnezzar +nec +necessaries +necessarily +necessary +necessitied +necessities +necessity +neck +necklace +necks +nectar +ned +nedar +need +needed +needer +needful +needfull +needing +needle +needles +needless +needly +needs +needy +neer +neeze +nefas +negation +negative +negatives +neglect +neglected +neglecting +neglectingly +neglection +negligence +negligent +negotiate +negotiations +negro +neigh +neighbors +neighbour +neighbourhood +neighbouring +neighbourly +neighbours +neighing +neighs +neither +nell +nemean +nemesis +neoptolemus +nephew +nephews +neptune +ner +nereides +nerissa +nero +neroes +ners +nerve +nerves +nervii +nervy +nessus +nest +nestor +nests +net +nether +netherlands +nets +nettle +nettled +nettles +neuter +neutral +nev +never +nevil +nevils +new +newborn +newer +newest +newgate +newly +newness +news +newsmongers +newt +newts +next +nibbling +nicanor +nice +nicely +niceness +nicer +nicety +nicholas +nick +nickname +nicks +niece +nieces +niggard +niggarding +niggardly +nigh +night +nightcap +nightcaps +nighted +nightgown +nightingale +nightingales +nightly +nightmare +nights +nightwork +nihil +nile +nill +nilus +nimble +nimbleness +nimbler +nimbly +nine +nineteen +ning +ningly +ninny +ninth +ninus +niobe +niobes +nip +nipp +nipping +nipple +nips +nit +nly +nnight +nnights +no +noah +nob +nobility +nobis +noble +nobleman +noblemen +nobleness +nobler +nobles +noblesse +noblest +nobly +nobody +noces +nod +nodded +nodding +noddle +noddles +noddy +nods +noes +nointed +nois +noise +noiseless +noisemaker +noises +noisome +nole +nominate +nominated +nomination +nominativo +non +nonage +nonce +none +nonino +nonny +nonpareil +nonsuits +nony +nook +nooks +noon +noonday +noontide +nor +norbery +norfolk +norman +normandy +normans +north +northampton +northamptonshire +northerly +northern +northgate +northumberland +northumberlands +northward +norway +norways +norwegian +norweyan +nos +nose +nosegays +noseless +noses +noster +nostra +nostril +nostrils +not +notable +notably +notary +notch +note +notebook +noted +notedly +notes +notest +noteworthy +nothing +nothings +notice +notify +noting +notion +notorious +notoriously +notre +notwithstanding +nought +noun +nouns +nourish +nourished +nourisher +nourishes +nourisheth +nourishing +nourishment +nous +novel +novelties +novelty +noverbs +novi +novice +novices +novum +now +nowhere +noyance +ns +nt +nubibus +numa +numb +number +numbered +numbering +numberless +numbers +numbness +nun +nuncio +nuncle +nunnery +nuns +nuntius +nuptial +nurs +nurse +nursed +nurser +nursery +nurses +nurseth +nursh +nursing +nurtur +nurture +nut +nuthook +nutmeg +nutmegs +nutriment +nuts +nutshell +ny +nym +nymph +nymphs +o +oak +oaken +oaks +oared +oars +oatcake +oaten +oath +oathable +oaths +oats +ob +obduracy +obdurate +obedience +obedient +obeisance +oberon +obey +obeyed +obeying +obeys +obidicut +object +objected +objections +objects +oblation +oblations +obligation +obligations +obliged +oblique +oblivion +oblivious +obloquy +obscene +obscenely +obscur +obscure +obscured +obscurely +obscures +obscuring +obscurity +obsequies +obsequious +obsequiously +observ +observance +observances +observancy +observant +observants +observation +observe +observed +observer +observers +observing +observingly +obsque +obstacle +obstacles +obstinacy +obstinate +obstinately +obstruct +obstruction +obstructions +obtain +obtained +obtaining +occasion +occasions +occident +occidental +occulted +occupat +occupation +occupations +occupied +occupies +occupy +occurrence +occurrences +occurrents +ocean +oceans +octavia +octavius +ocular +od +odd +oddest +oddly +odds +ode +odes +odious +odoriferous +odorous +odour +odours +ods +oeillades +oes +oeuvres +of +ofephesus +off +offal +offence +offenceful +offences +offend +offended +offendendo +offender +offenders +offendeth +offending +offendress +offends +offense +offenseless +offenses +offensive +offer +offered +offering +offerings +offers +offert +offic +office +officed +officer +officers +offices +official +officious +offspring +oft +often +oftener +oftentimes +oh +oil +oils +oily +old +oldcastle +olden +older +oldest +oldness +olive +oliver +olivers +olives +olivia +olympian +olympus +oman +omans +omen +ominous +omission +omit +omittance +omitted +omitting +omne +omnes +omnipotent +on +once +one +ones +oneyers +ongles +onion +onions +only +onset +onward +onwards +oo +ooze +oozes +oozy +op +opal +ope +open +opener +opening +openly +openness +opens +operant +operate +operation +operations +operative +opes +oph +ophelia +opinion +opinions +opportune +opportunities +opportunity +oppos +oppose +opposed +opposeless +opposer +opposers +opposes +opposing +opposite +opposites +opposition +oppositions +oppress +oppressed +oppresses +oppresseth +oppressing +oppression +oppressor +opprest +opprobriously +oppugnancy +opulency +opulent +or +oracle +oracles +orange +oration +orator +orators +oratory +orb +orbed +orbs +orchard +orchards +ord +ordain +ordained +ordaining +order +ordered +ordering +orderless +orderly +orders +ordinance +ordinant +ordinaries +ordinary +ordnance +ords +ordure +ore +organ +organs +orgillous +orient +orifex +origin +original +orisons +ork +orlando +orld +orleans +ornament +ornaments +orodes +orphan +orphans +orpheus +orsino +ort +orthography +orts +oscorbidulchos +osier +osiers +osprey +osr +osric +ossa +ost +ostent +ostentare +ostentation +ostents +ostler +ostlers +ostrich +osw +oswald +othello +other +othergates +others +otherwhere +otherwhiles +otherwise +otter +ottoman +ottomites +oublie +ouches +ought +oui +ounce +ounces +ouphes +our +ours +ourself +ourselves +ousel +out +outbids +outbrave +outbraves +outbreak +outcast +outcries +outcry +outdar +outdare +outdares +outdone +outfac +outface +outfaced +outfacing +outfly +outfrown +outgo +outgoes +outgrown +outjest +outlaw +outlawry +outlaws +outliv +outlive +outlives +outliving +outlook +outlustres +outpriz +outrage +outrageous +outrages +outran +outright +outroar +outrun +outrunning +outruns +outscold +outscorn +outsell +outsells +outside +outsides +outspeaks +outsport +outstare +outstay +outstood +outstretch +outstretched +outstrike +outstrip +outstripped +outswear +outvenoms +outward +outwardly +outwards +outwear +outweighs +outwent +outworn +outworths +oven +over +overawe +overbear +overblown +overboard +overbold +overborne +overbulk +overbuys +overcame +overcast +overcharg +overcharged +overcome +overcomes +overdone +overearnest +overfar +overflow +overflown +overglance +overgo +overgone +overgorg +overgrown +overhead +overhear +overheard +overhold +overjoyed +overkind +overland +overleather +overlive +overlook +overlooking +overlooks +overmaster +overmounting +overmuch +overpass +overpeer +overpeering +overplus +overrul +overrun +overscutch +overset +overshades +overshine +overshines +overshot +oversights +overspread +overstain +overswear +overt +overta +overtake +overtaketh +overthrow +overthrown +overthrows +overtook +overtopp +overture +overturn +overwatch +overween +overweening +overweigh +overwhelm +overwhelming +overworn +ovid +ovidius +ow +owe +owed +owedst +owen +owes +owest +oweth +owing +owl +owls +own +owner +owners +owning +owns +owy +ox +oxen +oxford +oxfordshire +oxlips +oyes +oyster +p +pabble +pabylon +pac +pace +paced +paces +pacified +pacify +pacing +pack +packet +packets +packhorses +packing +packings +packs +packthread +pacorus +paction +pad +paddle +paddling +paddock +padua +pagan +pagans +page +pageant +pageants +pages +pah +paid +pail +pailfuls +pails +pain +pained +painful +painfully +pains +paint +painted +painter +painting +paintings +paints +pair +paired +pairs +pajock +pal +palabras +palace +palaces +palamedes +palate +palates +palatine +palating +pale +paled +paleness +paler +pales +palestine +palfrey +palfreys +palisadoes +pall +pallabris +pallas +pallets +palm +palmer +palmers +palms +palmy +palpable +palsied +palsies +palsy +palt +palter +paltry +paly +pamp +pamper +pamphlets +pan +pancackes +pancake +pancakes +pandar +pandars +pandarus +pander +panderly +panders +pandulph +panel +pang +panging +pangs +pannier +pannonians +pansa +pansies +pant +pantaloon +panted +pantheon +panther +panthino +panting +pantingly +pantler +pantry +pants +pap +papal +paper +papers +paphlagonia +paphos +papist +paps +par +parable +paracelsus +paradise +paradox +paradoxes +paragon +paragons +parallel +parallels +paramour +paramours +parapets +paraquito +parasite +parasites +parca +parcel +parcell +parcels +parch +parched +parching +parchment +pard +pardon +pardona +pardoned +pardoner +pardoning +pardonne +pardonner +pardonnez +pardons +pare +pared +parel +parent +parentage +parents +parfect +paring +parings +paris +parish +parishioners +parisians +paritors +park +parks +parle +parler +parles +parley +parlez +parliament +parlors +parlour +parlous +parmacity +parolles +parricide +parricides +parrot +parrots +parsley +parson +part +partake +partaken +partaker +partakers +parted +parthia +parthian +parthians +parti +partial +partialize +partially +participate +participation +particle +particular +particularities +particularize +particularly +particulars +parties +parting +partisan +partisans +partition +partizan +partlet +partly +partner +partners +partridge +parts +party +pas +pash +pashed +pashful +pass +passable +passado +passage +passages +passant +passed +passenger +passengers +passes +passeth +passing +passio +passion +passionate +passioning +passions +passive +passport +passy +past +paste +pasterns +pasties +pastime +pastimes +pastoral +pastorals +pastors +pastry +pasture +pastures +pasty +pat +patay +patch +patchery +patches +pate +pated +patent +patents +paternal +pates +path +pathetical +paths +pathway +pathways +patience +patient +patiently +patients +patines +patrician +patricians +patrick +patrimony +patroclus +patron +patronage +patroness +patrons +patrum +patter +pattern +patterns +pattle +pauca +paucas +paul +paulina +paunch +paunches +pause +pauser +pauses +pausingly +pauvres +pav +paved +pavement +pavilion +pavilions +pavin +paw +pawn +pawns +paws +pax +pay +payest +paying +payment +payments +pays +paysan +paysans +pe +peace +peaceable +peaceably +peaceful +peacemakers +peaces +peach +peaches +peacock +peacocks +peak +peaking +peal +peals +pear +peard +pearl +pearls +pears +peas +peasant +peasantry +peasants +peascod +pease +peaseblossom +peat +peaten +peating +pebble +pebbled +pebbles +peck +pecks +peculiar +pecus +pedant +pedantical +pedascule +pede +pedestal +pedigree +pedlar +pedlars +pedro +peds +peel +peep +peeped +peeping +peeps +peer +peereth +peering +peerless +peers +peesel +peevish +peevishly +peflur +peg +pegasus +pegs +peise +peised +peize +pelf +pelican +pelion +pell +pella +pelleted +peloponnesus +pelt +pelting +pembroke +pen +penalties +penalty +penance +pence +pencil +pencill +pencils +pendant +pendent +pendragon +pendulous +penelope +penetrable +penetrate +penetrative +penitence +penitent +penitential +penitently +penitents +penker +penknife +penn +penned +penning +pennons +penny +pennyworth +pennyworths +pens +pense +pension +pensioners +pensive +pensived +pensively +pent +pentecost +penthesilea +penthouse +penurious +penury +peopl +people +peopled +peoples +pepin +pepper +peppercorn +peppered +per +peradventure +peradventures +perceiv +perceive +perceived +perceives +perceiveth +perch +perchance +percies +percussion +percy +perdie +perdita +perdition +perdonato +perdu +perdurable +perdurably +perdy +pere +peregrinate +peremptorily +peremptory +perfect +perfected +perfecter +perfectest +perfection +perfections +perfectly +perfectness +perfidious +perfidiously +perforce +perform +performance +performances +performed +performer +performers +performing +performs +perfum +perfume +perfumed +perfumer +perfumes +perge +perhaps +periapts +perigort +perigouna +peril +perilous +perils +period +periods +perish +perished +perishest +perisheth +perishing +periwig +perjur +perjure +perjured +perjuries +perjury +perk +perkes +permafoy +permanent +permission +permissive +permit +permitted +pernicious +perniciously +peroration +perpend +perpendicular +perpendicularly +perpetual +perpetually +perpetuity +perplex +perplexed +perplexity +pers +persecuted +persecutions +persecutor +perseus +persever +perseverance +persevers +persia +persian +persist +persisted +persistency +persistive +persists +person +personae +personage +personages +personal +personally +personate +personated +personates +personating +persons +perspective +perspectively +perspectives +perspicuous +persuade +persuaded +persuades +persuading +persuasion +persuasions +pert +pertain +pertaining +pertains +pertaunt +pertinent +pertly +perturb +perturbation +perturbations +perturbed +perus +perusal +peruse +perused +perusing +perverse +perversely +perverseness +pervert +perverted +peseech +pest +pester +pestiferous +pestilence +pestilent +pet +petar +peter +petit +petition +petitionary +petitioner +petitioners +petitions +peto +petrarch +petruchio +petter +petticoat +petticoats +pettiness +pettish +pettitoes +petty +peu +pew +pewter +pewterer +phaethon +phaeton +phantasime +phantasimes +phantasma +pharamond +pharaoh +pharsalia +pheasant +pheazar +phebe +phebes +pheebus +pheeze +phibbus +philadelphos +philario +philarmonus +philemon +philip +philippan +philippe +philippi +phillida +philo +philomel +philomela +philosopher +philosophers +philosophical +philosophy +philostrate +philotus +phlegmatic +phoebe +phoebus +phoenicia +phoenicians +phoenix +phorbus +photinus +phrase +phraseless +phrases +phrygia +phrygian +phrynia +physic +physical +physician +physicians +physics +pia +pibble +pible +picardy +pick +pickaxe +pickaxes +pickbone +picked +pickers +picking +pickle +picklock +pickpurse +picks +pickt +pickthanks +pictur +picture +pictured +pictures +pid +pie +piec +piece +pieces +piecing +pied +piedness +pier +pierc +pierce +pierced +pierces +pierceth +piercing +piercy +piers +pies +piety +pig +pigeon +pigeons +pight +pigmy +pigrogromitus +pike +pikes +pil +pilate +pilates +pilchers +pile +piles +pilf +pilfering +pilgrim +pilgrimage +pilgrims +pill +pillage +pillagers +pillar +pillars +pillicock +pillory +pillow +pillows +pills +pilot +pilots +pimpernell +pin +pinch +pinched +pinches +pinching +pindarus +pine +pined +pines +pinfold +pining +pinion +pink +pinn +pinnace +pins +pinse +pint +pintpot +pioned +pioneers +pioner +pioners +pious +pip +pipe +piper +pipers +pipes +piping +pippin +pippins +pirate +pirates +pisa +pisanio +pish +pismires +piss +pissing +pistol +pistols +pit +pitch +pitched +pitcher +pitchers +pitchy +piteous +piteously +pitfall +pith +pithless +pithy +pitie +pitied +pities +pitiful +pitifully +pitiless +pits +pittance +pittie +pittikins +pity +pitying +pius +plac +place +placed +placentio +places +placeth +placid +placing +plack +placket +plackets +plagu +plague +plagued +plagues +plaguing +plaguy +plain +plainer +plainest +plaining +plainings +plainly +plainness +plains +plainsong +plaintful +plaintiff +plaintiffs +plaints +planched +planet +planetary +planets +planks +plant +plantage +plantagenet +plantagenets +plantain +plantation +planted +planteth +plants +plash +plashy +plast +plaster +plasterer +plat +plate +plated +plates +platform +platforms +plats +platted +plausible +plausive +plautus +play +played +player +players +playeth +playfellow +playfellows +playhouse +playing +plays +plea +pleach +pleached +plead +pleaded +pleader +pleaders +pleading +pleads +pleas +pleasance +pleasant +pleasantly +please +pleased +pleaser +pleasers +pleases +pleasest +pleaseth +pleasing +pleasure +pleasures +plebeians +plebeii +plebs +pledge +pledges +pleines +plenitude +plenteous +plenteously +plenties +plentiful +plentifully +plenty +pless +plessed +plessing +pliant +plied +plies +plight +plighted +plighter +plod +plodded +plodders +plodding +plods +plood +ploody +plot +plots +plotted +plotter +plough +ploughed +ploughman +ploughmen +plow +plows +pluck +plucked +plucker +plucking +plucks +plue +plum +plume +plumed +plumes +plummet +plump +plumpy +plums +plung +plunge +plunged +plural +plurisy +plus +pluto +plutus +ply +po +pocket +pocketing +pockets +pocky +pody +poem +poesy +poet +poetical +poetry +poets +poictiers +poinards +poins +point +pointblank +pointed +pointing +points +pois +poise +poising +poison +poisoned +poisoner +poisoning +poisonous +poisons +poke +poking +pol +polack +polacks +poland +pold +pole +poleaxe +polecat +polecats +polemon +poles +poli +policies +policy +polish +polished +politic +politician +politicians +politicly +polixenes +poll +polluted +pollution +polonius +poltroons +polusion +polydamus +polydore +polyxena +pomander +pomegranate +pomewater +pomfret +pomgarnet +pommel +pomp +pompeius +pompey +pompion +pompous +pomps +pond +ponder +ponderous +ponds +poniard +poniards +pont +pontic +pontifical +ponton +pooh +pool +poole +poop +poor +poorer +poorest +poorly +pop +pope +popedom +popilius +popingay +popish +popp +poppy +pops +popular +popularity +populous +porch +porches +pore +poring +pork +porn +porpentine +porridge +porringer +port +portable +portage +portal +portance +portcullis +portend +portends +portent +portentous +portents +porter +porters +portia +portion +portly +portotartarossa +portrait +portraiture +ports +portugal +pose +posied +posies +position +positive +positively +posse +possess +possessed +possesses +possesseth +possessing +possession +possessions +possessor +posset +possets +possibilities +possibility +possible +possibly +possitable +post +poste +posted +posterior +posteriors +posterity +postern +posterns +posters +posthorse +posthorses +posthumus +posting +postmaster +posts +postscript +posture +postures +posy +pot +potable +potations +potato +potatoes +potch +potency +potent +potentates +potential +potently +potents +pothecary +pother +potion +potions +potpan +pots +potter +potting +pottle +pouch +poulter +poultice +poultney +pouncet +pound +pounds +pour +pourest +pouring +pourquoi +pours +pout +poverty +pow +powd +powder +power +powerful +powerfully +powerless +powers +pox +poys +poysam +prabbles +practic +practice +practiced +practicer +practices +practicing +practis +practisants +practise +practiser +practisers +practises +practising +praeclarissimus +praemunire +praetor +praetors +pragging +prague +prain +prains +prais +praise +praised +praises +praisest +praiseworthy +praising +prancing +prank +pranks +prat +prate +prated +prater +prating +prattle +prattler +prattling +prave +prawls +prawns +pray +prayer +prayers +praying +prays +pre +preach +preached +preachers +preaches +preaching +preachment +pread +preambulate +precedence +precedent +preceding +precept +preceptial +precepts +precinct +precious +preciously +precipice +precipitating +precipitation +precise +precisely +preciseness +precisian +precor +precurse +precursors +predeceased +predecessor +predecessors +predestinate +predicament +predict +prediction +predictions +predominance +predominant +predominate +preeches +preeminence +preface +prefer +preferment +preferments +preferr +preferreth +preferring +prefers +prefiguring +prefix +prefixed +preformed +pregnancy +pregnant +pregnantly +prejudicates +prejudice +prejudicial +prelate +premeditated +premeditation +premised +premises +prenez +prenominate +prentice +prentices +preordinance +prepar +preparation +preparations +prepare +prepared +preparedly +prepares +preparing +prepost +preposterous +preposterously +prerogatifes +prerogative +prerogatived +presage +presagers +presages +presageth +presaging +prescience +prescribe +prescript +prescription +prescriptions +prescripts +presence +presences +present +presentation +presented +presenter +presenters +presenteth +presenting +presently +presentment +presents +preserv +preservation +preservative +preserve +preserved +preserver +preservers +preserving +president +press +pressed +presser +presses +pressing +pressure +pressures +prest +prester +presume +presumes +presuming +presumption +presumptuous +presuppos +pret +pretence +pretences +pretend +pretended +pretending +pretense +pretext +pretia +prettier +prettiest +prettily +prettiness +pretty +prevail +prevailed +prevaileth +prevailing +prevailment +prevails +prevent +prevented +prevention +preventions +prevents +prey +preyful +preys +priam +priami +priamus +pribbles +price +prick +pricked +pricket +pricking +pricks +pricksong +pride +prides +pridge +prie +pried +prief +pries +priest +priesthood +priests +prig +primal +prime +primer +primero +primest +primitive +primo +primogenity +primrose +primroses +primy +prince +princely +princes +princess +principal +principalities +principality +principle +principles +princox +prings +print +printed +printing +printless +prints +prioress +priories +priority +priory +priscian +prison +prisoner +prisoners +prisonment +prisonnier +prisons +pristine +prithe +prithee +privacy +private +privately +privates +privilage +privileg +privilege +privileged +privileges +privilegio +privily +privity +privy +priz +prize +prized +prizer +prizes +prizest +prizing +pro +probable +probal +probation +proceed +proceeded +proceeders +proceeding +proceedings +proceeds +process +procession +proclaim +proclaimed +proclaimeth +proclaims +proclamation +proclamations +proconsul +procrastinate +procreant +procreants +procreation +procrus +proculeius +procur +procurator +procure +procured +procures +procuring +prodigal +prodigality +prodigally +prodigals +prodigies +prodigious +prodigiously +prodigy +proditor +produc +produce +produced +produces +producing +proface +profan +profanation +profane +profaned +profanely +profaneness +profaners +profaning +profess +professed +professes +profession +professions +professors +proffer +proffered +profferer +proffers +proficient +profit +profitable +profitably +profited +profiting +profitless +profits +profound +profoundest +profoundly +progenitors +progeny +progne +prognosticate +prognostication +progress +progression +prohibit +prohibition +project +projection +projects +prolixious +prolixity +prologue +prologues +prolong +prolongs +promethean +prometheus +promis +promise +promised +promises +promiseth +promising +promontory +promotion +promotions +prompt +prompted +promptement +prompter +prompting +prompts +prompture +promulgate +prone +prononcer +prononcez +pronoun +pronounc +pronounce +pronounced +pronouncing +pronouns +proof +proofs +prop +propagate +propagation +propend +propension +proper +properer +properly +propertied +properties +property +prophecies +prophecy +prophesied +prophesier +prophesy +prophesying +prophet +prophetess +prophetic +prophetically +prophets +propinquity +propontic +proportion +proportionable +proportions +propos +propose +proposed +proposer +proposes +proposing +proposition +propositions +propounded +propp +propre +propriety +props +propugnation +prorogue +prorogued +proscription +proscriptions +prose +prosecute +prosecution +proselytes +proserpina +prosp +prospect +prosper +prosperity +prospero +prosperous +prosperously +prospers +prostitute +prostrate +protect +protected +protection +protector +protectors +protectorship +protectress +protects +protest +protestation +protestations +protested +protester +protesting +protests +proteus +protheus +protract +protractive +proud +prouder +proudest +proudlier +proudly +prouds +prov +provand +prove +proved +provender +proverb +proverbs +proves +proveth +provide +provided +providence +provident +providently +provider +provides +province +provinces +provincial +proving +provision +proviso +provocation +provok +provoke +provoked +provoker +provokes +provoketh +provoking +provost +prowess +prudence +prudent +prun +prune +prunes +pruning +pry +prying +psalm +psalmist +psalms +psalteries +ptolemies +ptolemy +public +publican +publication +publicly +publicola +publish +published +publisher +publishing +publius +pucelle +puck +pudder +pudding +puddings +puddle +puddled +pudency +pueritia +puff +puffing +puffs +pugging +puis +puissance +puissant +puke +puking +pulcher +puling +pull +puller +pullet +pulling +pulls +pulpit +pulpiter +pulpits +pulse +pulsidge +pump +pumpion +pumps +pun +punched +punish +punished +punishes +punishment +punishments +punk +punto +puny +pupil +pupils +puppet +puppets +puppies +puppy +pur +purblind +purchas +purchase +purchased +purchases +purchaseth +purchasing +pure +purely +purer +purest +purg +purgation +purgative +purgatory +purge +purged +purgers +purging +purifies +purifying +puritan +purity +purlieus +purple +purpled +purples +purport +purpos +purpose +purposed +purposely +purposes +purposeth +purposing +purr +purs +purse +pursents +purses +pursu +pursue +pursued +pursuers +pursues +pursuest +pursueth +pursuing +pursuit +pursuivant +pursuivants +pursy +purus +purveyor +push +pushes +pusillanimity +put +putrefy +putrified +puts +putter +putting +puttock +puzzel +puzzle +puzzled +puzzles +py +pygmalion +pygmies +pygmy +pyramid +pyramides +pyramids +pyramis +pyramises +pyramus +pyrenean +pyrrhus +pythagoras +qu +quadrangle +quae +quaff +quaffing +quagmire +quail +quailing +quails +quaint +quaintly +quak +quake +quakes +qualification +qualified +qualifies +qualify +qualifying +qualite +qualities +quality +qualm +qualmish +quam +quand +quando +quantities +quantity +quare +quarrel +quarrell +quarreller +quarrelling +quarrelous +quarrels +quarrelsome +quarries +quarry +quart +quarter +quartered +quartering +quarters +quarts +quasi +quat +quatch +quay +que +quean +queas +queasiness +queasy +queen +queens +quell +queller +quench +quenched +quenching +quenchless +quern +quest +questant +question +questionable +questioned +questioning +questionless +questions +questrists +quests +queubus +qui +quick +quicken +quickens +quicker +quicklier +quickly +quickness +quicksand +quicksands +quicksilverr +quid +quiddities +quiddits +quier +quiet +quieter +quietly +quietness +quietus +quill +quillets +quills +quilt +quinapalus +quince +quinces +quintain +quintessence +quintus +quip +quips +quire +quiring +quirk +quirks +quis +quit +quite +quits +quittance +quitted +quitting +quiver +quivering +quivers +quo +quod +quoifs +quoint +quoit +quoits +quondam +quoniam +quote +quoted +quotes +quoth +quotidian +r +rabbit +rabble +rabblement +race +rack +rackers +racket +rackets +racking +racks +radiance +radiant +radish +rafe +raft +rag +rage +rages +rageth +ragg +ragged +raggedness +raging +ragozine +rags +rah +rail +railed +railer +railest +raileth +railing +rails +raiment +rain +rainbow +raineth +raining +rainold +rains +rainy +rais +raise +raised +raises +raising +raisins +rak +rake +rakers +rakes +ral +rald +ralph +ram +rambures +ramm +rampallian +rampant +ramping +rampir +ramps +rams +ramsey +ramston +ran +rance +rancorous +rancors +rancour +random +rang +range +ranged +rangers +ranges +ranging +rank +ranker +rankest +ranking +rankle +rankly +rankness +ranks +ransack +ransacking +ransom +ransomed +ransoming +ransomless +ransoms +rant +ranting +rap +rape +rapes +rapier +rapiers +rapine +raps +rapt +rapture +raptures +rar +rare +rarely +rareness +rarer +rarest +rarities +rarity +rascal +rascalliest +rascally +rascals +rased +rash +rasher +rashly +rashness +rat +ratcatcher +ratcliff +rate +rated +rately +rates +rather +ratherest +ratified +ratifiers +ratify +rating +rational +ratolorum +rats +ratsbane +rattle +rattles +rattling +rature +raught +rav +rave +ravel +raven +ravening +ravenous +ravens +ravenspurgh +raves +ravin +raving +ravish +ravished +ravisher +ravishing +ravishments +raw +rawer +rawly +rawness +ray +rayed +rays +raz +raze +razed +razes +razeth +razing +razor +razorable +razors +razure +re +reach +reaches +reacheth +reaching +read +reader +readiest +readily +readiness +reading +readins +reads +ready +real +really +realm +realms +reap +reapers +reaping +reaps +rear +rears +rearward +reason +reasonable +reasonably +reasoned +reasoning +reasonless +reasons +reave +rebate +rebato +rebeck +rebel +rebell +rebelling +rebellion +rebellious +rebels +rebound +rebuk +rebuke +rebukeable +rebuked +rebukes +rebus +recall +recant +recantation +recanter +recanting +receipt +receipts +receiv +receive +received +receiver +receives +receivest +receiveth +receiving +receptacle +rechate +reciprocal +reciprocally +recite +recited +reciterai +reck +recking +reckless +reckon +reckoned +reckoning +reckonings +recks +reclaim +reclaims +reclusive +recognizance +recognizances +recoil +recoiling +recollected +recomforted +recomforture +recommend +recommended +recommends +recompens +recompense +reconcil +reconcile +reconciled +reconcilement +reconciler +reconciles +reconciliation +record +recordation +recorded +recorder +recorders +records +recount +recounted +recounting +recountments +recounts +recourse +recov +recover +recoverable +recovered +recoveries +recovers +recovery +recreant +recreants +recreate +recreation +rectify +rector +rectorship +recure +recured +red +redbreast +redder +reddest +rede +redeem +redeemed +redeemer +redeeming +redeems +redeliver +redemption +redime +redness +redoubled +redoubted +redound +redress +redressed +redresses +reduce +reechy +reed +reeds +reek +reeking +reeks +reeky +reel +reeleth +reeling +reels +refell +refer +reference +referr +referred +refigured +refin +refined +reflect +reflecting +reflection +reflex +reform +reformation +reformed +refractory +refrain +refresh +refreshing +reft +refts +refuge +refus +refusal +refuse +refused +refusest +refusing +reg +regal +regalia +regan +regard +regardance +regarded +regardfully +regarding +regards +regenerate +regent +regentship +regia +regiment +regiments +regina +region +regions +regist +register +registers +regreet +regreets +regress +reguerdon +regular +rehears +rehearsal +rehearse +reign +reigned +reignier +reigning +reigns +rein +reinforc +reinforce +reinforcement +reins +reiterate +reject +rejected +rejoic +rejoice +rejoices +rejoiceth +rejoicing +rejoicingly +rejoindure +rejourn +rel +relapse +relate +relates +relation +relations +relative +releas +release +released +releasing +relent +relenting +relents +reliances +relics +relief +reliev +relieve +relieved +relieves +relieving +religion +religions +religious +religiously +relinquish +reliques +reliquit +relish +relume +rely +relying +remain +remainder +remainders +remained +remaineth +remaining +remains +remark +remarkable +remediate +remedied +remedies +remedy +rememb +remember +remembered +remembers +remembrance +remembrancer +remembrances +remercimens +remiss +remission +remissness +remit +remnant +remnants +remonstrance +remorse +remorseful +remorseless +remote +remotion +remov +remove +removed +removedness +remover +removes +removing +remunerate +remuneration +rence +rend +render +rendered +renders +rendezvous +renegado +renege +reneges +renew +renewed +renewest +renounce +renouncement +renouncing +renowmed +renown +renowned +rent +rents +repaid +repair +repaired +repairing +repairs +repass +repast +repasture +repay +repaying +repays +repeal +repealing +repeals +repeat +repeated +repeating +repeats +repel +repent +repentance +repentant +repented +repenting +repents +repetition +repetitions +repin +repine +repining +replant +replenish +replenished +replete +replication +replied +replies +repliest +reply +replying +report +reported +reporter +reportest +reporting +reportingly +reports +reposal +repose +reposeth +reposing +repossess +reprehend +reprehended +reprehending +represent +representing +reprieve +reprieves +reprisal +reproach +reproaches +reproachful +reproachfully +reprobate +reprobation +reproof +reprov +reprove +reproveable +reproves +reproving +repugn +repugnancy +repugnant +repulse +repulsed +repurchas +repured +reputation +repute +reputed +reputeless +reputes +reputing +request +requested +requesting +requests +requiem +requir +require +required +requires +requireth +requiring +requisite +requisites +requit +requital +requite +requited +requites +rer +rere +rers +rescu +rescue +rescued +rescues +rescuing +resemblance +resemble +resembled +resembles +resembleth +resembling +reserv +reservation +reserve +reserved +reserves +reside +residence +resident +resides +residing +residue +resign +resignation +resist +resistance +resisted +resisting +resists +resolute +resolutely +resolutes +resolution +resolv +resolve +resolved +resolvedly +resolves +resolveth +resort +resorted +resounding +resounds +respeaking +respect +respected +respecting +respective +respectively +respects +respice +respite +respites +responsive +respose +ress +rest +rested +resteth +restful +resting +restitution +restless +restor +restoration +restorative +restore +restored +restores +restoring +restrain +restrained +restraining +restrains +restraint +rests +resty +resum +resume +resumes +resurrections +retail +retails +retain +retainers +retaining +retell +retention +retentive +retinue +retir +retire +retired +retirement +retires +retiring +retold +retort +retorts +retourne +retract +retreat +retrograde +rets +return +returned +returnest +returneth +returning +returns +revania +reveal +reveals +revel +reveler +revell +reveller +revellers +revelling +revelry +revels +reveng +revenge +revenged +revengeful +revengement +revenger +revengers +revenges +revenging +revengingly +revenue +revenues +reverb +reverberate +reverbs +reverenc +reverence +reverend +reverent +reverently +revers +reverse +reversion +reverted +review +reviewest +revil +revile +revisits +reviv +revive +revives +reviving +revok +revoke +revokement +revolt +revolted +revolting +revolts +revolution +revolutions +revolve +revolving +reward +rewarded +rewarder +rewarding +rewards +reword +reworded +rex +rey +reynaldo +rford +rful +rfull +rhapsody +rheims +rhenish +rhesus +rhetoric +rheum +rheumatic +rheums +rheumy +rhinoceros +rhodes +rhodope +rhubarb +rhym +rhyme +rhymers +rhymes +rhyming +rialto +rib +ribald +riband +ribands +ribaudred +ribb +ribbed +ribbon +ribbons +ribs +rice +rich +richard +richer +riches +richest +richly +richmond +richmonds +rid +riddance +ridden +riddle +riddles +riddling +ride +rider +riders +rides +ridest +rideth +ridge +ridges +ridiculous +riding +rids +rien +ries +rifle +rift +rifted +rig +rigg +riggish +right +righteous +righteously +rightful +rightfully +rightly +rights +rigol +rigorous +rigorously +rigour +ril +rim +rin +rinaldo +rind +ring +ringing +ringleader +ringlets +rings +ringwood +riot +rioter +rioting +riotous +riots +rip +ripe +ripely +ripen +ripened +ripeness +ripening +ripens +riper +ripest +riping +ripp +ripping +rise +risen +rises +riseth +rish +rising +rite +rites +rivage +rival +rivality +rivall +rivals +rive +rived +rivelled +river +rivers +rivet +riveted +rivets +rivo +rj +rless +road +roads +roam +roaming +roan +roar +roared +roarers +roaring +roars +roast +roasted +rob +roba +robas +robb +robbed +robber +robbers +robbery +robbing +robe +robed +robert +robes +robin +robs +robustious +rochester +rochford +rock +rocks +rocky +rod +rode +roderigo +rods +roe +roes +roger +rogero +rogue +roguery +rogues +roguish +roi +roisting +roll +rolled +rolling +rolls +rom +romage +roman +romano +romanos +romans +rome +romeo +romish +rondure +ronyon +rood +roof +roofs +rook +rooks +rooky +room +rooms +root +rooted +rootedly +rooteth +rooting +roots +rope +ropery +ropes +roping +ros +rosalind +rosalinda +rosalinde +rosaline +roscius +rose +rosed +rosemary +rosencrantz +roses +ross +rosy +rot +rote +roted +rother +rotherham +rots +rotted +rotten +rottenness +rotting +rotundity +rouen +rough +rougher +roughest +roughly +roughness +round +rounded +roundel +rounder +roundest +rounding +roundly +rounds +roundure +rous +rouse +roused +rousillon +rously +roussi +rout +routed +routs +rove +rover +row +rowel +rowland +rowlands +roy +royal +royalize +royally +royalties +royalty +roynish +rs +rt +rub +rubb +rubbing +rubbish +rubies +rubious +rubs +ruby +rud +rudand +rudder +ruddiness +ruddock +ruddy +rude +rudely +rudeness +ruder +rudesby +rudest +rudiments +rue +rued +ruff +ruffian +ruffians +ruffle +ruffling +ruffs +rug +rugby +rugemount +rugged +ruin +ruinate +ruined +ruining +ruinous +ruins +rul +rule +ruled +ruler +rulers +rules +ruling +rumble +ruminaies +ruminat +ruminate +ruminated +ruminates +rumination +rumor +rumour +rumourer +rumours +rump +run +runagate +runagates +runaway +runaways +rung +runn +runner +runners +running +runs +rupture +ruptures +rural +rush +rushes +rushing +rushling +rushy +russet +russia +russian +russians +rust +rusted +rustic +rustically +rustics +rustle +rustling +rusts +rusty +rut +ruth +ruthful +ruthless +rutland +ruttish +ry +rye +rything +s +sa +saba +sabbath +sable +sables +sack +sackbuts +sackcloth +sacked +sackerson +sacks +sacrament +sacred +sacrific +sacrifice +sacrificers +sacrifices +sacrificial +sacrificing +sacrilegious +sacring +sad +sadder +saddest +saddle +saddler +saddles +sadly +sadness +saf +safe +safeguard +safely +safer +safest +safeties +safety +saffron +sag +sage +sagittary +said +saidst +sail +sailing +sailmaker +sailor +sailors +sails +sain +saint +sainted +saintlike +saints +saith +sake +sakes +sala +salad +salamander +salary +sale +salerio +salicam +salique +salisbury +sall +sallet +sallets +sallies +sallow +sally +salmon +salmons +salt +salter +saltiers +saltness +saltpetre +salutation +salutations +salute +saluted +salutes +saluteth +salv +salvation +salve +salving +same +samingo +samp +sampire +sample +sampler +sampson +samson +samsons +sancta +sanctified +sanctifies +sanctify +sanctimonies +sanctimonious +sanctimony +sanctities +sanctity +sanctuarize +sanctuary +sand +sandal +sandbag +sanded +sands +sandy +sandys +sang +sanguine +sanguis +sanity +sans +santrailles +sap +sapient +sapit +sapless +sapling +sapphire +sapphires +saracens +sarcenet +sard +sardians +sardinia +sardis +sarum +sat +satan +satchel +sate +sated +satiate +satiety +satin +satire +satirical +satis +satisfaction +satisfied +satisfies +satisfy +satisfying +saturday +saturdays +saturn +saturnine +saturninus +satyr +satyrs +sauc +sauce +sauced +saucers +sauces +saucily +sauciness +saucy +sauf +saunder +sav +savage +savagely +savageness +savagery +savages +save +saved +saves +saving +saviour +savory +savour +savouring +savours +savoury +savoy +saw +sawed +sawest +sawn +sawpit +saws +sawyer +saxons +saxony +saxton +say +sayest +saying +sayings +says +sayst +sblood +sc +scab +scabbard +scabs +scaffold +scaffoldage +scal +scald +scalded +scalding +scale +scaled +scales +scaling +scall +scalp +scalps +scaly +scamble +scambling +scamels +scan +scandal +scandaliz +scandalous +scandy +scann +scant +scanted +scanter +scanting +scantling +scants +scap +scape +scaped +scapes +scapeth +scar +scarce +scarcely +scarcity +scare +scarecrow +scarecrows +scarf +scarfed +scarfs +scaring +scarlet +scarr +scarre +scars +scarus +scath +scathe +scathful +scatt +scatter +scattered +scattering +scatters +scelera +scelerisque +scene +scenes +scent +scented +scept +scepter +sceptre +sceptred +sceptres +schedule +schedules +scholar +scholarly +scholars +school +schoolboy +schoolboys +schoolfellows +schooling +schoolmaster +schoolmasters +schools +sciatica +sciaticas +science +sciences +scimitar +scion +scions +scissors +scoff +scoffer +scoffing +scoffs +scoggin +scold +scolding +scolds +sconce +scone +scope +scopes +scorch +scorched +score +scored +scores +scoring +scorn +scorned +scornful +scornfully +scorning +scorns +scorpion +scorpions +scot +scotch +scotches +scotland +scots +scottish +scoundrels +scour +scoured +scourg +scourge +scouring +scout +scouts +scowl +scrap +scrape +scraping +scraps +scratch +scratches +scratching +scream +screams +screech +screeching +screen +screens +screw +screws +scribbl +scribbled +scribe +scribes +scrimers +scrip +scrippage +scripture +scriptures +scrivener +scroll +scrolls +scroop +scrowl +scroyles +scrubbed +scruple +scruples +scrupulous +scuffles +scuffling +scullion +sculls +scum +scurril +scurrility +scurrilous +scurvy +scuse +scut +scutcheon +scutcheons +scylla +scythe +scythed +scythia +scythian +sdeath +se +sea +seacoal +seafaring +seal +sealed +sealing +seals +seam +seamen +seamy +seaport +sear +searce +search +searchers +searches +searcheth +searching +seared +seas +seasick +seaside +season +seasoned +seasons +seat +seated +seats +sebastian +second +secondarily +secondary +seconded +seconds +secrecy +secret +secretaries +secretary +secretly +secrets +sect +sectary +sects +secundo +secure +securely +securing +security +sedg +sedge +sedges +sedgy +sedition +seditious +seduc +seduce +seduced +seducer +seducing +see +seed +seeded +seedness +seeds +seedsman +seein +seeing +seek +seeking +seeks +seel +seeling +seely +seem +seemed +seemers +seemest +seemeth +seeming +seemingly +seemly +seems +seen +seer +sees +seese +seest +seethe +seethes +seething +seeting +segregation +seigneur +seigneurs +seiz +seize +seized +seizes +seizeth +seizing +seizure +seld +seldom +select +seleucus +self +selfsame +sell +seller +selling +sells +selves +semblable +semblably +semblance +semblances +semblative +semi +semicircle +semiramis +semper +sempronius +senate +senator +senators +send +sender +sendeth +sending +sends +seneca +senior +seniory +senis +sennet +senoys +sense +senseless +senses +sensible +sensibly +sensual +sensuality +sent +sentenc +sentence +sentences +sententious +sentinel +sentinels +separable +separate +separated +separates +separation +septentrion +sepulchre +sepulchres +sepulchring +sequel +sequence +sequent +sequest +sequester +sequestration +sere +serenis +serge +sergeant +serious +seriously +sermon +sermons +serpent +serpentine +serpents +serpigo +serv +servant +servanted +servants +serve +served +server +serves +serveth +service +serviceable +services +servile +servility +servilius +serving +servingman +servingmen +serviteur +servitor +servitors +servitude +sessa +session +sessions +sestos +set +setebos +sets +setter +setting +settle +settled +settlest +settling +sev +seven +sevenfold +sevennight +seventeen +seventh +seventy +sever +several +severally +severals +severe +severed +severely +severest +severing +severity +severn +severs +sew +seward +sewer +sewing +sex +sexes +sexton +sextus +seymour +seyton +sfoot +sh +shackle +shackles +shade +shades +shadow +shadowed +shadowing +shadows +shadowy +shady +shafalus +shaft +shafts +shag +shak +shake +shaked +shaken +shakes +shaking +shales +shall +shallenge +shallow +shallowest +shallowly +shallows +shalt +sham +shambles +shame +shamed +shameful +shamefully +shameless +shames +shamest +shaming +shank +shanks +shap +shape +shaped +shapeless +shapen +shapes +shaping +shar +shard +sharded +shards +share +shared +sharers +shares +sharing +shark +sharp +sharpen +sharpened +sharpens +sharper +sharpest +sharply +sharpness +sharps +shatter +shav +shave +shaven +shaw +she +sheaf +sheal +shear +shearers +shearing +shearman +shears +sheath +sheathe +sheathed +sheathes +sheathing +sheaved +sheaves +shed +shedding +sheds +sheen +sheep +sheepcote +sheepcotes +sheeps +sheepskins +sheer +sheet +sheeted +sheets +sheffield +shelf +shell +shells +shelt +shelter +shelters +shelves +shelving +shelvy +shent +shepherd +shepherdes +shepherdess +shepherdesses +shepherds +sher +sheriff +sherris +shes +sheweth +shield +shielded +shields +shift +shifted +shifting +shifts +shilling +shillings +shin +shine +shines +shineth +shining +shins +shiny +ship +shipboard +shipman +shipmaster +shipmen +shipp +shipped +shipping +ships +shipt +shipwreck +shipwrecking +shipwright +shipwrights +shire +shirley +shirt +shirts +shive +shiver +shivering +shivers +shoal +shoals +shock +shocks +shod +shoe +shoeing +shoemaker +shoes +shog +shone +shook +shoon +shoot +shooter +shootie +shooting +shoots +shop +shops +shore +shores +shorn +short +shortcake +shorten +shortened +shortens +shorter +shortly +shortness +shot +shotten +shoughs +should +shoulder +shouldering +shoulders +shouldst +shout +shouted +shouting +shouts +shov +shove +shovel +shovels +show +showed +shower +showers +showest +showing +shown +shows +shreds +shrew +shrewd +shrewdly +shrewdness +shrewish +shrewishly +shrewishness +shrews +shrewsbury +shriek +shrieking +shrieks +shrieve +shrift +shrill +shriller +shrills +shrilly +shrimp +shrine +shrink +shrinking +shrinks +shriv +shrive +shriver +shrives +shriving +shroud +shrouded +shrouding +shrouds +shrove +shrow +shrows +shrub +shrubs +shrug +shrugs +shrunk +shudd +shudders +shuffl +shuffle +shuffled +shuffling +shun +shunless +shunn +shunned +shunning +shuns +shut +shuts +shuttle +shy +shylock +si +sibyl +sibylla +sibyls +sicil +sicilia +sicilian +sicilius +sicils +sicily +sicinius +sick +sicken +sickens +sicker +sickle +sicklemen +sicklied +sickliness +sickly +sickness +sicles +sicyon +side +sided +sides +siege +sieges +sienna +sies +sieve +sift +sifted +sigeia +sigh +sighed +sighing +sighs +sight +sighted +sightless +sightly +sights +sign +signal +signet +signieur +significant +significants +signified +signifies +signify +signifying +signior +signiories +signiors +signiory +signor +signories +signs +signum +silenc +silence +silenced +silencing +silent +silently +silius +silk +silken +silkman +silks +silliest +silliness +silling +silly +silva +silver +silvered +silverly +silvia +silvius +sima +simile +similes +simois +simon +simony +simp +simpcox +simple +simpleness +simpler +simples +simplicity +simply +simular +simulation +sin +since +sincere +sincerely +sincerity +sinel +sinew +sinewed +sinews +sinewy +sinful +sinfully +sing +singe +singeing +singer +singes +singeth +singing +single +singled +singleness +singly +sings +singular +singulariter +singularities +singularity +singuled +sinister +sink +sinking +sinks +sinn +sinner +sinners +sinning +sinon +sins +sip +sipping +sir +sire +siren +sirrah +sirs +sist +sister +sisterhood +sisterly +sisters +sit +sith +sithence +sits +sitting +situate +situation +situations +siward +six +sixpence +sixpences +sixpenny +sixteen +sixth +sixty +siz +size +sizes +sizzle +skains +skamble +skein +skelter +skies +skilful +skilfully +skill +skilless +skillet +skillful +skills +skim +skimble +skin +skinker +skinny +skins +skip +skipp +skipper +skipping +skirmish +skirmishes +skirr +skirted +skirts +skittish +skulking +skull +skulls +sky +skyey +skyish +slab +slack +slackly +slackness +slain +slake +sland +slander +slandered +slanderer +slanderers +slandering +slanderous +slanders +slash +slaught +slaughter +slaughtered +slaughterer +slaughterman +slaughtermen +slaughterous +slaughters +slave +slaver +slavery +slaves +slavish +slay +slayeth +slaying +slays +sleave +sledded +sleek +sleekly +sleep +sleeper +sleepers +sleepest +sleeping +sleeps +sleepy +sleeve +sleeves +sleid +sleided +sleight +sleights +slender +slenderer +slenderly +slept +slew +slewest +slice +slid +slide +slides +sliding +slight +slighted +slightest +slightly +slightness +slights +slily +slime +slimy +slings +slink +slip +slipp +slipper +slippers +slippery +slips +slish +slit +sliver +slobb +slomber +slop +slope +slops +sloth +slothful +slough +slovenly +slovenry +slow +slower +slowly +slowness +slubber +slug +sluggard +sluggardiz +sluggish +sluic +slumb +slumber +slumbers +slumbery +slunk +slut +sluts +sluttery +sluttish +sluttishness +sly +slys +smack +smacking +smacks +small +smaller +smallest +smallness +smalus +smart +smarting +smartly +smatch +smatter +smear +smell +smelling +smells +smelt +smil +smile +smiled +smiles +smilest +smilets +smiling +smilingly +smirch +smirched +smit +smite +smites +smith +smithfield +smock +smocks +smok +smoke +smoked +smokes +smoking +smoky +smooth +smoothed +smoothing +smoothly +smoothness +smooths +smote +smoth +smother +smothered +smothering +smug +smulkin +smutch +snaffle +snail +snails +snake +snakes +snaky +snap +snapp +snapper +snar +snare +snares +snarl +snarleth +snarling +snatch +snatchers +snatches +snatching +sneak +sneaking +sneap +sneaping +sneck +snip +snipe +snipt +snore +snores +snoring +snorting +snout +snow +snowballs +snowed +snowy +snuff +snuffs +snug +so +soak +soaking +soaks +soar +soaring +soars +sob +sobbing +sober +soberly +sobriety +sobs +sociable +societies +society +socks +socrates +sod +sodden +soe +soever +soft +soften +softens +softer +softest +softly +softness +soil +soiled +soilure +soit +sojourn +sol +sola +solace +solanio +sold +soldat +solder +soldest +soldier +soldiers +soldiership +sole +solely +solem +solemn +solemness +solemnities +solemnity +solemniz +solemnize +solemnized +solemnly +soles +solicit +solicitation +solicited +soliciting +solicitings +solicitor +solicits +solid +solidares +solidity +solinus +solitary +solomon +solon +solum +solus +solyman +some +somebody +someone +somerset +somerville +something +sometime +sometimes +somever +somewhat +somewhere +somewhither +somme +son +sonance +song +songs +sonnet +sonneting +sonnets +sons +sont +sonties +soon +sooner +soonest +sooth +soothe +soothers +soothing +soothsay +soothsayer +sooty +sop +sophister +sophisticated +sophy +sops +sorcerer +sorcerers +sorceress +sorceries +sorcery +sore +sorel +sorely +sorer +sores +sorrier +sorriest +sorrow +sorrowed +sorrowest +sorrowful +sorrowing +sorrows +sorry +sort +sortance +sorted +sorting +sorts +sossius +sot +soto +sots +sottish +soud +sought +soul +sould +soulless +souls +sound +sounded +sounder +soundest +sounding +soundless +soundly +soundness +soundpost +sounds +sour +source +sources +sourest +sourly +sours +sous +souse +south +southam +southampton +southerly +southern +southward +southwark +southwell +souviendrai +sov +sovereign +sovereignest +sovereignly +sovereignty +sovereignvours +sow +sowing +sowl +sowter +space +spaces +spacious +spade +spades +spain +spak +spake +spakest +span +spangle +spangled +spaniard +spaniel +spaniels +spanish +spann +spans +spar +spare +spares +sparing +sparingly +spark +sparkle +sparkles +sparkling +sparks +sparrow +sparrows +sparta +spartan +spavin +spavins +spawn +speak +speaker +speakers +speakest +speaketh +speaking +speaks +spear +speargrass +spears +special +specialities +specially +specialties +specialty +specify +speciously +spectacle +spectacled +spectacles +spectators +spectatorship +speculation +speculations +speculative +sped +speech +speeches +speechless +speed +speeded +speedier +speediest +speedily +speediness +speeding +speeds +speedy +speens +spell +spelling +spells +spelt +spencer +spend +spendest +spending +spends +spendthrift +spent +sperato +sperm +spero +sperr +spher +sphere +sphered +spheres +spherical +sphery +sphinx +spice +spiced +spicery +spices +spider +spiders +spied +spies +spieth +spightfully +spigot +spill +spilling +spills +spilt +spilth +spin +spinii +spinners +spinster +spinsters +spire +spirit +spirited +spiritless +spirits +spiritual +spiritualty +spirt +spit +spital +spite +spited +spiteful +spites +spits +spitted +spitting +splay +spleen +spleenful +spleens +spleeny +splendour +splenitive +splinter +splinters +split +splits +splitted +splitting +spoil +spoils +spok +spoke +spoken +spokes +spokesman +sponge +spongy +spoon +spoons +sport +sportful +sporting +sportive +sports +spot +spotless +spots +spotted +spousal +spouse +spout +spouting +spouts +sprag +sprang +sprat +sprawl +spray +sprays +spread +spreading +spreads +sprighted +sprightful +sprightly +sprigs +spring +springe +springes +springeth +springhalt +springing +springs +springtime +sprinkle +sprinkles +sprite +sprited +spritely +sprites +spriting +sprout +spruce +sprung +spun +spur +spurio +spurn +spurns +spurr +spurrer +spurring +spurs +spy +spying +squabble +squadron +squadrons +squand +squar +square +squarer +squares +squash +squeak +squeaking +squeal +squealing +squeezes +squeezing +squele +squier +squints +squiny +squire +squires +squirrel +st +stab +stabb +stabbed +stabbing +stable +stableness +stables +stablish +stablishment +stabs +stacks +staff +stafford +staffords +staffordshire +stag +stage +stages +stagger +staggering +staggers +stags +staid +staider +stain +stained +staines +staineth +staining +stainless +stains +stair +stairs +stake +stakes +stale +staled +stalk +stalking +stalks +stall +stalling +stalls +stamford +stammer +stamp +stamped +stamps +stanch +stanchless +stand +standard +standards +stander +standers +standest +standeth +standing +stands +staniel +stanley +stanze +stanzo +stanzos +staple +staples +star +stare +stared +stares +staring +starings +stark +starkly +starlight +starling +starr +starry +stars +start +started +starting +startingly +startle +startles +starts +starv +starve +starved +starvelackey +starveling +starveth +starving +state +statelier +stately +states +statesman +statesmen +statilius +station +statist +statists +statue +statues +stature +statures +statute +statutes +stave +staves +stay +stayed +stayest +staying +stays +stead +steaded +steadfast +steadier +steads +steal +stealer +stealers +stealing +steals +stealth +stealthy +steed +steeds +steel +steeled +steely +steep +steeped +steeple +steeples +steeps +steepy +steer +steerage +steering +steers +stelled +stem +stemming +stench +step +stepdame +stephano +stephen +stepmothers +stepp +stepping +steps +sterile +sterility +sterling +stern +sternage +sterner +sternest +sternness +steterat +stew +steward +stewards +stewardship +stewed +stews +stick +sticking +stickler +sticks +stiff +stiffen +stiffly +stifle +stifled +stifles +stigmatic +stigmatical +stile +still +stiller +stillest +stillness +stilly +sting +stinging +stingless +stings +stink +stinking +stinkingly +stinks +stint +stinted +stints +stir +stirr +stirred +stirrer +stirrers +stirreth +stirring +stirrup +stirrups +stirs +stitchery +stitches +stithied +stithy +stoccadoes +stoccata +stock +stockfish +stocking +stockings +stockish +stocks +stog +stogs +stoics +stokesly +stol +stole +stolen +stolest +stomach +stomachers +stomaching +stomachs +ston +stone +stonecutter +stones +stonish +stony +stood +stool +stools +stoop +stooping +stoops +stop +stope +stopp +stopped +stopping +stops +stor +store +storehouse +storehouses +stores +stories +storm +stormed +storming +storms +stormy +story +stoup +stoups +stout +stouter +stoutly +stoutness +stover +stow +stowage +stowed +strachy +stragglers +straggling +straight +straightest +straightway +strain +strained +straining +strains +strait +straited +straiter +straitly +straitness +straits +strand +strange +strangely +strangeness +stranger +strangers +strangest +strangle +strangled +strangler +strangles +strangling +strappado +straps +stratagem +stratagems +stratford +strato +straw +strawberries +strawberry +straws +strawy +stray +straying +strays +streak +streaks +stream +streamers +streaming +streams +streching +street +streets +strength +strengthen +strengthened +strengthless +strengths +stretch +stretched +stretches +stretching +strew +strewing +strewings +strewments +stricken +strict +stricter +strictest +strictly +stricture +stride +strides +striding +strife +strifes +strik +strike +strikers +strikes +strikest +striking +string +stringless +strings +strip +stripes +stripling +striplings +stripp +stripping +striv +strive +strives +striving +strok +stroke +strokes +strond +stronds +strong +stronger +strongest +strongly +strooke +strossers +strove +strown +stroy +struck +strucken +struggle +struggles +struggling +strumpet +strumpeted +strumpets +strung +strut +struts +strutted +strutting +stubble +stubborn +stubbornest +stubbornly +stubbornness +stuck +studded +student +students +studied +studies +studious +studiously +studs +study +studying +stuff +stuffing +stuffs +stumble +stumbled +stumblest +stumbling +stump +stumps +stung +stupefy +stupid +stupified +stuprum +sturdy +sty +styga +stygian +styl +style +styx +su +sub +subcontracted +subdu +subdue +subdued +subduements +subdues +subduing +subject +subjected +subjection +subjects +submerg +submission +submissive +submit +submits +submitting +suborn +subornation +suborned +subscrib +subscribe +subscribed +subscribes +subscription +subsequent +subsidies +subsidy +subsist +subsisting +substance +substances +substantial +substitute +substituted +substitutes +substitution +subtile +subtilly +subtle +subtleties +subtlety +subtly +subtractors +suburbs +subversion +subverts +succedant +succeed +succeeded +succeeders +succeeding +succeeds +success +successantly +successes +successful +successfully +succession +successive +successively +successor +successors +succour +succours +such +suck +sucker +suckers +sucking +suckle +sucks +sudden +suddenly +sue +sued +suerly +sues +sueth +suff +suffer +sufferance +sufferances +suffered +suffering +suffers +suffic +suffice +sufficed +suffices +sufficeth +sufficiency +sufficient +sufficiently +sufficing +sufficit +suffigance +suffocate +suffocating +suffocation +suffolk +suffrage +suffrages +sug +sugar +sugarsop +suggest +suggested +suggesting +suggestion +suggestions +suggests +suis +suit +suitable +suited +suiting +suitor +suitors +suits +suivez +sullen +sullens +sullied +sullies +sully +sulph +sulpherous +sulphur +sulphurous +sultan +sultry +sum +sumless +summ +summa +summary +summer +summers +summit +summon +summoners +summons +sumpter +sumptuous +sumptuously +sums +sun +sunbeams +sunburning +sunburnt +sund +sunday +sundays +sunder +sunders +sundry +sung +sunk +sunken +sunny +sunrising +suns +sunset +sunshine +sup +super +superficial +superficially +superfluity +superfluous +superfluously +superflux +superior +supernal +supernatural +superpraise +superscript +superscription +superserviceable +superstition +superstitious +superstitiously +supersubtle +supervise +supervisor +supp +supper +suppers +suppertime +supping +supplant +supple +suppler +suppliance +suppliant +suppliants +supplicant +supplication +supplications +supplie +supplied +supplies +suppliest +supply +supplyant +supplying +supplyment +support +supportable +supportance +supported +supporter +supporters +supporting +supportor +suppos +supposal +suppose +supposed +supposes +supposest +supposing +supposition +suppress +suppressed +suppresseth +supremacy +supreme +sups +sur +surance +surcease +surd +sure +surecard +surely +surer +surest +sureties +surety +surfeit +surfeited +surfeiter +surfeiting +surfeits +surge +surgeon +surgeons +surgere +surgery +surges +surly +surmis +surmise +surmised +surmises +surmount +surmounted +surmounts +surnam +surname +surnamed +surpasseth +surpassing +surplice +surplus +surpris +surprise +surprised +surrender +surrey +surreys +survey +surveyest +surveying +surveyor +surveyors +surveys +survive +survives +survivor +susan +suspect +suspected +suspecting +suspects +suspend +suspense +suspicion +suspicions +suspicious +suspiration +suspire +sust +sustain +sustaining +sutler +sutton +suum +swabber +swaddling +swag +swagg +swagger +swaggerer +swaggerers +swaggering +swain +swains +swallow +swallowed +swallowing +swallows +swam +swan +swans +sward +sware +swarm +swarming +swart +swarth +swarths +swarthy +swashers +swashing +swath +swathing +swathling +sway +swaying +sways +swear +swearer +swearers +swearest +swearing +swearings +swears +sweat +sweaten +sweating +sweats +sweaty +sweep +sweepers +sweeps +sweet +sweeten +sweetens +sweeter +sweetest +sweetheart +sweeting +sweetly +sweetmeats +sweetness +sweets +swell +swelling +swellings +swells +swelter +sweno +swept +swerve +swerver +swerving +swift +swifter +swiftest +swiftly +swiftness +swill +swills +swim +swimmer +swimmers +swimming +swims +swine +swineherds +swing +swinge +swinish +swinstead +switches +swits +switzers +swol +swoll +swoln +swoon +swooned +swooning +swoons +swoop +swoopstake +swor +sword +sworder +swords +swore +sworn +swounded +swounds +swum +swung +sy +sycamore +sycorax +sylla +syllable +syllables +syllogism +symbols +sympathise +sympathiz +sympathize +sympathized +sympathy +synagogue +synod +synods +syracuse +syracusian +syracusians +syria +syrups +t +ta +taber +table +tabled +tables +tablet +tabor +taborer +tabors +tabourines +taciturnity +tack +tackle +tackled +tackles +tackling +tacklings +taddle +tadpole +taffeta +taffety +tag +tagrag +tah +tail +tailor +tailors +tails +taint +tainted +tainting +taints +tainture +tak +take +taken +taker +takes +takest +taketh +taking +tal +talbot +talbotites +talbots +tale +talent +talents +taleporter +tales +talk +talked +talker +talkers +talkest +talking +talks +tall +taller +tallest +tallies +tallow +tally +talons +tam +tambourines +tame +tamed +tamely +tameness +tamer +tames +taming +tamora +tamworth +tan +tang +tangle +tangled +tank +tanlings +tann +tanned +tanner +tanquam +tanta +tantaene +tap +tape +taper +tapers +tapestries +tapestry +taphouse +tapp +tapster +tapsters +tar +tardied +tardily +tardiness +tardy +tarentum +targe +targes +target +targets +tarpeian +tarquin +tarquins +tarr +tarre +tarriance +tarried +tarries +tarry +tarrying +tart +tartar +tartars +tartly +tartness +task +tasker +tasking +tasks +tassel +taste +tasted +tastes +tasting +tatt +tatter +tattered +tatters +tattle +tattling +tattlings +taught +taunt +taunted +taunting +tauntingly +taunts +taurus +tavern +taverns +tavy +tawdry +tawny +tax +taxation +taxations +taxes +taxing +tc +te +teach +teacher +teachers +teaches +teachest +teacheth +teaching +team +tear +tearful +tearing +tears +tearsheet +teat +tedious +tediously +tediousness +teem +teeming +teems +teen +teeth +teipsum +telamon +telamonius +tell +teller +telling +tells +tellus +temp +temper +temperality +temperance +temperate +temperately +tempers +tempest +tempests +tempestuous +temple +temples +temporal +temporary +temporiz +temporize +temporizer +temps +tempt +temptation +temptations +tempted +tempter +tempters +tempteth +tempting +tempts +ten +tenable +tenant +tenantius +tenantless +tenants +tench +tend +tendance +tended +tender +tendered +tenderly +tenderness +tenders +tending +tends +tenedos +tenement +tenements +tenfold +tennis +tenour +tenours +tens +tent +tented +tenth +tenths +tents +tenure +tenures +tercel +tereus +term +termagant +termed +terminations +termless +terms +terra +terrace +terram +terras +terre +terrene +terrestrial +terrible +terribly +territories +territory +terror +terrors +tertian +tertio +test +testament +tested +tester +testern +testify +testimonied +testimonies +testimony +testiness +testril +testy +tetchy +tether +tetter +tevil +tewksbury +text +tgv +th +thaes +thames +than +thane +thanes +thank +thanked +thankful +thankfully +thankfulness +thanking +thankings +thankless +thanks +thanksgiving +thasos +that +thatch +thaw +thawing +thaws +the +theatre +theban +thebes +thee +theft +thefts +thein +their +theirs +theise +them +theme +themes +themselves +then +thence +thenceforth +theoric +there +thereabout +thereabouts +thereafter +thereat +thereby +therefore +therein +thereof +thereon +thereto +thereunto +thereupon +therewith +therewithal +thersites +these +theseus +thessalian +thessaly +thetis +thews +they +thick +thicken +thickens +thicker +thickest +thicket +thickskin +thief +thievery +thieves +thievish +thigh +thighs +thimble +thimbles +thin +thine +thing +things +think +thinkest +thinking +thinkings +thinks +thinkst +thinly +third +thirdly +thirds +thirst +thirsting +thirsts +thirsty +thirteen +thirties +thirtieth +thirty +this +thisby +thisne +thistle +thistles +thither +thitherward +thoas +thomas +thorn +thorns +thorny +thorough +thoroughly +those +thou +though +thought +thoughtful +thoughts +thousand +thousands +thracian +thraldom +thrall +thralled +thralls +thrash +thrasonical +thread +threadbare +threaden +threading +threat +threaten +threatening +threatens +threatest +threats +three +threefold +threepence +threepile +threes +threescore +thresher +threshold +threw +thrice +thrift +thriftless +thrifts +thrifty +thrill +thrilling +thrills +thrive +thrived +thrivers +thrives +thriving +throat +throats +throbbing +throbs +throca +throe +throes +thromuldo +thron +throne +throned +thrones +throng +thronging +throngs +throstle +throttle +through +throughfare +throughfares +throughly +throughout +throw +thrower +throwest +throwing +thrown +throws +thrum +thrumm +thrush +thrust +thrusteth +thrusting +thrusts +thumb +thumbs +thump +thund +thunder +thunderbolt +thunderbolts +thunderer +thunders +thunderstone +thunderstroke +thurio +thursday +thus +thwack +thwart +thwarted +thwarting +thwartings +thy +thyme +thymus +thyreus +thyself +ti +tib +tiber +tiberio +tibey +ticed +tick +tickl +tickle +tickled +tickles +tickling +ticklish +tiddle +tide +tides +tidings +tidy +tie +tied +ties +tiff +tiger +tigers +tight +tightly +tike +til +tile +till +tillage +tilly +tilt +tilter +tilth +tilting +tilts +tiltyard +tim +timandra +timber +time +timeless +timelier +timely +times +timon +timor +timorous +timorously +tinct +tincture +tinctures +tinder +tingling +tinker +tinkers +tinsel +tiny +tip +tipp +tippling +tips +tipsy +tiptoe +tir +tire +tired +tires +tirest +tiring +tirra +tirrits +tis +tish +tisick +tissue +titan +titania +tithe +tithed +tithing +titinius +title +titled +titleless +titles +tittle +tittles +titular +titus +tn +to +toad +toads +toadstool +toast +toasted +toasting +toasts +toaze +toby +tock +tod +today +todpole +tods +toe +toes +tofore +toge +toged +together +toil +toiled +toiling +toils +token +tokens +told +toledo +tolerable +toll +tolling +tom +tomb +tombe +tombed +tombless +tomboys +tombs +tomorrow +tomyris +ton +tongs +tongu +tongue +tongued +tongueless +tongues +tonight +too +took +tool +tools +tooth +toothache +toothpick +toothpicker +top +topas +topful +topgallant +topless +topmast +topp +topping +topple +topples +tops +topsail +topsy +torch +torchbearer +torchbearers +torcher +torches +torchlight +tore +torment +tormenta +tormente +tormented +tormenting +tormentors +torments +torn +torrent +tortive +tortoise +tortur +torture +tortured +torturer +torturers +tortures +torturest +torturing +toryne +toss +tossed +tosseth +tossing +tot +total +totally +tott +tottered +totters +tou +touch +touched +touches +toucheth +touching +touchstone +tough +tougher +toughness +touraine +tournaments +tours +tous +tout +touze +tow +toward +towardly +towards +tower +towering +towers +town +towns +township +townsman +townsmen +towton +toy +toys +trace +traces +track +tract +tractable +trade +traded +traders +trades +tradesman +tradesmen +trading +tradition +traditional +traduc +traduced +traducement +traffic +traffickers +traffics +tragedian +tragedians +tragedies +tragedy +tragic +tragical +trail +train +trained +training +trains +trait +traitor +traitorly +traitorous +traitorously +traitors +traitress +traject +trammel +trample +trampled +trampling +tranc +trance +tranio +tranquil +tranquillity +transcendence +transcends +transferred +transfigur +transfix +transform +transformation +transformations +transformed +transgress +transgresses +transgressing +transgression +translate +translated +translates +translation +transmigrates +transmutation +transparent +transport +transportance +transported +transporting +transports +transpose +transshape +trap +trapp +trappings +traps +trash +travail +travails +travel +traveler +traveling +travell +travelled +traveller +travellers +travellest +travelling +travels +travers +traverse +tray +treacherous +treacherously +treachers +treachery +tread +treading +treads +treason +treasonable +treasonous +treasons +treasure +treasurer +treasures +treasuries +treasury +treat +treaties +treatise +treats +treaty +treble +trebled +trebles +trebonius +tree +trees +tremble +trembled +trembles +tremblest +trembling +tremblingly +tremor +trempling +trench +trenchant +trenched +trencher +trenchering +trencherman +trenchers +trenches +trenching +trent +tres +trespass +trespasses +tressel +tresses +treys +trial +trials +trib +tribe +tribes +tribulation +tribunal +tribune +tribunes +tributaries +tributary +tribute +tributes +trice +trick +tricking +trickling +tricks +tricksy +trident +tried +trier +trifle +trifled +trifler +trifles +trifling +trigon +trill +trim +trimly +trimm +trimmed +trimming +trims +trinculo +trinculos +trinkets +trip +tripartite +tripe +triple +triplex +tripoli +tripolis +tripp +tripping +trippingly +trips +tristful +triton +triumph +triumphant +triumphantly +triumpher +triumphers +triumphing +triumphs +triumvir +triumvirate +triumvirs +triumviry +trivial +troat +trod +trodden +troiant +troien +troilus +troiluses +trojan +trojans +troll +tromperies +trompet +troop +trooping +troops +trop +trophies +trophy +tropically +trot +troth +trothed +troths +trots +trotting +trouble +troubled +troubler +troubles +troublesome +troublest +troublous +trough +trout +trouts +trovato +trow +trowel +trowest +troy +troyan +troyans +truant +truce +truckle +trudge +true +trueborn +truepenny +truer +truest +truie +trull +trulls +truly +trump +trumpery +trumpet +trumpeter +trumpeters +trumpets +truncheon +truncheoners +trundle +trunk +trunks +trust +trusted +truster +trusters +trusting +trusts +trusty +truth +truths +try +ts +tu +tuae +tub +tubal +tubs +tuck +tucket +tuesday +tuft +tufts +tug +tugg +tugging +tuition +tullus +tully +tumble +tumbled +tumbler +tumbling +tumult +tumultuous +tun +tune +tuneable +tuned +tuners +tunes +tunis +tuns +tupping +turban +turbans +turbulence +turbulent +turd +turf +turfy +turk +turkey +turkeys +turkish +turks +turlygod +turmoil +turmoiled +turn +turnbull +turncoat +turncoats +turned +turneth +turning +turnips +turns +turph +turpitude +turquoise +turret +turrets +turtle +turtles +turvy +tuscan +tush +tut +tutor +tutored +tutors +tutto +twain +twang +twangling +twas +tway +tweaks +tween +twelfth +twelve +twelvemonth +twentieth +twenty +twere +twice +twig +twiggen +twigs +twilight +twill +twilled +twin +twine +twink +twinkle +twinkled +twinkling +twinn +twins +twire +twist +twisted +twit +twits +twitting +twixt +two +twofold +twopence +twopences +twos +twould +tyb +tybalt +tybalts +tyburn +tying +tyke +tymbria +type +types +typhon +tyrannical +tyrannically +tyrannize +tyrannous +tyranny +tyrant +tyrants +tyrian +tyrrel +u +ubique +udders +udge +uds +uglier +ugliest +ugly +ulcer +ulcerous +ulysses +um +umber +umbra +umbrage +umfrevile +umpire +umpires +un +unable +unaccommodated +unaccompanied +unaccustom +unaching +unacquainted +unactive +unadvis +unadvised +unadvisedly +unagreeable +unanel +unanswer +unappeas +unapproved +unapt +unaptness +unarm +unarmed +unarms +unassail +unassailable +unattainted +unattempted +unattended +unauspicious +unauthorized +unavoided +unawares +unback +unbak +unbanded +unbar +unbarb +unbashful +unbated +unbatter +unbecoming +unbefitting +unbegot +unbegotten +unbelieved +unbend +unbent +unbewail +unbid +unbidden +unbind +unbinds +unbitted +unbless +unblest +unbloodied +unblown +unbodied +unbolt +unbolted +unbonneted +unbookish +unborn +unbosom +unbound +unbounded +unbow +unbowed +unbrac +unbraced +unbraided +unbreathed +unbred +unbreech +unbridled +unbroke +unbruis +unbruised +unbuckle +unbuckles +unbuckling +unbuild +unburden +unburdens +unburied +unburnt +unburthen +unbutton +unbuttoning +uncapable +uncape +uncase +uncasing +uncaught +uncertain +uncertainty +unchain +unchanging +uncharge +uncharged +uncharitably +unchary +unchaste +uncheck +unchilded +uncivil +unclaim +unclasp +uncle +unclean +uncleanliness +uncleanly +uncleanness +uncles +unclew +unclog +uncoined +uncolted +uncomeliness +uncomfortable +uncompassionate +uncomprehensive +unconfinable +unconfirm +unconfirmed +unconquer +unconquered +unconsidered +unconstant +unconstrain +unconstrained +uncontemn +uncontroll +uncorrected +uncounted +uncouple +uncourteous +uncouth +uncover +uncovered +uncropped +uncross +uncrown +unction +unctuous +uncuckolded +uncurable +uncurbable +uncurbed +uncurls +uncurrent +uncurse +undaunted +undeaf +undeck +undeeded +under +underbearing +underborne +undercrest +underfoot +undergo +undergoes +undergoing +undergone +underground +underhand +underlings +undermine +underminers +underneath +underprizing +underprop +understand +understandeth +understanding +understandings +understands +understood +underta +undertake +undertakeing +undertaker +undertakes +undertaking +undertakings +undertook +undervalu +undervalued +underwent +underwrit +underwrite +undescried +undeserved +undeserver +undeservers +undeserving +undetermin +undid +undinted +undiscernible +undiscover +undishonoured +undispos +undistinguishable +undistinguished +undividable +undivided +undivulged +undo +undoes +undoing +undone +undoubted +undoubtedly +undream +undress +undressed +undrown +unduteous +undutiful +une +uneared +unearned +unearthly +uneasines +uneasy +uneath +uneducated +uneffectual +unelected +unequal +uneven +unexamin +unexecuted +unexpected +unexperienc +unexperient +unexpressive +unfair +unfaithful +unfallible +unfam +unfashionable +unfasten +unfather +unfathered +unfed +unfeed +unfeeling +unfeigned +unfeignedly +unfellowed +unfelt +unfenced +unfilial +unfill +unfinish +unfirm +unfit +unfitness +unfix +unfledg +unfold +unfolded +unfoldeth +unfolding +unfolds +unfool +unforc +unforced +unforfeited +unfortified +unfortunate +unfought +unfrequented +unfriended +unfurnish +ungain +ungalled +ungart +ungarter +ungenitur +ungentle +ungentleness +ungently +ungird +ungodly +ungor +ungot +ungotten +ungovern +ungracious +ungrateful +ungravely +ungrown +unguarded +unguem +unguided +unhack +unhair +unhallow +unhallowed +unhand +unhandled +unhandsome +unhang +unhappied +unhappily +unhappiness +unhappy +unhardened +unharm +unhatch +unheard +unhearts +unheedful +unheedfully +unheedy +unhelpful +unhidden +unholy +unhop +unhopefullest +unhorse +unhospitable +unhous +unhoused +unhurtful +unicorn +unicorns +unimproved +uninhabitable +uninhabited +unintelligent +union +unions +unite +united +unity +universal +universe +universities +university +unjointed +unjust +unjustice +unjustly +unkennel +unkept +unkind +unkindest +unkindly +unkindness +unking +unkinglike +unkiss +unknit +unknowing +unknown +unlace +unlaid +unlawful +unlawfully +unlearn +unlearned +unless +unlesson +unletter +unlettered +unlick +unlike +unlikely +unlimited +unlineal +unlink +unload +unloaded +unloading +unloads +unlock +unlocks +unlook +unlooked +unloos +unloose +unlov +unloving +unluckily +unlucky +unmade +unmake +unmanly +unmann +unmanner +unmannerd +unmannerly +unmarried +unmask +unmasked +unmasking +unmasks +unmast +unmatch +unmatchable +unmatched +unmeasurable +unmeet +unmellowed +unmerciful +unmeritable +unmeriting +unminded +unmindfull +unmingled +unmitigable +unmitigated +unmix +unmoan +unmov +unmoved +unmoving +unmuffles +unmuffling +unmusical +unmuzzle +unmuzzled +unnatural +unnaturally +unnaturalness +unnecessarily +unnecessary +unneighbourly +unnerved +unnoble +unnoted +unnumb +unnumber +unowed +unpack +unpaid +unparagon +unparallel +unpartial +unpath +unpaved +unpay +unpeaceable +unpeg +unpeople +unpeopled +unperfect +unperfectness +unpick +unpin +unpink +unpitied +unpitifully +unplagu +unplausive +unpleas +unpleasant +unpleasing +unpolicied +unpolish +unpolished +unpolluted +unpossess +unpossessing +unpossible +unpractis +unpregnant +unpremeditated +unprepar +unprepared +unpress +unprevailing +unprevented +unpriz +unprizable +unprofitable +unprofited +unproper +unproperly +unproportion +unprovide +unprovided +unprovident +unprovokes +unprun +unpruned +unpublish +unpurged +unpurpos +unqualitied +unqueen +unquestion +unquestionable +unquiet +unquietly +unquietness +unraised +unrak +unread +unready +unreal +unreasonable +unreasonably +unreclaimed +unreconciled +unreconciliable +unrecounted +unrecuring +unregarded +unregist +unrelenting +unremovable +unremovably +unreprievable +unresolv +unrespected +unrespective +unrest +unrestor +unrestrained +unreveng +unreverend +unreverent +unrevers +unrewarded +unrighteous +unrightful +unripe +unripp +unrivall +unroll +unroof +unroosted +unroot +unrough +unruly +unsafe +unsaluted +unsanctified +unsatisfied +unsavoury +unsay +unscalable +unscann +unscarr +unschool +unscorch +unscour +unscratch +unseal +unseam +unsearch +unseason +unseasonable +unseasonably +unseasoned +unseconded +unsecret +unseduc +unseeing +unseeming +unseemly +unseen +unseminar +unseparable +unserviceable +unset +unsettle +unsettled +unsever +unsex +unshak +unshaked +unshaken +unshaped +unshapes +unsheath +unsheathe +unshorn +unshout +unshown +unshrinking +unshrubb +unshunn +unshunnable +unsifted +unsightly +unsinew +unsisting +unskilful +unskilfully +unskillful +unslipping +unsmirched +unsoil +unsolicited +unsorted +unsought +unsound +unsounded +unspeak +unspeakable +unspeaking +unsphere +unspoke +unspoken +unspotted +unsquar +unstable +unstaid +unstain +unstained +unstanched +unstate +unsteadfast +unstooping +unstringed +unstuff +unsubstantial +unsuitable +unsuiting +unsullied +unsunn +unsur +unsure +unsuspected +unsway +unswayable +unswayed +unswear +unswept +unsworn +untainted +untalk +untangle +untangled +untasted +untaught +untempering +untender +untent +untented +unthankful +unthankfulness +unthink +unthought +unthread +unthrift +unthrifts +unthrifty +untie +untied +until +untimber +untimely +untir +untirable +untired +untitled +unto +untold +untouch +untoward +untowardly +untraded +untrain +untrained +untread +untreasur +untried +untrimmed +untrod +untrodden +untroubled +untrue +untrussing +untruth +untruths +untucked +untun +untune +untuneable +untutor +untutored +untwine +unurg +unus +unused +unusual +unvalued +unvanquish +unvarnish +unveil +unveiling +unvenerable +unvex +unviolated +unvirtuous +unvisited +unvulnerable +unwares +unwarily +unwash +unwatch +unwearied +unwed +unwedgeable +unweeded +unweighed +unweighing +unwelcome +unwept +unwhipp +unwholesome +unwieldy +unwilling +unwillingly +unwillingness +unwind +unwiped +unwise +unwisely +unwish +unwished +unwitted +unwittingly +unwonted +unwooed +unworthier +unworthiest +unworthily +unworthiness +unworthy +unwrung +unyok +unyoke +up +upbraid +upbraided +upbraidings +upbraids +uphoarded +uphold +upholdeth +upholding +upholds +uplift +uplifted +upmost +upon +upper +uprear +upreared +upright +uprighteously +uprightness +uprise +uprising +uproar +uproars +uprous +upshoot +upshot +upside +upspring +upstairs +upstart +upturned +upward +upwards +urchin +urchinfield +urchins +urg +urge +urged +urgent +urges +urgest +urging +urinal +urinals +urine +urn +urns +urs +ursa +ursley +ursula +urswick +us +usage +usance +usances +use +used +useful +useless +user +uses +usest +useth +usher +ushered +ushering +ushers +using +usual +usually +usurer +usurers +usuries +usuring +usurp +usurpation +usurped +usurper +usurpers +usurping +usurpingly +usurps +usury +ut +utensil +utensils +utility +utmost +utt +utter +utterance +uttered +uttereth +uttering +utterly +uttermost +utters +uy +v +va +vacancy +vacant +vacation +vade +vagabond +vagabonds +vagram +vagrom +vail +vailed +vailing +vaillant +vain +vainer +vainglory +vainly +vainness +vais +valanc +valance +vale +valence +valentine +valentinus +valentio +valeria +valerius +vales +valiant +valiantly +valiantness +validity +vallant +valley +valleys +vally +valor +valorous +valorously +valour +valu +valuation +value +valued +valueless +values +valuing +vane +vanish +vanished +vanishes +vanishest +vanishing +vanities +vanity +vanquish +vanquished +vanquisher +vanquishest +vanquisheth +vant +vantage +vantages +vantbrace +vapians +vapor +vaporous +vapour +vapours +vara +variable +variance +variation +variations +varied +variest +variety +varld +varlet +varletry +varlets +varletto +varnish +varrius +varro +vary +varying +vassal +vassalage +vassals +vast +vastidity +vasty +vat +vater +vaudemont +vaughan +vault +vaultages +vaulted +vaulting +vaults +vaulty +vaumond +vaunt +vaunted +vaunter +vaunting +vauntingly +vaunts +vauvado +vaux +vaward +ve +veal +vede +vehemence +vehemency +vehement +vehor +veil +veiled +veiling +vein +veins +vell +velure +velutus +velvet +vendible +venerable +venereal +venetia +venetian +venetians +veneys +venge +vengeance +vengeances +vengeful +veni +venial +venice +venison +venit +venom +venomous +venomously +vent +ventages +vented +ventidius +ventricle +vents +ventur +venture +ventured +ventures +venturing +venturous +venue +venus +venuto +ver +verb +verba +verbal +verbatim +verbosity +verdict +verdun +verdure +vere +verefore +verg +verge +vergers +verges +verier +veriest +verified +verify +verily +veritable +verite +verities +verity +vermilion +vermin +vernon +verona +veronesa +versal +verse +verses +versing +vert +very +vesper +vessel +vessels +vestal +vestments +vesture +vetch +vetches +veux +vex +vexation +vexations +vexed +vexes +vexest +vexeth +vexing +vi +via +vial +vials +viand +viands +vic +vicar +vice +vicegerent +vicentio +viceroy +viceroys +vices +vici +vicious +viciousness +vict +victims +victor +victoress +victories +victorious +victors +victory +victual +victuall +victuals +videlicet +video +vides +videsne +vidi +vie +vied +vienna +view +viewest +vieweth +viewing +viewless +views +vigil +vigilance +vigilant +vigitant +vigour +vii +viii +vile +vilely +vileness +viler +vilest +vill +village +villager +villagery +villages +villain +villainies +villainous +villainously +villains +villainy +villanies +villanous +villany +villiago +villian +villianda +villians +vinaigre +vincentio +vincere +vindicative +vine +vinegar +vines +vineyard +vineyards +vint +vintner +viol +viola +violate +violated +violates +violation +violator +violence +violent +violenta +violenteth +violently +violet +violets +viper +viperous +vipers +vir +virgilia +virgin +virginal +virginalling +virginity +virginius +virgins +virgo +virtue +virtues +virtuous +virtuously +visag +visage +visages +visard +viscount +visible +visibly +vision +visions +visit +visitation +visitations +visited +visiting +visitings +visitor +visitors +visits +visor +vita +vitae +vital +vitement +vitruvio +vitx +viva +vivant +vive +vixen +viz +vizaments +vizard +vizarded +vizards +vizor +vlouting +vocation +vocativo +vocatur +voce +voic +voice +voices +void +voided +voiding +voke +volable +volant +volivorco +volley +volquessen +volsce +volsces +volscian +volscians +volt +voltemand +volubility +voluble +volume +volumes +volumnia +volumnius +voluntaries +voluntary +voluptuously +voluptuousness +vomissement +vomit +vomits +vor +vore +vortnight +vot +votaries +votarist +votarists +votary +votre +vouch +voucher +vouchers +vouches +vouching +vouchsaf +vouchsafe +vouchsafed +vouchsafes +vouchsafing +voudrais +vour +vous +voutsafe +vow +vowed +vowel +vowels +vowing +vows +vox +voyage +voyages +vraiment +vulcan +vulgar +vulgarly +vulgars +vulgo +vulnerable +vulture +vultures +vurther +w +wad +waddled +wade +waded +wafer +waft +waftage +wafting +wafts +wag +wage +wager +wagers +wages +wagging +waggish +waggling +waggon +waggoner +wagon +wagoner +wags +wagtail +wail +wailful +wailing +wails +wain +wainropes +wainscot +waist +wait +waited +waiter +waiteth +waiting +waits +wak +wake +waked +wakefield +waken +wakened +wakes +wakest +waking +wales +walk +walked +walking +walks +wall +walled +wallet +wallets +wallon +walloon +wallow +walls +walnut +walter +wan +wand +wander +wanderer +wanderers +wandering +wanders +wands +wane +waned +wanes +waning +wann +want +wanted +wanteth +wanting +wanton +wantonly +wantonness +wantons +wants +wappen +war +warble +warbling +ward +warded +warden +warder +warders +wardrobe +wardrop +wards +ware +wares +warily +warkworth +warlike +warm +warmed +warmer +warming +warms +warmth +warn +warned +warning +warnings +warns +warp +warped +warr +warrant +warranted +warranteth +warrantise +warrantize +warrants +warranty +warren +warrener +warring +warrior +warriors +wars +wart +warwick +warwickshire +wary +was +wash +washed +washer +washes +washford +washing +wasp +waspish +wasps +wassail +wassails +wast +waste +wasted +wasteful +wasters +wastes +wasting +wat +watch +watched +watchers +watches +watchful +watching +watchings +watchman +watchmen +watchword +water +waterdrops +watered +waterfly +waterford +watering +waterish +waterpots +waterrugs +waters +waterton +watery +wav +wave +waved +waver +waverer +wavering +waves +waving +waw +wawl +wax +waxed +waxen +waxes +waxing +way +waylaid +waylay +ways +wayward +waywarder +waywardness +we +weak +weaken +weakens +weaker +weakest +weakling +weakly +weakness +weal +wealsmen +wealth +wealthiest +wealthily +wealthy +wealtlly +wean +weapon +weapons +wear +wearer +wearers +wearied +wearies +weariest +wearily +weariness +wearing +wearisome +wears +weary +weasel +weather +weathercock +weathers +weav +weave +weaver +weavers +weaves +weaving +web +wed +wedded +wedding +wedg +wedged +wedges +wedlock +wednesday +weed +weeded +weeder +weeding +weeds +weedy +week +weeke +weekly +weeks +ween +weening +weep +weeper +weeping +weepingly +weepings +weeps +weet +weigh +weighed +weighing +weighs +weight +weightier +weightless +weights +weighty +weird +welcom +welcome +welcomer +welcomes +welcomest +welfare +welkin +well +wells +welsh +welshman +welshmen +welshwomen +wench +wenches +wenching +wend +went +wept +weraday +were +wert +west +western +westminster +westmoreland +westward +wet +wether +wetting +wezand +whale +whales +wharf +wharfs +what +whate +whatever +whatsoe +whatsoever +whatsome +whe +wheat +wheaten +wheel +wheeling +wheels +wheer +wheeson +wheezing +whelk +whelks +whelm +whelp +whelped +whelps +when +whenas +whence +whencesoever +whene +whenever +whensoever +where +whereabout +whereas +whereat +whereby +wherefore +wherein +whereinto +whereof +whereon +whereout +whereso +wheresoe +wheresoever +wheresome +whereto +whereuntil +whereunto +whereupon +wherever +wherewith +wherewithal +whet +whether +whetstone +whetted +whew +whey +which +whiff +whiffler +while +whiles +whilst +whin +whine +whined +whinid +whining +whip +whipp +whippers +whipping +whips +whipster +whipstock +whipt +whirl +whirled +whirligig +whirling +whirlpool +whirls +whirlwind +whirlwinds +whisp +whisper +whispering +whisperings +whispers +whist +whistle +whistles +whistling +whit +white +whitehall +whitely +whiteness +whiter +whites +whitest +whither +whiting +whitmore +whitsters +whitsun +whittle +whizzing +who +whoa +whoe +whoever +whole +wholesom +wholesome +wholly +whom +whoobub +whoop +whooping +whor +whore +whoremaster +whoremasterly +whoremonger +whores +whoreson +whoresons +whoring +whorish +whose +whoso +whosoe +whosoever +why +wi +wick +wicked +wickednes +wickedness +wicket +wicky +wid +wide +widens +wider +widow +widowed +widower +widowhood +widows +wield +wife +wight +wights +wild +wildcats +wilder +wilderness +wildest +wildfire +wildly +wildness +wilds +wiles +wilful +wilfull +wilfully +wilfulnes +wilfulness +will +willed +willers +willeth +william +williams +willing +willingly +willingness +willoughby +willow +wills +wilt +wiltshire +wimpled +win +wince +winch +winchester +wincot +wind +winded +windgalls +winding +windlasses +windmill +window +windows +windpipe +winds +windsor +windy +wine +wing +winged +wingfield +wingham +wings +wink +winking +winks +winner +winners +winning +winnow +winnowed +winnows +wins +winter +winterly +winters +wip +wipe +wiped +wipes +wiping +wire +wires +wiry +wisdom +wisdoms +wise +wiselier +wisely +wiser +wisest +wish +wished +wisher +wishers +wishes +wishest +wisheth +wishful +wishing +wishtly +wisp +wist +wit +witb +witch +witchcraft +witches +witching +with +withal +withdraw +withdrawing +withdrawn +withdrew +wither +withered +withering +withers +withheld +withhold +withholds +within +withold +without +withstand +withstanding +withstood +witless +witness +witnesses +witnesseth +witnessing +wits +witted +wittenberg +wittiest +wittily +witting +wittingly +wittol +wittolly +witty +wiv +wive +wived +wives +wiving +wizard +wizards +wo +woe +woeful +woefull +woefullest +woes +woful +wolf +wolfish +wolsey +wolves +wolvish +woman +womanhood +womanish +womankind +womanly +womb +wombs +womby +women +won +woncot +wond +wonder +wondered +wonderful +wonderfully +wondering +wonders +wondrous +wondrously +wont +wonted +woo +wood +woodbine +woodcock +woodcocks +wooden +woodland +woodman +woodmonger +woods +woodstock +woodville +wooed +wooer +wooers +wooes +woof +wooing +wooingly +wool +woollen +woolly +woolsack +woolsey +woolward +woos +wor +worcester +word +words +wore +worins +work +workers +working +workings +workman +workmanly +workmanship +workmen +works +worky +world +worldlings +worldly +worlds +worm +worms +wormwood +wormy +worn +worried +worries +worry +worrying +worse +worser +worship +worshipful +worshipfully +worshipp +worshipper +worshippers +worshippest +worships +worst +worsted +wort +worth +worthied +worthier +worthies +worthiest +worthily +worthiness +worthless +worths +worthy +worts +wot +wots +wotting +wouid +would +wouldest +wouldst +wound +wounded +wounding +woundings +woundless +wounds +wouns +woven +wow +wrack +wrackful +wrangle +wrangler +wranglers +wrangling +wrap +wrapp +wraps +wrapt +wrath +wrathful +wrathfully +wraths +wreak +wreakful +wreaks +wreath +wreathed +wreathen +wreaths +wreck +wrecked +wrecks +wren +wrench +wrenching +wrens +wrest +wrested +wresting +wrestle +wrestled +wrestler +wrestling +wretch +wretchcd +wretched +wretchedness +wretches +wring +wringer +wringing +wrings +wrinkle +wrinkled +wrinkles +wrist +wrists +writ +write +writer +writers +writes +writhled +writing +writings +writs +written +wrong +wronged +wronger +wrongful +wrongfully +wronging +wrongly +wrongs +wronk +wrote +wroth +wrought +wrung +wry +wrying +wt +wul +wye +x +xanthippe +xi +xii +xiii +xiv +xv +y +yard +yards +yare +yarely +yarn +yaughan +yaw +yawn +yawning +ycleped +ycliped +ye +yea +yead +year +yearly +yearn +yearns +years +yeas +yeast +yedward +yell +yellow +yellowed +yellowing +yellowness +yellows +yells +yelping +yeoman +yeomen +yerk +yes +yesterday +yesterdays +yesternight +yesty +yet +yew +yicld +yield +yielded +yielder +yielders +yielding +yields +yok +yoke +yoked +yokefellow +yokes +yoketh +yon +yond +yonder +yongrey +yore +yorick +york +yorkists +yorks +yorkshire +you +young +younger +youngest +youngling +younglings +youngly +younker +your +yours +yourself +yourselves +youth +youthful +youths +youtli +zanies +zany +zeal +zealous +zeals +zed +zenelophon +zenith +zephyrs +zir +zo +zodiac +zodiacs +zone +zounds +zwagger diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 92d039a15d..bcd91a4d94 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays byte-arrays generic hashtables io assocs -kernel math namespaces make sequences strings sbufs io.styles -vectors words prettyprint.config prettyprint.custom -prettyprint.sections quotations io io.files math.parser effects +kernel math namespaces make sequences strings sbufs vectors +words prettyprint.config prettyprint.custom prettyprint.sections +quotations io io.pathnames io.styles math.parser effects classes.tuple math.order classes.tuple.private classes combinators colors ; IN: prettyprint.backend diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index 46d4e6e5ff..1e372d7cc0 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -193,11 +193,11 @@ HELP: unparse HELP: pprint-short { $values { "obj" object } } -{ $description "Prettyprints an object to " { $link output-stream } ". This word rebinds printer control variables to enforce ``shorter'' output. See " { $link "prettyprint-variables" } "." } ; +{ $description "Prettyprints an object to " { $link output-stream } ". This word rebinds printer control variables to enforce “shorter” output. See " { $link "prettyprint-variables" } "." } ; HELP: short. { $values { "obj" object } } -{ $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. This word rebinds printer control variables to enforce ``shorter'' output." } ; +{ $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. This word rebinds printer control variables to enforce “shorter” output." } ; HELP: .b { $values { "n" "an integer" } } diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 648c707967..b1239086d7 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -3,7 +3,7 @@ kernel math namespaces parser prettyprint prettyprint.config prettyprint.sections sequences tools.test vectors words effects splitting generic.standard prettyprint.private continuations generic compiler.units tools.walker eval -accessors make ; +accessors make vocabs.parser ; IN: prettyprint.tests [ "4" ] [ 4 unparse ] unit-test diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 9d5af9e6a5..95f05c21ff 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -2,13 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays generic generic.standard assocs io kernel math namespaces make sequences strings io.styles io.streams.string -vectors words prettyprint.backend prettyprint.custom +vectors words words.symbol prettyprint.backend prettyprint.custom prettyprint.sections prettyprint.config sorting splitting grouping math.parser vocabs definitions effects classes.builtin -classes.tuple io.files classes continuations hashtables +classes.tuple io.pathnames classes continuations hashtables classes.mixin classes.union classes.intersection classes.predicate classes.singleton combinators quotations sets -accessors colors parser summary ; +accessors colors parser summary vocabs.parser ; IN: prettyprint : make-pprint ( obj quot -- block in use ) @@ -248,7 +248,8 @@ GENERIC: declarations. ( obj -- ) M: object declarations. drop ; : declaration. ( word prop -- ) - tuck name>> word-prop [ pprint-word ] [ drop ] if ; + [ nip ] [ name>> word-prop ] 2bi + [ pprint-word ] [ drop ] if ; M: word declarations. { @@ -357,12 +358,12 @@ M: builtin-class see-class* ] when drop ; M: word see - dup see-class - dup class? over symbol? not and [ - nl - ] when - dup [ class? ] [ symbol? ] bi and - [ drop ] [ call-next-method ] if ; + [ see-class ] + [ [ class? ] [ symbol? not ] bi and [ nl ] when ] + [ + dup [ class? ] [ symbol? ] bi and + [ drop ] [ call-next-method ] if + ] tri ; : see-all ( seq -- ) natural-sort [ nl ] [ see ] interleave ; diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index 102d005f39..faa254be69 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -3,7 +3,7 @@ USING: arrays generic hashtables io kernel math assocs namespaces make sequences strings io.styles vectors words prettyprint.config splitting classes continuations -io.streams.nested accessors sets ; +accessors sets ; IN: prettyprint.sections ! State diff --git a/basis/qualified/authors.txt b/basis/qualified/authors.txt deleted file mode 100644 index f990dd0ed2..0000000000 --- a/basis/qualified/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Daniel Ehrenberg diff --git a/basis/qualified/qualified-docs.factor b/basis/qualified/qualified-docs.factor deleted file mode 100644 index 828d811b46..0000000000 --- a/basis/qualified/qualified-docs.factor +++ /dev/null @@ -1,55 +0,0 @@ -USING: help.markup help.syntax ; -IN: qualified - -HELP: QUALIFIED: -{ $syntax "QUALIFIED: vocab" } -{ $description "Similar to " { $link POSTPONE: USE: } " but loads vocabulary with prefix." } -{ $examples { $example - "USING: prettyprint qualified ;" - "QUALIFIED: math" - "1 2 math:+ ." "3" -} } ; - -HELP: QUALIFIED-WITH: -{ $syntax "QUALIFIED-WITH: vocab word-prefix" } -{ $description "Works like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." } -{ $examples { $code - "USING: prettyprint qualified ;" - "QUALIFIED-WITH: math m" - "1 2 m:+ ." - "3" -} } ; - -HELP: FROM: -{ $syntax "FROM: vocab => words ... ;" } -{ $description "Imports " { $snippet "words" } " from " { $snippet "vocab" } "." } -{ $examples { $code - "FROM: math.parser => bin> hex> ; ! imports only bin> and hex>" } } ; - -HELP: EXCLUDE: -{ $syntax "EXCLUDE: vocab => words ... ;" } -{ $description "Imports everything from " { $snippet "vocab" } " excluding " { $snippet "words" } "." } -{ $examples { $code - "EXCLUDE: math.parser => bin> hex> ; ! imports everything but bin> and hex>" } } ; - -HELP: RENAME: -{ $syntax "RENAME: word vocab => newname " } -{ $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "newname" } "." } -{ $examples { $example - "USING: prettyprint qualified ;" - "RENAME: + math => -" - "2 3 - ." - "5" -} } ; - -ARTICLE: "qualified" "Qualified word lookup" -"The " { $vocab-link "qualified" } " vocabulary provides a handful of parsing words which give more control over word lookup than is offered by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } "." -$nl -"These words are useful when there is no way to avoid using two vocabularies with identical word names in the same source file." -{ $subsection POSTPONE: QUALIFIED: } -{ $subsection POSTPONE: QUALIFIED-WITH: } -{ $subsection POSTPONE: FROM: } -{ $subsection POSTPONE: EXCLUDE: } -{ $subsection POSTPONE: RENAME: } ; - -ABOUT: "qualified" diff --git a/basis/qualified/qualified-tests.factor b/basis/qualified/qualified-tests.factor deleted file mode 100644 index 78efec4861..0000000000 --- a/basis/qualified/qualified-tests.factor +++ /dev/null @@ -1,33 +0,0 @@ -USING: tools.test qualified eval accessors parser ; -IN: qualified.tests.foo -: x 1 ; -: y 5 ; -IN: qualified.tests.bar -: x 2 ; -: y 4 ; -IN: qualified.tests.baz -: x 3 ; - -QUALIFIED: qualified.tests.foo -QUALIFIED: qualified.tests.bar -[ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test - -QUALIFIED-WITH: qualified.tests.bar p -[ 2 ] [ p:x ] unit-test - -RENAME: x qualified.tests.baz => y -[ 3 ] [ y ] unit-test - -FROM: qualified.tests.baz => x ; -[ 3 ] [ x ] unit-test -[ 3 ] [ y ] unit-test - -EXCLUDE: qualified.tests.bar => x ; -[ 3 ] [ x ] unit-test -[ 4 ] [ y ] unit-test - -[ "USE: qualified IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ] -[ error>> no-word-error? ] must-fail-with - -[ "USE: qualified IN: qualified.tests RENAME: doesnotexist qualified.tests => blah" eval ] -[ error>> no-word-error? ] must-fail-with diff --git a/basis/qualified/qualified.factor b/basis/qualified/qualified.factor deleted file mode 100644 index 2cd64e90bf..0000000000 --- a/basis/qualified/qualified.factor +++ /dev/null @@ -1,43 +0,0 @@ -! Copyright (C) 2007, 2008 Daniel Ehrenberg. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences assocs hashtables parser lexer -vocabs words namespaces vocabs.loader sets fry ; -IN: qualified - -: define-qualified ( vocab-name prefix-name -- ) - [ load-vocab vocab-words ] [ CHAR: : suffix ] bi* - '[ [ [ _ ] dip append ] dip ] assoc-map - use get push ; - -: QUALIFIED: - #! Syntax: QUALIFIED: vocab - scan dup define-qualified ; parsing - -: QUALIFIED-WITH: - #! Syntax: QUALIFIED-WITH: vocab prefix - scan scan define-qualified ; parsing - -: partial-vocab ( words vocab -- assoc ) - '[ dup _ lookup [ no-word-error ] unless* ] - { } map>assoc ; - -: FROM: - #! Syntax: FROM: vocab => words... ; - scan dup load-vocab drop "=>" expect - ";" parse-tokens swap partial-vocab use get push ; parsing - -: partial-vocab-excluding ( words vocab -- assoc ) - [ load-vocab vocab-words keys swap diff ] keep partial-vocab ; - -: EXCLUDE: - #! Syntax: EXCLUDE: vocab => words ... ; - scan "=>" expect - ";" parse-tokens swap partial-vocab-excluding use get push ; parsing - -: RENAME: - #! Syntax: RENAME: word vocab => newname - scan scan dup load-vocab drop - dupd lookup [ ] [ no-word-error ] ?if - "=>" expect - scan associate use get push ; parsing - diff --git a/basis/qualified/summary.txt b/basis/qualified/summary.txt deleted file mode 100644 index 94b44c6052..0000000000 --- a/basis/qualified/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Qualified naming for vocabularies diff --git a/basis/qualified/tags.txt b/basis/qualified/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/basis/qualified/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/basis/quoted-printable/authors.txt b/basis/quoted-printable/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/quoted-printable/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/quoted-printable/quoted-printable-docs.factor b/basis/quoted-printable/quoted-printable-docs.factor new file mode 100644 index 0000000000..81219a3f84 --- /dev/null +++ b/basis/quoted-printable/quoted-printable-docs.factor @@ -0,0 +1,27 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax strings byte-arrays io.encodings.string ; +IN: quoted-printable + +ABOUT: "quoted-printable" + +ARTICLE: "quoted-printable" "Quoted printable encoding" +"The " { $vocab-link "quoted-printable" } " vocabulary implements RFC 2045 part 6.7, providing words for reading and generating quotable printed text." +{ $subsection >quoted } +{ $subsection >quoted-lines } +{ $subsection quoted> } ; + +HELP: >quoted +{ $values { "byte-array" byte-array } { "string" string } } +{ $description "Encodes a byte array as quoted printable, on a single line." } +{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word." } ; + +HELP: >quoted-lines +{ $values { "byte-array" byte-array } { "string" string } } +{ $description "Encodes a byte array as quoted printable, with soft line breaks inserted so the output lines are no longer than 76 characters." } +{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word with a specific encoding." } ; + +HELP: quoted> +{ $values { "string" string } { "byte-array" byte-array } } +{ $description "Decodes a quoted printable string into an array of the bytes represented." } +{ $warning "When decoding something in quoted printable form and using it as a string, be sure to use the " { $link decode } " word rather than simply converting the byte array to a string." } ; diff --git a/basis/quoted-printable/quoted-printable-tests.factor b/basis/quoted-printable/quoted-printable-tests.factor new file mode 100644 index 0000000000..6f42a48b37 --- /dev/null +++ b/basis/quoted-printable/quoted-printable-tests.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test quoted-printable multiline io.encodings.string +sequences io.encodings.8-bit splitting kernel ; +IN: quoted-printable.tests + +[ <" José was the +person who knew how to write the letters: + ő and ü +and we didn't know hów tö do thât"> ] +[ <" Jos=E9 was the +person who knew how to write the letters: + =F5 and =FC=20 +and w= +e didn't know h=F3w t=F6 do th=E2t"> quoted> latin2 decode ] unit-test + +[ <" Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t"> ] +[ <" José was the +person who knew how to write the letters: + ő and ü +and we didn't know hów tö do thât"> latin2 encode >quoted ] unit-test + +: message ( -- str ) + 55 [ "hello" ] replicate concat ; + +[ f ] [ message >quoted "=\r\n" swap subseq? ] unit-test +[ 1 ] [ message >quoted string-lines length ] unit-test +[ t ] [ message >quoted-lines "=\r\n" swap subseq? ] unit-test +[ 4 ] [ message >quoted-lines string-lines length ] unit-test +[ "===o" ] [ message >quoted-lines string-lines [ peek ] "" map-as ] unit-test diff --git a/basis/quoted-printable/quoted-printable.factor b/basis/quoted-printable/quoted-printable.factor new file mode 100644 index 0000000000..83fee523a0 --- /dev/null +++ b/basis/quoted-printable/quoted-printable.factor @@ -0,0 +1,62 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences strings kernel io.encodings.string +math.order ascii math io io.encodings.utf8 io.streams.string +combinators.short-circuit math.parser arrays ; +IN: quoted-printable + +! This implements RFC 2045 section 6.7 + + CHAR: ~ between? ] + [ CHAR: \t = ] + } 1|| ; + +: char>quoted ( ch -- str ) + dup printable? [ 1string ] [ + assure-small >hex >upper + 2 CHAR: 0 pad-left + CHAR: = prefix + ] if ; + +: take-some ( seqs -- seqs seq ) + 0 over [ length + dup 76 >= ] find drop nip + [ 1- cut-slice swap ] [ f swap ] if* concat ; + +: divide-lines ( strings -- strings ) + [ dup ] [ take-some ] [ ] produce nip ; + +PRIVATE> + +: >quoted ( byte-array -- string ) + [ char>quoted ] { } map-as concat "" like ; + +: >quoted-lines ( byte-array -- string ) + [ char>quoted ] { } map-as + divide-lines "=\r\n" join ; + + ] if + ] when ; + +: read-quoted ( -- bytes ) + [ read1 dup ] [ read-char ] [ drop ] B{ } produce-as ; + +PRIVATE> + +: quoted> ( string -- byte-array ) + ! Input should already be normalized to make \r\n into \n + [ read-quoted ] with-string-reader ; diff --git a/basis/quoted-printable/summary.txt b/basis/quoted-printable/summary.txt new file mode 100644 index 0000000000..c32ac1fc80 --- /dev/null +++ b/basis/quoted-printable/summary.txt @@ -0,0 +1 @@ +Quoted printable encoding/decoding diff --git a/basis/quoted-printable/tags.txt b/basis/quoted-printable/tags.txt new file mode 100644 index 0000000000..8fd3eccc9a --- /dev/null +++ b/basis/quoted-printable/tags.txt @@ -0,0 +1,2 @@ +parsing +web diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 18c9ca781c..01b389c19c 100755 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -73,7 +73,7 @@ ARTICLE: "random-protocol" "Random protocol" ARTICLE: "random" "Generating random integers" "The " { $vocab-link "random" } " vocabulary contains a protocol for generating random or pseudorandom numbers." $nl -"The ``Mersenne Twister'' pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "." +"The “Mersenne Twister” pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "." $nl "Generate a random object:" { $subsection random } diff --git a/basis/random/random.factor b/basis/random/random.factor index 5c93606ab5..554ed5c96a 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel math namespaces sequences io.backend io.binary combinators system vocabs.loader -summary math.bitwise byte-vectors fry byte-arrays ; +summary math.bitwise byte-vectors fry byte-arrays +math.ranges ; IN: random SYMBOL: system-random-generator @@ -51,6 +52,9 @@ PRIVATE> [ length random-integer ] keep nth ] if-empty ; +: randomize ( seq -- seq' ) + dup length 1 (a,b] [ dup random pick exchange ] each ; + : delete-random ( seq -- elt ) [ length random-integer ] keep [ nth ] 2keep delete-nth ; diff --git a/basis/refs/refs-docs.factor b/basis/refs/refs-docs.factor index 0034b7e566..b6f222cce9 100644 --- a/basis/refs/refs-docs.factor +++ b/basis/refs/refs-docs.factor @@ -14,7 +14,7 @@ ARTICLE: "refs" "References to assoc entries" "References to values:" { $subsection value-ref } { $subsection } -"References are used by the inspector." ; +"References are used by the UI inspector." ; ABOUT: "refs" diff --git a/basis/refs/refs.factor b/basis/refs/refs.factor index 81a2338b8f..5f21dad776 100644 --- a/basis/refs/refs.factor +++ b/basis/refs/refs.factor @@ -5,7 +5,7 @@ IN: refs TUPLE: ref assoc key ; -: >ref< [ key>> ] [ assoc>> ] bi ; inline +: >ref< ( ref -- key value ) [ key>> ] [ assoc>> ] bi ; inline : delete-ref ( ref -- ) >ref< delete-at ; GENERIC: get-ref ( ref -- obj ) diff --git a/basis/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor index eec0d309b1..4a807fa51b 100644 --- a/basis/regexp/classes/classes.factor +++ b/basis/regexp/classes/classes.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math math.order symbols -words regexp.utils unicode.categories combinators.short-circuit ; +USING: accessors kernel math math.order words regexp.utils +unicode.categories combinators.short-circuit ; IN: regexp.classes SINGLETONS: any-char any-char-no-nl diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor index 0abd1c2edc..549669cab7 100644 --- a/basis/regexp/dfa/dfa.factor +++ b/basis/regexp/dfa/dfa.factor @@ -57,7 +57,7 @@ IN: regexp.dfa dup [ nfa-table>> final-states>> keys ] [ dfa-table>> transitions>> states ] bi - [ intersect empty? not ] with filter + [ intersects? ] with filter swap dfa-table>> final-states>> [ conjoin ] curry each ; @@ -72,7 +72,7 @@ IN: regexp.dfa dup [ nfa-traversal-flags>> ] [ dfa-table>> transitions>> keys ] bi - [ tuck [ swap at ] with map concat ] with H{ } map>assoc + [ [ nip ] [ [ swap at ] with map concat ] 2bi ] with H{ } map>assoc >>dfa-traversal-flags drop ; : construct-dfa ( regexp -- ) diff --git a/basis/regexp/nfa/nfa.factor b/basis/regexp/nfa/nfa.factor index 7620652948..537c85c2d3 100644 --- a/basis/regexp/nfa/nfa.factor +++ b/basis/regexp/nfa/nfa.factor @@ -3,9 +3,14 @@ USING: accessors arrays assocs grouping kernel regexp.backend locals math namespaces regexp.parser sequences fry quotations math.order math.ranges vectors unicode.categories regexp.utils -regexp.transition-tables words sets regexp.classes unicode.case ; +regexp.transition-tables words sets regexp.classes unicode.case.private ; +! This uses unicode.case.private for ch>upper and ch>lower +! but case-insensitive matching should be done by case-folding everything +! before processing starts IN: regexp.nfa +ERROR: feature-is-broken feature ; + SYMBOL: negation-mode : negated? ( -- ? ) negation-mode get 0 or odd? ; @@ -160,6 +165,8 @@ M: LETTER-class nfa-node ( node -- ) M: character-class-range nfa-node ( node -- ) case-insensitive option? [ + ! This should be implemented for Unicode by case-folding + ! the input and all strings in the regexp. dup [ from>> ] [ to>> ] bi 2dup [ Letter? ] bi@ and [ rot drop @@ -176,6 +183,7 @@ M: character-class-range nfa-node ( node -- ) ] if ; M: capture-group nfa-node ( node -- ) + "capture-groups" feature-is-broken eps literal-transition add-simple-entry capture-group-on add-traversal-flag term>> nfa-node @@ -196,6 +204,7 @@ M: negation nfa-node ( node -- ) negation-mode dec ; M: lookahead nfa-node ( node -- ) + "lookahead" feature-is-broken eps literal-transition add-simple-entry lookahead-on add-traversal-flag term>> nfa-node @@ -204,6 +213,7 @@ M: lookahead nfa-node ( node -- ) 2 [ concatenate-nodes ] times ; M: lookbehind nfa-node ( node -- ) + "lookbehind" feature-is-broken eps literal-transition add-simple-entry lookbehind-on add-traversal-flag term>> nfa-node diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index 4d8f3ddfbc..377535eccd 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators io io.streams.string -kernel math math.parser namespaces qualified sets -quotations sequences splitting symbols vectors math.order -unicode.categories strings regexp.backend regexp.utils -unicode.case words locals regexp.classes ; +kernel math math.parser namespaces sets +quotations sequences splitting vectors math.order +strings regexp.backend regexp.utils +unicode.case unicode.categories words locals regexp.classes ; IN: regexp.parser FROM: math.ranges => [a,b] ; @@ -63,7 +63,7 @@ left-parenthesis pipe caret dash ; : cut-out ( vector n -- vector' vector ) cut rest ; ERROR: cut-stack-error ; : cut-stack ( obj vector -- vector' vector ) - tuck last-index [ cut-stack-error ] unless* cut-out swap ; + [ nip ] [ last-index ] 2bi [ cut-stack-error ] unless* cut-out swap ; : ( obj -- kleene ) possessive-kleene-star boa ; : ( obj -- kleene ) reluctant-kleene-star boa ; @@ -261,7 +261,7 @@ ERROR: bad-escaped-literals seq ; parse-til-E drop1 [ epsilon ] [ - [ quot call ] V{ } map-as + quot call [ ] V{ } map-as first|concatenation ] if-empty ; inline @@ -269,10 +269,10 @@ ERROR: bad-escaped-literals seq ; [ ] (parse-escaped-literals) ; : lower-case-literals ( -- obj ) - [ ch>lower ] (parse-escaped-literals) ; + [ >lower ] (parse-escaped-literals) ; : upper-case-literals ( -- obj ) - [ ch>upper ] (parse-escaped-literals) ; + [ >upper ] (parse-escaped-literals) ; : parse-escaped ( -- obj ) read1 diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 74f06ed65b..1cd9a2392e 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -1,5 +1,5 @@ USING: regexp tools.test kernel sequences regexp.parser -regexp.traversal eval strings ; +regexp.traversal eval strings multiline ; IN: regexp-tests \ must-infer @@ -76,6 +76,8 @@ IN: regexp-tests [ t ] [ "bar" "foo|bar" matches? ] unit-test [ f ] [ "foobar" "foo|bar" matches? ] unit-test +/* +! FIXME [ f ] [ "" "(a)" matches? ] unit-test [ t ] [ "a" "(a)" matches? ] unit-test [ f ] [ "aa" "(a)" matches? ] unit-test @@ -83,6 +85,7 @@ IN: regexp-tests [ f ] [ "aababaaabbac" "(a|b)+" matches? ] unit-test [ t ] [ "ababaaabba" "(a|b)+" matches? ] unit-test +*/ [ f ] [ "" "a{1}" matches? ] unit-test [ t ] [ "a" "a{1}" matches? ] unit-test @@ -165,9 +168,12 @@ IN: regexp-tests [ f ] [ "0" "[^\\d]" matches? ] unit-test [ t ] [ "a" "[^\\d]" matches? ] unit-test +/* +! FIXME [ t ] [ "a" "[a-z]{1,}|[A-Z]{2,4}|b*|c|(f|g)*" matches? ] unit-test [ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}|b*|c|(f|g)*" matches? ] unit-test [ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" matches? ] unit-test +*/ [ t ] [ "1000" "\\d{4,6}" matches? ] unit-test [ t ] [ "1000" "[0-9]{4,6}" matches? ] unit-test @@ -238,7 +244,7 @@ IN: regexp-tests [ t ] [ "abc" R/ abc/r matches? ] unit-test [ t ] [ "abc" R/ a[bB][cC]/r matches? ] unit-test -[ t ] [ "adcbe" R/ a(?r)(bcd)(?-r)e/ matches? ] unit-test +! [ t ] [ "adcbe" R/ a(?r)(bcd)(?-r)e/ matches? ] unit-test ! FIXME [ t ] [ "s@f" "[a-z.-]@[a-z]" matches? ] unit-test [ f ] [ "a" "[a-z.-]@[a-z]" matches? ] unit-test @@ -247,6 +253,8 @@ IN: regexp-tests [ t ] [ "abc*" "[^\\*]*\\*" matches? ] unit-test [ t ] [ "bca" "[^a]*a" matches? ] unit-test +/* +! FIXME [ ] [ "(0[lL]?|[1-9]\\d{0,9}(\\d{0,9}[lL])?|0[xX]\\p{XDigit}{1,8}(\\p{XDigit}{0,8}[lL])?|0[0-7]{1,11}([0-7]{0,11}[lL])?|([0-9]+\\.[0-9]*|\\.[0-9]+)([eE][+-]?[0-9]+)?[fFdD]?|[0-9]+([eE][+-]?[0-9]+[fFdD]?|([eE][+-]?[0-9]+)?[fFdD]))" drop @@ -270,6 +278,7 @@ IN: regexp-tests [ "abc" ] [ "abc" "(ab|a)(bc)?" first-match >string ] unit-test [ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" first-match >string ] unit-test +*/ ! [ t ] [ "a:b" ".+:?" matches? ] unit-test @@ -278,9 +287,13 @@ IN: regexp-tests [ { "1" "2" "3" "4" } ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test -[ { "1" "2" "3" "4" } ] +[ { "1" "2" "3" "4" "" } ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ re-split [ >string ] map ] unit-test +[ { "" } ] [ "" R/ =/ re-split [ >string ] map ] unit-test + +[ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test + [ { "ABC" "DEF" "GHI" } ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test @@ -290,12 +303,16 @@ IN: regexp-tests [ 0 ] [ "123" R/ [A-Z]+/ count-matches ] unit-test -[ "1.2.3.4" ] +[ "1.2.3.4." ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test + +[ "-- title --" ] [ "== title ==" R/ =/ "-" re-replace ] unit-test +/* +! FIXME [ f ] [ "ab" "a(?!b)" first-match ] unit-test [ "a" ] [ "ac" "a(?!b)" first-match >string ] unit-test -! [ t ] [ "fxxbar" "(?!foo).{3}bar" matches? ] unit-test +[ t ] [ "fxxbar" "(?!foo).{3}bar" matches? ] unit-test [ f ] [ "foobar" "(?!foo).{3}bar" matches? ] unit-test [ "a" ] [ "ab" "a(?=b)(?=b)" first-match >string ] unit-test [ "a" ] [ "ba" "a(?<=b)(?<=b)" first-match >string ] unit-test @@ -303,9 +320,10 @@ IN: regexp-tests [ 3 ] [ "foobar" "foo(?=bar)" match-head ] unit-test [ f ] [ "foobxr" "foo(?=bar)" match-head ] unit-test +*/ ! Bug in parsing word -[ t ] [ "a" R' a' matches? ] unit-test +[ t ] [ "a" R' a' matches? ] unit-test ! Convert to lowercase until E [ f ] [ "AA" R/ \LAA\E/ matches? ] unit-test diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index c615719cc4..86f978373b 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -61,8 +61,11 @@ IN: regexp dupd first-match [ split1-slice swap ] [ "" like f swap ] if* ; +: (re-split) ( string regexp -- ) + over [ [ re-cut , ] keep (re-split) ] [ 2drop ] if ; + : re-split ( string regexp -- seq ) - [ dup length 0 > ] swap '[ _ re-cut ] [ ] produce nip ; + [ (re-split) ] { } make ; : re-replace ( string regexp replacement -- result ) [ re-split ] dip join ; diff --git a/basis/regexp/transition-tables/transition-tables.factor b/basis/regexp/transition-tables/transition-tables.factor index 5375d813e1..e5c31a54e0 100644 --- a/basis/regexp/transition-tables/transition-tables.factor +++ b/basis/regexp/transition-tables/transition-tables.factor @@ -35,7 +35,7 @@ TUPLE: transition-table transitions start-state final-states ; H{ } clone >>final-states ; : maybe-initialize-key ( key hashtable -- ) - 2dup key? [ 2drop ] [ H{ } clone -rot set-at ] if ; + 2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ; : set-transition ( transition hash -- ) #! set the state as a key diff --git a/basis/roman/authors.txt b/basis/roman/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/roman/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/roman/roman-docs.factor b/basis/roman/roman-docs.factor new file mode 100644 index 0000000000..4a8197f064 --- /dev/null +++ b/basis/roman/roman-docs.factor @@ -0,0 +1,120 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel math ; +IN: roman + +HELP: >roman +{ $values { "n" "an integer" } { "str" "a string" } } +{ $description "Converts a number to its lower-case Roman Numeral equivalent." } +{ $notes "The range for this word is 1-3999, inclusive." } +{ $examples + { $example "USING: io roman ;" + "56 >roman print" + "lvi" + } +} ; + +HELP: >ROMAN +{ $values { "n" "an integer" } { "str" "a string" } } +{ $description "Converts a number to its upper-case Roman numeral equivalent." } +{ $notes "The range for this word is 1-3999, inclusive." } +{ $examples + { $example "USING: io roman ;" + "56 >ROMAN print" + "LVI" + } +} ; + +HELP: roman> +{ $values { "str" "a string" } { "n" "an integer" } } +{ $description "Converts a Roman numeral to an integer." } +{ $notes "The range for this word is i-mmmcmxcix, inclusive." } +{ $examples + { $example "USING: prettyprint roman ;" + "\"lvi\" roman> ." + "56" + } +} ; + +{ >roman >ROMAN roman> } related-words + +HELP: roman+ +{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $description "Adds two Roman numerals." } +{ $examples + { $example "USING: io roman ;" + "\"v\" \"v\" roman+ print" + "x" + } +} ; + +HELP: roman- +{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $description "Subtracts two Roman numerals." } +{ $examples + { $example "USING: io roman ;" + "\"x\" \"v\" roman- print" + "v" + } +} ; + +{ roman+ roman- } related-words + +HELP: roman* +{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $description "Multiplies two Roman numerals." } +{ $examples + { $example "USING: io roman ;" + "\"ii\" \"iii\" roman* print" + "vi" + } +} ; + +HELP: roman/i +{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $description "Computes the integer division of two Roman numerals." } +{ $examples + { $example "USING: io roman ;" + "\"v\" \"iv\" roman/i print" + "i" + } +} ; + +HELP: roman/mod +{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } { "str4" "a string" } } +{ $description "Computes the quotient and remainder of two Roman numerals." } +{ $examples + { $example "USING: kernel io roman ;" + "\"v\" \"iv\" roman/mod [ print ] bi@" + "i\ni" + } +} ; + +{ roman* roman/i roman/mod } related-words + +HELP: ROMAN: +{ $description "A parsing word that reads the next token and converts it to an integer." } +{ $examples + { $example "USING: prettyprint roman ;" + "ROMAN: v ." + "5" + } +} ; + +ARTICLE: "roman" "Roman numerals" +"The " { $vocab-link "roman" } " vocabulary can convert numbers to and from the Roman numeral system and can perform arithmetic given Roman numerals as input." $nl +"A parsing word for literal Roman numerals:" +{ $subsection POSTPONE: ROMAN: } +"Converting to Roman numerals:" +{ $subsection >roman } +{ $subsection >ROMAN } +"Converting Roman numerals to integers:" +{ $subsection roman> } +"Roman numeral arithmetic:" +{ $subsection roman+ } +{ $subsection roman- } +{ $subsection roman* } +{ $subsection roman/i } +{ $subsection roman/mod } ; + +ABOUT: "roman" diff --git a/basis/roman/roman-tests.factor b/basis/roman/roman-tests.factor new file mode 100644 index 0000000000..82084e0b1f --- /dev/null +++ b/basis/roman/roman-tests.factor @@ -0,0 +1,40 @@ +USING: arrays kernel math roman roman.private sequences tools.test ; + +[ "i" ] [ 1 >roman ] unit-test +[ "ii" ] [ 2 >roman ] unit-test +[ "iii" ] [ 3 >roman ] unit-test +[ "iv" ] [ 4 >roman ] unit-test +[ "v" ] [ 5 >roman ] unit-test +[ "vi" ] [ 6 >roman ] unit-test +[ "vii" ] [ 7 >roman ] unit-test +[ "viii" ] [ 8 >roman ] unit-test +[ "ix" ] [ 9 >roman ] unit-test +[ "x" ] [ 10 >roman ] unit-test +[ "mdclxvi" ] [ 1666 >roman ] unit-test +[ "mmmcdxliv" ] [ 3444 >roman ] unit-test +[ "mmmcmxcix" ] [ 3999 >roman ] unit-test +[ "MMMCMXCIX" ] [ 3999 >ROMAN ] unit-test +[ 3999 ] [ 3999 >ROMAN roman> ] unit-test +[ 1 ] [ 1 >roman roman> ] unit-test +[ 2 ] [ 2 >roman roman> ] unit-test +[ 3 ] [ 3 >roman roman> ] unit-test +[ 4 ] [ 4 >roman roman> ] unit-test +[ 5 ] [ 5 >roman roman> ] unit-test +[ 6 ] [ 6 >roman roman> ] unit-test +[ 7 ] [ 7 >roman roman> ] unit-test +[ 8 ] [ 8 >roman roman> ] unit-test +[ 9 ] [ 9 >roman roman> ] unit-test +[ 10 ] [ 10 >roman roman> ] unit-test +[ 1666 ] [ 1666 >roman roman> ] unit-test +[ 3444 ] [ 3444 >roman roman> ] unit-test +[ 3999 ] [ 3999 >roman roman> ] unit-test +[ 0 >roman ] must-fail +[ 4000 >roman ] must-fail +[ "vi" ] [ "iii" "iii" roman+ ] unit-test +[ "viii" ] [ "x" "ii" roman- ] unit-test +[ "ix" ] [ "iii" "iii" roman* ] unit-test +[ "i" ] [ "iii" "ii" roman/i ] unit-test +[ "i" "ii" ] [ "v" "iii" roman/mod ] unit-test +[ "iii" "iii" roman- ] must-fail + +[ 30 ] [ ROMAN: xxx ] unit-test diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor new file mode 100644 index 0000000000..81a6d69a09 --- /dev/null +++ b/basis/roman/roman.factor @@ -0,0 +1,77 @@ +! Copyright (C) 2007 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays assocs kernel math math.order math.vectors +namespaces make quotations sequences splitting.monotonic +sequences.private strings unicode.case lexer parser +grouping ; +IN: roman + += ; + +: roman>n ( ch -- n ) + 1string roman-digits index roman-values nth ; + +: (>roman) ( n -- ) + roman-values roman-digits [ + [ /mod swap ] dip concat % + ] 2each drop ; + +: (roman>) ( seq -- n ) + dup [ roman>n ] map swap all-eq? [ + sum + ] [ + first2 swap - + ] if ; + +PRIVATE> + +: >roman ( n -- str ) + dup roman-range-check + [ (>roman) ] "" make ; + +: >ROMAN ( n -- str ) >roman >upper ; + +: roman> ( str -- n ) + >lower [ roman<= ] monotonic-split + [ (roman>) ] sigma ; + + ( str1 str2 -- m n ) + [ roman> ] bi@ ; + +: binary-roman-op ( str1 str2 quot -- str3 ) + [ 2roman> ] dip call >roman ; inline + +PRIVATE> + +: roman+ ( str1 str2 -- str3 ) + [ + ] binary-roman-op ; + +: roman- ( str1 str2 -- str3 ) + [ - ] binary-roman-op ; + +: roman* ( str1 str2 -- str3 ) + [ * ] binary-roman-op ; + +: roman/i ( str1 str2 -- str3 ) + [ /i ] binary-roman-op ; + +: roman/mod ( str1 str2 -- str3 str4 ) + [ /mod ] binary-roman-op [ >roman ] dip ; + +: ROMAN: scan roman> parsed ; parsing diff --git a/basis/roman/summary.txt b/basis/roman/summary.txt new file mode 100644 index 0000000000..f6d018cd4d --- /dev/null +++ b/basis/roman/summary.txt @@ -0,0 +1 @@ +Roman numerals library diff --git a/basis/roman/tags.txt b/basis/roman/tags.txt new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/basis/roman/tags.txt @@ -0,0 +1 @@ + diff --git a/basis/search-deques/search-deques-docs.factor b/basis/search-deques/search-deques-docs.factor index fe0ce7c157..c20e67d13c 100644 --- a/basis/search-deques/search-deques-docs.factor +++ b/basis/search-deques/search-deques-docs.factor @@ -10,6 +10,6 @@ $nl ABOUT: "search-deques" -HELP: ( assoc deque -- search-deque ) +HELP: { $values { "assoc" assoc } { "deque" deque } { "search-deque" search-deque } } { $description "Creates a new " { $link search-deque } "." } ; diff --git a/basis/sequences/complex-components/authors.txt b/basis/sequences/complex-components/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/sequences/complex-components/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/sequences/complex-components/complex-components-docs.factor b/basis/sequences/complex-components/complex-components-docs.factor new file mode 100644 index 0000000000..386735aa7d --- /dev/null +++ b/basis/sequences/complex-components/complex-components-docs.factor @@ -0,0 +1,35 @@ +USING: help.markup help.syntax math multiline +sequences sequences.complex-components ; +IN: sequences.complex-components + +ARTICLE: "sequences.complex-components" "Complex component virtual sequences" +"The " { $link complex-components } " class wraps a sequence of " { $link complex } " number values, presenting a sequence of " { $link real } " values made by interleaving the real and imaginary parts of the complex values in the original sequence." +{ $subsection complex-components } +{ $subsection } ; + +ABOUT: "sequences.complex-components" + +HELP: complex-components +{ $class-description "Sequence wrapper class that transforms a sequence of " { $link complex } " number values into a sequence of " { $link real } " values, interleaving the real and imaginary parts of the complex values in the original sequence." } +{ $examples { $example <" +USING: prettyprint sequences arrays sequences.complex-components ; +{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } >array . +"> "{ 1.0 -1.0 -2.0 0 3.0 1.0 }" } } ; + +HELP: +{ $values { "sequence" sequence } { "complex-components" complex-components } } +{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-components } " wrapper." } +{ $examples +{ $example <" +USING: prettyprint sequences arrays +sequences.complex-components ; +{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } third . +"> "-2.0" } +{ $example <" +USING: prettyprint sequences arrays +sequences.complex-components ; +{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } fourth . +"> "0" } +} ; + +{ complex-components } related-words diff --git a/basis/sequences/complex-components/complex-components-tests.factor b/basis/sequences/complex-components/complex-components-tests.factor new file mode 100644 index 0000000000..f0c8e92c6e --- /dev/null +++ b/basis/sequences/complex-components/complex-components-tests.factor @@ -0,0 +1,16 @@ +USING: sequences.complex-components +kernel sequences tools.test arrays accessors ; +IN: sequences.complex-components.tests + +: test-array ( -- x ) + { C{ 1.0 2.0 } 3.0 C{ 5.0 6.0 } } ; + +[ 6 ] [ test-array length ] unit-test + +[ 1.0 ] [ test-array first ] unit-test +[ 2.0 ] [ test-array second ] unit-test +[ 3.0 ] [ test-array third ] unit-test +[ 0 ] [ test-array fourth ] unit-test + +[ { 1.0 2.0 3.0 0 5.0 6.0 } ] [ test-array >array ] unit-test + diff --git a/basis/sequences/complex-components/complex-components.factor b/basis/sequences/complex-components/complex-components.factor new file mode 100644 index 0000000000..ae808971b6 --- /dev/null +++ b/basis/sequences/complex-components/complex-components.factor @@ -0,0 +1,28 @@ +USING: accessors kernel math math.functions combinators +sequences sequences.private ; +IN: sequences.complex-components + +TUPLE: complex-components seq ; +INSTANCE: complex-components sequence + +: ( sequence -- complex-components ) + complex-components boa ; inline + +> ] bi* ; inline +: complex-component ( remainder complex -- component ) + swap { + { 0 [ real-part ] } + { 1 [ imaginary-part ] } + } case ; + +PRIVATE> + +M: complex-components length + seq>> length 1 shift ; +M: complex-components nth-unsafe + complex-components@ nth-unsafe complex-component ; +M: complex-components set-nth-unsafe + immutable ; diff --git a/basis/sequences/complex-components/summary.txt b/basis/sequences/complex-components/summary.txt new file mode 100644 index 0000000000..af00158213 --- /dev/null +++ b/basis/sequences/complex-components/summary.txt @@ -0,0 +1 @@ +Virtual sequence wrapper to convert complex values into real value pairs diff --git a/basis/sequences/complex-components/tags.txt b/basis/sequences/complex-components/tags.txt new file mode 100644 index 0000000000..64cdcd9e69 --- /dev/null +++ b/basis/sequences/complex-components/tags.txt @@ -0,0 +1,2 @@ +sequences +math diff --git a/basis/sequences/complex/authors.txt b/basis/sequences/complex/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/sequences/complex/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/sequences/complex/complex-docs.factor b/basis/sequences/complex/complex-docs.factor new file mode 100644 index 0000000000..65dd520fd8 --- /dev/null +++ b/basis/sequences/complex/complex-docs.factor @@ -0,0 +1,31 @@ +USING: help.markup help.syntax math multiline +sequences sequences.complex ; +IN: sequences.complex + +ARTICLE: "sequences.complex" "Complex virtual sequences" +"The " { $link complex-sequence } " class wraps a sequence of " { $link real } " number values, presenting a sequence of " { $link complex } " values made by treating the underlying sequence as pairs of alternating real and imaginary values." +{ $subsection complex-sequence } +{ $subsection } ; + +ABOUT: "sequences.complex" + +HELP: complex-sequence +{ $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." } +{ $examples { $example <" +USING: prettyprint +specialized-arrays.double sequences.complex +sequences arrays ; +double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } >array . +"> "{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ; + +HELP: +{ $values { "sequence" sequence } { "complex-sequence" complex-sequence } } +{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." } +{ $examples { $example <" +USING: prettyprint +specialized-arrays.double sequences.complex +sequences arrays ; +double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } second . +"> "C{ -2.0 2.0 }" } } ; + +{ complex-sequence } related-words diff --git a/basis/sequences/complex/complex-tests.factor b/basis/sequences/complex/complex-tests.factor new file mode 100644 index 0000000000..5861bc8b02 --- /dev/null +++ b/basis/sequences/complex/complex-tests.factor @@ -0,0 +1,26 @@ +USING: specialized-arrays.float sequences.complex +kernel sequences tools.test arrays accessors ; +IN: sequences.complex.tests + +: test-array ( -- x ) + float-array{ 1.0 2.0 3.0 4.0 } clone ; +: odd-length-test-array ( -- x ) + float-array{ 1.0 2.0 3.0 4.0 5.0 } clone ; + +[ 2 ] [ test-array length ] unit-test +[ 2 ] [ odd-length-test-array length ] unit-test + +[ C{ 1.0 2.0 } ] [ test-array first ] unit-test +[ C{ 3.0 4.0 } ] [ test-array second ] unit-test + +[ { C{ 1.0 2.0 } C{ 3.0 4.0 } } ] +[ test-array >array ] unit-test + +[ float-array{ 1.0 2.0 5.0 6.0 } ] +[ test-array [ C{ 5.0 6.0 } 1 rot set-nth ] [ seq>> ] bi ] +unit-test + +[ float-array{ 7.0 0.0 3.0 4.0 } ] +[ test-array [ 7.0 0 rot set-nth ] [ seq>> ] bi ] +unit-test + diff --git a/basis/sequences/complex/complex.factor b/basis/sequences/complex/complex.factor new file mode 100644 index 0000000000..93f9727f75 --- /dev/null +++ b/basis/sequences/complex/complex.factor @@ -0,0 +1,25 @@ +USING: accessors kernel math math.functions +sequences sequences.private ; +IN: sequences.complex + +TUPLE: complex-sequence seq ; +INSTANCE: complex-sequence sequence + +: ( sequence -- complex-sequence ) + complex-sequence boa ; inline + +> ] bi* ; inline + +PRIVATE> + +M: complex-sequence length + seq>> length -1 shift ; +M: complex-sequence nth-unsafe + complex@ [ nth-unsafe ] [ [ 1+ ] dip nth-unsafe ] 2bi rect> ; +M: complex-sequence set-nth-unsafe + complex@ + [ [ real-part ] [ ] [ ] tri* set-nth-unsafe ] + [ [ imaginary-part ] [ 1+ ] [ ] tri* set-nth-unsafe ] 3bi ; diff --git a/basis/sequences/complex/summary.txt b/basis/sequences/complex/summary.txt new file mode 100644 index 0000000000..d94c4ba0f0 --- /dev/null +++ b/basis/sequences/complex/summary.txt @@ -0,0 +1 @@ +Virtual sequence wrapper to convert real pairs into complex values diff --git a/basis/sequences/complex/tags.txt b/basis/sequences/complex/tags.txt new file mode 100644 index 0000000000..64cdcd9e69 --- /dev/null +++ b/basis/sequences/complex/tags.txt @@ -0,0 +1,2 @@ +sequences +math diff --git a/basis/sequences/deep/authors.txt b/basis/sequences/deep/authors.txt index f990dd0ed2..a07c427c98 100644 --- a/basis/sequences/deep/authors.txt +++ b/basis/sequences/deep/authors.txt @@ -1 +1,2 @@ Daniel Ehrenberg +Doug Coleman diff --git a/basis/sequences/deep/deep-tests.factor b/basis/sequences/deep/deep-tests.factor index 522b5ecdf9..2d3260f427 100644 --- a/basis/sequences/deep/deep-tests.factor +++ b/basis/sequences/deep/deep-tests.factor @@ -24,3 +24,18 @@ IN: sequences.deep.tests [ "foo" ] [ "foo" [ string? ] deep-find ] unit-test [ { { 1 2 } 1 2 } ] [ [ { 1 2 } [ , ] deep-each ] { } make ] unit-test + +[ t ] +[ { { 1 2 3 } 4 } { { { 1 { { 1 2 3 } 4 } } } 2 } deep-member? ] unit-test + +[ t ] +[ { { 1 2 3 } 4 } { { { 1 2 3 } 4 } 2 } deep-member? ] unit-test + +[ f ] +[ { 1 2 3 4 } { 1 2 3 { 4 } } deep-subseq? ] unit-test + +[ t ] +[ { 1 2 3 4 } { 1 2 3 4 } deep-subseq? ] unit-test + +[ t ] +[ { 1 2 3 4 } { { 1 2 3 4 } } deep-subseq? ] unit-test diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor index db572681a1..d942b3f4c4 100644 --- a/basis/sequences/deep/deep.factor +++ b/basis/sequences/deep/deep.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2007 Daniel Ehrenberg +! Copyright (C) 2007, 2008 Daniel Ehrenberg, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: sequences kernel strings math ; +USING: sequences kernel strings math fry ; IN: sequences.deep ! All traversal goes in postorder @@ -14,11 +14,11 @@ M: object branch? drop f ; : deep-each ( obj quot: ( elt -- ) -- ) [ call ] 2keep over branch? - [ [ deep-each ] curry each ] [ 2drop ] if ; inline recursive + [ '[ _ deep-each ] each ] [ 2drop ] if ; inline recursive : deep-map ( obj quot: ( elt -- elt' ) -- newobj ) [ call ] keep over branch? - [ [ deep-map ] curry map ] [ drop ] if ; inline recursive + [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive : deep-filter ( obj quot: ( elt -- ? ) -- seq ) over [ pusher [ deep-each ] dip ] dip @@ -27,7 +27,7 @@ M: object branch? drop f ; : (deep-find) ( obj quot: ( elt -- ? ) -- elt ? ) [ call ] 2keep rot [ drop t ] [ over branch? [ - f -rot [ [ nip ] dip (deep-find) ] curry find drop >boolean + [ f ] 2dip '[ nip _ (deep-find) ] find drop >boolean ] [ 2drop f f ] if ] if ; inline recursive @@ -36,11 +36,21 @@ M: object branch? drop f ; : deep-contains? ( obj quot -- ? ) (deep-find) nip ; inline : deep-all? ( obj quot -- ? ) - [ not ] compose deep-contains? not ; inline + '[ @ not ] deep-contains? not ; inline + +: deep-member? ( obj seq -- ? ) + swap '[ + _ swap dup branch? [ member? ] [ 2drop f ] if + ] deep-find >boolean ; + +: deep-subseq? ( subseq seq -- ? ) + swap '[ + _ swap dup branch? [ subseq? ] [ 2drop f ] if + ] deep-find >boolean ; : deep-change-each ( obj quot: ( elt -- elt' ) -- ) over branch? [ - [ [ call ] keep over [ deep-change-each ] dip ] curry change-each + '[ _ [ call ] keep over [ deep-change-each ] dip ] change-each ] [ 2drop ] if ; inline recursive : flatten ( obj -- seq ) diff --git a/basis/sequences/next/next.factor b/basis/sequences/next/next.factor index a0a441ab50..19b406cc58 100644 --- a/basis/sequences/next/next.factor +++ b/basis/sequences/next/next.factor @@ -3,7 +3,8 @@ IN: sequences.next > ] bi@ eq? ] [ 2drop f ] if ; } cond ; : serialize-shared ( obj quot -- ) - >r dup object-id - [ CHAR: o write1 serialize-cell drop ] - r> if* ; inline + [ + dup object-id + [ CHAR: o write1 serialize-cell drop ] + ] dip if* ; inline M: f (serialize) ( obj -- ) drop CHAR: n write1 ; @@ -220,8 +221,7 @@ SYMBOL: deserialized (deserialize) (deserialize) 2dup lookup dup [ 2nip ] [ drop - "Unknown word: " -rot - 2array unparse append throw + 2array unparse "Unknown word: " prepend throw ] if ; : deserialize-gensym ( -- word ) @@ -256,7 +256,7 @@ SYMBOL: deserialized [ ] tri ; : copy-seq-to-tuple ( seq tuple -- ) - >r dup length r> [ set-array-nth ] curry 2each ; + [ dup length ] dip [ set-array-nth ] curry 2each ; : deserialize-tuple ( -- array ) #! Ugly because we have to intern the tuple before reading diff --git a/basis/smtp/server/server.factor b/basis/smtp/server/server.factor index 7de22e9af9..5d7791292b 100644 --- a/basis/smtp/server/server.factor +++ b/basis/smtp/server/server.factor @@ -4,7 +4,7 @@ USING: combinators kernel prettyprint io io.timeouts sequences namespaces io.sockets io.sockets.secure continuations calendar io.encodings.ascii io.streams.duplex destructors locals concurrency.promises threads accessors smtp.private -io.unix.sockets.secure.debug ; +io.sockets.secure.unix.debug io.crlf ; IN: smtp.server ! Mock SMTP server for testing purposes. diff --git a/basis/smtp/smtp-docs.factor b/basis/smtp/smtp-docs.factor index 83b9287043..8e34411604 100644 --- a/basis/smtp/smtp-docs.factor +++ b/basis/smtp/smtp-docs.factor @@ -25,7 +25,7 @@ HELP: no-auth HELP: plain-auth { $class-description "If the " { $link smtp-auth } " variable is set to this value, plain authentication will be performed, with the username and password stored in the " { $slot "username" } " and " { $slot "password" } " slots of the tuple sent to the server as plain-text." } ; -HELP: ( username password -- plain-auth ) +HELP: { $values { "username" string } { "password" string } { "plain-auth" plain-auth } } { $description "Creates a new " { $link plain-auth } " instance." } ; diff --git a/basis/smtp/smtp-tests.factor b/basis/smtp/smtp-tests.factor index e3638bd969..8a9107b905 100644 --- a/basis/smtp/smtp-tests.factor +++ b/basis/smtp/smtp-tests.factor @@ -15,7 +15,7 @@ IN: smtp.tests [ { "hello" "." "world" } validate-message ] must-fail -[ "hello\r\nworld\r\n.\r\n" ] [ +[ "aGVsbG8Kd29ybGQ=\r\n.\r\n" ] [ "hello\nworld" [ send-body ] with-string-writer ] unit-test @@ -50,7 +50,10 @@ IN: smtp.tests [ { + { "Content-Transfer-Encoding" "base64" } + { "Content-Type" "Text/plain; charset=utf-8" } { "From" "Doug " } + { "MIME-Version" "1.0" } { "Subject" "Factor rules" } { "To" "Slava , Ed " } } diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index f689ad0858..03b9d8af11 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -6,7 +6,7 @@ io.encodings.utf8 io.timeouts io.sockets io.sockets.secure io.encodings.ascii kernel logging sequences combinators splitting assocs strings math.order math.parser random system calendar summary calendar.format accessors sets hashtables -base64 debugger classes prettyprint ; +base64 debugger classes prettyprint io.crlf ; IN: smtp SYMBOL: smtp-domain @@ -50,12 +50,6 @@ TUPLE: email " intersect empty? - [ bad-email-address ] unless ; + dup "\r\n>" intersects? + [ bad-email-address ] when ; : mail-from ( fromaddr -- ) validate-address @@ -92,9 +86,8 @@ M: message-contains-dot summary ( obj -- string ) [ message-contains-dot ] when ; : send-body ( body -- ) - string-lines - validate-message - [ write crlf ] each + utf8 encode + >base64-lines write crlf "." command ; : quit ( -- ) @@ -102,7 +95,7 @@ M: message-contains-dot summary ( obj -- string ) LOG: smtp-response DEBUG -: multiline? ( response -- boolean ) +: multiline? ( response -- ? ) 3 swap ?nth CHAR: - = ; : (receive-response) ( -- ) @@ -167,15 +160,22 @@ M: plain-auth send-auth : auth ( -- ) smtp-auth get send-auth ; +: encode-header ( string -- string' ) + dup aux>> [ + "=?utf-8?B?" + swap utf8 encode >base64 + "?=" 3append + ] when ; + ERROR: invalid-header-string string ; : validate-header ( string -- string' ) - dup "\r\n" intersect empty? - [ invalid-header-string ] unless ; + dup "\r\n" intersects? + [ invalid-header-string ] when ; : write-header ( key value -- ) [ validate-header write ] - [ ": " write validate-header write ] bi* crlf ; + [ ": " write validate-header encode-header write ] bi* crlf ; : write-headers ( assoc -- ) [ write-header ] assoc-each ; @@ -195,6 +195,13 @@ ERROR: invalid-header-string string ; ! This could be much smarter. " " split1-last swap or "<" ?head drop ">" ?tail drop ; +: utf8-mime-header ( -- alist ) + { + { "MIME-Version" "1.0" } + { "Content-Transfer-Encoding" "base64" } + { "Content-Type" "Text/plain; charset=utf-8" } + } ; + : email>headers ( email -- hashtable ) [ { @@ -205,7 +212,7 @@ ERROR: invalid-header-string string ; } cleave now timestamp>rfc822 "Date" set message-id "Message-Id" set - ] { } make-assoc ; + ] { } make-assoc utf8-mime-header append ; : (send-email) ( headers email -- ) [ diff --git a/basis/sorting/human/human-docs.factor b/basis/sorting/human/human-docs.factor new file mode 100644 index 0000000000..5952b3e3f9 --- /dev/null +++ b/basis/sorting/human/human-docs.factor @@ -0,0 +1,71 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel math.order quotations +sequences strings ; +IN: sorting.human + +HELP: find-numbers +{ $values + { "string" string } + { "seq" sequence } +} +{ $description "Splits a string on numbers and returns a sequence of sequences and integers." } ; + +HELP: human<=> +{ $values + { "obj1" object } { "obj2" object } + { "<=>" "an ordering specifier" } +} +{ $description "Compares two objects after converting numbers in the string into integers." } ; + +HELP: human>=< +{ $values + { "obj1" object } { "obj2" object } + { ">=<" "an ordering specifier" } +} +{ $description "Compares two objects using the " { $link human<=> } " word and inverts the result." } ; + +HELP: human-compare +{ $values + { "obj1" object } { "obj2" object } { "quot" quotation } + { "<=>" "an ordering specifier" } +} +{ $description "Compares the results of applying the quotation to both objects via <=>." } ; + +HELP: human-sort +{ $values + { "seq" sequence } + { "seq'" sequence } +} +{ $description "Sorts a sequence of objects by comparing the magnitude of any integers in the input string using the <=> word." } ; + +HELP: human-sort-keys +{ $values + { "seq" "an alist" } + { "sortedseq" "a new sorted sequence" } +} +{ $description "Sorts the elements comparing first elements of pairs using the " { $link human<=> } " word." } ; + +HELP: human-sort-values +{ $values + { "seq" "an alist" } + { "sortedseq" "a new sorted sequence" } +} +{ $description "Sorts the elements comparing second elements of pairs using the " { $link human<=> } " word." } ; + +{ <=> >=< human-compare human-sort human-sort-keys human-sort-values } related-words + +ARTICLE: "sorting.human" "Human-friendly sorting" +"The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl +"Comparing two objects:" +{ $subsection human<=> } +{ $subsection human>=< } +{ $subsection human-compare } +"Sort a sequence:" +{ $subsection human-sort } +{ $subsection human-sort-keys } +{ $subsection human-sort-values } +"Splitting a string into substrings and integers:" +{ $subsection find-numbers } ; + +ABOUT: "sorting.human" diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor index 1c2ba419c7..1c7392901b 100644 --- a/basis/sorting/human/human.factor +++ b/basis/sorting/human/human.factor @@ -1,10 +1,22 @@ ! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: peg.ebnf math.parser kernel assocs sorting ; +USING: peg.ebnf math.parser kernel assocs sorting fry +math.order sequences ascii splitting.monotonic ; IN: sorting.human : find-numbers ( string -- seq ) [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ; -: human-sort ( seq -- seq' ) - [ dup find-numbers ] { } map>assoc sort-values keys ; +: human<=> ( obj1 obj2 -- <=> ) [ find-numbers ] bi@ <=> ; + +: human>=< ( obj1 obj2 -- >=< ) human<=> invert-comparison ; inline + +: human-compare ( obj1 obj2 quot -- <=> ) bi@ human<=> ; + +: human-sort ( seq -- seq' ) [ human<=> ] sort ; + +: human-sort-keys ( seq -- sortedseq ) + [ [ first ] human-compare ] sort ; + +: human-sort-values ( seq -- sortedseq ) + [ [ second ] human-compare ] sort ; diff --git a/basis/sorting/slots/authors.txt b/basis/sorting/slots/authors.txt new file mode 100644 index 0000000000..5674120196 --- /dev/null +++ b/basis/sorting/slots/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Slava Pestov diff --git a/basis/sorting/slots/slots-docs.factor b/basis/sorting/slots/slots-docs.factor new file mode 100644 index 0000000000..a3bdbf9ac1 --- /dev/null +++ b/basis/sorting/slots/slots-docs.factor @@ -0,0 +1,49 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations math.order +sequences ; +IN: sorting.slots + +HELP: compare-slots +{ $values + { "sort-specs" "a sequence of accessors ending with a comparator" } + { "<=>" { $link +lt+ } " " { $link +eq+ } " or " { $link +gt+ } } +} +{ $description "Compares two objects using a chain of intrinsic linear orders such that if two objects are " { $link +eq+ } ", then the next comparator is tried. The comparators are slot-name/comparator pairs." } ; + +HELP: sort-by-slots +{ $values + { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" } + { "seq'" sequence } +} +{ $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." } +{ $examples + "Sort by slot c, then b descending:" + { $example + "USING: accessors math.order prettyprint sorting.slots ;" + "IN: scratchpad" + "TUPLE: sort-me a b ;" + "{" + " T{ sort-me f 2 3 } T{ sort-me f 3 2 }" + " T{ sort-me f 4 3 } T{ sort-me f 2 1 }" + "}" + "{ { a>> <=> } { b>> >=< } } sort-by-slots ." + "{\n T{ sort-me { a 2 } { b 3 } }\n T{ sort-me { a 2 } { b 1 } }\n T{ sort-me { a 3 } { b 2 } }\n T{ sort-me { a 4 } { b 3 } }\n}" + } +} ; + +HELP: split-by-slots +{ $values + { "accessor-seqs" "a sequence of sequences of tuple accessors" } + { "quot" quotation } +} +{ $description "Splits a sequence of tuples into a sequence of slices of tuples that have the same values in all slots in the accessor sequence. This word is only useful for splitting a sorted sequence, but is more efficient than partitioning in such a case." } ; + +ARTICLE: "sorting.slots" "Sorting by slots" +"The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl +"Comparing two objects by a sequence of slots:" +{ $subsection compare-slots } +"Sorting a sequence by a sequence of slots:" +{ $subsection sort-by-slots } ; + +ABOUT: "sorting.slots" diff --git a/basis/sorting/slots/slots-tests.factor b/basis/sorting/slots/slots-tests.factor new file mode 100644 index 0000000000..46824c6fdb --- /dev/null +++ b/basis/sorting/slots/slots-tests.factor @@ -0,0 +1,145 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors math.order sorting.slots tools.test +sorting.human arrays sequences kernel assocs multiline ; +IN: sorting.literals.tests + +TUPLE: sort-test a b c tuple2 ; + +TUPLE: tuple2 d ; + +[ + { + T{ sort-test { a 1 } { b 3 } { c 9 } } + T{ sort-test { a 1 } { b 1 } { c 10 } } + T{ sort-test { a 1 } { b 1 } { c 11 } } + T{ sort-test { a 2 } { b 5 } { c 2 } } + T{ sort-test { a 2 } { b 5 } { c 3 } } + } +] [ + { + T{ sort-test f 1 3 9 } + T{ sort-test f 1 1 10 } + T{ sort-test f 1 1 11 } + T{ sort-test f 2 5 3 } + T{ sort-test f 2 5 2 } + } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots +] unit-test + +[ + { + T{ sort-test { a 1 } { b 3 } { c 9 } } + T{ sort-test { a 1 } { b 1 } { c 10 } } + T{ sort-test { a 1 } { b 1 } { c 11 } } + T{ sort-test { a 2 } { b 5 } { c 2 } } + T{ sort-test { a 2 } { b 5 } { c 3 } } + } +] [ + { + T{ sort-test f 1 3 9 } + T{ sort-test f 1 1 10 } + T{ sort-test f 1 1 11 } + T{ sort-test f 2 5 3 } + T{ sort-test f 2 5 2 } + } { { a>> human<=> } { b>> human>=< } { c>> <=> } } sort-by-slots +] unit-test + +[ + { + { + T{ sort-test { a 1 } { b 1 } { c 10 } } + T{ sort-test { a 1 } { b 1 } { c 11 } } + } + { T{ sort-test { a 1 } { b 3 } { c 9 } } } + { + T{ sort-test { a 2 } { b 5 } { c 3 } } + T{ sort-test { a 2 } { b 5 } { c 2 } } + } + } +] [ + { + T{ sort-test f 1 3 9 } + T{ sort-test f 1 1 10 } + T{ sort-test f 1 1 11 } + T{ sort-test f 2 5 3 } + T{ sort-test f 2 5 2 } + } + { { a>> human<=> } { b>> <=> } } [ sort-by-slots ] keep + [ but-last-slice ] map split-by-slots [ >array ] map +] unit-test + +: split-test ( seq -- seq' ) + { { a>> } { b>> } } split-by-slots ; + +[ split-test ] must-infer + +[ { } ] +[ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test + +[ + { + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } } + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 2 } } } } + T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 3 } } } } + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } } + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } } + T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } } + } +] [ + { + T{ sort-test f 6 f f T{ tuple2 f 1 } } + T{ sort-test f 5 f f T{ tuple2 f 4 } } + T{ sort-test f 6 f f T{ tuple2 f 3 } } + T{ sort-test f 6 f f T{ tuple2 f 3 } } + T{ sort-test f 5 f f T{ tuple2 f 3 } } + T{ sort-test f 6 f f T{ tuple2 f 2 } } + } { { tuple2>> d>> <=> } { a>> <=> } } sort-by-slots +] unit-test + +[ + { + { + T{ sort-test + { a 6 } + { tuple2 T{ tuple2 { d 1 } } } + } + } + { + T{ sort-test + { a 6 } + { tuple2 T{ tuple2 { d 2 } } } + } + } + { + T{ sort-test + { a 5 } + { tuple2 T{ tuple2 { d 3 } } } + } + } + { + T{ sort-test + { a 6 } + { tuple2 T{ tuple2 { d 3 } } } + } + T{ sort-test + { a 6 } + { tuple2 T{ tuple2 { d 3 } } } + } + } + { + T{ sort-test + { a 5 } + { tuple2 T{ tuple2 { d 4 } } } + } + } + } +] [ + { + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } } + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 2 } } } } + T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 3 } } } } + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } } + T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } } + T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } } + } { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map +] unit-test diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor new file mode 100644 index 0000000000..56b6a115f0 --- /dev/null +++ b/basis/sorting/slots/slots.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2009 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators.short-circuit fry kernel macros math.order +sequences words sorting sequences.deep assocs splitting.monotonic +math ; +IN: sorting.slots + + + +MACRO: compare-slots ( sort-specs -- <=> ) + #! sort-spec: { accessors comparator } + [ slot-comparator ] map '[ _ 2|| +eq+ or ] ; + +: sort-by-slots ( seq sort-specs -- seq' ) + '[ _ compare-slots ] sort ; + +MACRO: split-by-slots ( accessor-seqs -- quot ) + [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map + '[ [ _ 2&& ] slice monotonic-slice ] ; diff --git a/basis/soundex/author.txt b/basis/soundex/author.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/soundex/author.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/soundex/soundex-tests.factor b/basis/soundex/soundex-tests.factor new file mode 100644 index 0000000000..f4bd18e34b --- /dev/null +++ b/basis/soundex/soundex-tests.factor @@ -0,0 +1,5 @@ +IN: soundex.tests +USING: soundex tools.test ; + +[ "S162" ] [ "supercalifrag" soundex ] unit-test +[ "M000" ] [ "M" soundex ] unit-test diff --git a/basis/soundex/soundex.factor b/basis/soundex/soundex.factor new file mode 100644 index 0000000000..164f634185 --- /dev/null +++ b/basis/soundex/soundex.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: sequences grouping assocs kernel ascii ascii tr ; +IN: soundex + +TR: soundex-tr + ch>upper + "AEHIOUWYBFPVCGJKQSXZDTLMNR" + "00000000111122222222334556" ; + +: remove-duplicates ( seq -- seq' ) + #! Remove _consecutive_ duplicates (unlike prune which removes + #! all duplicates). + [ 2 [ = not ] assoc-filter values ] [ first ] bi prefix ; + +: first>upper ( seq -- seq' ) 1 head >upper ; +: trim-first ( seq -- seq' ) dup first [ = ] curry trim-left ; +: remove-zeroes ( seq -- seq' ) CHAR: 0 swap remove ; +: remove-non-alpha ( seq -- seq' ) [ alpha? ] filter ; +: pad-4 ( first seq -- seq' ) "000" 3append 4 head ; + +: soundex ( string -- soundex ) + remove-non-alpha [ f ] [ + [ first>upper ] + [ + soundex-tr + [ "" ] [ trim-first ] if-empty + [ "" ] [ remove-duplicates ] if-empty + remove-zeroes + ] bi + pad-4 + ] if-empty ; diff --git a/basis/soundex/summary.txt b/basis/soundex/summary.txt new file mode 100644 index 0000000000..95a271d911 --- /dev/null +++ b/basis/soundex/summary.txt @@ -0,0 +1 @@ +Soundex is a phonetic algorithm for indexing names by sound diff --git a/basis/specialized-arrays/direct/functor/functor.factor b/basis/specialized-arrays/direct/functor/functor.factor index 14fb739947..ce23186fc6 100755 --- a/basis/specialized-arrays/direct/functor/functor.factor +++ b/basis/specialized-arrays/direct/functor/functor.factor @@ -27,8 +27,8 @@ TUPLE: A M: A length length>> ; M: A nth-unsafe underlying>> NTH call ; M: A set-nth-unsafe underlying>> SET-NTH call ; -M: A like drop dup A instance? [ >A' execute ] unless ; -M: A new-sequence drop execute ; +M: A like drop dup A instance? [ >A' ] unless ; +M: A new-sequence drop ; INSTANCE: A sequence diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 579da5b84a..9a56346be4 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -49,9 +49,9 @@ M: A set-nth-unsafe underlying>> SET-NTH call ; : >A ( seq -- specialized-array ) A new clone-like ; inline -M: A like drop dup A instance? [ >A execute ] unless ; +M: A like drop dup A instance? [ >A ] unless ; -M: A new-sequence drop (A) execute ; +M: A new-sequence drop (A) ; M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ; @@ -64,13 +64,13 @@ M: A resize M: A byte-length underlying>> length ; -M: A pprint-delims drop A{ \ } ; +M: A pprint-delims drop \ A{ \ } ; M: A >pprint-sequence ; M: A pprint* pprint-object ; -: A{ \ } [ >A execute ] parse-literal ; parsing +: A{ \ } [ >A ] parse-literal ; parsing INSTANCE: A sequence diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor index 8ba5354dc4..2410cc284e 100644 --- a/basis/specialized-vectors/functor/functor.factor +++ b/basis/specialized-vectors/functor/functor.factor @@ -18,28 +18,28 @@ WHERE TUPLE: V { underlying A } { length array-capacity } ; -:
execute 0 V boa ; inline +: ( capacity -- vector ) 0 V boa ; inline M: V like drop dup V instance? [ - dup A instance? [ dup length V boa ] [ >V execute ] if + dup A instance? [ dup length V boa ] [ >V ] if ] unless ; -M: V new-sequence drop [ execute ] [ >fixnum ] bi V boa ; +M: V new-sequence drop [ ] [ >fixnum ] bi V boa ; -M: A new-resizable drop execute ; +M: A new-resizable drop ; M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ; -: >V V new clone-like ; inline +: >V ( seq -- vector ) V new clone-like ; inline -M: V pprint-delims drop V{ \ } ; +M: V pprint-delims drop \ V{ \ } ; M: V >pprint-sequence ; M: V pprint* pprint-object ; -: V{ \ } [ >V execute ] parse-literal ; parsing +: V{ \ } [ >V ] parse-literal ; parsing INSTANCE: V growable diff --git a/basis/splitting/monotonic/authors.txt b/basis/splitting/monotonic/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/splitting/monotonic/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/splitting/monotonic/monotonic-docs.factor b/basis/splitting/monotonic/monotonic-docs.factor new file mode 100644 index 0000000000..983c5b0dea --- /dev/null +++ b/basis/splitting/monotonic/monotonic-docs.factor @@ -0,0 +1,109 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations classes sequences +multiline ; +IN: splitting.monotonic + +HELP: monotonic-slice +{ $values + { "seq" sequence } { "quot" quotation } { "class" class } + { "slices" "a sequence of slices" } +} +{ $description "Monotonically splits a sequence into slices of the type " { $snippet "class" } "." } +{ $examples + { $example + "USING: splitting.monotonic math prettyprint ;" + "{ 1 2 3 2 3 4 } [ < ] upward-slice monotonic-slice ." + <" { + T{ upward-slice + { from 0 } + { to 3 } + { seq { 1 2 3 2 3 4 } } + } + T{ upward-slice + { from 3 } + { to 6 } + { seq { 1 2 3 2 3 4 } } + } +}"> + } +} ; + +HELP: monotonic-split +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" "a sequence of sequences" } +} +{ $description "Compares pairs of elements in a sequence and collects elements into sequences while they satisfy the predicate. Once the predicate fails, a new sequence is started, and all sequences are returned in a single sequence." } +{ $examples + { $example + "USING: splitting.monotonic math prettyprint ;" + "{ 1 2 3 2 3 4 } [ < ] monotonic-split ." + "{ V{ 1 2 3 } V{ 2 3 4 } }" + } +} ; + +HELP: downward-slices +{ $values + { "seq" sequence } + { "slices" "a sequence of downward-slices" } +} +{ $description "Returns an array of monotonically decreasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ; + +HELP: stable-slices +{ $values + { "seq" sequence } + { "slices" "a sequence of stable-slices" } +} +{ $description "Returns an array of monotonically decreasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ; + +HELP: upward-slices +{ $values + { "seq" sequence } + { "slices" "a sequence of upward-slices" } +} +{ $description "Returns an array of monotonically increasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ; + +HELP: trends +{ $values + { "seq" sequence } + { "slices" "a sequence of downward, stable, and upward slices" } +} +{ $description "Returns a sorted sequence of downward, stable, or upward slices. The endpoints of some slices may overlap with each other." } +{ $examples + { $example + "USING: splitting.monotonic math prettyprint ;" + "{ 1 2 3 3 2 1 } trends ." + <" { + T{ upward-slice + { from 0 } + { to 3 } + { seq { 1 2 3 3 2 1 } } + } + T{ stable-slice + { from 2 } + { to 4 } + { seq { 1 2 3 3 2 1 } } + } + T{ downward-slice + { from 3 } + { to 6 } + { seq { 1 2 3 3 2 1 } } + } +}"> + } +} ; + +ARTICLE: "splitting.monotonic" "Splitting trending sequences" +"The " { $vocab-link "splitting.monotonic" } " vocabulary splits sequences that are trending downwards, upwards, or stably." $nl +"Splitting into sequences:" +{ $subsection monotonic-split } +"Splitting into slices:" +{ $subsection monotonic-slice } +"Trending:" +{ $subsection downward-slices } +{ $subsection stable-slices } +{ $subsection upward-slices } +{ $subsection trends } ; + +ABOUT: "splitting.monotonic" diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor new file mode 100644 index 0000000000..2b44f42394 --- /dev/null +++ b/basis/splitting/monotonic/monotonic-tests.factor @@ -0,0 +1,55 @@ +IN: splitting.monotonic +USING: tools.test math arrays kernel sequences ; + +[ { { 1 } { -1 5 } { 2 4 } } ] +[ { 1 -1 5 2 4 } [ < ] monotonic-split [ >array ] map ] unit-test +[ { { 1 1 1 1 } { 2 2 } { 3 } { 4 } { 5 } { 6 6 6 } } ] +[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split [ >array ] map ] unit-test + +[ { } ] +[ { } [ = ] slice monotonic-slice ] unit-test + +[ t ] +[ { 1 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test + +[ { { 1 } } ] +[ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test + +[ { 1 } [ = ] slice monotonic-slice ] must-infer + +[ t ] +[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test + +[ { { 1 1 1 } { 2 2 } { 3 3 } { 4 } } ] +[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ >array ] map ] unit-test + +[ { { 3 3 } } ] +[ { 3 3 } [ = ] slice monotonic-slice [ >array ] map ] unit-test + +[ + { + T{ upward-slice { from 0 } { to 3 } { seq { 1 2 3 2 1 } } } + T{ downward-slice { from 2 } { to 5 } { seq { 1 2 3 2 1 } } } + } +] +[ { 1 2 3 2 1 } trends ] unit-test + +[ + { + T{ upward-slice + { from 0 } + { to 3 } + { seq { 1 2 3 3 2 1 } } + } + T{ stable-slice + { from 2 } + { to 4 } + { seq { 1 2 3 3 2 1 } } + } + T{ downward-slice + { from 3 } + { to 6 } + { seq { 1 2 3 3 2 1 } } + } + } +] [ { 1 2 3 3 2 1 } trends ] unit-test diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor new file mode 100644 index 0000000000..2e2ac74e30 --- /dev/null +++ b/basis/splitting/monotonic/monotonic.factor @@ -0,0 +1,69 @@ +! Copyright (C) 2008, 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: make namespaces sequences kernel fry arrays compiler.utilities +math accessors circular grouping combinators sorting math.order ; +IN: splitting.monotonic + + + +: monotonic-split ( seq quot -- newseq ) + over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline + + 1 over change-circular-start ] tri + [ @ not [ , ] [ drop ] if ] 3each + ] { } make + dup empty? [ over length 1- prefix ] when -1 prefix 2 clump + swap + ] dip + '[ first2 [ 1+ ] bi@ _ _ boa ] map ; inline + +PRIVATE> + +: monotonic-slice ( seq quot class -- slices ) + pick length { + { 0 [ 2drop ] } + { 1 [ nip [ 0 1 rot ] dip boa 1array ] } + [ drop (monotonic-slice) ] + } case ; inline + +TUPLE: downward-slice < slice ; +TUPLE: stable-slice < slice ; +TUPLE: upward-slice < slice ; + +: downward-slices ( seq -- slices ) + [ > ] downward-slice monotonic-slice [ length 1 > ] filter ; + +: stable-slices ( seq -- slices ) + [ = ] stable-slice monotonic-slice [ length 1 > ] filter ; + +: upward-slices ( seq -- slices ) + [ < ] upward-slice monotonic-slice [ length 1 > ] filter ; + +: trends ( seq -- slices ) + dup length { + { 0 [ ] } + { 1 [ [ 0 1 ] dip stable-slice boa ] } + [ + drop + [ downward-slices ] + [ stable-slices ] + [ upward-slices ] tri 3append [ [ from>> ] compare ] sort + ] + } case ; diff --git a/basis/splitting/monotonic/summary.txt b/basis/splitting/monotonic/summary.txt new file mode 100644 index 0000000000..6782bd0010 --- /dev/null +++ b/basis/splitting/monotonic/summary.txt @@ -0,0 +1 @@ +Split a sequence into monotonically-increasing subsequences diff --git a/basis/splitting/monotonic/tags.txt b/basis/splitting/monotonic/tags.txt new file mode 100644 index 0000000000..d4c087751e --- /dev/null +++ b/basis/splitting/monotonic/tags.txt @@ -0,0 +1,2 @@ +algorithms +sequences diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 147749864d..9516b8cd7d 100644 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -145,7 +145,6 @@ M: object apply-object push-literal ; : effect-required? ( word -- ? ) { - { [ dup inline? ] [ drop f ] } { [ dup deferred? ] [ drop f ] } { [ dup crossref? not ] [ drop f ] } [ def>> [ word? ] contains? ] diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index e4c11960de..aa179fe191 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: fry vectors sequences assocs math accessors kernel -combinators quotations namespaces stack-checker.state +combinators quotations namespaces grouping stack-checker.state stack-checker.backend stack-checker.errors stack-checker.visitor stack-checker.values stack-checker.recursive-state ; IN: stack-checker.branches diff --git a/basis/stack-checker/errors/errors-docs.factor b/basis/stack-checker/errors/errors-docs.factor index d4a074031d..c3b9797a36 100644 --- a/basis/stack-checker/errors/errors-docs.factor +++ b/basis/stack-checker/errors/errors-docs.factor @@ -28,22 +28,10 @@ $nl } ; HELP: too-many->r -{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." } -{ $examples - { $code - ": too-many->r-example ( a b -- )" - " >r 3 + >r ;" - } -} ; +{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." } ; HELP: too-many-r> -{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." } -{ $examples - { $code - ": too-many-r>-example ( a b -- )" - " r> 3 + >r ;" - } -} ; +{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." } ; HELP: missing-effect { $error-description "Thrown when inference encounters a word lacking a stack effect declaration. Stack effects of words must be declared, with the exception of words which only push literals on the stack." } diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index bce42f1456..7cdce301b5 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -174,8 +174,6 @@ M: object infer-call* : infer-special ( word -- ) { - { \ >r [ 1 infer->r ] } - { \ r> [ 1 infer-r> ] } { \ declare [ infer-declare ] } { \ call [ infer-call ] } { \ (call) [ infer-call ] } @@ -194,6 +192,7 @@ M: object infer-call* { \ [ infer- ] } { \ (throw) [ infer-(throw) ] } { \ exit [ infer-exit ] } + { \ load-local [ 1 infer->r ] } { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } @@ -213,9 +212,9 @@ M: object infer-call* "local-word-def" word-prop infer-quot-here ; { - >r r> declare call (call) slip 2slip 3slip dip 2dip 3dip + declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose execute (execute) if dispatch - (throw) load-locals get-local drop-locals do-primitive + (throw) load-local load-locals get-local drop-locals do-primitive alien-invoke alien-indirect alien-callback } [ t "special" set-word-prop ] each @@ -644,7 +643,7 @@ M: object infer-call* \ dll-valid? { object } { object } define-primitive -\ modify-code-heap { array object } { } define-primitive +\ modify-code-heap { array } { } define-primitive \ unimplemented { } { } define-primitive diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor index f208178b10..5b67cd9adc 100644 --- a/basis/stack-checker/stack-checker-docs.factor +++ b/basis/stack-checker/stack-checker-docs.factor @@ -21,7 +21,7 @@ $nl ARTICLE: "inference-combinators" "Combinator stack effects" "Without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the inferencer encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised." -{ $example "[ dup call ] infer." "... an error ..." } +{ $example "[ dup call ] infer." "Literal value expected\n\nType :help for debugging help." } "On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point:" { $example "[ [ 2 + ] call ] infer." "( object -- object )" } "Consider a combinator such as " { $link keep } ". The combinator itself does not have a stack effect, because it applies " { $link call } " to a potentially arbitrary quotation. However, since the combinator is declared " { $link POSTPONE: inline } ", a given usage of it can have a stack effect:" @@ -35,7 +35,15 @@ $nl "Here is an example where the stack effect cannot be inferred:" { $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." } "However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":" -{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } ; +{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } +"Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:" +{ $example + "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Literal value expected\n\nType :help for debugging help." +} +"To make this work, pass the quotation on the retain stack instead:" +{ $example + "[ [ reverse ] [ [ reverse ] map ] dip call ] infer." "( object -- object )" +} ; ARTICLE: "inference-branches" "Branch stack effects" "Conditionals such as " { $link if } " and combinators built on " { $link if } " present a problem, in that if the two branches leave the stack at a different height, it is not clear what the stack effect should be. In this case, inference throws a " { $link unbalanced-branches-error } "." @@ -58,12 +66,14 @@ $nl $nl "If a recursive word takes quotation parameters from the stack and calls them, it must be declared " { $link POSTPONE: inline } " (as documented in " { $link "inference-combinators" } ") as well as " { $link POSTPONE: recursive } "." $nl -"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example," -{ $see loop } -"An inline recursive word cannot pass a quotation through the recursive call. For example, the following will not infer:" -{ $code ": foo ( a b c -- d e f ) [ f foo drop ] when 2dup call ; inline" "[ 1 [ 1+ ] foo ] infer." } +"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example, the following will not infer:" +{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Literal value expected\n\nType :help for debugging help." } +"The following is correct:" +{ $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" } +"An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:" +{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Literal value expected\n\nType :help for debugging help." } "However a small change can be made:" -{ $example ": foo ( a b c -- d ) [ 2dup f foo drop ] when call ; inline" "[ 1 [ 1+ ] t foo ] infer." "( -- object )" } +{ $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" } "An inline recursive word must have a fixed stack effect in its base case. The following will not infer:" { $code ": foo ( quot ? -- ) [ f foo ] [ call ] if ; inline" diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index defcde53f0..4d7295042c 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -6,7 +6,7 @@ quotations effects tools.test continuations generic.standard sorting assocs definitions prettyprint io inspector classes.tuple classes.union classes.predicate debugger threads.private io.streams.string io.timeouts io.thread -sequences.private destructors combinators eval ; +sequences.private destructors combinators eval locals.backend ; IN: stack-checker.tests \ infer. must-infer @@ -218,7 +218,7 @@ DEFER: do-crap* MATH: xyz ( a b -- c ) M: fixnum xyz 2array ; M: float xyz - [ 3 ] bi@ swapd >r 2array swap r> 2array swap ; + [ 3 ] bi@ swapd [ 2array swap ] dip 2array swap ; [ [ xyz ] infer ] [ inference-error? ] must-fail-with @@ -320,7 +320,7 @@ DEFER: bar : bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ; [ [ bad-bin ] infer ] must-fail -[ [ r> ] infer ] [ inference-error? ] must-fail-with +[ [ 1 drop-locals ] infer ] [ inference-error? ] must-fail-with ! Regression [ [ cleave ] infer ] [ inference-error? ] must-fail-with @@ -416,12 +416,7 @@ DEFER: bar \ stream-write must-infer \ stream-write1 must-infer \ stream-nl must-infer -\ stream-format must-infer -\ stream-write-table must-infer \ stream-flush must-infer -\ make-span-stream must-infer -\ make-block-stream must-infer -\ make-cell-stream must-infer ! Test stream utilities \ lines must-infer @@ -480,7 +475,7 @@ DEFER: an-inline-word dup [ normal-word-2 ] when ; : an-inline-word ( obj quot -- ) - >r normal-word r> call ; inline + [ normal-word ] dip call ; inline { 1 1 } [ [ 3 * ] an-inline-word ] must-infer-as @@ -502,8 +497,8 @@ ERROR: custom-error ; [ custom-error inference-error ] infer ] unit-test -[ T{ effect f 1 1 t } ] [ - [ dup >r 3 throw r> ] infer +[ T{ effect f 1 2 t } ] [ + [ dup [ 3 throw ] dip ] infer ] unit-test ! This was a false trigger of the undecidable quotation @@ -511,7 +506,7 @@ ERROR: custom-error ; { 2 1 } [ find-last-sep ] must-infer-as ! Regression -: missing->r-check >r ; +: missing->r-check 1 load-locals ; [ [ missing->r-check ] infer ] must-fail @@ -548,7 +543,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ; [ [ inference-invalidation-d ] infer ] must-fail -: bad-recursion-3 ( -- ) dup [ >r bad-recursion-3 r> ] when ; inline +: bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline [ [ bad-recursion-3 ] infer ] must-fail : bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline @@ -572,7 +567,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ; DEFER: eee' : ddd' ( ? -- ) [ f eee' ] when ; inline recursive -: eee' ( ? -- ) >r swap [ ] r> ddd' call ; inline recursive +: eee' ( ? -- ) [ swap [ ] ] dip ddd' call ; inline recursive [ [ eee' ] infer ] [ inference-error? ] must-fail-with diff --git a/basis/state-parser/authors.txt b/basis/state-parser/authors.txt deleted file mode 100644 index f990dd0ed2..0000000000 --- a/basis/state-parser/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Daniel Ehrenberg diff --git a/basis/state-parser/state-parser-docs.factor b/basis/state-parser/state-parser-docs.factor deleted file mode 100644 index 3027c01c19..0000000000 --- a/basis/state-parser/state-parser-docs.factor +++ /dev/null @@ -1,72 +0,0 @@ -USING: help.markup help.syntax ; -IN: state-parser - -ABOUT: { "state-parser" "main" } - -ARTICLE: { "state-parser" "main" } "State-based parsing" - "This module defines a state-based parsing mechanism. It was originally created for libs/xml, but is also used in libs/csv and can be easily used in new libraries or applications." - { $subsection spot } - { $subsection skip-until } - { $subsection take-until } - { $subsection take-char } - { $subsection take-string } - { $subsection next } - { $subsection state-parse } - { $subsection get-char } - { $subsection take-rest } - { $subsection string-parse } - { $subsection expect } - { $subsection expect-string } - { $subsection parsing-error } ; - -HELP: get-char -{ $values { "char" "the current character" } } -{ $description "Accesses the current character of the stream that is being parsed" } ; - -HELP: take-rest -{ $values { "string" "the rest of the parser input" } } -{ $description "Exausts the stream of the parser input and returns a string representing the rest of the input" } ; - -HELP: string-parse -{ $values { "input" "a string" } { "quot" "a quotation ( -- )" } } -{ $description "Calls the given quotation using the given string as parser input" } -{ $see-also state-parse } ; - -HELP: expect -{ $values { "ch" "a number representing a character" } } -{ $description "Asserts that the current character is the given ch, and moves to the next spot" } -{ $see-also expect-string } ; - -HELP: expect-string -{ $values { "string" "a string" } } -{ $description "Asserts that the current parsing spot is followed by the given string, and skips the parser past that string" } -{ $see-also expect } ; - -HELP: spot -{ $var-description "This variable represents the location in the program. It is a tuple T{ spot f char column line next } where char is the current character, line is the line number, column is the column number, and line-str is the full contents of the line, as a string. The contents shouldn't be accessed directly but rather with the proxy words get-char set-char get-line etc." } ; - -HELP: skip-until -{ $values { "quot" "a quotation ( -- ? )" } } -{ $description "executes " { $link next } " until the quotation yields false. Usually, the quotation will call " { $link get-char } " in its test, but not always." } -{ $see-also take-until } ; - -HELP: take-until -{ $values { "quot" "a quotation ( -- ? )" } { "string" "a string" } } -{ $description "like " { $link skip-until } " but records what it passes over and outputs the string." } -{ $see-also skip-until take-char take-string } ; - -HELP: take-char -{ $values { "ch" "a character" } { "string" "a string" } } -{ $description "records the document from the current spot to the first instance of the given character. Outputs the content between those two points." } -{ $see-also take-until take-string } ; - -HELP: take-string -{ $values { "match" "a string to match" } { "string" "the portion of the XML document" } } -{ $description "records the document from the current spot to the first instance of the given character. Outputs the content between those two points." } -{ $notes "match may not contain a newline" } ; - -HELP: next -{ $description "originally written as " { $code "spot inc" } ", code that would no longer run, this word moves the state of the XML parser to the next place in the source file, keeping track of appropriate debugging information." } ; - -HELP: parsing-error -{ $class-description "class from which parsing errors inherit, containing information about which line and column the error occured on, and what the line was. Contains three slots, line, an integer, column, another integer, and line-str, a string" } ; diff --git a/basis/state-parser/state-parser-tests.factor b/basis/state-parser/state-parser-tests.factor deleted file mode 100644 index e0b274b3e6..0000000000 --- a/basis/state-parser/state-parser-tests.factor +++ /dev/null @@ -1,8 +0,0 @@ -USING: tools.test state-parser kernel io strings ascii ; - -[ "hello" ] [ "hello" [ take-rest ] string-parse ] unit-test -[ 2 4 ] [ "12\n123" [ take-rest drop get-line get-column ] string-parse ] unit-test -[ "hi" " how are you?" ] [ "hi how are you?" [ [ get-char blank? ] take-until take-rest ] string-parse ] unit-test -[ "foo" ";bar" ] [ "foo;bar" [ CHAR: ; take-char take-rest ] string-parse ] unit-test -[ "foo " " bar" ] [ "foo and bar" [ "and" take-string take-rest ] string-parse ] unit-test -[ "baz" ] [ " \n\t baz" [ pass-blank take-rest ] string-parse ] unit-test diff --git a/basis/state-parser/state-parser.factor b/basis/state-parser/state-parser.factor deleted file mode 100644 index 9341f39426..0000000000 --- a/basis/state-parser/state-parser.factor +++ /dev/null @@ -1,158 +0,0 @@ -! Copyright (C) 2005, 2006 Daniel Ehrenberg -! See http://factorcode.org/license.txt for BSD license. -USING: io io.streams.string kernel math namespaces sequences -strings circular prettyprint debugger ascii sbufs fry summary -accessors ; -IN: state-parser - -! * Basic underlying words -! Code stored in stdio -! Spot is composite so it won't be lost in sub-scopes -TUPLE: spot char line column next ; - -C: spot - -: get-char ( -- char ) spot get char>> ; -: set-char ( char -- ) spot get swap >>char drop ; -: get-line ( -- line ) spot get line>> ; -: set-line ( line -- ) spot get swap >>line drop ; -: get-column ( -- column ) spot get column>> ; -: set-column ( column -- ) spot get swap >>column drop ; -: get-next ( -- char ) spot get next>> ; -: set-next ( char -- ) spot get swap >>next drop ; - -! * Errors -TUPLE: parsing-error line column ; - -: parsing-error ( class -- obj ) - new - get-line >>line - get-column >>column ; -M: parsing-error summary ( obj -- str ) - [ - "Parsing error" print - "Line: " write dup line>> . - "Column: " write column>> . - ] with-string-writer ; - -TUPLE: expected < parsing-error should-be was ; -: expected ( should-be was -- * ) - \ expected parsing-error - swap >>was - swap >>should-be throw ; -M: expected summary ( obj -- str ) - [ - dup call-next-method write - "Token expected: " write dup should-be>> print - "Token present: " write was>> print - ] with-string-writer ; - -TUPLE: unexpected-end < parsing-error ; -: unexpected-end ( -- * ) \ unexpected-end parsing-error throw ; -M: unexpected-end summary ( obj -- str ) - [ - call-next-method write - "File unexpectedly ended." print - ] with-string-writer ; - -TUPLE: missing-close < parsing-error ; -: missing-close ( -- * ) \ missing-close parsing-error throw ; -M: missing-close summary ( obj -- str ) - [ - call-next-method write - "Missing closing token." print - ] with-string-writer ; - -SYMBOL: prolog-data - -! * Basic utility words - -: record ( char -- ) - CHAR: \n = - [ 0 get-line 1+ set-line ] [ get-column 1+ ] if - set-column ; - -! (next) normalizes \r\n and \r -: (next) ( -- char ) - get-next read1 - 2dup swap CHAR: \r = [ - CHAR: \n = - [ nip read1 ] [ nip CHAR: \n swap ] if - ] [ drop ] if - set-next dup set-char ; - -: next ( -- ) - #! Increment spot. - get-char [ unexpected-end ] unless (next) record ; - -: next* ( -- ) - get-char [ (next) record ] when ; - -: skip-until ( quot: ( -- ? ) -- ) - get-char [ - [ call ] keep swap [ drop ] [ - next skip-until - ] if - ] [ drop ] if ; inline recursive - -: take-until ( quot -- string ) - #! Take the substring of a string starting at spot - #! from code until the quotation given is true and - #! advance spot to after the substring. - 10 [ - '[ @ [ t ] [ get-char _ push f ] if ] skip-until - ] keep >string ; inline - -: take-rest ( -- string ) - [ f ] take-until ; - -: take-char ( ch -- string ) - [ dup get-char = ] take-until nip ; - -TUPLE: not-enough-characters < parsing-error ; -: not-enough-characters ( -- * ) - \ not-enough-characters parsing-error throw ; -M: not-enough-characters summary ( obj -- str ) - [ - call-next-method write - "Not enough characters" print - ] with-string-writer ; - -: take ( n -- string ) - [ 1- ] [ ] bi [ - '[ drop get-char [ next _ push f ] [ t ] if* ] contains? drop - ] keep get-char [ over push ] when* >string ; - -: pass-blank ( -- ) - #! Advance code past any whitespace, including newlines - [ get-char blank? not ] skip-until ; - -: string-matches? ( string circular -- ? ) - get-char over push-circular - sequence= ; - -: take-string ( match -- string ) - dup length - [ 2dup string-matches? ] take-until nip - dup length rot length 1- - head - get-char [ missing-close ] unless next ; - -: expect ( ch -- ) - get-char 2dup = [ 2drop ] [ - [ 1string ] bi@ expected - ] if next ; - -: expect-string ( string -- ) - dup [ get-char next ] replicate 2dup = - [ 2drop ] [ expected ] if ; - -: init-parser ( -- ) - 0 1 0 f spot set - read1 set-next next ; - -: state-parse ( stream quot -- ) - ! with-input-stream implicitly creates a new scope which we use - swap [ init-parser call ] with-input-stream ; inline - -: string-parse ( input quot -- ) - [ ] dip state-parse ; inline diff --git a/basis/state-parser/summary.txt b/basis/state-parser/summary.txt deleted file mode 100644 index 5d1429090b..0000000000 --- a/basis/state-parser/summary.txt +++ /dev/null @@ -1 +0,0 @@ -State-machined based text parsing framework diff --git a/basis/struct-arrays/struct-arrays-tests.factor b/basis/struct-arrays/struct-arrays-tests.factor index d2bf583b5a..6f77e66cd2 100755 --- a/basis/struct-arrays/struct-arrays-tests.factor +++ b/basis/struct-arrays/struct-arrays-tests.factor @@ -1,6 +1,7 @@ IN: struct-arrays.tests USING: struct-arrays tools.test kernel math sequences -alien.syntax alien.c-types destructors libc accessors ; +alien.syntax alien.c-types destructors libc accessors +destructors ; C-STRUCT: test-struct { "int" "x" } @@ -27,3 +28,12 @@ C-STRUCT: test-struct 0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce ] with-destructors ] unit-test + +[ ] [ ALIEN: 123 10 "test-struct" drop ] unit-test + +[ ] [ + [ + 10 "test-struct" malloc-struct-array + underlying>> &free drop + ] with-destructors +] unit-test \ No newline at end of file diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor index 33a469d0c8..ba0524009f 100755 --- a/basis/struct-arrays/struct-arrays.factor +++ b/basis/struct-arrays/struct-arrays.factor @@ -32,9 +32,9 @@ ERROR: bad-byte-array-length byte-array ; ] keep struct-array boa ; inline : ( alien length c-type -- struct-array ) - struct-array boa ; inline + heap-size struct-array boa ; inline : malloc-struct-array ( length c-type -- struct-array ) - heap-size [ calloc ] 2keep ; + [ heap-size calloc ] 2keep ; INSTANCE: struct-array sequence diff --git a/basis/symbols/authors.txt b/basis/symbols/authors.txt deleted file mode 100644 index f372b574ae..0000000000 --- a/basis/symbols/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Slava Pestov -Doug Coleman diff --git a/basis/symbols/summary.txt b/basis/symbols/summary.txt deleted file mode 100644 index 3093468c50..0000000000 --- a/basis/symbols/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Utility for defining multiple symbols at a time diff --git a/basis/symbols/symbols-docs.factor b/basis/symbols/symbols-docs.factor deleted file mode 100644 index 9f79b71365..0000000000 --- a/basis/symbols/symbols-docs.factor +++ /dev/null @@ -1,9 +0,0 @@ -USING: help.markup help.syntax ; -IN: symbols - -HELP: SYMBOLS: -{ $syntax "SYMBOLS: words... ;" } -{ $values { "words" "a sequence of new words to define" } } -{ $description "Creates a new word for every token until the ';'." } -{ $examples { $example "USING: prettyprint symbols ;" "IN: scratchpad" "SYMBOLS: foo bar baz ;\nfoo . bar . baz ." "foo\nbar\nbaz" } } -{ $see-also POSTPONE: SYMBOL: } ; diff --git a/basis/symbols/symbols-tests.factor b/basis/symbols/symbols-tests.factor deleted file mode 100644 index 274c4de85b..0000000000 --- a/basis/symbols/symbols-tests.factor +++ /dev/null @@ -1,21 +0,0 @@ -USING: kernel symbols tools.test parser generic words accessors -eval ; -IN: symbols.tests - -[ ] [ SYMBOLS: a b c ; ] unit-test -[ a ] [ a ] unit-test -[ b ] [ b ] unit-test -[ c ] [ c ] unit-test - -DEFER: blah - -[ ] [ "IN: symbols.tests GENERIC: blah" eval ] unit-test -[ ] [ "IN: symbols.tests USE: symbols SYMBOLS: blah ;" eval ] unit-test - -[ f ] [ \ blah generic? ] unit-test -[ t ] [ \ blah symbol? ] unit-test - -[ "IN: symbols.tests USE: symbols SINGLETONS: blah blah blah ;" eval ] -[ error>> error>> def>> \ blah eq? ] -must-fail-with - diff --git a/basis/symbols/symbols.factor b/basis/symbols/symbols.factor deleted file mode 100644 index 6cf8eac6fb..0000000000 --- a/basis/symbols/symbols.factor +++ /dev/null @@ -1,15 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: parser lexer sequences words kernel classes.singleton -classes.parser ; -IN: symbols - -: SYMBOLS: - ";" parse-tokens - [ create-in dup reset-generic define-symbol ] each ; - parsing - -: SINGLETONS: - ";" parse-tokens - [ create-class-in define-singleton-class ] each ; - parsing diff --git a/basis/symbols/tags.txt b/basis/symbols/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/basis/symbols/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/basis/syndication/syndication-tests.factor b/basis/syndication/syndication-tests.factor index 1ddcbf8090..8cfdc9e1d5 100644 --- a/basis/syndication/syndication-tests.factor +++ b/basis/syndication/syndication-tests.factor @@ -1,5 +1,5 @@ USING: syndication io kernel io.files tools.test io.encodings.utf8 -calendar urls ; +calendar urls xml.writer ; IN: syndication.tests \ download-feed must-infer @@ -43,3 +43,4 @@ IN: syndication.tests } } } ] [ "resource:basis/syndication/test/atom.xml" load-news-file ] unit-test +[ ] [ "resource:basis/syndication/test/atom.xml" load-news-file feed>xml xml>string drop ] unit-test diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index a6eaff4492..b23910e200 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -1,15 +1,15 @@ ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg. ! Portions copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: xml.utilities kernel assocs xml.generator math.order +USING: xml.utilities kernel assocs math.order strings sequences xml.data xml.writer - io.streams.string combinators xml xml.entities io.files io - http.client namespaces make xml.generator hashtables + io.streams.string combinators xml xml.entities.html io.files io + http.client namespaces make xml.interpolate hashtables calendar.format accessors continuations urls present ; IN: syndication : any-tag-named ( tag names -- tag-inside ) - f -rot [ tag-named nip dup ] with find 2drop ; + [ f ] 2dip [ tag-named nip dup ] with find 2drop ; TUPLE: feed title url entries ; @@ -70,8 +70,8 @@ TUPLE: entry title url description date ; tri ; : atom-entry-link ( tag -- url/f ) - "link" tags-named [ "rel" swap at "alternate" = ] find nip - dup [ "href" swap at >url ] when ; + "link" tags-named [ "rel" attr "alternate" = ] find nip + dup [ "href" attr >url ] when ; : atom1.0-entry ( tag -- entry ) entry new @@ -81,7 +81,7 @@ TUPLE: entry title url description date ; [ { "content" "summary" } any-tag-named dup children>> [ string? not ] contains? - [ children>> [ write-xml-chunk ] with-string-writer ] + [ children>> xml>string ] [ children>string ] if >>description ] [ @@ -95,7 +95,7 @@ TUPLE: entry title url description date ; feed new swap [ "title" tag-named children>string >>title ] - [ "link" tag-named "href" swap at >url >>url ] + [ "link" tag-named "href" attr >url >>url ] [ "entry" tags-named [ atom1.0-entry ] map set-entries ] tri ; @@ -114,26 +114,31 @@ TUPLE: entry title url description date ; http-get nip string>feed ; ! Atom generation -: simple-tag, ( content name -- ) - [ , ] tag, ; - -: simple-tag*, ( content name attrs -- ) - [ , ] tag*, ; - -: entry, ( entry -- ) - "entry" [ - { - [ title>> "title" { { "type" "html" } } simple-tag*, ] - [ url>> present "href" associate "link" swap contained*, ] - [ date>> timestamp>rfc3339 "published" simple-tag, ] - [ description>> [ "content" { { "type" "html" } } simple-tag*, ] when* ] - } cleave - ] tag, ; + +: entry>xml ( entry -- xml ) + { + [ title>> ] + [ url>> present ] + [ date>> timestamp>rfc3339 ] + [ description>> ] + } cleave + [XML + + <-> + /> + <-> + <-> + + XML] ; : feed>xml ( feed -- xml ) - "feed" { { "xmlns" "http://www.w3.org/2005/Atom" } } [ - [ title>> "title" simple-tag, ] - [ url>> present "href" associate "link" swap contained*, ] - [ entries>> [ entry, ] each ] - tri - ] make-xml* ; + [ title>> ] + [ url>> present ] + [ entries>> [ entry>xml ] map ] tri + + <-> + /> + <-> + + XML> ; diff --git a/basis/tools/cocoa/cocoa.factor b/basis/tools/cocoa/cocoa.factor index a8cdf6f41c..9dd1895a68 100644 --- a/basis/tools/cocoa/cocoa.factor +++ b/basis/tools/cocoa/cocoa.factor @@ -1,16 +1,18 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays cocoa.messages cocoa.runtime combinators -prettyprint ; +prettyprint combinators.smart ; IN: tools.cocoa : method. ( method -- ) - { - [ method_getName sel_getName ] - [ method-return-type ] - [ method-arg-types ] - [ method_getImplementation ] - } cleave 4array . ; + [ + { + [ method_getName sel_getName ] + [ method-return-type ] + [ method-arg-types ] + [ method_getImplementation ] + } cleave + ] output>array . ; : methods. ( class -- ) [ method. ] each-method-in-class ; diff --git a/basis/tools/crossref/crossref-tests.factor b/basis/tools/crossref/crossref-tests.factor index 5bf917f906..e7e2e55259 100644 --- a/basis/tools/crossref/crossref-tests.factor +++ b/basis/tools/crossref/crossref-tests.factor @@ -1,5 +1,6 @@ -USING: math kernel sequences io.files tools.crossref tools.test -parser namespaces source-files generic definitions ; +USING: math kernel sequences io.files io.pathnames +tools.crossref tools.test parser namespaces source-files generic +definitions ; IN: tools.crossref.tests GENERIC: foo diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index ee8615ac5a..636e44062e 100644 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -4,9 +4,11 @@ USING: namespaces make continuations.private kernel.private init assocs kernel vocabs words sequences memory io system arrays continuations math definitions mirrors splitting parser classes summary layouts vocabs.loader prettyprint.config prettyprint -debugger io.streams.c io.files io.backend quotations io.launcher -words.private tools.deploy.config tools.deploy.config.editor -bootstrap.image io.encodings.utf8 destructors accessors ; +debugger io.streams.c io.files io.files.temp io.pathnames +io.directories io.directories.hierarchy io.backend quotations +io.launcher words.private tools.deploy.config +tools.deploy.config.editor bootstrap.image io.encodings.utf8 +destructors accessors ; IN: tools.deploy.backend : copy-vm ( executable bundle-name extension -- vm ) diff --git a/basis/tools/deploy/config/editor/editor.factor b/basis/tools/deploy/config/editor/editor.factor index 2b5788adfc..ac89e3290b 100644 --- a/basis/tools/deploy/config/editor/editor.factor +++ b/basis/tools/deploy/config/editor/editor.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs io.files kernel parser prettyprint sequences +USING: assocs io.pathnames kernel parser prettyprint sequences splitting tools.deploy.config tools.vocabs vocabs.loader ; IN: tools.deploy.config.editor diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index a390ce56c4..8b36947f43 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -1,18 +1,10 @@ IN: tools.deploy.tests -USING: tools.test system io.files kernel tools.deploy.config +USING: tools.test system io.pathnames io.files io.files.info +io.files.temp kernel tools.deploy.config tools.deploy.config.editor tools.deploy.backend math sequences io.launcher arrays namespaces continuations layouts accessors -io.encodings.ascii urls math.parser ; - -: shake-and-bake ( vocab -- ) - [ "test.image" temp-file delete-file ] ignore-errors - "resource:" [ - [ vm "test.image" temp-file ] dip - dup deploy-config make-deploy-image - ] with-directory ; - -: small-enough? ( n -- ? ) - [ "test.image" temp-file file-info size>> ] [ cell 4 / * ] bi* <= ; +io.encodings.ascii urls math.parser io.directories +tools.deploy.test ; [ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test @@ -35,11 +27,6 @@ os macosx? [ [ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test ] when -: run-temp-image ( -- ) - vm - "-i=" "test.image" temp-file append - 2array try-process ; - { "tools.deploy.test.1" "tools.deploy.test.2" @@ -112,3 +99,8 @@ M: quit-responder call-responder* "tools.deploy.test.9" shake-and-bake run-temp-image ] unit-test + +[ ] [ + "tools.deploy.test.10" shake-and-bake + run-temp-image +] unit-test diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor index 1f0e482441..91b4d603af 100644 --- a/basis/tools/deploy/macosx/macosx.factor +++ b/basis/tools/deploy/macosx/macosx.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.files kernel namespaces make sequences system -tools.deploy.backend tools.deploy.config +USING: io io.files io.files.info.unix io.pathnames +io.directories io.directories.hierarchy kernel namespaces make +sequences system tools.deploy.backend tools.deploy.config tools.deploy.config.editor assocs hashtables prettyprint -io.unix.backend cocoa io.encodings.utf8 io.backend -cocoa.application cocoa.classes cocoa.plists qualified +io.backend.unix cocoa io.encodings.utf8 io.backend +cocoa.application cocoa.classes cocoa.plists combinators ; IN: tools.deploy.macosx @@ -12,7 +13,7 @@ IN: tools.deploy.macosx vm parent-directory parent-directory ; : copy-bundle-dir ( bundle-name dir -- ) - bundle-dir over append-path -rot + [ bundle-dir prepend-path swap ] keep "Contents" prepend-path append-path copy-tree ; : app-plist ( executable bundle-name -- assoc ) @@ -53,7 +54,8 @@ IN: tools.deploy.macosx } cleave ] [ create-app-plist ] - [ "Contents/MacOS/" append-path "" copy-vm ] 2tri ; + [ "Contents/MacOS/" append-path "" copy-vm ] 2tri + dup OCT: 755 set-file-permissions ; : deploy.app-image ( vocab bundle-name -- str ) [ % "/Contents/Resources/" % % ".image" % ] "" make ; diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 3d4944841d..c894a8931b 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors qualified io.backend io.streams.c init fry +USING: accessors io.backend io.streams.c init fry namespaces make assocs kernel parser lexer strings.parser vocabs sequences words words.private memory kernel.private continuations io vocabs.loader system strings sets @@ -365,6 +365,7 @@ SYMBOL: deploy-vocab init-hooks get values concat % , strip-io? [ \ flush , ] unless + [ 0 exit ] % ] [ ] make set-boot-quot ; diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor index 773b2d0f3b..df64443b7b 100644 --- a/basis/tools/deploy/shaker/strip-cocoa.factor +++ b/basis/tools/deploy/shaker/strip-cocoa.factor @@ -19,12 +19,8 @@ IN: cocoa.application [ [ die ] 19 setenv ] "cocoa.application" add-init-hook -"stop-after-last-window?" get - H{ } clone \ pool [ global [ - "stop-after-last-window?" "ui" lookup set - ! Only keeps those methods that we actually call sent-messages get super-sent-messages get assoc-union objc-methods [ assoc-intersect pool-values ] change diff --git a/basis/tools/deploy/test/10/10-tests.factor b/basis/tools/deploy/test/10/10-tests.factor new file mode 100644 index 0000000000..ba6f354aa5 --- /dev/null +++ b/basis/tools/deploy/test/10/10-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test tools.deploy.test.10 ; +IN: tools.deploy.test.10.tests diff --git a/basis/tools/deploy/test/10/10.factor b/basis/tools/deploy/test/10/10.factor new file mode 100644 index 0000000000..95329ff7f2 --- /dev/null +++ b/basis/tools/deploy/test/10/10.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: prettyprint ; +IN: tools.deploy.test.10 + +: main ( -- ) C{ 0 1 } pprint ; + +MAIN: main \ No newline at end of file diff --git a/basis/tools/deploy/test/10/authors.txt b/basis/tools/deploy/test/10/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/tools/deploy/test/10/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/tools/deploy/test/10/deploy.factor b/basis/tools/deploy/test/10/deploy.factor new file mode 100644 index 0000000000..3f5940651d --- /dev/null +++ b/basis/tools/deploy/test/10/deploy.factor @@ -0,0 +1,15 @@ +USING: tools.deploy.config ; +H{ + { deploy-reflection 3 } + { deploy-unicode? f } + { deploy-io 2 } + { deploy-word-props? f } + { deploy-compiler? f } + { deploy-threads? f } + { deploy-word-defs? f } + { "stop-after-last-window?" t } + { deploy-ui? f } + { deploy-math? t } + { deploy-c-types? f } + { deploy-name "tools.deploy.test.10" } +} diff --git a/basis/tools/deploy/test/test.factor b/basis/tools/deploy/test/test.factor new file mode 100644 index 0000000000..eb780e40cc --- /dev/null +++ b/basis/tools/deploy/test/test.factor @@ -0,0 +1,19 @@ +USING: accessors arrays continuations io.directories io.files.info +io.files.temp io.launcher kernel layouts math sequences system +tools.deploy.backend tools.deploy.config.editor ; +IN: tools.deploy.test + +: shake-and-bake ( vocab -- ) + [ "test.image" temp-file delete-file ] ignore-errors + "resource:" [ + [ vm "test.image" temp-file ] dip + dup deploy-config make-deploy-image + ] with-directory ; + +: small-enough? ( n -- ? ) + [ "test.image" temp-file file-info size>> ] [ cell 4 / * ] bi* <= ; + +: run-temp-image ( -- ) + vm + "-i=" "test.image" temp-file append + 2array try-process ; \ No newline at end of file diff --git a/basis/tools/deploy/unix/unix.factor b/basis/tools/deploy/unix/unix.factor index bd49155e84..9e0bb8ac68 100644 --- a/basis/tools/deploy/unix/unix.factor +++ b/basis/tools/deploy/unix/unix.factor @@ -1,13 +1,15 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: io io.files io.backend kernel namespaces make sequences +USING: io io.pathnames io.directories io.files +io.files.info.unix io.backend kernel namespaces make sequences system tools.deploy.backend tools.deploy.config tools.deploy.config.editor assocs hashtables prettyprint ; IN: tools.deploy.unix : create-app-dir ( vocab bundle-name -- vm ) dup "" copy-fonts - "" copy-vm ; + "" copy-vm + dup OCT: 755 set-file-permissions ; : bundle-name ( -- str ) deploy-name get ; diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor index 6188e78b0e..7ce635b1ba 100755 --- a/basis/tools/deploy/windows/windows.factor +++ b/basis/tools/deploy/windows/windows.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.files kernel namespaces sequences system +USING: io io.files io.directories kernel namespaces sequences system tools.deploy.backend tools.deploy.config tools.deploy.config.editor assocs hashtables prettyprint combinators windows.shell32 windows.user32 ; diff --git a/basis/tools/disassembler/gdb/gdb.factor b/basis/tools/disassembler/gdb/gdb.factor old mode 100644 new mode 100755 index 65d0e2f43a..9076b67606 --- a/basis/tools/disassembler/gdb/gdb.factor +++ b/basis/tools/disassembler/gdb/gdb.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia. ! See http://factorcode.org/license.txt for BSD license. -USING: io.files io words alien kernel math.parser alien.syntax -io.launcher system assocs arrays sequences namespaces make -qualified system math io.encodings.ascii accessors -tools.disassembler ; +USING: io.files io.files.temp io words alien kernel math.parser +alien.syntax io.launcher system assocs arrays sequences +namespaces make system math io.encodings.ascii +accessors tools.disassembler ; IN: tools.disassembler.gdb SINGLETON: gdb-disassembler diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index c5b5c80d13..a915551263 100644 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -20,8 +20,9 @@ TYPEDEF: char[592] ud FUNCTION: void ud_translate_intel ( ud* u ) ; FUNCTION: void ud_translate_att ( ud* u ) ; -: UD_SYN_INTEL &: ud_translate_intel ; inline -: UD_SYN_ATT &: ud_translate_att ; inline +: UD_SYN_INTEL ( -- addr ) &: ud_translate_intel ; inline +: UD_SYN_ATT ( -- addr ) &: ud_translate_att ; inline + : UD_EOI -1 ; inline : UD_INP_CACHE_SZ 32 ; inline : UD_VENDOR_AMD 0 ; inline diff --git a/basis/tools/files/files-tests.factor b/basis/tools/files/files-tests.factor index 6cbc7d192c..aa4273f35f 100644 --- a/basis/tools/files/files-tests.factor +++ b/basis/tools/files/files-tests.factor @@ -1,10 +1,8 @@ -! Copyright (C) 2008 Your name. +! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: tools.test tools.files strings kernel ; IN: tools.files.tests -\ directory. must-infer - [ ] [ "" directory. ] unit-test [ ] [ file-systems. ] unit-test diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 7968639d47..936c682322 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -1,22 +1,29 @@ -! Copyright (C) 2008 Doug Coleman. +! Copyright (C) 2008, 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators io io.files kernel -math.parser sequences system vocabs.loader calendar math -symbols fry prettyprint ; +USING: accessors arrays calendar combinators fry io io.directories +io.files.info kernel math math.parser prettyprint sequences system +vocabs.loader sorting.slots calendar.format ; IN: tools.files " 20 CHAR: \s pad-right + ] [ + size>> number>string 20 CHAR: \s pad-left + ] if ; + +: listing-time ( timestamp -- string ) [ hour>> ] [ minute>> ] bi [ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ; -: ls-timestamp ( timestamp -- string ) +: listing-date ( timestamp -- string ) [ month>> month-abbreviation ] [ day>> number>string 2 CHAR: \s pad-left ] [ dup year>> dup now year>> = - [ drop ls-time ] [ nip number>string ] if + [ drop listing-time ] [ nip number>string ] if 5 CHAR: \s pad-left ] tri 3array " " join ; @@ -26,12 +33,57 @@ IN: tools.files : execute>string ( ? -- string ) "x" "-" ? ; inline -HOOK: (directory.) os ( path -- lines ) - PRIVATE> -: directory. ( path -- ) - [ (directory.) ] with-directory-files [ print ] each ; +SYMBOLS: file-name file-name/type permissions file-type nlinks file-size +file-date file-time file-datetime uid gid user group link-target unix-datetime +directory-or-size ; + +TUPLE: listing-tool path specs sort ; + +TUPLE: file-listing directory-entry file-info ; + +C: file-listing + +: ( path -- listing-tool ) + listing-tool new + swap >>path + { file-name } >>specs ; + +: list-slow? ( listing-tool -- ? ) + specs>> { file-name } sequence= not ; + +ERROR: unknown-file-spec symbol ; + +HOOK: file-spec>string os ( file-listing spec -- string ) + +M: object file-spec>string ( file-listing spec -- string ) + { + { file-name [ directory-entry>> name>> ] } + { directory-or-size [ file-info>> dir-or-size ] } + { file-size [ file-info>> size>> number>string ] } + { file-date [ file-info>> modified>> listing-date ] } + { file-time [ file-info>> modified>> listing-time ] } + { file-datetime [ file-info>> modified>> timestamp>ymdhms ] } + [ unknown-file-spec ] + } case ; + +: list-files-fast ( listing-tool -- array ) + path>> [ [ name>> 1array ] map ] with-directory-entries ; inline + +: list-files-slow ( listing-tool -- array ) + [ path>> ] [ sort>> ] [ specs>> ] tri '[ + [ dup name>> file-info file-listing boa ] map + _ [ sort-by-slots ] when* + [ _ [ file-spec>string ] with map ] map + ] with-directory-entries ; inline + +: list-files ( listing-tool -- array ) + dup list-slow? [ list-files-slow ] [ list-files-fast ] if ; inline + +HOOK: (directory.) os ( path -- lines ) + +: directory. ( path -- ) (directory.) simple-table. ; SYMBOLS: device-name mount-point type available-space free-space used-space total-space @@ -41,16 +93,16 @@ percent-used percent-free ; : file-system-spec ( file-system-info obj -- str ) { - { device-name [ device-name>> [ "" ] unless* ] } - { mount-point [ mount-point>> [ "" ] unless* ] } - { type [ type>> [ "" ] unless* ] } - { available-space [ available-space>> [ 0 ] unless* ] } - { free-space [ free-space>> [ 0 ] unless* ] } - { used-space [ used-space>> [ 0 ] unless* ] } - { total-space [ total-space>> [ 0 ] unless* ] } + { device-name [ device-name>> "" or ] } + { mount-point [ mount-point>> "" or ] } + { type [ type>> "" or ] } + { available-space [ available-space>> 0 or ] } + { free-space [ free-space>> 0 or ] } + { used-space [ used-space>> 0 or ] } + { total-space [ total-space>> 0 or ] } { percent-used [ [ used-space>> ] [ total-space>> ] bi - [ [ 0 ] unless* ] bi@ dup 0 = + [ 0 or ] bi@ dup 0 = [ 2drop 0 ] [ / percent ] if ] } } case ; @@ -63,8 +115,10 @@ percent-used percent-free ; [ [ unparse ] map ] bi prefix simple-table. ; : file-systems. ( -- ) - { device-name free-space used-space total-space percent-used mount-point } - print-file-systems ; + { + device-name available-space free-space used-space + total-space percent-used mount-point + } print-file-systems ; { { [ os unix? ] [ "tools.files.unix" ] } diff --git a/basis/tools/files/unix/unix.factor b/basis/tools/files/unix/unix.factor index 184f371b1c..e63ab09076 100755 --- a/basis/tools/files/unix/unix.factor +++ b/basis/tools/files/unix/unix.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators kernel system unicode.case -io.unix.files tools.files generalizations strings -arrays sequences io.files math.parser unix.groups unix.users -tools.files.private unix.stat math ; +USING: accessors combinators kernel system unicode.case io.files +io.files.info io.files.info.unix generalizations +strings arrays sequences math.parser unix.groups unix.users +tools.files.private unix.stat math fry macros combinators.smart +io.files.info.unix io tools.files math.order prettyprint ; IN: tools.files.unix > file-type>ch 1string ] - [ user-read? read>string ] - [ user-write? write>string ] - [ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ] - [ group-read? read>string ] - [ group-write? write>string ] - [ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ] - [ other-read? read>string ] - [ other-write? write>string ] - [ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ] - } cleave 10 narray concat ; + [ + { + [ type>> file-type>ch 1string ] + [ user-read? read>string ] + [ user-write? write>string ] + [ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ] + [ group-read? read>string ] + [ group-write? write>string ] + [ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ] + [ other-read? read>string ] + [ other-write? write>string ] + [ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ] + } cleave + ] output>array concat ; : mode>symbol ( mode -- ch ) S_IFMT bitand @@ -43,18 +46,23 @@ IN: tools.files.unix } cond ; M: unix (directory.) ( path -- lines ) - [ [ - [ - dup file-info - { - [ permissions-string ] - [ nlink>> number>string 3 CHAR: \s pad-left ] - ! [ uid>> ] - ! [ gid>> ] - [ size>> number>string 15 CHAR: \s pad-left ] - [ modified>> ls-timestamp ] - } cleave 4 narray swap suffix " " join - ] map - ] with-group-cache ] with-user-cache ; + + { permissions nlinks user group file-size file-date file-name } >>specs + { { directory-entry>> name>> <=> } } >>sort + [ [ list-files ] with-group-cache ] with-user-cache ; + +M: unix file-spec>string ( file-listing spec -- string ) + { + { file-name/type [ + directory-entry>> [ name>> ] [ file-type>trailing ] bi append + ] } + { permissions [ file-info>> permissions-string ] } + { nlinks [ file-info>> nlink>> number>string ] } + { user [ file-info>> uid>> user-name ] } + { group [ file-info>> gid>> group-name ] } + { uid [ file-info>> uid>> number>string ] } + { gid [ file-info>> gid>> number>string ] } + [ call-next-method ] + } case ; PRIVATE> diff --git a/basis/tools/files/windows/windows.factor b/basis/tools/files/windows/windows.factor index 76e6ea5590..f321c2fc7f 100755 --- a/basis/tools/files/windows/windows.factor +++ b/basis/tools/files/windows/windows.factor @@ -2,24 +2,15 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors calendar.format combinators io.files kernel math.parser sequences splitting system tools.files -generalizations tools.files.private ; +generalizations tools.files.private io.files.info math.order ; IN: tools.files.windows " 20 CHAR: \s pad-right - ] [ - size>> number>string 20 CHAR: \s pad-left - ] if ; - M: windows (directory.) ( entries -- lines ) - [ - dup file-info { - [ modified>> timestamp>ymdhms ] - [ directory-or-size ] - } cleave 2 narray swap suffix " " join - ] map ; + + { file-datetime directory-or-size file-name } >>specs + { { directory-entry>> name>> <=> } } >>sort + list-files ; PRIVATE> diff --git a/basis/tools/profiler/profiler-docs.factor b/basis/tools/profiler/profiler-docs.factor index 69edf1a7e0..da9171cedf 100644 --- a/basis/tools/profiler/profiler-docs.factor +++ b/basis/tools/profiler/profiler-docs.factor @@ -2,14 +2,18 @@ USING: tools.profiler.private tools.time help.markup help.syntax quotations io strings words definitions ; IN: tools.profiler -ARTICLE: "profiling" "Profiling code" -"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler. The profiler is completely accurate with words and methods which are compiled with the non-optimizing compiler. Some optimizations performed by the optimizing compiler can inhibit accurate call counting, however:" +ARTICLE: "profiler-limitations" "Profiler limitations" +"Certain optimizations performed by the compiler can inhibit accurate call counting:" { $list - "The optimizing compiler open-codes certain primitives with inline machine code, and in some cases optimizes them out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations." - { "Calls to " { $link POSTPONE: inline } " words are not counted.." } + "Calls to open-coded intrinsics are not counted. Certain words are open-coded as inline machine code, and in some cases optimized out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations." + { "Calls to " { $link POSTPONE: inline } " words are not counted." } { "Calls to methods which were inlined as a result of type inference are not counted." } "Tail-recursive loops will only count the initial invocation of the word, not every tail call." -} +} ; + +ARTICLE: "profiling" "Profiling code" +"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler." +$nl "Quotations can be passed to a combinator which calls them with the profiler enabled:" { $subsection profile } "After a quotation has been profiled, call counts can be presented in various ways:" @@ -17,7 +21,9 @@ ARTICLE: "profiling" "Profiling code" { $subsection vocab-profile. } { $subsection usage-profile. } { $subsection vocabs-profile. } -{ $subsection method-profile. } ; +{ $subsection method-profile. } +{ $subsection "profiler-limitations" } +{ $see-also "ui-profiler" } ; ABOUT: "profiling" diff --git a/basis/tools/profiler/profiler.factor b/basis/tools/profiler/profiler.factor index f21e8498eb..8391536374 100644 --- a/basis/tools/profiler/profiler.factor +++ b/basis/tools/profiler/profiler.factor @@ -3,7 +3,7 @@ USING: accessors words sequences math prettyprint kernel arrays io io.styles namespaces assocs kernel.private strings combinators sorting math.parser vocabs definitions tools.profiler.private -continuations generic ; +continuations generic compiler.units sets ; IN: tools.profiler : profile ( quot -- ) @@ -19,7 +19,7 @@ TUPLE: usage-profile word ; C: usage-profile M: word (profile.) - dup unparse swap write-object ; + [ name>> "( no name )" or ] [ ] bi write-object ; TUPLE: vocab-profile vocab ; @@ -29,8 +29,8 @@ M: string (profile.) dup write-object ; M: method-body (profile.) - dup synopsis swap "method-generic" word-prop - write-object ; + [ synopsis ] [ "method-generic" word-prop ] bi + write-object ; : counter. ( obj n -- ) [ @@ -58,7 +58,10 @@ M: method-body (profile.) "Call counts for words which call " write dup pprint ":" print - smart-usage [ word? ] filter counters counters. ; + [ smart-usage [ word? ] filter ] + [ compiled-generic-usage keys ] + [ compiled-usage keys ] + tri 3append prune counters counters. ; : vocabs-profile. ( -- ) "Call counts for all vocabularies:" print diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index d2989d3cac..9074c80986 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -26,7 +26,7 @@ HELP: scaffold-undocumented HELP: scaffold-vocab { $values { "vocab-root" "a vocabulary root string" } { "string" string } } -{ $description "Creates a direcory in the given root for a new vocabulary and adds a main .factor file, a tests file, and an authors.txt file." } ; +{ $description "Creates a directory in the given root for a new vocabulary and adds a main .factor file, a tests file, and an authors.txt file." } ; HELP: using { $description "Stores the vocabularies that are pulled into the documentation file from looking up the stack effect types." } ; diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index d8822f51dc..b6e8eb2a46 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs io.files hashtables kernel namespaces sequences -vocabs.loader io combinators io.encodings.utf8 calendar accessors -math.parser io.streams.string ui.tools.operations quotations -strings arrays prettyprint words vocabs sorting sets -classes math alien urls splitting ascii ; +USING: assocs io.files io.pathnames io.directories +io.encodings.utf8 hashtables kernel namespaces sequences +vocabs.loader io combinators calendar accessors math.parser +io.streams.string ui.tools.operations quotations strings arrays +prettyprint words vocabs sorting sets classes math alien urls +splitting ascii ; IN: tools.scaffold SYMBOL: developer-name diff --git a/basis/tools/threads/threads-docs.factor b/basis/tools/threads/threads-docs.factor index d4c5be9c17..c60255b377 100644 --- a/basis/tools/threads/threads-docs.factor +++ b/basis/tools/threads/threads-docs.factor @@ -2,10 +2,10 @@ IN: tools.threads USING: help.markup help.syntax threads ; HELP: threads. -{ $description "Prints a list of running threads and their state. The ``Waiting on'' column displays one of the following:" +{ $description "Prints a list of running threads and their state. The “Waiting on” column displays one of the following:" { $list - "``running'' if the thread is the current thread" - "``yield'' if the thread is waiting to run" + "“running” if the thread is the current thread" + "“yield” if the thread is waiting to run" { "the string given to " { $link suspend } " if the thread is suspended" } } } ; diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/tools/vocabs/browser/browser.factor index e9e8d27870..36f23a8298 100644 --- a/basis/tools/vocabs/browser/browser.factor +++ b/basis/tools/vocabs/browser/browser.factor @@ -3,10 +3,10 @@ USING: accessors arrays assocs classes classes.builtin classes.intersection classes.mixin classes.predicate classes.singleton classes.tuple classes.union combinators -definitions effects fry generic help help.markup -help.stylesheet help.topics io io.files io.styles kernel macros +definitions effects fry generic help help.markup help.stylesheet +help.topics io io.files io.pathnames io.styles kernel macros make namespaces prettyprint sequences sets sorting summary -tools.vocabs vocabs vocabs.loader words ; +tools.vocabs vocabs vocabs.loader words words.symbol ; IN: tools.vocabs.browser : vocab-status-string ( vocab -- string ) diff --git a/basis/tools/vocabs/monitor/monitor-tests.factor b/basis/tools/vocabs/monitor/monitor-tests.factor index f1eece91c2..0e767a3d34 100644 --- a/basis/tools/vocabs/monitor/monitor-tests.factor +++ b/basis/tools/vocabs/monitor/monitor-tests.factor @@ -1,4 +1,4 @@ -USING: tools.test tools.vocabs.monitor io.files ; +USING: tools.test tools.vocabs.monitor io.pathnames ; IN: tools.vocabs.monitor.tests [ "kernel" ] [ "core/kernel/kernel.factor" path>vocab ] unit-test diff --git a/basis/tools/vocabs/monitor/monitor.factor b/basis/tools/vocabs/monitor/monitor.factor index 416eec91d2..4091cdd90c 100644 --- a/basis/tools/vocabs/monitor/monitor.factor +++ b/basis/tools/vocabs/monitor/monitor.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: threads io.files io.monitors init kernel +USING: threads io.files io.pathnames io.monitors init kernel vocabs vocabs.loader tools.vocabs namespaces continuations sequences splitting assocs command-line concurrency.messaging -io.backend sets tr ; +io.backend sets tr accessors ; IN: tools.vocabs.monitor TR: convert-separators "/\\" ".." ; @@ -29,7 +29,7 @@ TR: convert-separators "/\\" ".." ; : monitor-loop ( -- ) #! On OS X, monitors give us the full path, so we chop it #! off if its there. - receive first path>vocab changed-vocab + receive path>> path>vocab changed-vocab reset-cache monitor-loop ; diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor index ab2d089d94..fe380e0afe 100644 --- a/basis/tools/vocabs/vocabs.factor +++ b/basis/tools/vocabs/vocabs.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel io io.styles io.files io.encodings.utf8 -vocabs.loader vocabs sequences namespaces make math.parser -arrays hashtables assocs memoize summary sorting splitting -combinators source-files debugger continuations compiler.errors -init checksums checksums.crc32 sets accessors generic -definitions words ; +USING: kernel io io.styles io.files io.files.info io.directories +io.pathnames io.encodings.utf8 vocabs.loader vocabs sequences +namespaces make math.parser arrays hashtables assocs memoize +summary sorting splitting combinators source-files debugger +continuations compiler.errors init checksums checksums.crc32 +sets accessors generic definitions words ; IN: tools.vocabs : vocab-xref ( vocab quot -- vocabs ) diff --git a/basis/tr/tr-tests.factor b/basis/tr/tr-tests.factor index c168f5384d..3434c28216 100644 --- a/basis/tr/tr-tests.factor +++ b/basis/tr/tr-tests.factor @@ -1,5 +1,5 @@ IN: tr.tests -USING: tr tools.test unicode.case ; +USING: tr tools.test ascii ; TR: tr-test ch>upper "ABC" "XYZ" ; diff --git a/basis/tr/tr.factor b/basis/tr/tr.factor index 66d8df7d44..ce535f335a 100644 --- a/basis/tr/tr.factor +++ b/basis/tr/tr.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: byte-arrays strings sequences sequences.private +USING: byte-arrays strings sequences sequences.private ascii fry kernel words parser lexer assocs math math.order summary ; IN: tr @@ -11,8 +11,6 @@ M: bad-tr summary > nth ] [ class>> ] bi prefix >tuple ; M: tuple-array set-nth ( elt n seq -- ) - >r >r tuple>array 1 tail r> r> seq>> set-nth ; + [ tuple>array 1 tail ] 2dip seq>> set-nth ; M: tuple-array new-sequence class>> ; diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor index aa84419d64..eaa0953d25 100755 --- a/basis/ui/backend/backend.factor +++ b/basis/ui/backend/backend.factor @@ -5,8 +5,6 @@ IN: ui.backend SYMBOL: ui-backend -HOOK: do-events ui-backend ( -- ) - HOOK: set-title ui-backend ( string world -- ) HOOK: set-fullscreen* ui-backend ( ? world -- ) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index fecbb52a25..331c0a698c 100755 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -3,10 +3,11 @@ USING: accessors math arrays assocs cocoa cocoa.application command-line kernel memory namespaces cocoa.messages cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types -cocoa.windows cocoa.classes cocoa.nibs sequences system -ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds -ui.cocoa.views core-foundation threads math.geometry.rect fry -libc generalizations alien.c-types cocoa.views combinators ; +cocoa.windows cocoa.classes cocoa.nibs sequences system ui +ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds +ui.cocoa.views core-foundation core-foundation.run-loop threads +math.geometry.rect fry libc generalizations alien.c-types +cocoa.views combinators io.thread ; IN: ui.cocoa TUPLE: handle ; @@ -18,9 +19,6 @@ C: offscreen-handle SINGLETON: cocoa-ui-backend -M: cocoa-ui-backend do-events ( -- ) - [ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ; - TUPLE: pasteboard handle ; C: pasteboard @@ -134,8 +132,8 @@ CLASS: { { +name+ "FactorApplicationDelegate" } } -{ "applicationDidFinishLaunching:" "void" { "id" "SEL" "id" } - [ 3drop event-loop ] +{ "applicationDidUpdate:" "void" { "id" "SEL" "id" } + [ 3drop reset-run-loop ] } ; : install-app-delegate ( -- ) @@ -153,6 +151,9 @@ M: cocoa-ui-backend ui init-clipboard cocoa-init-hook get call start-ui + f io-thread-running? set-global + init-thread-timer + reset-run-loop NSApp -> run ] ui-running ] with-cocoa ; diff --git a/basis/ui/event-loop/event-loop-tests.factor b/basis/ui/event-loop/event-loop-tests.factor new file mode 100644 index 0000000000..ae1d7ec8bc --- /dev/null +++ b/basis/ui/event-loop/event-loop-tests.factor @@ -0,0 +1,4 @@ +IN: ui.event-loop.tests +USING: ui.event-loop tools.test ; + +\ event-loop must-infer diff --git a/basis/ui/event-loop/event-loop.factor b/basis/ui/event-loop/event-loop.factor new file mode 100644 index 0000000000..7c08d802f5 --- /dev/null +++ b/basis/ui/event-loop/event-loop.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: calendar combinators deques kernel namespaces sequences +threads ui ui.backend ui.gadgets ; +IN: ui.event-loop + +: event-loop? ( -- ? ) + { + { [ graft-queue deque-empty? not ] [ t ] } + { [ windows get-global empty? not ] [ t ] } + [ f ] + } cond ; + +HOOK: do-events ui-backend ( -- ) + +: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ; + +: ui-wait ( -- ) 10 milliseconds sleep ; diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor index 22a4f1722d..0f36f3dcba 100644 --- a/basis/ui/freetype/freetype.factor +++ b/basis/ui/freetype/freetype.factor @@ -78,9 +78,9 @@ SYMBOL: dpi 72 dpi set-global -: ft-floor -6 shift ; inline +: ft-floor ( m -- n ) -6 shift ; inline -: ft-ceil 63 + -64 bitand -6 shift ; inline +: ft-ceil ( m -- n ) 63 + -64 bitand -6 shift ; inline : font-units>pixels ( n font -- n ) face-size face-size-y-scale FT_MulFix ; diff --git a/basis/ui/gadgets/borders/borders.factor b/basis/ui/gadgets/borders/borders.factor index 94816788e1..1f66cca178 100644 --- a/basis/ui/gadgets/borders/borders.factor +++ b/basis/ui/gadgets/borders/borders.factor @@ -16,6 +16,9 @@ TUPLE: border < gadget swap border new-border swap dup 2array >>size ; +: ( child gap -- border ) + { 1 1 } >>fill ; + M: border pref-dim* [ size>> 2 v*n ] keep gadget-child pref-dim v+ ; diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 75469671ef..dabc12d3ae 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -6,7 +6,7 @@ classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.render math.geometry.rect locals alien.c-types -specialized-arrays.float fry ; +specialized-arrays.float fry combinators.smart ; IN: ui.gadgets.buttons TUPLE: button < border pressed? selected? quot ; @@ -111,12 +111,14 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ; array ; : checkmark-vertices ( dim -- vertices ) checkmark-points concat >float-array ; diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 72d5900c28..dc2cedfef8 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -107,7 +107,7 @@ M: editor ungraft* editor-font* "" string-height ; : y>line ( y editor -- line# ) - line-height / >fixnum ; + line-height /i ; :: point>loc ( point editor -- loc ) point second editor y>line { @@ -350,7 +350,7 @@ M: editor gadget-text* editor-string % ; dupd editor-select-next mark>caret ; : editor-select ( from to editor -- ) - tuck caret>> set-model mark>> set-model ; + tuck [ mark>> set-model ] [ caret>> set-model ] 2bi* ; : select-elt ( editor elt -- ) [ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index baf025d116..2af0f6e6a2 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -165,7 +165,9 @@ M: gadget dim-changed in-layout? get [ invalidate ] [ invalidate* ] if ; M: gadget (>>dim) ( dim gadget -- ) - 2dup dim>> = [ 2drop ] [ tuck call-next-method dim-changed ] if ; + 2dup dim>> = + [ 2drop ] + [ [ nip ] [ call-next-method ] 2bi dim-changed ] if ; GENERIC: pref-dim* ( gadget -- dim ) @@ -250,7 +252,7 @@ M: gadget ungraft* drop ; f >>parent drop ; : unfocus-gadget ( child gadget -- ) - tuck focus>> eq? [ f >>focus ] when drop ; + [ nip ] [ focus>> eq? ] 2bi [ f >>focus ] when drop ; SYMBOL: in-layout? @@ -286,10 +288,7 @@ SYMBOL: in-layout? dup unparent over >>parent tuck ((add-gadget)) - tuck graft-state>> second - [ graft ] - [ drop ] - if ; + tuck graft-state>> second [ graft ] [ drop ] if ; : add-gadget ( parent child -- parent ) not-in-layout @@ -316,7 +315,7 @@ SYMBOL: in-layout? : (screen-rect) ( gadget -- loc ext ) dup parent>> [ [ rect-extent ] dip (screen-rect) - [ tuck v+ ] dip vmin [ v+ ] dip + [ [ nip ] [ v+ ] 2bi ] dip [ v+ ] [ vmin ] 2bi* ] [ rect-extent ] if* ; diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor index 8d79c9e07c..03e2e64d95 100755 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -11,7 +11,7 @@ C: grid-lines SYMBOL: grid-dim -: half-gap grid get gap>> [ 2/ ] map ; inline +: half-gap ( -- gap ) grid get gap>> [ 2/ ] map ; inline : grid-line-from/to ( orientation point -- from to ) half-gap v- diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor index eab8833120..e40da44483 100644 --- a/basis/ui/gadgets/grids/grids.factor +++ b/basis/ui/gadgets/grids/grids.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math namespaces make sequences words io -io.streams.string math.vectors ui.gadgets columns accessors +io.styles math.vectors ui.gadgets columns accessors math.geometry.rect locals fry ; IN: ui.gadgets.grids diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor index af249bbdc8..2b33d2bfe1 100644 --- a/basis/ui/gadgets/incremental/incremental.factor +++ b/basis/ui/gadgets/incremental/incremental.factor @@ -23,7 +23,7 @@ M: incremental pref-dim* ] keep orientation>> set-axis ; : update-cursor ( gadget incremental -- ) - tuck next-cursor >>cursor drop ; + [ nip ] [ next-cursor ] 2bi >>cursor drop ; : incremental-loc ( gadget incremental -- ) [ cursor>> ] [ orientation>> ] bi v* diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor index 5706f47639..eff3c6f7bb 100644 --- a/basis/ui/gadgets/labels/labels.factor +++ b/basis/ui/gadgets/labels/labels.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays hashtables io kernel math namespaces make opengl sequences strings splitting ui.gadgets @@ -12,11 +12,7 @@ TUPLE: label < gadget text font color ; text>> dup string? [ "\n" join ] unless ; inline : set-label-string ( string label -- ) - CHAR: \n pick memq? [ - [ string-lines ] dip (>>text) - ] [ - (>>text) - ] if ; inline + [ CHAR: \n over memq? [ string-lines ] when ] dip (>>text) ; inline : label-theme ( gadget -- gadget ) sans-serif-font >>font diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor index 2aef0b8417..c482f31896 100644 --- a/basis/ui/gadgets/menus/menus.factor +++ b/basis/ui/gadgets/menus/menus.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: locals accessors arrays ui.commands ui.gadgets +USING: locals accessors arrays ui.commands ui.operations ui.gadgets ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic hashtables kernel math models namespaces opengl sequences math.vectors ui.gadgets.theme ui.gadgets.packs @@ -54,3 +54,9 @@ M: menu-glass layout* gadget-child prefer ; : show-commands-menu ( target commands -- ) [ dup [ ] ] dip show-menu ; + +: ( target hook -- menu ) + over object-operations ; + +: show-operations-menu ( gadget target -- ) + [ ] show-menu ; \ No newline at end of file diff --git a/basis/ui/gadgets/panes/panes-docs.factor b/basis/ui/gadgets/panes/panes-docs.factor index d53cba5f76..23dc99da82 100644 --- a/basis/ui/gadgets/panes/panes-docs.factor +++ b/basis/ui/gadgets/panes/panes-docs.factor @@ -49,8 +49,8 @@ HELP: HELP: pane-stream { $class-description "Pane streams implement the portion of the " { $link "stream-protocol" } " responsible for output of text, including full support for " { $link "styles" } ". Pane streams also support direct output of gadgets via " { $link write-gadget } " and " { $link print-gadget } ". Pane streams are created by calling " { $link } "." } ; -HELP: ( pane -- stream ) -{ $values { "pane" pane } { "stream" "a new " { $link pane-stream } } } +HELP: +{ $values { "pane" pane } { "pane-stream" "a new " { $link pane-stream } } } { $description "Creates a new " { $link pane-stream } " for writing to " { $snippet "pane" } "." } ; { with-pane make-pane } related-words diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 79a47380b6..569d6e0f3f 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -6,7 +6,7 @@ ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render hashtables io kernel namespaces sequences io.styles strings quotations math opengl combinators math.vectors sorting -splitting io.streams.nested assocs ui.gadgets.presentations +splitting assocs ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines classes.tuple models continuations destructors accessors math.geometry.rect fry ; @@ -358,25 +358,25 @@ M: f sloppy-pick-up* [ 3drop { } ] if ; -: move-caret ( pane -- pane ) - dup hand-rel over sloppy-pick-up >>caret +: move-caret ( pane loc -- pane ) + over screen-loc v- over sloppy-pick-up >>caret dup relayout-1 ; : begin-selection ( pane -- ) f >>selecting? - move-caret + hand-loc get move-caret f >>mark drop ; : extend-selection ( pane -- ) hand-moved? [ dup selecting?>> [ - move-caret + hand-loc get move-caret ] [ dup hand-clicked get child? [ t >>selecting? dup hand-clicked set-global - move-caret + hand-click-loc get move-caret caret>mark ] when ] if @@ -394,7 +394,7 @@ M: f sloppy-pick-up* : select-to-caret ( pane -- ) t >>selecting? dup mark>> [ caret>mark ] unless - move-caret + hand-loc get move-caret dup request-focus com-copy-selection ; diff --git a/basis/ui/gadgets/presentations/presentations-docs.factor b/basis/ui/gadgets/presentations/presentations-docs.factor index c651e849a2..005fa1e7fe 100644 --- a/basis/ui/gadgets/presentations/presentations-docs.factor +++ b/basis/ui/gadgets/presentations/presentations-docs.factor @@ -35,8 +35,6 @@ HELP: {

+ + + diff --git a/extra/webapps/imagebin/uploaded-image.xml b/extra/webapps/imagebin/uploaded-image.xml new file mode 100644 index 0000000000..903be5cca4 --- /dev/null +++ b/extra/webapps/imagebin/uploaded-image.xml @@ -0,0 +1,7 @@ + + +Uploaded + +hi from uploaded-image + + diff --git a/extra/webapps/irc-log/irc-log.factor b/extra/webapps/irc-log/irc-log.factor index c193550719..bd9843bdc9 100644 --- a/extra/webapps/irc-log/irc-log.factor +++ b/extra/webapps/irc-log/irc-log.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: calendar kernel http.server.dispatchers prettyprint -sequences printf furnace.actions html.forms accessors +sequences formatting furnace.actions html.forms accessors furnace.redirection ; IN: webapps.irc-log diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index 01e068d351..38a3097999 100644 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: namespaces assocs sorting sequences kernel accessors -hashtables sequences.lib db.types db.tuples db combinators +hashtables db.types db.tuples db combinators calendar calendar.format math.parser math.order syndication urls xml.writer xmode.catalog validators html.forms diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 6c097d7faa..52d64f0f9e 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors sequences sorting math math.order calendar alarms logging concurrency.combinators namespaces -sequences.lib db.types db.tuples db fry locals hashtables +db.types db.tuples db fry locals hashtables syndication urls xml.writer validators html.forms html.components diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index f2c0600ed5..07fbbe0596 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel hashtables calendar random assocs namespaces make splitting sequences sorting math.order present -io.files io.encodings.ascii +io.files io.directories io.encodings.ascii syndication farkup html.components html.forms http.server diff --git a/extra/webkit-demo/deploy.factor b/extra/webkit-demo/deploy.factor index 8c0b1beb83..322212c4fc 100644 --- a/extra/webkit-demo/deploy.factor +++ b/extra/webkit-demo/deploy.factor @@ -1,14 +1,15 @@ USING: tools.deploy.config ; H{ + { deploy-io 1 } + { deploy-threads? f } + { deploy-word-defs? f } { deploy-ui? f } { deploy-compiler? t } + { deploy-word-props? f } + { "stop-after-last-window?" t } + { deploy-unicode? f } { deploy-c-types? f } + { deploy-math? f } { deploy-reflection 1 } { deploy-name "WebKit demo" } - { deploy-io 1 } - { deploy-math? f } - { deploy-word-props? f } - { "stop-after-last-window?" t } - { deploy-word-defs? f } - { deploy-threads? f } } diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index d7fdfa2460..302967969f 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel sequences assocs io.files io.sockets -io.sockets.secure io.servers.connection +USING: accessors kernel sequences assocs io.files io.pathnames +io.sockets io.sockets.secure io.servers.connection namespaces db db.tuples db.sqlite smtp urls logging.insomniac html.templates.chloe diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor index 803f0c2a66..7abdc149dd 100644 --- a/extra/wordtimer/wordtimer.factor +++ b/extra/wordtimer/wordtimer.factor @@ -30,7 +30,7 @@ SYMBOL: *calling* *calling* get-global at ; inline : timed-call ( quot word -- ) - [ calling ] [ >r benchmark r> register-time ] [ finished ] tri ; inline + [ calling ] [ [ benchmark ] dip register-time ] [ finished ] tri ; inline : time-unless-recursing ( quot word -- ) dup called-recursively? not @@ -71,9 +71,10 @@ SYMBOL: *calling* : wordtimer-call ( quot -- ) reset-word-timer - benchmark >r - correct-for-timing-overhead - "total time:" write r> pprint nl + benchmark [ + correct-for-timing-overhead + "total time:" write + ] dip pprint nl print-word-timings nl ; : profile-vocab ( vocab quot -- ) @@ -81,9 +82,10 @@ SYMBOL: *calling* over [ reset-vocab ] [ add-timers ] bi reset-word-timer "executing quotation..." print flush - benchmark >r - "resetting annotations..." print flush - reset-vocab - correct-for-timing-overhead - "total time:" write r> pprint + benchmark [ + "resetting annotations..." print flush + reset-vocab + correct-for-timing-overhead + "total time:" write + ] dip pprint print-word-timings ; diff --git a/license.txt b/license.txt index 768c13c549..8f4f53585a 100644 --- a/license.txt +++ b/license.txt @@ -1,4 +1,4 @@ -Copyright (C) 2003, 2008 Slava Pestov and friends. +Copyright (C) 2003, 2009 Slava Pestov and friends. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/misc/factor.vim b/misc/factor.vim deleted file mode 100644 index 90a3d46d50..0000000000 --- a/misc/factor.vim +++ /dev/null @@ -1,265 +0,0 @@ -" Vim syntax file -" Language: factor -" Maintainer: Alex Chapman -" Last Change: 2008 Apr 28 - -" For version 5.x: Clear all syntax items -" For version 6.x: Quit when a syntax file was already loaded -if version < 600 - syntax clear -elseif exists("b:current_syntax") - finish -endif - -" factor is case sensitive. -syn case match - -" make all of these characters part of a word (useful for skipping over words with w, e, and b) -if version >= 600 - setlocal iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255 -else - set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255 -endif - -syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple - -syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained -syn match factorComment /\<#! .*/ contains=factorTodo -syn match factorComment /\/ end=/\<;\>/ contains=@factorDefnContents -syn region factorMethod matchgroup=factorMethodDelims start=/\/ end=/\<;\>/ contains=@factorDefnContents -syn region factorGeneric matchgroup=factorGenericDelims start=/\/ end=/$/ contains=factorStackEffect -syn region factorGenericN matchgroup=factorGenericNDelims start=/\/ end=/$/ contains=factorStackEffect - -syn region factorPrivateDefn matchgroup=factorPrivateDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained -syn region factorPrivateMethod matchgroup=factorPrivateMethodDelims start=/\/ end=/\<;\>/ contains=@factorDefnContents contained -syn region factorPGeneric matchgroup=factorPGenericDelims start=/\/ end=/$/ contains=factorStackEffect contained -syn region factorPGenericN matchgroup=factorPGenericNDelims start=/\/ end=/$/ contains=factorStackEffect - -syn region None matchgroup=factorPrivate start=/\</ end=/\\>/ contains=@factorDefnContents,factorPrivateDefn,factorPrivateMethod,factorPGeneric,factorPGenericN - - -syn keyword factorBoolean boolean f general-t t -syn keyword factorCompileDirective inline foldable parsing - - - -" kernel vocab keywords -syn keyword factorKeyword or construct-delegate set-slots tuck 2bi 2tri while wrapper nip bi* wrapper? hashcode callstack>array both? die set-delegate dupd callstack callstack? 3dup tri@ pick curry build prepose 3bi >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep construct clear 2dup when not tuple? 3compose dup 2bi* call object bi@ wrapped unless* if* >r curry-quot drop when* retainstack -rot 2bi@ delegate boa with 3slip slip compose-first compose-second 3drop either? bi curry? datastack curry-obj over 3curry roll throw swap and 2nip set-retainstack (clone) hashcode* get-slots compose spin if 3tri unless compose? tuple keep 2curry equal? set-datastack 2slip tri 2drop most identity-tuple? null r> new set-callstack dip xor rot -roll identity-tuple -syn keyword factorKeyword assoc? assoc-clone-like delete-any assoc= delete-at* new-assoc subassoc? assoc-size map>assoc search-alist assoc-like key? assoc-intersect update assoc-union at* assoc-empty? at+ set-enum-seq set-at assoc-all? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at (assoc-stack) enum? at cache assoc>map assoc-contains? assoc assoc-map assoc-pusher (assoc>map) enum assoc-push-if remove-all >alist (substitute) substitute-here clear-assoc assoc-stack substitute assoc-filter delete-at assoc-find enum-seq keys -syn keyword factorKeyword case dispatch-case-quot with-datastack no-cond no-case? 3cleave>quot (distribute-buckets) contiguous-range? 2cleave cond>quot no-cond? cleave>quot no-case recursive-hashcode case>quot 3cleave alist>quot dispatch-case hash-case-table hash-case-quot case-find cond cleave distribute-buckets 2cleave>quot linear-case-quot spread spread>quot hash-dispatch-quot -syn keyword factorKeyword byte-array>bignum sgn >bignum number= each-integer next-power-of-2 ?1+ imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum (all-integers?) times denominator find-last-integer (each-integer) bit? * + power-of-2? - / >= bitand find-integer complex < real > log2 integer? number bits>double double>bits bitor 2/ zero? rem all-integers? (find-integer) real-part align bits>float float? shift float 1+ 1- fp-nan? ratio? bitxor even? ratio <= /mod >integer odd? rational? bitnot real? >fixnum complex? (next-power-of-2) /i numerator /f -syn keyword factorKeyword slice-to append left-trim find-last-from clone-like 3sequence map-as last-index-from reversed index-from pad-left cut* nth sequence slice? tail-slice empty? tail* find-from member? virtual-sequence? unclip set-length drop-prefix bounds-error? set-slice-seq map start open-slice midpoint@ set-immutable-seq move-forward rest-slice prepend fourth delete set-slice-to new-sequence follow all-eq? monotonic? set-reversed-seq like delete-nth first4 repetition-len (open-slice) reverse slice padding virtual@ repetition? index 4sequence max-length set-second first2 first3 (3append) supremum unclip-slice move-backward tail 3append sequence-hashcode-step right-trim reversed-seq pad-right suffix concat set-slice-from flip filter sum immutable? 2sequence delete-all start* immutable-sequence? (append) check-slice sequence? head set-slice-error-reason reduce set-bounds-error-index reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check immutable find remove ((append)) set-fourth peek contains? reversed? shorter? push-new find-last head-slice pop* immutable-seq tail-slice* accumulate each pusher all-equal? new-resizable cut-slice head-slice* 2reverse-each pop memq? set-nth ?nth second change-each join set-repetition-len all? virtual-sequence set-repetition-elt subseq? immutable-sequence slice-error-reason new-like length last-index push-if 2all? lengthen joined-length copy set-bounds-error-seq cache-nth move third first slice-from repetition-elt tail? set-first prefix bounds-error bounds-error-seq bounds-error-index unfold exchange slice-seq cut 2reduce change-nth min-length set-third (delete) push-all head? delete-slice rest sum-lengths 2each head* infimum sequence-hashcode slice-error subseq replace-slice repetition push trim mismatch -syn keyword factorKeyword global +@ set-namestack with-variable on set bind dec namestack get get-global change init-namespaces with-scope off set-global namespace % make , inc counter building make-assoc -syn keyword factorKeyword 3array >array 4array pair? array pair 2array 1array resize-array array? -syn keyword factorKeyword readln stream-read-until stream-read-partial stderr with-stream read with-stream* print contents make-span-stream write1 stream-write1 stream-format make-block-stream stream-copy with-cell stream-write format with-row stream-print stream-read with-nesting (stream-copy) bl write-object nl stream-nl write stdio flush read-until tabular-output make-cell-stream write-cell stream-flush read1 lines stream-read1 stream-write-table with-style stream-readln -syn keyword factorKeyword resize-string >string 1string string string? -syn keyword factorKeyword vector? ?push vector >vector 1vector -syn keyword factorKeyword rethrow-restarts restarts recover set-restart-name set-continuation-name condition-continuation ifcc continuation-name condition-error set-restart-continuation ignore-errors continuation-retain continue restart-continuation with-disposal set-continuation-catch set-condition-error restart-obj error thread-error-hook set-continuation-retain continuation rethrow callcc1 callcc0 condition continuation? continuation-call continuation-data set-condition-restarts set-catchstack >continuation< error-continuation cleanup restart? compute-restarts condition? error-thread set-continuation-call set-condition-continuation set-restart-obj dispose set-continuation-data throw-restarts catchstack continue-with attempt-all restart restart-name continuation-catch condition-restarts - - -syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal -syn cluster factorNumber contains=@factorReal,factorComplex -syn cluster factorNumErr contains=factorBinErr,factorHexErr,factorOctErr -syn match factorInt /\<-\=\d\+\>/ -syn match factorFloat /\<-\=\d*\.\d\+\>/ -syn match factorRatio /\<-\=\d*\.*\d\+\/-\=\d*\.*\d\+\>/ -syn region factorComplex start=/\/ end=/\<}\>/ contains=@factorReal -syn match factorBinErr /\/ -syn match factorBinary /\/ -syn match factorHexErr /\/ -syn match factorHex /\/ -syn match factorOctErr /\/ -syn match factorOctal /\/ - -syn match factorIn /\/ -syn match factorUse /\/ - -syn match factorCharErr /\/ - -syn match factorBackslash /\<\\\>\s\+\S\+\>/ - -syn region factorUsing start=/\/ end=/;/ -syn region factorRequires start=/\/ end=/;/ - -syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor -syn match factorSymbol /\/ -syn match factorPostpone /\/ -syn match factorDefer /\/ -syn match factorForget /\/ -syn match factorMixin /\/ -syn match factorInstance /\/ -syn match factorHook /\/ -syn match factorMain /\/ -syn match factorConstructor /\/ - -syn match factorAlien /\/ - -syn region factorTuple start=/\/ end=/\<;\>/ - -"TODO: -"misc: -" HELP: -" ARTICLE: -"literals: -" PRIMITIVE: - -"C interface: -" FIELD: -" BEGIN-STRUCT: -" C-ENUM: -" FUNCTION: -" END-STRUCT -" DLL" -" TYPEDEF: -" LIBRARY: -" C-UNION: - -syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline -syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline - -syn region factorMultiString matchgroup=factorMultiStringDelims start=/\/ end=/^;$/ contains=factorMultiStringContents -syn match factorMultiStringContents /.*/ contained - -"syn match factorStackEffectErr /\<)\>/ -"syn region factorStackEffectErr start=/\<(\>/ end=/\<)\>/ -syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained - -"adapted from lisp.vim -if exists("g:factor_norainbow") - syn region factorQuotation0 matchgroup=factorDelimiter start=/\<\'\?\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL -else - syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1 - syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2 - syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3 - syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4 - syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5 - syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6 - syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7 - syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8 - syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9 - syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0 -endif - -if exists("g:factor_norainbow") - syn region factorArray matchgroup=factorDelimiter start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL -else - syn region factorArray0 matchgroup=hlLevel0 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1 - syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2 - syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3 - syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4 - syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5 - syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6 - syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7 - syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8 - syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9 - syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0 -endif - -syn match factorBracketErr /\<\]\>/ -syn match factorBracketErr /\<}\>/ - -syn sync lines=100 - -if version >= 508 || !exists("did_factor_syn_inits") - if version <= 508 - let did_factor_syn_inits = 1 - command -nargs=+ HiLink hi link - else - command -nargs=+ HiLink hi def link - endif - - HiLink factorComment Comment - HiLink factorStackEffect Typedef - HiLink factorTodo Todo - HiLink factorInclude Include - HiLink factorRepeat Repeat - HiLink factorConditional Conditional - HiLink factorKeyword Keyword - HiLink factorOperator Operator - HiLink factorBoolean Boolean - HiLink factorDefnDelims Typedef - HiLink factorMethodDelims Typedef - HiLink factorGenericDelims Typedef - HiLink factorGenericNDelims Typedef - HiLink factorConstructor Typedef - HiLink factorPrivate Special - HiLink factorPrivateDefnDelims Special - HiLink factorPrivateMethodDelims Special - HiLink factorPGenericDelims Special - HiLink factorPGenericNDelims Special - HiLink factorString String - HiLink factorSbuf String - HiLink factorMultiStringContents String - HiLink factorMultiStringDelims Typedef - HiLink factorBracketErr Error - HiLink factorComplex Number - HiLink factorRatio Number - HiLink factorBinary Number - HiLink factorBinErr Error - HiLink factorHex Number - HiLink factorHexErr Error - HiLink factorOctal Number - HiLink factorOctErr Error - HiLink factorFloat Float - HiLink factorInt Number - HiLink factorUsing Include - HiLink factorUse Include - HiLink factorRequires Include - HiLink factorIn Define - HiLink factorChar Character - HiLink factorCharErr Error - HiLink factorDelimiter Delimiter - HiLink factorBackslash Special - HiLink factorCompileDirective Typedef - HiLink factorSymbol Define - HiLink factorMixin Typedef - HiLink factorInstance Typedef - HiLink factorHook Typedef - HiLink factorMain Define - HiLink factorPostpone Define - HiLink factorDefer Define - HiLink factorForget Define - HiLink factorAlien Define - HiLink factorTuple Typedef - - if &bg == "dark" - hi hlLevel0 ctermfg=red guifg=red1 - hi hlLevel1 ctermfg=yellow guifg=orange1 - hi hlLevel2 ctermfg=green guifg=yellow1 - hi hlLevel3 ctermfg=cyan guifg=greenyellow - hi hlLevel4 ctermfg=magenta guifg=green1 - hi hlLevel5 ctermfg=red guifg=springgreen1 - hi hlLevel6 ctermfg=yellow guifg=cyan1 - hi hlLevel7 ctermfg=green guifg=slateblue1 - hi hlLevel8 ctermfg=cyan guifg=magenta1 - hi hlLevel9 ctermfg=magenta guifg=purple1 - else - hi hlLevel0 ctermfg=red guifg=red3 - hi hlLevel1 ctermfg=darkyellow guifg=orangered3 - hi hlLevel2 ctermfg=darkgreen guifg=orange2 - hi hlLevel3 ctermfg=blue guifg=yellow3 - hi hlLevel4 ctermfg=darkmagenta guifg=olivedrab4 - hi hlLevel5 ctermfg=red guifg=green4 - hi hlLevel6 ctermfg=darkyellow guifg=paleturquoise3 - hi hlLevel7 ctermfg=darkgreen guifg=deepskyblue4 - hi hlLevel8 ctermfg=blue guifg=darkslateblue - hi hlLevel9 ctermfg=darkmagenta guifg=darkviolet - endif - - delcommand HiLink -endif - -let b:current_syntax = "factor" - -set sw=4 -set ts=4 -set expandtab -set autoindent " annoying? - -" vim: syntax=vim - diff --git a/misc/fuel/README b/misc/fuel/README index 4dfb16da51..cf96e29f52 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -5,78 +5,182 @@ FUEL provides a complete environment for your Factor coding pleasure inside Emacs, including source code edition and interaction with a Factor listener instance running within Emacs. -FUEL was started by Jose A Ortega as an extension to Ed Cavazos' -original factor.el code. +FUEL was started by Jose A Ortega as an extension to Eduardo Cavazos' +original factor.el code. Eduardo is also responsible of naming the +beast. -Installation ------------- +* Installation -FUEL comes bundled with Factor's distribution. The folder misc/fuel -contains Elisp code, and there's a fuel vocabulary in extras/fuel. + FUEL comes bundled with Factor's distribution. The folder misc/fuel + contains Elisp code, and there's a fuel vocabulary in extras/fuel. -To install FUEL, either add this line to your Emacs initialisation: + To install FUEL, either add this line to your Emacs initialisation: (load-file "/misc/fuel/fu.el") -or + If all you want is a major mode for editing Factor code with pretty + font colors and indentation, without running the factor listener + inside Emacs, you can use instead: - (add-to-list load-path "/fuel") - (require 'fuel) - -If all you want is a major mode for editing Factor code with pretty -font colors and indentation, without running the factor listener -inside Emacs, you can use instead: - - (add-to-list load-path "/fuel") + (add-to-list 'load-path "/fuel") (setq factor-mode-use-fuel nil) (require 'factor-mode) -Basic usage ------------ - -If you're using the default factor binary and images locations inside -the Factor's source tree, that should be enough to start using FUEL. -Editing any file with the extension .factor will put you in -factor-mode; try C-hm for a summary of available commands. - -To start the listener, try M-x run-factor. - -Many aspects of the environment can be customized: -M-x customize-group fuel will show you how many. - -Quick key reference -------------------- - -(Chords ending in a single letter accept also C- (e.g. C-cC-z is -the same as C-cz)). - -* In factor source files: - - - C-cz : switch to listener - - C-co : cycle between code, tests and docs factor files - - - M-. : edit word at point in Emacs (also in listener) - - - C-cr, C-cC-er : eval region - - C-M-r, C-cC-ee : eval region, extending it to definition boundaries - - C-M-x, C-cC-ex : eval definition around point - - C-ck, C-cC-ek : compile file - - - C-cC-da : toggle autodoc mode - - C-cC-dd : help for word at point - - C-cC-ds : short help word at point - -* In the debugger (it pops up upon eval/compilation errors): - - - g : go to error - - : invoke nth restart - - w/e/l : invoke :warnings, :errors, :linkage - - q : bury buffer - -* In the Help browser: - - - RET : help for word at point - - f/b : next/previous page - - SPC/S-SPC : scroll up/down - - q: bury buffer - +* Basic usage +*** Running the listener + + If you're using the default factor binary and images locations inside + the Factor's source tree, that should be enough to start using FUEL. + Editing any file with the extension .factor will put you in + factor-mode; try C-hm for a summary of available commands. + + To start the listener, try M-x run-factor. + + By default, FUEL will try to use the binary and image files in the + factor installation directory. You can customize them with: + + (setq fuel-listener-factor-binary ) + (setq fuel-listener-factor-image ) + + Many aspects of the environment can be customized: + M-x customize-group fuel will show you how many. + +*** Faster listener startup + + On startup, run-factor loads the fuel vocabulary, which can take a + while. If you want to speedup the load process, type 'save' in the + listener prompt just after invoking run-factor. This will save a + factor image (overwriting the current one) with all the needed + vocabs. + +*** Connecting to a running Factor + + 'run-factor' starts a new factor listener process managed by Emacs. + If you prefer to start Factor externally, you can also connect + remotely from Emacs. Here's how to proceed: + + - In the factor listener, run FUEL: "fuel" run + This will start a server listener in port 9000. + - Switch to Emacs and issue the command 'M-x connect-to-factor'. + + That's it; you should be up and running. See the help for + 'connect-to-factor' for how to use a different port. + +*** Vocabulary creation + + FUEL offers a basic interface to Factor's scaffolding utilities. + To create a new vocabulary directory and associated files: + + M-x fuel-scaffold-vocab + + and when in a vocab file, to create a docs file with boilerplate + for each word: + + M-x fuel-scaffold-help + +* Quick key reference + + Triple chords ending in a single letter accept also C- (e.g. + C-cC-eC-r is the same as C-cC-er). + +*** In factor source files: + + Commands in parenthesis can be invoked interactively with + M-x , not necessarily in a factor buffer. + + |-----------------+------------------------------------------------------------| + | C-cz | switch to listener (run-factor) | + | C-co | cycle between code, tests and docs files | + | C-cr | switch to listener and refresh all loaded vocabs | + | C-cs | switch to other factor buffer (fuel-switch-to-buffer) | + | C-x4s | switch to other factor buffer in other window | + | C-x5s | switch to other factor buffer in other frame | + |-----------------+------------------------------------------------------------| + | M-. | edit word at point in Emacs (fuel-edit-word) | + | M-, | go back to where M-. was last invoked | + | M-TAB | complete word at point | + | C-cC-eu | update USING: line (fuel-update-usings) | + | C-cC-ev | edit vocabulary (fuel-edit-vocabulary) | + | C-cC-ew | edit word (fuel-edit-word-at-point) | + | C-cC-ed | edit word's doc (C-u M-x fuel-edit-word-doc-at-point) | + |-----------------+------------------------------------------------------------| + | C-cC-er | eval region | + | C-M-r, C-cC-ee | eval region, extending it to definition boundaries | + | C-M-x, C-cC-ex | eval definition around point | + | C-ck, C-cC-ek | run file (fuel-run-file) | + |-----------------+------------------------------------------------------------| + | C-cC-da | toggle autodoc mode (fuel-autodoc-mode) | + | C-cC-dd | help for word at point (fuel-help) | + | C-cC-ds | short help word at point (fuel-help-short) | + | C-cC-de | show stack effect of current sexp (with prefix, region) | + | C-cC-dp | find words containing given substring (fuel-apropos) | + | C-cC-dv | show words in current file (with prefix, ask for vocab) | + |-----------------+------------------------------------------------------------| + | C-cM-<, C-cC-d< | show callers of word or vocabulary at point | + | | (fuel-show-callers, fuel-vocab-usage) | + | C-cM->, C-cC-d> | show callees of word or vocabulary at point | + | | (fuel-show-callees, fuel-vocab-uses) | + |-----------------+------------------------------------------------------------| + | C-cC-xs | extract innermost sexp (up to point) as a separate word | + | | (fuel-refactor-extract-sexp) | + | C-cC-xr | extract region as a separate word | + | | (fuel-refactor-extract-region) | + | C-cC-xv | extract region as a separate vocabulary | + | | (fuel-refactor-extract-vocab) | + | C-cC-xi | replace word by its definition (fuel-refactor-inline-word) | + | C-cC-xw | rename all uses of a word (fuel-refactor-rename-word) | + |-----------------+------------------------------------------------------------| + +*** In the listener: + + |------+----------------------------------------------------------| + | TAB | complete word at point | + | M-. | edit word at point in Emacs | + | C-cr | refresh all loaded vocabs | + | C-ca | toggle autodoc mode | + | C-cp | find words containing given substring (M-x fuel-apropos) | + | C-cs | toggle stack mode | + | C-cv | edit vocabulary | + | C-ch | help for word at point | + | C-ck | run file | + |------+----------------------------------------------------------| + +*** In the debugger (it pops up upon eval/compilation errors): + + |---------+-------------------------------------| + | g | go to error | + | | invoke nth restart | + | w/e/l | invoke :warnings, :errors, :linkage | + | q | bury buffer | + |---------+-------------------------------------| + +*** In the help browser: + + |-----------+----------------------------------------------------------| + | h | help for word at point | + | v | help for a vocabulary | + | a | find words containing given substring (M-x fuel-apropos) | + | e | edit current article | + | ba | bookmark current page | + | bb | display bookmarks | + | bd | delete bookmark at point | + | n/p | next/previous page | + | l | previous page | + | SPC/S-SPC | scroll up/down | + | TAB/S-TAB | next/previous link | + | k | kill current page and go to previous or next | + | r | refresh page | + | c | clean browsing history | + | M-. | edit word at point in Emacs | + | C-cz | switch to listener | + | q | bury buffer | + |-----------+----------------------------------------------------------| + +*** In crossref buffers + + |-----------------+-----------------------------| + | TAB/BACKTAB | navigate links | + | RET/mouse click | follow link | + | h | show help for word at point | + | q | bury buffer | + |-----------------+-----------------------------| diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index b3952074f5..ba9be2edd3 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -1,6 +1,6 @@ ;;; factor-mode.el -- mode for editing Factor source -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -24,8 +24,17 @@ ;;; Customization: (defgroup factor-mode nil - "Major mode for Factor source code" - :group 'fuel) + "Major mode for Factor source code." + :group 'fuel + :group 'languages) + +(defcustom factor-mode-cycle-always-ask-p t + "Whether to always ask for file creation when cycling to a +source/docs/tests file. + +When set to false, you'll be asked only once." + :type 'boolean + :group 'factor-mode) (defcustom factor-mode-use-fuel t "Whether to use the full FUEL facilities in factor mode. @@ -59,23 +68,6 @@ code in the buffer." :type 'hook :group 'factor-mode) - -;;; Faces: - -(fuel-font-lock--define-faces - factor-font-lock font-lock factor-mode - ((comment comment "comments") - (constructor type "constructors ()") - (declaration keyword "declaration words") - (parsing-word keyword "parsing words") - (setter-word function-name "setter words (>>foo)") - (stack-effect comment "stack effect specifications") - (string string "strings") - (symbol variable-name "name of symbol being defined") - (type-name type "type names") - (vocabulary-name constant "vocabulary names") - (word function-name "word, generic or method being defined"))) - ;;; Syntax table: @@ -84,8 +76,7 @@ code in the buffer." (set (make-local-variable 'beginning-of-defun-function) 'fuel-syntax--beginning-of-defun) (set (make-local-variable 'end-of-defun-function) 'fuel-syntax--end-of-defun) - (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) - (fuel-syntax--enable-usings)) + (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)) ;;; Indentation: @@ -112,13 +103,19 @@ code in the buffer." (save-excursion (beginning-of-line) (when (> (fuel-syntax--brackets-depth) 0) - (let ((op (fuel-syntax--brackets-start)) - (cl (fuel-syntax--brackets-end)) - (ln (line-number-at-pos))) - (when (> ln (line-number-at-pos op)) - (if (and (> cl 0) (= ln (line-number-at-pos cl))) - (fuel-syntax--indentation-at op) - (fuel-syntax--increased-indentation (fuel-syntax--indentation-at op)))))))) + (let* ((bs (fuel-syntax--brackets-start)) + (be (fuel-syntax--brackets-end)) + (ln (line-number-at-pos))) + (when (> ln (line-number-at-pos bs)) + (cond ((and (> be 0) + (= (- be (point)) (current-indentation)) + (= ln (line-number-at-pos be))) + (fuel-syntax--indentation-at bs)) + ((or (fuel-syntax--is-last-char bs) + (not (eq ?\ (char-after (1+ bs))))) + (fuel-syntax--increased-indentation + (fuel-syntax--indentation-at bs))) + (t (+ 2 (fuel-syntax--line-offset bs))))))))) (defun factor-mode--indent-definition () (save-excursion @@ -147,8 +144,7 @@ code in the buffer." (cond ((or (fuel-syntax--at-end-of-def) (fuel-syntax--at-setter-line)) (fuel-syntax--decreased-indentation)) - ((and (fuel-syntax--at-begin-of-def) - (not (fuel-syntax--at-using))) + ((fuel-syntax--at-begin-of-indent-def) (fuel-syntax--increased-indentation)) (t (current-indentation))))) @@ -185,46 +181,73 @@ code in the buffer." (defconst factor-mode--cycle-endings '(".factor" "-tests.factor" "-docs.factor")) -(defconst factor-mode--regex-cycle-endings - (format "\\(.*?\\)\\(%s\\)$" - (regexp-opt factor-mode--cycle-endings))) +(make-local-variable + (defvar factor-mode--cycling-no-ask nil)) -(defconst factor-mode--cycle-endings-ring +(defvar factor-mode--cycle-ring (let ((ring (make-ring (length factor-mode--cycle-endings)))) (dolist (e factor-mode--cycle-endings ring) - (ring-insert ring e)))) + (ring-insert ring e)) + ring)) + +(defconst factor-mode--cycle-basename-regex + (format "\\(.+?\\)\\(%s\\)$" (regexp-opt factor-mode--cycle-endings))) + +(defun factor-mode--cycle-split (basename) + (when (string-match factor-mode--cycle-basename-regex basename) + (cons (match-string 1 basename) (match-string 2 basename)))) (defun factor-mode--cycle-next (file) - (let* ((match (string-match factor-mode--regex-cycle-endings file)) - (base (and match (match-string-no-properties 1 file))) - (ending (and match (match-string-no-properties 2 file))) - (idx (and ending (ring-member factor-mode--cycle-endings-ring ending))) - (gfl (lambda (i) (concat base (ring-ref factor-mode--cycle-endings-ring i))))) - (if (not idx) file - (let ((l (length factor-mode--cycle-endings)) (i 1) next) - (while (and (not next) (< i l)) - (when (file-exists-p (funcall gfl (+ idx i))) - (setq next (+ idx i))) - (setq i (1+ i))) - (funcall gfl (or next idx)))))) + (let* ((dir (file-name-directory file)) + (basename (file-name-nondirectory file)) + (p/s (factor-mode--cycle-split basename)) + (prefix (car p/s)) + (ring factor-mode--cycle-ring) + (idx (or (ring-member ring (cdr p/s)) 0)) + (len (ring-size ring)) + (i 1) + (result nil)) + (while (and (< i len) (not result)) + (let* ((suffix (ring-ref ring (+ i idx))) + (path (expand-file-name (concat prefix suffix) dir))) + (when (or (file-exists-p path) + (and (not (member suffix factor-mode--cycling-no-ask)) + (y-or-n-p (format "Create %s? " path)))) + (setq result path)) + (when (and (not factor-mode-cycle-always-ask-p) + (not (member suffix factor-mode--cycling-no-ask))) + (setq factor-mode--cycling-no-ask + (cons name factor-mode--cycling-no-ask)))) + (setq i (1+ i))) + result)) + +(defsubst factor-mode--cycling-setup () + (setq factor-mode--cycling-no-ask nil)) (defun factor-mode-visit-other-file (&optional file) "Cycle between code, tests and docs factor files." (interactive) - (find-file (factor-mode--cycle-next (or file (buffer-file-name))))) + (let ((file (factor-mode--cycle-next (or file (buffer-file-name))))) + (unless file (error "No other file found")) + (find-file file) + (unless (file-exists-p file) + (set-buffer-modified-p t) + (save-buffer)))) ;;; Keymap: -(defun factor-mode-insert-and-indent (n) - (interactive "p") - (self-insert-command n) - (indent-for-tab-command)) +(defun factor-mode--insert-and-indent (n) + (interactive "*p") + (let ((start (point))) + (self-insert-command n) + (save-excursion (font-lock-fontify-region start (point)))) + (indent-according-to-mode)) (defvar factor-mode-map (let ((map (make-sparse-keymap))) - (define-key map [?\]] 'factor-mode-insert-and-indent) - (define-key map [?}] 'factor-mode-insert-and-indent) + (define-key map [?\]] 'factor-mode--insert-and-indent) + (define-key map [?}] 'factor-mode--insert-and-indent) (define-key map "\C-m" 'newline-and-indent) (define-key map "\C-co" 'factor-mode-visit-other-file) (define-key map "\C-c\C-o" 'factor-mode-visit-other-file) @@ -248,6 +271,7 @@ code in the buffer." (factor-mode--keymap-setup) (factor-mode--indentation-setup) (factor-mode--syntax-setup) + (factor-mode--cycling-setup) (when factor-mode-use-fuel (require 'fuel-mode) (fuel-mode)) (run-hooks 'factor-mode-hook)) diff --git a/misc/fuel/fu.el b/misc/fuel/fu.el index 508d7ef3a4..e9217fbd03 100644 --- a/misc/fuel/fu.el +++ b/misc/fuel/fu.el @@ -1,6 +1,6 @@ ;;; fu.el --- Startup file for FUEL -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -8,7 +8,11 @@ ;;; Code: -(add-to-list 'load-path (file-name-directory load-file-name)) +(setq fuel-factor-fuel-dir (file-name-directory load-file-name)) + +(setq fuel-factor-root-dir (expand-file-name "../../" fuel-factor-fuel-dir)) + +(add-to-list 'load-path fuel-factor-fuel-dir) (add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode)) (autoload 'factor-mode "factor-mode.el" @@ -17,10 +21,21 @@ (autoload 'run-factor "fuel-listener.el" "Start a Factor listener, or switch to a running one." t) +(autoload 'switch-to-factor "fuel-listener.el" + "Start a Factor listener, or switch to a running one." t) + +(autoload 'connect-to-factor "fuel-listener.el" + "Connect to an external Factor listener." t) + (autoload 'fuel-autodoc-mode "fuel-help.el" "Minor mode showing in the minibuffer a synopsis of Factor word at point." t) +(autoload 'fuel-scaffold-vocab "fuel-scaffold.el" + "Create a new Factor vocabulary." t) + +(autoload 'fuel-scaffold-help "fuel-scaffold.el" + "Create a Factor vocabulary help file." t) ;;; fu.el ends here diff --git a/misc/fuel/fuel-autodoc.el b/misc/fuel/fuel-autodoc.el new file mode 100644 index 0000000000..76919702bb --- /dev/null +++ b/misc/fuel/fuel-autodoc.el @@ -0,0 +1,92 @@ +;;; fuel-autodoc.el -- doc snippets in the echo area + +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Sat Dec 20, 2008 00:50 + +;;; Comentary: + +;; Utilities for displaying information automatically in the echo +;; area. + +;;; Code: + +(require 'fuel-eval) +(require 'fuel-font-lock) +(require 'fuel-syntax) +(require 'fuel-base) + + +;;; Customization: + +(defgroup fuel-autodoc nil + "Options controlling FUEL's autodoc system." + :group 'fuel) + +(defcustom fuel-autodoc-minibuffer-font-lock t + "Whether to use font lock for info messages in the minibuffer." + :group 'fuel-autodoc + :type 'boolean) + + + +;;; Eldoc function: + +(defvar fuel-autodoc--timeout 200) + +(defun fuel-autodoc--word-synopsis (&optional word) + (let ((word (or word (fuel-syntax-symbol-at-point))) + (fuel-log--inhibit-p t)) + (when word + (let* ((cmd (if (fuel-syntax--in-using) + `(:fuel* (,word fuel-vocab-summary) :in t) + `(:fuel* (((:quote ,word) synopsis :get)) :in))) + (ret (fuel-eval--send/wait cmd fuel-autodoc--timeout)) + (res (fuel-eval--retort-result ret))) + (when (and ret (not (fuel-eval--retort-error ret)) (stringp res)) + (if fuel-autodoc-minibuffer-font-lock + (fuel-font-lock--factor-str res) + res)))))) + +(make-variable-buffer-local + (defvar fuel-autodoc--fallback-function nil)) + +(defun fuel-autodoc--eldoc-function () + (or (and fuel-autodoc--fallback-function + (funcall fuel-autodoc--fallback-function)) + (condition-case e + (fuel-autodoc--word-synopsis) + (error (format "Autodoc not available (%s)" + (error-message-string e)))))) + + +;;; Autodoc mode: + +(make-variable-buffer-local + (defvar fuel-autodoc-mode-string " A" + "Modeline indicator for fuel-autodoc-mode")) + +(define-minor-mode fuel-autodoc-mode + "Toggle Fuel's Autodoc mode. +With no argument, this command toggles the mode. +Non-null prefix argument turns on the mode. +Null prefix argument turns off the mode. + +When Autodoc mode is enabled, a synopsis of the word at point is +displayed in the minibuffer." + :init-value nil + :lighter fuel-autodoc-mode-string + :group 'fuel-autodoc + + (set (make-local-variable 'eldoc-documentation-function) + (when fuel-autodoc-mode 'fuel-autodoc--eldoc-function)) + (set (make-local-variable 'eldoc-minor-mode-string) nil) + (eldoc-mode fuel-autodoc-mode) + (message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled"))) + + +(provide 'fuel-autodoc) +;;; fuel-autodoc.el ends here diff --git a/misc/fuel/fuel-base.el b/misc/fuel/fuel-base.el index 9ea1790380..5e8364e3a7 100644 --- a/misc/fuel/fuel-base.el +++ b/misc/fuel/fuel-base.el @@ -1,6 +1,6 @@ ;;; fuel-base.el --- Basic FUEL support code -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -25,8 +25,8 @@ ;;;###autoload (defgroup fuel nil - "Factor's Ultimate Emacs Library" - :group 'language) + "Factor's Ultimate Emacs Library." + :group 'languages) ;;; Emacs compatibility: @@ -39,6 +39,20 @@ (when (equal item (ring-ref ring ind)) (throw 'found ind))))))) +(when (not (fboundp 'completion-table-dynamic)) + (defun completion-table-dynamic (fun) + (lexical-let ((fun fun)) + (lambda (string pred action) + (with-current-buffer (let ((win (minibuffer-selected-window))) + (if (window-live-p win) (window-buffer win) + (current-buffer))) + (complete-with-action action (funcall fun string) string pred)))))) + +(when (not (fboundp 'looking-at-p)) + (defsubst looking-at-p (regexp) + (let ((inhibit-changing-match-data t)) + (looking-at regexp)))) + ;;; Utilities @@ -59,7 +73,29 @@ " ") len)) +(defsubst fuel--region-to-string (begin &optional end) + (let ((end (or end (point)))) + (if (< begin end) + (mapconcat 'identity + (split-string (buffer-substring-no-properties begin end) + nil + t) + " ") + ""))) + (defsubst empty-string-p (str) (equal str "")) +(defun fuel--string-prefix-p (prefix str) + (and (>= (length str) (length prefix)) + (string= (substring-no-properties str 0 (length prefix)) + (substring-no-properties prefix)))) + +(defun fuel--respecting-message (format &rest format-args) + "Display TEXT as a message, without hiding any minibuffer contents." + (let ((text (format " [%s]" (apply #'format format format-args)))) + (if (minibuffer-window-active-p (minibuffer-window)) + (minibuffer-message text) + (message "%s" text)))) + (provide 'fuel-base) ;;; fuel-base.el ends here diff --git a/misc/fuel/fuel-completion.el b/misc/fuel/fuel-completion.el new file mode 100644 index 0000000000..e6ec8b2dc9 --- /dev/null +++ b/misc/fuel/fuel-completion.el @@ -0,0 +1,203 @@ +;;; fuel-completion.el -- completion utilities + +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Sun Dec 14, 2008 21:17 + +;;; Comentary: + +;; Code completion utilities. + +;;; Code: + +(require 'fuel-base) +(require 'fuel-syntax) +(require 'fuel-eval) +(require 'fuel-log) + + +;;; Vocabs dictionary: + +(defvar fuel-completion--vocabs nil) + +(defun fuel-completion--vocabs (&optional reload) + (when (or reload (not fuel-completion--vocabs)) + (fuel--respecting-message "Retrieving vocabs list") + (let ((fuel-log--inhibit-p t)) + (setq fuel-completion--vocabs + (fuel-eval--retort-result + (fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array))))))) + fuel-completion--vocabs) + +(defun fuel-completion--read-vocab (&optional reload init-input history) + (let ((vocabs (fuel-completion--vocabs reload))) + (completing-read "Vocab name: " vocabs nil nil init-input history))) + +(defsubst fuel-completion--vocab-list (prefix) + (fuel-eval--retort-result + (fuel-eval--send/wait `(:fuel* (,prefix fuel-get-vocabs/prefix) t t)))) + +(defun fuel-completion--words (prefix vocabs) + (let ((vs (if vocabs (cons :array vocabs) 'f)) + (us (or vocabs 't))) + (fuel-eval--retort-result + (fuel-eval--send/wait `(:fuel* (,prefix ,vs fuel-get-words) t ,us))))) + + +;;; Completions window handling, heavily inspired in slime's: + +(defvar fuel-completion--comp-buffer "*Completions*") + +(make-variable-buffer-local + (defvar fuel-completion--window-cfg nil + "Window configuration before we show the *Completions* buffer. +This is buffer local in the buffer where the completion is +performed.")) + +(make-variable-buffer-local + (defvar fuel-completion--completions-window nil + "The window displaying *Completions* after saving window configuration. +If this window is no longer active or displaying the completions +buffer then we can ignore `fuel-completion--window-cfg'.")) + +(defun fuel-completion--save-window-cfg () + "Maybe save the current window configuration. +Return true if the configuration was saved." + (unless (or fuel-completion--window-cfg + (get-buffer-window fuel-completion--comp-buffer)) + (setq fuel-completion--window-cfg + (current-window-configuration)) + t)) + +(defun fuel-completion--delay-restoration () + (add-hook 'pre-command-hook + 'fuel-completion--maybe-restore-window-cfg + nil t)) + +(defun fuel-completion--forget-window-cfg () + (setq fuel-completion--window-cfg nil) + (setq fuel-completion--completions-window nil)) + +(defun fuel-completion--restore-window-cfg () + "Restore the window config if available." + (remove-hook 'pre-command-hook + 'fuel-completion--maybe-restore-window-cfg) + (when (and fuel-completion--window-cfg + (fuel-completion--window-active-p)) + (save-excursion + (set-window-configuration fuel-completion--window-cfg)) + (setq fuel-completion--window-cfg nil) + (when (buffer-live-p fuel-completion--comp-buffer) + (kill-buffer fuel-completion--comp-buffer)))) + +(defun fuel-completion--maybe-restore-window-cfg () + "Restore the window configuration, if the following command +terminates a current completion." + (remove-hook 'pre-command-hook + 'fuel-completion--maybe-restore-window-cfg) + (condition-case err + (cond ((find last-command-char "()\"'`,# \r\n:") + (fuel-completion--restore-window-cfg)) + ((not (fuel-completion--window-active-p)) + (fuel-completion--forget-window-cfg)) + (t (fuel-completion--delay-restoration))) + (error + ;; Because this is called on the pre-command-hook, we mustn't let + ;; errors propagate. + (message "Error in fuel-completion--restore-window-cfg: %S" err)))) + +(defun fuel-completion--window-active-p () + "Is the completion window currently active?" + (and (window-live-p fuel-completion--completions-window) + (equal (buffer-name (window-buffer fuel-completion--completions-window)) + fuel-completion--comp-buffer))) + +(defun fuel-completion--display-comp-list (completions base) + (let ((savedp (fuel-completion--save-window-cfg))) + (with-output-to-temp-buffer fuel-completion--comp-buffer + (display-completion-list completions base) + (let ((offset (- (point) 1 (length base)))) + (with-current-buffer standard-output + (setq completion-base-size offset) + (set-syntax-table fuel-syntax--syntax-table)))) + (when savedp + (setq fuel-completion--completions-window + (get-buffer-window fuel-completion--comp-buffer))))) + +(defun fuel-completion--display-or-scroll (completions base) + (cond ((and (eq last-command this-command) (fuel-completion--window-active-p)) + (fuel-completion--scroll-completions)) + (t (fuel-completion--display-comp-list completions base))) + (fuel-completion--delay-restoration)) + +(defun fuel-completion--scroll-completions () + (let ((window fuel-completion--completions-window)) + (with-current-buffer (window-buffer window) + (if (pos-visible-in-window-p (point-max) window) + (set-window-start window (point-min)) + (save-selected-window + (select-window window) + (scroll-up)))))) + + +;;; Completion functionality: + +(defun fuel-completion--word-list (prefix) + (let* ((fuel-log--inhibit-p t) + (cv (fuel-syntax--current-vocab)) + (vs (and cv `("syntax" ,cv ,@(fuel-syntax--usings))))) + (fuel-completion--words prefix vs))) + +(defsubst fuel-completion--all-words-list (prefix) + (fuel-completion--words prefix nil)) + +(defvar fuel-completion--word-list-func + (completion-table-dynamic 'fuel-completion--word-list)) + +(defvar fuel-completion--all-words-list-func + (completion-table-dynamic 'fuel-completion--all-words-list)) + +(defun fuel-completion--complete (prefix vocabs) + (let* ((words (if vocabs + (fuel-completion--vocabs) + (fuel-completion--word-list prefix))) + (completions (all-completions prefix words)) + (partial (try-completion prefix words)) + (partial (if (eq partial t) prefix partial))) + (cons completions partial))) + +(defun fuel-completion--read-word (prompt &optional default history all) + (completing-read prompt + (if all fuel-completion--all-words-list-func + fuel-completion--word-list-func) + nil nil nil + history + (or default (fuel-syntax-symbol-at-point)))) + +(defun fuel-completion--complete-symbol () + "Complete the symbol at point. +Perform completion similar to Emacs' complete-symbol." + (interactive) + (let* ((end (point)) + (beg (fuel-syntax--beginning-of-symbol-pos)) + (prefix (buffer-substring-no-properties beg end)) + (result (fuel-completion--complete prefix (fuel-syntax--in-using))) + (completions (car result)) + (partial (cdr result))) + (cond ((null completions) + (fuel--respecting-message "Can't find completion for %S" prefix) + (fuel-completion--restore-window-cfg)) + (t (insert-and-inherit (substring partial (length prefix))) + (cond ((= (length completions) 1) + (fuel--respecting-message "Sole completion") + (fuel-completion--restore-window-cfg)) + (t (fuel--respecting-message "Complete but not unique") + (fuel-completion--display-or-scroll completions + partial))))))) + + +(provide 'fuel-completion) +;;; fuel-completion.el ends here diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index 191424589c..14c4d0b36f 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -1,6 +1,6 @@ ;;; fuel-connection.el -- asynchronous comms with the fuel listener -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -14,6 +14,12 @@ ;;; Code: +(require 'fuel-log) +(require 'fuel-base) + +(require 'comint) +(require 'advice) + ;;; Default connection: @@ -23,10 +29,7 @@ (defun fuel-con--get-connection (buffer/proc) (if (processp buffer/proc) (fuel-con--get-connection (process-buffer buffer/proc)) - (with-current-buffer buffer/proc - (or fuel-con--connection - (setq fuel-con--connection - (fuel-con--setup-connection buffer/proc)))))) + (with-current-buffer buffer/proc fuel-con--connection))) ;;; Request and connection datatypes: @@ -65,10 +68,11 @@ (defsubst fuel-con--make-connection (buffer) (list :fuel-connection - (list :requests) - (list :current) + (cons :requests (list)) + (cons :current nil) (cons :completed (make-hash-table :weakness 'value)) - (cons :buffer buffer))) + (cons :buffer buffer) + (cons :timer nil))) (defsubst fuel-con--connection-p (c) (and (listp c) (eq (car c) :fuel-connection))) @@ -96,67 +100,144 @@ (let ((reqs (assoc :requests c)) (current (assoc :current c))) (setcdr current (prog1 (cadr reqs) (setcdr reqs (cddr reqs)))) - (if (and current (fuel-con--request-deactivated-p current)) + (if (and (cdr current) + (fuel-con--request-deactivated-p (cdr current))) (fuel-con--connection-pop-request c) - current))) + (cdr current)))) + +(defun fuel-con--connection-start-timer (c) + (let ((cell (assoc :timer c))) + (when (cdr cell) (cancel-timer (cdr cell))) + (setcdr cell (run-at-time t 0.5 'fuel-con--process-next c)))) + +(defun fuel-con--connection-cancel-timer (c) + (let ((cell (assoc :timer c))) + (when (cdr cell) (cancel-timer (cdr cell))))) ;;; Connection setup: +(defun fuel-con--cleanup-connection (c) + (fuel-con--connection-cancel-timer c)) + (defun fuel-con--setup-connection (buffer) (set-buffer buffer) + (fuel-con--cleanup-connection fuel-con--connection) + (setq fuel-con--connection nil) (let ((conn (fuel-con--make-connection buffer))) (fuel-con--setup-comint) - (setq fuel-con--connection conn))) + (fuel-con--establish-connection conn buffer))) + +(defconst fuel-con--prompt-regex "( .+ ) ") +(defconst fuel-con--eot-marker "<~FUEL~>") +(defconst fuel-con--init-stanza "USE: fuel fuel-retort") + +(defconst fuel-con--comint-finished-regex-connected + (format "^%s$" fuel-con--eot-marker)) + +(defvar fuel-con--comint-finished-regex fuel-con--prompt-regex) (defun fuel-con--setup-comint () + (set (make-local-variable 'comint-redirect-insert-matching-regexp) t) (add-hook 'comint-redirect-filter-functions - 'fuel-con--comint-redirect-filter t t)) + 'fuel-con--comint-preoutput-filter nil t) + (add-hook 'comint-redirect-hook + 'fuel-con--comint-redirect-hook nil t)) + +(defadvice comint-redirect-setup (after fuel-con--advice activate) + (setq comint-redirect-finished-regexp fuel-con--comint-finished-regex)) + +(defun fuel-con--comint-preoutput-filter (str) + (when (string-match fuel-con--comint-finished-regex str) + (setq comint-redirect-finished-regexp fuel-con--prompt-regex)) + str) + +(defun fuel-con--establish-connection (conn buffer) + (with-current-buffer (fuel-con--comint-buffer) (erase-buffer)) + (with-current-buffer buffer + (setq fuel-con--connection conn) + (setq fuel-con--comint-finished-regex fuel-con--prompt-regex) + (fuel-con--send-string/wait buffer + fuel-con--init-stanza + 'fuel-con--establish-connection-cont + 60000) + conn)) + +(defun fuel-con--establish-connection-cont (ignore) + (let ((str (with-current-buffer (fuel-con--comint-buffer) (buffer-string)))) + (if (string-match fuel-con--eot-marker str) + (progn + (setq fuel-con--comint-finished-regex + fuel-con--comint-finished-regex-connected) + (fuel-con--connection-start-timer conn) + (message "FUEL listener up and running!")) + (fuel-con--connection-clean-current-request fuel-con--connection) + (setq fuel-con--connection nil) + (message "An error occurred initialising FUEL's Factor library!") + (pop-to-buffer (fuel-con--comint-buffer))))) ;;; Requests handling: +(defsubst fuel-con--comint-buffer () + (get-buffer-create " *fuel connection retort*")) + +(defun fuel-con--comint-buffer-form () + (with-current-buffer (fuel-con--comint-buffer) + (goto-char (point-min)) + (condition-case nil + (let ((form (read (current-buffer)))) + (if (listp form) form + (list 'fuel-con-error (buffer-string)))) + (error (list 'fuel-con-error (buffer-string)))))) + (defun fuel-con--process-next (con) (when (not (fuel-con--connection-current-request con)) (let* ((buffer (fuel-con--connection-buffer con)) (req (fuel-con--connection-pop-request con)) - (str (and req (fuel-con--request-string req)))) - (when (and buffer req str) - (set-buffer buffer) - (comint-redirect-send-command str - (get-buffer-create "*factor messages*") - nil - t))))) - -(defun fuel-con--comint-redirect-filter (str) + (str (and req (fuel-con--request-string req))) + (cbuf (with-current-buffer (fuel-con--comint-buffer) + (erase-buffer) + (current-buffer)))) + (if (not (buffer-live-p buffer)) + (fuel-con--connection-cancel-timer con) + (when (and buffer req str) + (set-buffer buffer) + (fuel-log--info "<%s>: %s" (fuel-con--request-id req) str) + (comint-redirect-send-command (format "%s" str) cbuf nil t)))))) + +(defun fuel-con--process-completed-request (req) + (let ((cont (fuel-con--request-continuation req)) + (id (fuel-con--request-id req)) + (rstr (fuel-con--request-string req)) + (buffer (fuel-con--request-buffer req))) + (if (not cont) + (fuel-log--warn "<%s> Droping result for request %S (%s)" + id rstr req) + (condition-case cerr + (with-current-buffer (or buffer (current-buffer)) + (funcall cont (fuel-con--comint-buffer-form)) + (fuel-log--info "<%s>: processed" id)) + (error (fuel-log--error + "<%s>: continuation failed %S \n\t%s" id rstr cerr)))))) + +(defun fuel-con--comint-redirect-hook () (if (not fuel-con--connection) - (format "\nERROR: No connection in buffer (%s)\n" str) + (fuel-log--error "No connection in buffer") (let ((req (fuel-con--connection-current-request fuel-con--connection))) - (if (not req) (format "\nERROR: No current request (%s)\n" str) - (let ((cont (fuel-con--request-continuation req)) - (id (fuel-con--request-id req)) - (rstr (fuel-con--request-string req)) - (buffer (fuel-con--request-buffer req))) - (prog1 - (if (not cont) - (format "\nWARNING: Droping result for request %s:%S (%s)\n" - id rstr str) - (condition-case cerr - (with-current-buffer (or buffer (current-buffer)) - (funcall cont str) - (format "\nINFO: %s:%S processed\nINFO: %s\n" id rstr str)) - (error (format "\nERROR: continuation failed %s:%S \nERROR: %s\n" - id rstr cerr)))) - (fuel-con--connection-clean-current-request fuel-con--connection))))))) + (if (not req) (fuel-log--error "No current request") + (fuel-con--process-completed-request req) + (fuel-con--connection-clean-current-request fuel-con--connection))))) ;;; Message sending interface: +(defconst fuel-con--error-message "FUEL connection not active") + (defun fuel-con--send-string (buffer/proc str cont &optional sender-buffer) (save-current-buffer (let ((con (fuel-con--get-connection buffer/proc))) - (unless con - (error "FUEL: couldn't find connection")) + (unless con (error fuel-con--error-message)) (let ((req (fuel-con--make-request str cont sender-buffer))) (fuel-con--connection-queue-request con req) (fuel-con--process-next con) @@ -167,19 +248,23 @@ (defun fuel-con--send-string/wait (buffer/proc str cont &optional timeout sbuf) (save-current-buffer - (let* ((con (fuel-con--get-connection buffer/proc)) - (req (fuel-con--send-string buffer/proc str cont sbuf)) - (id (and req (fuel-con--request-id req))) - (time (or timeout fuel-connection-timeout)) - (step 2)) - (when id - (while (and (> time 0) - (not (fuel-con--connection-completed-p con id))) - (sleep-for 0 step) - (setq time (- time step))) - (or (> time 0) - (fuel-con--request-deactivate req) - nil))))) + (let ((con (fuel-con--get-connection buffer/proc))) + (unless con (error fuel-con--error-message)) + (let* ((req (fuel-con--send-string buffer/proc str cont sbuf)) + (id (and req (fuel-con--request-id req))) + (time (or timeout fuel-connection-timeout)) + (step 100) + (waitsecs (/ step 1000.0))) + (when id + (condition-case nil + (while (and (> time 0) + (not (fuel-con--connection-completed-p con id))) + (accept-process-output nil waitsecs) + (setq time (- time step))) + (error (setq time 0))) + (or (> time 0) + (fuel-con--request-deactivate req) + nil)))))) (provide 'fuel-connection) diff --git a/misc/fuel/fuel-debug-uses.el b/misc/fuel/fuel-debug-uses.el new file mode 100644 index 0000000000..4842f960d1 --- /dev/null +++ b/misc/fuel/fuel-debug-uses.el @@ -0,0 +1,208 @@ +;;; fuel-debug-uses.el -- retrieving USING: stanzas + +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Tue Dec 23, 2008 04:23 + +;;; Comentary: + +;; Support for getting and updating factor source vocabulary lists. + +;;; Code: + +(require 'fuel-debug) +(require 'fuel-eval) +(require 'fuel-popup) +(require 'fuel-font-lock) +(require 'fuel-base) + + + +;;; Customization: + +(fuel-font-lock--defface fuel-font-lock-debug-uses-header + 'bold fuel-debug "headers in Uses buffers") + +(fuel-font-lock--defface fuel-font-lock-debug-uses-prompt + 'italic fuel-debug "prompts in Uses buffers") + + +;;; Utility functions: + +(defsubst fuel-debug--chomp (s) + (replace-regexp-in-string "[\n\r\f]" "" s)) + +(defun fuel-debug--file-lines (file) + (when (file-readable-p file) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (let ((lines) (in-usings)) + (while (not (eobp)) + (when (looking-at "^USING: ") (setq in-usings t)) + (let ((line (fuel-debug--chomp + (substring-no-properties (thing-at-point 'line))))) + (when in-usings (setq line (concat "! " line))) + (push line lines)) + (when (and in-usings (looking-at "\\(^\\|.* \\);\\( \\|\n\\)")) + (setq in-usings nil)) + (forward-line)) + (reverse lines)))))) + +(defun fuel-debug--uses-filter (restarts) + (let ((result) (i 1) (rn 0)) + (dolist (r restarts (reverse result)) + (setq rn (1+ rn)) + (when (string-match "Use the .+ vocabulary\\|Defer" r) + (push (list i rn r) result) + (setq i (1+ i)))))) + + +;;; Retrieving USINGs: + +(fuel-popup--define fuel-debug--uses-buffer + "*fuel uses*" 'fuel-debug-uses-mode) + +(make-variable-buffer-local + (defvar fuel-debug--uses-file nil)) + +(make-variable-buffer-local + (defvar fuel-debug--uses-restarts nil)) + +(defsubst fuel-debug--uses-insert-title () + (insert "Inferring USING: stanza for " fuel-debug--uses-file ".\n\n")) + +(defun fuel-debug--uses-prepare (file) + (fuel--with-popup (fuel-debug--uses-buffer) + (setq fuel-debug--uses-file file + fuel-debug--uses nil + fuel-debug--uses-restarts nil) + (erase-buffer) + (fuel-debug--uses-insert-title))) + +(defun fuel-debug--uses-clean () + (setq fuel-debug--uses-file nil + fuel-debug--uses nil + fuel-debug--uses-restarts nil)) + +(defun fuel-debug--uses-for-file (file) + (let* ((lines (fuel-debug--file-lines file)) + (cmd `(:fuel ((V{ ,@lines } fuel-get-uses)) t t))) + (fuel-debug--uses-prepare file) + (fuel--with-popup (fuel-debug--uses-buffer) + (insert "Asking Factor. Please, wait ...\n") + (fuel-eval--send cmd 'fuel-debug--uses-cont)) + (fuel-popup--display (fuel-debug--uses-buffer)))) + +(defun fuel-debug--uses-cont (retort) + (let ((uses (fuel-debug--uses retort)) + (err (fuel-eval--retort-error retort))) + (if uses (fuel-debug--uses-display uses) + (fuel-debug--uses-display-err retort)))) + +(defun fuel-debug--uses-display (uses) + (let* ((inhibit-read-only t) + (old (with-current-buffer (find-file-noselect fuel-debug--uses-file) + (sort (fuel-syntax--find-usings t) 'string<))) + (new (sort uses 'string<))) + (erase-buffer) + (fuel-debug--uses-insert-title) + (if (equalp old new) + (progn + (insert "Current USING: is already fine!. Type 'q' to bury buffer.\n") + (fuel-debug--uses-clean)) + (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab) + (fuel-debug--highlight-names new old 'fuel-font-lock-debug-missing-vocab) + (fuel-debug--insert-vlist "Current vocabulary list:" old) + (newline) + (fuel-debug--insert-vlist "Correct vocabulary list:" new) + (setq fuel-debug--uses new) + (insert "\nType 'y' to update your USING: to the new one.\n")))) + +(defun fuel-debug--uses-display-err (retort) + (let* ((inhibit-read-only t) + (err (fuel-eval--retort-error retort)) + (restarts (fuel-debug--uses-filter (fuel-eval--error-restarts err))) + (unique (= 1 (length restarts)))) + (erase-buffer) + (fuel-debug--uses-insert-title) + (insert (fuel-eval--retort-output retort)) + (newline) + (if (not restarts) + (insert "\nSorry, couldn't infer the vocabulary list.\n") + (setq fuel-debug--uses-restarts restarts) + (if unique (fuel-debug--uses-restart 1) + (insert "\nPlease, type the number of the desired vocabulary:\n\n") + (dolist (r restarts) + (insert (format " :%s %s\n" (first r) (third r)))))))) + +(defun fuel-debug--uses-update-usings () + (interactive) + (let ((inhibit-read-only t) + (file fuel-debug--uses-file) + (uses fuel-debug--uses)) + (when (and uses file) + (insert "\nDone!") + (fuel-debug--uses-clean) + (fuel-popup--quit) + (fuel-debug--replace-usings file uses) + (message "USING: updated!")))) + +(defun fuel-debug--uses-restart (n) + (when (and (> n 0) (<= n (length fuel-debug--uses-restarts))) + (let* ((inhibit-read-only t) + (restart (format ":%s" (cadr (nth (1- n) fuel-debug--uses-restarts)))) + (cmd `(:fuel ([ (:factor ,restart) ] fuel-with-autouse) t t))) + (setq fuel-debug--uses-restarts nil) + (insert "\nAsking Factor. Please, wait ...\n") + (fuel-eval--send cmd 'fuel-debug--uses-cont)))) + + +;;; Fuel uses mode: + +(defvar fuel-debug-uses-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (dotimes (n 9) + (define-key map (vector (+ ?1 n)) + `(lambda () (interactive) (fuel-debug--uses-restart ,(1+ n))))) + (define-key map "y" 'fuel-debug--uses-update-usings) + (define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings) + map)) + +(defconst fuel-debug--uses-header-regex + (format "^%s.*$" (regexp-opt '("Inferring USING: stanza for " + "Current USING: is already fine!" + "Current vocabulary list:" + "Correct vocabulary list:" + "Sorry, couldn't infer the vocabulary list." + "Done!")))) + +(defconst fuel-debug--uses-prompt-regex + (format "^%s" (regexp-opt '("Asking Factor. Please, wait ..." + "Please, type the number of the desired vocabulary:" + "Type 'y' to update your USING: to the new one.")))) + +(defconst fuel-debug--uses-font-lock-keywords + `((,fuel-debug--uses-header-regex . 'fuel-font-lock-debug-uses-header) + (,fuel-debug--uses-prompt-regex . 'fuel-font-lock-debug-uses-prompt) + (,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number) + (2 'fuel-font-lock-debug-restart-name)))) + +(defun fuel-debug-uses-mode () + "A major mode for displaying Factor's USING: inference results." + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'fuel-debug-uses-mode) + (setq mode-name "Fuel Uses:") + (set (make-local-variable 'font-lock-defaults) + '(fuel-debug--uses-font-lock-keywords t nil nil nil)) + (use-local-map fuel-debug-uses-mode-map)) + + +(provide 'fuel-debug-uses) +;;; fuel-debug-uses.el ends here diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el index ad9f47ceb1..611884e087 100644 --- a/misc/fuel/fuel-debug.el +++ b/misc/fuel/fuel-debug.el @@ -1,6 +1,6 @@ ;;; fuel-debug.el -- debugging factor code -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -14,35 +14,44 @@ ;;; Code: -(require 'fuel-base) (require 'fuel-eval) +(require 'fuel-popup) (require 'fuel-font-lock) +(require 'fuel-base) ;;; Customization: (defgroup fuel-debug nil - "Major mode for interaction with the Factor debugger" + "Major mode for interaction with the Factor debugger." :group 'fuel) (defcustom fuel-debug-mode-hook nil - "Hook run after `fuel-debug-mode' activates" + "Hook run after `fuel-debug-mode' activates." :group 'fuel-debug :type 'hook) +(defcustom fuel-debug-confirm-restarts-p t + "Whether to ask for confimation before executing a restart in +the debugger." + :group 'fuel-debug + :type 'boolean) + (defcustom fuel-debug-show-short-help t - "Whether to show short help on available keys in debugger" + "Whether to show short help on available keys in debugger." :group 'fuel-debug :type 'boolean) (fuel-font-lock--define-faces - fuel-debug-font-lock font-lock fuel-debug + fuel-font-lock-debug font-lock fuel-debug ((error warning "highlighting errors") (line variable-name "line numbers in errors/warnings") (column variable-name "column numbers in errors/warnings") (info comment "information headers") (restart-number warning "restart numbers") - (restart-name function-name "restart names"))) + (restart-name function-name "restart names") + (missing-vocab warning"missing vocabulary names") + (unneeded-vocab warning "unneeded vocabulary names"))) ;;; Font lock and other pattern matching: @@ -66,14 +75,14 @@ (defconst fuel-debug--restart-regex "^:\\([0-9]+\\) \\(.+\\)") (defconst fuel-debug--font-lock-keywords - `((,fuel-debug--error-file-regex . 'fuel-debug-font-lock-error) - (,fuel-debug--error-line-regex 1 'fuel-debug-font-lock-line) - (,fuel-debug--error-cont-regex 1 'fuel-debug-font-lock-column) - (,fuel-debug--restart-regex (1 'fuel-debug-font-lock-restart-number) - (2 'fuel-debug-font-lock-restart-name)) - (,fuel-debug--compiler-info-regex 1 'fuel-debug-font-lock-restart-number) - ("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-debug-font-lock-info) - ("^Error: " . 'fuel-debug-font-lock-error))) + `((,fuel-debug--error-file-regex . 'fuel-font-lock-debug-error) + (,fuel-debug--error-line-regex 1 'fuel-font-lock-debug-line) + (,fuel-debug--error-cont-regex 1 'fuel-font-lock-debug-column) + (,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number) + (2 'fuel-font-lock-debug-restart-name)) + (,fuel-debug--compiler-info-regex 1 'fuel-font-lock-debug-restart-number) + ("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-font-lock-debug-info) + ("^Error: " . 'fuel-font-lock-debug-error))) (defun fuel-debug--font-lock-setup () (set (make-local-variable 'font-lock-defaults) @@ -82,7 +91,8 @@ ;;; Debug buffer: -(defvar fuel-debug--buffer nil) +(fuel-popup--define fuel-debug--buffer + "*fuel debug*" 'fuel-debug-mode) (make-variable-buffer-local (defvar fuel-debug--last-ret nil)) @@ -90,14 +100,17 @@ (make-variable-buffer-local (defvar fuel-debug--file nil)) -(defun fuel-debug--buffer () - (or (and (buffer-live-p fuel-debug--buffer) fuel-debug--buffer) - (with-current-buffer - (setq fuel-debug--buffer (get-buffer-create "*fuel dbg*")) - (fuel-debug-mode) - (current-buffer)))) +(make-variable-buffer-local + (defvar fuel-debug--uses nil)) -(defun fuel-debug--display-retort (ret &optional success-msg no-pop file) +(defun fuel-debug--prepare-compilation (file msg) + (let ((inhibit-read-only t)) + (with-current-buffer (fuel-debug--buffer) + (erase-buffer) + (insert msg) + (setq fuel-debug--file file)))) + +(defun fuel-debug--display-retort (ret &optional success-msg no-pop) (let ((err (fuel-eval--retort-error ret)) (inhibit-read-only t)) (with-current-buffer (fuel-debug--buffer) @@ -111,17 +124,58 @@ (when err (fuel-debug--display-restarts err) (delete-blank-lines) - (newline) - (let ((hstr (fuel-debug--help-string err file))) - (if fuel-debug-show-short-help - (insert "-----------\n" hstr "\n") - (message "%s" hstr)))) + (newline)) + (fuel-debug--display-uses ret) + (let ((hstr (fuel-debug--help-string err fuel-debug--file))) + (if fuel-debug-show-short-help + (insert "-----------\n" hstr "\n") + (message "%s" hstr))) (setq fuel-debug--last-ret ret) - (setq fuel-debug--file file) (goto-char (point-max)) - (when (and err (not no-pop)) (pop-to-buffer fuel-debug--buffer)) + (font-lock-fontify-buffer) + (when (and err (not no-pop)) (fuel-popup--display)) (not err)))) +(defun fuel-debug--uses (ret) + (let ((uses (fuel-eval--retort-result ret))) + (and (eq :uses (car uses)) + (cdr uses)))) + +(defun fuel-debug--insert-vlist (title vlist) + (goto-char (point-max)) + (insert title "\n\n ") + (let ((i 0) (step 5)) + (dolist (v vlist) + (setq i (1+ i)) + (insert v) + (insert (if (zerop (mod i step)) "\n " " "))) + (unless (zerop (mod i step)) (newline)) + (newline))) + +(defun fuel-debug--highlight-names (names ref face) + (dolist (n names) + (when (not (member n ref)) + (put-text-property 0 (length n) 'font-lock-face face n)))) + +(defun fuel-debug--insert-uses (uses) + (let* ((file (or file fuel-debug--file)) + (old (with-current-buffer (find-file-noselect file) + (sort (fuel-syntax--find-usings t) 'string<))) + (new (sort uses 'string<))) + (when (not (equalp old new)) + (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab) + (newline) + (fuel-debug--insert-vlist "Correct vocabulary list:" new) + new))) + +(defun fuel-debug--display-uses (ret) + (when (setq fuel-debug--uses (fuel-debug--uses ret)) + (newline) + (fuel-debug--highlight-names fuel-debug--uses + nil 'fuel-font-lock-debug-missing-vocab) + (fuel-debug--insert-vlist "Missing vocabularies:" fuel-debug--uses) + (newline))) + (defun fuel-debug--display-output (ret) (let* ((last (fuel-eval--retort-output fuel-debug--last-ret)) (current (fuel-eval--retort-output ret)) @@ -130,7 +184,7 @@ (trail (and last (substring-no-properties last (/ llen 2)))) (err (fuel-eval--retort-error ret)) (p (point))) - (save-excursion (insert current)) + (when current (save-excursion (insert current))) (when (and (> clen llen) (> llen 0) (search-forward trail nil t)) (delete-region p (point))) (goto-char (point-max)) @@ -147,7 +201,7 @@ (newline)))) (defun fuel-debug--help-string (err &optional file) - (format "Press %s%s%sq bury buffer" + (format "Press %s%s%s%sq bury buffer" (if (or file (fuel-eval--error-file err)) "g go to file, " "") (let ((rsn (length (fuel-eval--error-restarts err)))) (cond ((zerop rsn) "") @@ -158,7 +212,8 @@ (save-excursion (goto-char (point-min)) (when (search-forward (car ci) nil t) - (setq str (format "%c %s, %s" (cdr ci) (car ci) str)))))))) + (setq str (format "%c %s, %s" (cdr ci) (car ci) str)))))) + (if fuel-debug--uses "u to update USING:, " ""))) (defun fuel-debug--buffer-file () (with-current-buffer (fuel-debug--buffer) @@ -178,16 +233,16 @@ (defun fuel-debug-goto-error () (interactive) - (let* ((err (or (fuel-debug--buffer-error) - (error "No errors reported"))) + (let* ((err (fuel-debug--buffer-error)) (file (or (fuel-debug--buffer-file) - (error "No file associated with error"))) - (l/c (fuel-eval--error-line/column err)) + (error "No file associated with compilation"))) + (l/c (and err (fuel-eval--error-line/column err))) (line (or (car l/c) 1)) (col (or (cdr l/c) 0))) (find-file-other-window file) - (goto-line line) - (forward-char col))) + (when line + (goto-line line) + (when col (forward-char col))))) (defun fuel-debug--read-restart-no () (let ((rs (fuel-debug--buffer-restarts))) @@ -214,7 +269,7 @@ (buffer (if file (find-file-noselect file) (current-buffer)))) (with-current-buffer buffer (fuel-debug--display-retort - (fuel-eval--send/wait (fuel-eval--cmd/string (format ":%s" n))) + (fuel-eval--send/wait `(:fuel ((:factor ,(format ":%s" n))))) (format "Restart %s (%s) successful" n (nth (1- n) rs)))))))) (defun fuel-debug-show--compiler-info (info) @@ -224,10 +279,35 @@ (error "%s information not available" info)) (message "Retrieving %s info ..." info) (unless (fuel-debug--display-retort - (fuel-eval--send/wait (fuel-eval--cmd/string info)) - "" (fuel-debug--buffer-file)) + (fuel-eval--send/wait `(:fuel ((:factor ,info)))) "") (error "Sorry, no %s info available" info)))) +(defun fuel-debug--replace-usings (file uses) + (pop-to-buffer (find-file-noselect file)) + (goto-char (point-min)) + (if (re-search-forward "^USING: " nil t) + (let ((begin (point)) + (end (or (and (re-search-forward ";\\( \\|$\\)") (point)) + (point)))) + (kill-region begin end)) + (re-search-forward "^IN: " nil t) + (beginning-of-line) + (open-line 2) + (insert "USING: ")) + (let ((start (point))) + (insert (mapconcat 'substring-no-properties uses " ") " ;") + (fill-region start (point) nil))) + +(defun fuel-debug-update-usings () + (interactive) + (when (and fuel-debug--file fuel-debug--uses) + (let* ((file fuel-debug--file) + (old (with-current-buffer (find-file-noselect file) + (fuel-syntax--find-usings t))) + (uses (sort (append fuel-debug--uses old) 'string<))) + (fuel-popup--quit) + (fuel-debug--replace-usings file uses)))) + ;;; Fuel Debug mode: @@ -238,10 +318,11 @@ (define-key map "\C-c\C-c" 'fuel-debug-goto-error) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) - (define-key map "q" 'bury-buffer) + (define-key map "u" 'fuel-debug-update-usings) (dotimes (n 9) (define-key map (vector (+ ?1 n)) - `(lambda () (interactive) (fuel-debug-exec-restart ,(1+ n) t)))) + `(lambda () (interactive) + (fuel-debug-exec-restart ,(1+ n) fuel-debug-confirm-restarts-p)))) (dolist (ci fuel-debug--compiler-info-alist) (define-key map (vector (cdr ci)) `(lambda () (interactive) (fuel-debug-show--compiler-info ,(car ci))))) @@ -253,15 +334,16 @@ invoking restarts as needed. \\{fuel-debug-mode-map}" (interactive) (kill-all-local-variables) - (setq major-mode 'factor-mode) + (buffer-disable-undo) + (setq major-mode 'fuel-debug-mode) (setq mode-name "Fuel Debug") (use-local-map fuel-debug-mode-map) (fuel-debug--font-lock-setup) (setq fuel-debug--file nil) (setq fuel-debug--last-ret nil) - (toggle-read-only 1) (run-hooks 'fuel-debug-mode-hook)) + (provide 'fuel-debug) ;;; fuel-debug.el ends here diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el new file mode 100644 index 0000000000..e5f0ffd26f --- /dev/null +++ b/misc/fuel/fuel-edit.el @@ -0,0 +1,170 @@ +;;; fuel-edit.el -- utilities for file editing + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Mon Jan 05, 2009 21:16 + +;;; Comentary: + +;; Locating and opening factor source and documentation files. + +;;; Code: + +(require 'fuel-completion) +(require 'fuel-eval) +(require 'fuel-base) + +(require 'etags) + + +;;; Customization + +(defmacro fuel-edit--define-custom-visit (var group doc) + `(defcustom ,var nil + ,doc + :group ',group + :type '(choice (const :tag "Other window" window) + (const :tag "Other frame" frame) + (const :tag "Current window" nil)))) + +(fuel-edit--define-custom-visit + fuel-edit-word-method fuel + "How the new buffer is opened when invoking \\[fuel-edit-word-at-point]") + + +;;; Auxiliar functions: + +(defun fuel-edit--visit-file (file method) + (cond ((eq method 'window) (find-file-other-window file)) + ((eq method 'frame) (find-file-other-frame file)) + (t (find-file file)))) + +(defun fuel-edit--looking-at-vocab () + (save-excursion + (fuel-syntax--beginning-of-defun) + (looking-at "USING:\\|USE:\\|IN:"))) + +(defun fuel-edit--try-edit (ret) + (let* ((err (fuel-eval--retort-error ret)) + (loc (fuel-eval--retort-result ret))) + (when (or err (not loc) (not (listp loc)) (not (stringp (car loc)))) + (error "Couldn't find edit location")) + (unless (file-readable-p (car loc)) + (error "Couldn't open '%s' for read" (car loc))) + (fuel-edit--visit-file (car loc) fuel-edit-word-method) + (goto-line (if (numberp (cadr loc)) (cadr loc) 1)))) + +(defun fuel-edit--read-vocabulary-name (refresh) + (let* ((vocabs (fuel-completion--vocabs refresh)) + (prompt "Vocabulary name: ")) + (if vocabs + (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history) + (read-string prompt nil fuel-edit--vocab-history)))) + +(defun fuel-edit--edit-article (name) + (let ((cmd `(:fuel* (,name fuel-get-article-location) "fuel" t))) + (fuel-edit--try-edit (fuel-eval--send/wait cmd)))) + + +;;; Editing commands: + +(defvar fuel-edit--word-history nil) +(defvar fuel-edit--vocab-history nil) +(defvar fuel-edit--previous-location nil) + +(defun fuel-edit-vocabulary (&optional refresh vocab) + "Visits vocabulary file in Emacs. +When called interactively, asks for vocabulary with completion. +With prefix argument, refreshes cached vocabulary list." + (interactive "P") + (let* ((vocab (or vocab (fuel-edit--read-vocabulary-name refresh))) + (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t))) + (fuel-edit--try-edit (fuel-eval--send/wait cmd)))) + +(defun fuel-edit-word (&optional arg) + "Asks for a word to edit, with completion. +With prefix, only words visible in the current vocabulary are +offered." + (interactive "P") + (let* ((word (fuel-completion--read-word "Edit word: " + nil + fuel-edit--word-history + arg)) + (cmd `(:fuel* ((:quote ,word) fuel-get-word-location)))) + (fuel-edit--try-edit (fuel-eval--send/wait cmd)))) + +(defun fuel-edit-word-at-point (&optional arg) + "Opens a new window visiting the definition of the word at point. +With prefix, asks for the word to edit." + (interactive "P") + (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point)) + (fuel-completion--read-word "Edit word: "))) + (cmd `(:fuel* ((:quote ,word) fuel-get-word-location))) + (marker (and (not arg) (point-marker)))) + (if (and (not arg) (fuel-edit--looking-at-vocab)) + (fuel-edit-vocabulary nil word) + (fuel-edit--try-edit (fuel-eval--send/wait cmd))) + (when marker (ring-insert find-tag-marker-ring marker)))) + +(defun fuel-edit-word-doc-at-point (&optional arg word) + "Opens a new window visiting the documentation file for the word at point. +With prefix, asks for the word to edit." + (interactive "P") + (let* ((word (or word + (and (not arg) (fuel-syntax-symbol-at-point)) + (fuel-completion--read-word "Edit word: "))) + (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))) + (marker (and (not arg) (point-marker)))) + (condition-case nil + (fuel-edit--try-edit (fuel-eval--send/wait cmd)) + (error + (message "Documentation for '%s' not found" word) + (when (and (eq major-mode 'factor-mode) + (y-or-n-p (concat "No documentation found. " + "Do you want to open the vocab's " + "doc file? "))) + (when marker (ring-insert find-tag-marker-ring marker)) + (find-file-other-window + (format "%s-docs.factor" + (file-name-sans-extension (buffer-file-name))))))))) + +(defun fuel-edit-pop-edit-word-stack () + "Pop back to where \\[fuel-edit-word-at-point] or \\[fuel-edit-word-doc-at-point] +was last invoked." + (interactive) + (condition-case nil + (pop-tag-mark) + (error "No previous location for find word or vocab invokation"))) + +(defvar fuel-edit--buffer-history nil) + +(defun fuel-switch-to-buffer (&optional method) + "Switch to any of the existing Factor buffers, with completion." + (interactive) + (let ((buffer (completing-read "Factor buffer: " + (remove (buffer-name) + (mapcar 'buffer-name (buffer-list))) + '(lambda (s) (string-match "\\.factor$" s)) + t + nil + fuel-edit--buffer-history))) + (cond ((eq method 'window) (switch-to-buffer-other-window buffer)) + ((eq method 'frame) (switch-to-buffer-other-frame buffer)) + (t (switch-to-buffer buffer))))) + +(defun fuel-switch-to-buffer-other-window () + "Switch to any of the existing Factor buffers, in other window." + (interactive) + (fuel-switch-to-buffer 'window)) + +(defun fuel-switch-to-buffer-other-frame () + "Switch to any of the existing Factor buffers, in other frame." + (interactive) + (fuel-switch-to-buffer 'frame)) + + +(provide 'fuel-edit) +;;; fuel-edit.el ends here diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index 02bcb54d66..9e8210a3e3 100644 --- a/misc/fuel/fuel-eval.el +++ b/misc/fuel/fuel-eval.el @@ -1,6 +1,6 @@ ;;; fuel-eval.el --- evaluating Factor expressions -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -13,9 +13,103 @@ ;;; Code: -(require 'fuel-base) (require 'fuel-syntax) (require 'fuel-connection) +(require 'fuel-log) +(require 'fuel-base) + +(eval-when-compile (require 'cl)) + + +;;; Simple sexp-based representation of factor code + +(defun factor (sexp) + (cond ((null sexp) "f") + ((eq sexp t) "t") + ((or (stringp sexp) (numberp sexp)) (format "%S" sexp)) + ((vectorp sexp) (factor (cons :quotation (append sexp nil)))) + ((listp sexp) + (case (car sexp) + (:array (factor--seq 'V{ '} (cdr sexp))) + (:seq (factor--seq '{ '} (cdr sexp))) + (:tuple (factor--seq 'T{ '} (cdr sexp))) + (:quote (format "\\ %s" (factor `(:factor ,(cadr sexp))))) + (:quotation (factor--seq '\[ '\] (cdr sexp))) + (:using (factor `(USING: ,@(cdr sexp) :end))) + (:factor (format "%s" (mapconcat 'identity (cdr sexp) " "))) + (:fuel (factor--fuel-factor (cons :rs (cdr sexp)))) + (:fuel* (factor--fuel-factor (cons :nrs (cdr sexp)))) + (t (mapconcat 'factor sexp " ")))) + ((keywordp sexp) + (factor (case sexp + (:rs 'fuel-eval-restartable) + (:nrs 'fuel-eval-non-restartable) + (:in (or (fuel-syntax--current-vocab) "fuel")) + (:usings `(:array ,@(fuel-syntax--usings))) + (:get 'fuel-eval-set-result) + (:end '\;) + (t `(:factor ,(symbol-name sexp)))))) + ((symbolp sexp) (symbol-name sexp)))) + +(defsubst factor--seq (begin end forms) + (format "%s %s %s" begin (if forms (factor forms) "") end)) + +(defsubst factor--fuel-factor (sexp) + (factor `(,(factor--fuel-restart (nth 0 sexp)) + ,(factor--fuel-lines (nth 1 sexp)) + ,(factor--fuel-in (nth 2 sexp)) + ,(factor--fuel-usings (nth 3 sexp)) + fuel-eval-in-context))) + +(defsubst factor--fuel-restart (rs) + (unless (member rs '(:rs :nrs)) + (error "Invalid restart spec (%s)" rs)) + rs) + +(defsubst factor--fuel-lines (lst) + (cons :array (mapcar 'factor lst))) + +(defsubst factor--fuel-in (in) + (cond ((or (eq in :in) (null in)) :in) + ((eq in 'f) 'f) + ((eq in 't) "fuel") + ((stringp in) in) + (t (error "Invalid 'in' (%s)" in)))) + +(defsubst factor--fuel-usings (usings) + (cond ((null usings) :usings) + ((eq usings t) nil) + ((listp usings) `(:array ,@usings)) + (t (error "Invalid 'usings' (%s)" usings)))) + + +;;; Code sending: + +(defvar fuel-eval--default-proc-function nil) +(defsubst fuel-eval--default-proc () + (and fuel-eval--default-proc-function + (funcall fuel-eval--default-proc-function))) + +(defvar fuel-eval--proc nil) + +(defvar fuel-eval--sync-retort nil) + +(defun fuel-eval--send/wait (code &optional timeout buffer) + (setq fuel-eval--sync-retort nil) + (fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc)) + (if (stringp code) code (factor code)) + '(lambda (s) + (setq fuel-eval--sync-retort + (fuel-eval--parse-retort s))) + timeout + buffer) + fuel-eval--sync-retort) + +(defun fuel-eval--send (code cont &optional buffer) + (fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc)) + (if (stringp code) code (factor code)) + `(lambda (s) (,cont (fuel-eval--parse-retort s))) + buffer)) ;;; Retort and retort-error datatypes: @@ -27,28 +121,28 @@ (defsubst fuel-eval--retort-result (ret) (nth 1 ret)) (defsubst fuel-eval--retort-output (ret) (nth 2 ret)) -(defsubst fuel-eval--retort-p (ret) (listp ret)) +(defsubst fuel-eval--retort-p (ret) + (and (listp ret) (= 3 (length ret)))) (defsubst fuel-eval--make-parse-error-retort (str) (fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil)) -(defun fuel-eval--parse-retort (str) - (save-current-buffer - (condition-case nil - (let ((ret (car (read-from-string str)))) - (if (fuel-eval--retort-p ret) ret (error))) - (error (fuel-eval--make-parse-error-retort str))))) +(defun fuel-eval--parse-retort (ret) + (fuel-log--info "RETORT: %S" ret) + (if (fuel-eval--retort-p ret) ret + (fuel-eval--make-parse-error-retort ret))) (defsubst fuel-eval--error-name (err) (car err)) -(defsubst fuel-eval--error-restarts (err) - (cdr (assoc :restarts (fuel-eval--error-name-p err 'condition)))) - (defun fuel-eval--error-name-p (err name) (unless (null err) (or (and (eq (fuel-eval--error-name err) name) err) (assoc name err)))) +(defsubst fuel-eval--error-restarts (err) + (cdr (assoc :restarts (or (fuel-eval--error-name-p err 'condition) + (fuel-eval--error-name-p err 'lexer-error))))) + (defsubst fuel-eval--error-file (err) (nth 1 (fuel-eval--error-name-p err 'source-file-error))) @@ -64,69 +158,6 @@ (defsubst fuel-eval--error-line-text (err) (nth 3 (fuel-eval--error-lexer-p err))) - -;;; String sending:: - -(defvar fuel-eval-log-max-length 16000) - -(defvar fuel-eval--default-proc-function nil) -(defsubst fuel-eval--default-proc () - (and fuel-eval--default-proc-function - (funcall fuel-eval--default-proc-function))) - -(defvar fuel-eval--proc nil) - -(defvar fuel-eval--log t) - -(defvar fuel-eval--sync-retort nil) - -(defun fuel-eval--send/wait (str &optional timeout buffer) - (setq fuel-eval--sync-retort nil) - (fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc)) - str - '(lambda (s) - (setq fuel-eval--sync-retort - (fuel-eval--parse-retort s))) - timeout - buffer) - fuel-eval--sync-retort) - -(defun fuel-eval--send (str cont &optional buffer) - (fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc)) - str - `(lambda (s) (,cont (fuel-eval--parse-retort s))) - buffer)) - - -;;; Evaluation protocol - -(defsubst fuel-eval--factor-array (strs) - (format "V{ %S }" (mapconcat 'identity strs " "))) - -(defun fuel-eval--cmd/lines (strs &optional no-rs in usings) - (unless (and in usings) (fuel-syntax--usings-update)) - (let* ((in (cond ((not in) (or fuel-syntax--current-vocab "f")) - ((eq in t) "fuel-scratchpad") - (in in))) - (usings (cond ((not usings) fuel-syntax--usings) - ((eq usings t) nil) - (usings usings)))) - (format "fuel-eval-%srestartable %s %S %s fuel-eval-in-context" - (if no-rs "non-" "") - (fuel-eval--factor-array strs) - in - (fuel-eval--factor-array usings)))) - -(defsubst fuel-eval--cmd/string (str &optional no-rs in usings) - (fuel-eval--cmd/lines (list str) no-rs in usings)) - -(defun fuel-eval--cmd/region (begin end &optional no-rs in usings) - (let ((lines (split-string (buffer-substring-no-properties begin end) - "[\f\n\r\v]+" t))) - (when (> (length lines) 0) - (fuel-eval--cmd/lines lines no-rs in usings)))) - - (provide 'fuel-eval) ;;; fuel-eval.el ends here diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index ba2a499b4b..86ae94fe8a 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -1,6 +1,6 @@ ;;; fuel-font-lock.el -- font lock for factor code -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -13,21 +13,32 @@ ;;; Code: -(require 'fuel-base) (require 'fuel-syntax) +(require 'fuel-base) (require 'font-lock) ;;; Faces: +(defgroup fuel-faces nil + "Faces used by FUEL." + :group 'fuel + :group 'faces) + +(defmacro fuel-font-lock--defface (face def group doc) + `(defface ,face (face-default-spec ,def) + ,(format "Face for %s." doc) + :group ',group + :group 'fuel-faces + :group 'faces)) + +(put 'fuel-font-lock--defface 'lisp-indent-function 1) + (defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc) (let ((face (intern (format "%s-%s" prefix face))) (def (intern (format "%s-%s-face" def-prefix def)))) - `(defface ,face (face-default-spec ,def) - ,(format "Face for %s." doc) - :group ',group - :group 'faces))) + `(fuel-font-lock--defface ,face ,def ,group ,doc))) (defmacro fuel-font-lock--define-faces (prefix def-prefix group faces) (let ((setup (make-symbol (format "%s--faces-setup" prefix)))) @@ -39,43 +50,116 @@ ',faces))) (,setup)))) +(fuel-font-lock--define-faces + factor-font-lock font-lock factor-mode + ((comment comment "comments") + (constructor type "constructors ()") + (constant constant "constants and literal values") + (number constant "integers and floats") + (ratio constant "ratios") + (declaration keyword "declaration words") + (parsing-word keyword "parsing words") + (setter-word function-name "setter words (>>foo)") + (getter-word function-name "getter words (foo>>)") + (stack-effect comment "stack effect specifications") + (string string "strings") + (symbol variable-name "name of symbol being defined") + (type-name type "type names") + (vocabulary-name constant "vocabulary names") + (word function-name "word, generic or method being defined") + (invalid-syntax warning "syntactically invalid constructs"))) + ;;; Font lock: -(defconst fuel-font-lock--parsing-lock-keywords - (cons '("\\(P\\|SBUF\\)\"" 1 'factor-font-lock-parsing-word) - (mapcar (lambda (w) `(,(format "\\(^\\| \\)\\(%s\\)\\($\\| \\)" w) - 2 'factor-font-lock-parsing-word)) - fuel-syntax--parsing-words))) +(defun fuel-font-lock--syntactic-face (state) + (if (nth 3 state) 'factor-font-lock-string + (let ((c (char-after (nth 8 state)))) + (cond ((or (char-equal c ?\ ) (char-equal c ?\n)) + (save-excursion + (goto-char (nth 8 state)) + (beginning-of-line) + (cond ((looking-at "USING: ") + 'factor-font-lock-vocabulary-name) + ((looking-at "\\(TUPLE\\|SYMBOLS\\|VARS\\): ") + 'factor-font-lock-symbol) + ((looking-at "C-ENUM:\\( \\|\n\\)") + 'factor-font-lock-constant) + (t 'default)))) + ((or (char-equal c ?U) (char-equal c ?C)) + 'factor-font-lock-parsing-word) + ((char-equal c ?\() 'factor-font-lock-stack-effect) + ((char-equal c ?\") 'factor-font-lock-string) + (t 'factor-font-lock-comment))))) (defconst fuel-font-lock--font-lock-keywords - `(,@fuel-font-lock--parsing-lock-keywords - (,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect) - (,fuel-syntax--parsing-words-ext-regex . 'factor-font-lock-parsing-word) - (,fuel-syntax--declaration-words-regex 1 'factor-font-lock-declaration) + `((,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect) + (,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word) + (,fuel-syntax--alien-function-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word)) + (,fuel-syntax--vocab-ref-regexp 2 'factor-font-lock-vocabulary-name) + (,fuel-syntax--constructor-decl-regex (1 'factor-font-lock-word) + (2 'factor-font-lock-type-name) + (3 'factor-font-lock-invalid-syntax nil t)) + (,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-type-name) + (3 'factor-font-lock-invalid-syntax nil t)) + (,fuel-syntax--rename-regex (1 'factor-font-lock-word) + (2 'factor-font-lock-vocabulary-name) + (3 'factor-font-lock-word) + (4 'factor-font-lock-invalid-syntax nil t)) + (,fuel-syntax--declaration-words-regex . 'factor-font-lock-declaration) (,fuel-syntax--word-definition-regex 2 'factor-font-lock-word) + (,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word) + (2 'factor-font-lock-word)) + (,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant) + (,fuel-syntax--integer-regex . 'factor-font-lock-number) + (,fuel-syntax--float-regex . 'factor-font-lock-number) + (,fuel-syntax--ratio-regex . 'factor-font-lock-ratio) (,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name) (,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-word)) - (,fuel-syntax--parent-type-regex 1 'factor-font-lock-type-name) + (,fuel-syntax--tuple-decl-regex 2 'factor-font-lock-type-name) (,fuel-syntax--constructor-regex . 'factor-font-lock-constructor) (,fuel-syntax--setter-regex . 'factor-font-lock-setter-word) + (,fuel-syntax--getter-regex . 'factor-font-lock-getter-word) (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol) - (,fuel-syntax--use-line-regex 1 'factor-font-lock-vocabulary-name)) - "Font lock keywords definition for Factor mode.") + (,fuel-syntax--bad-string-regex . 'factor-font-lock-invalid-syntax) + ("\\_<\\(P\\|SBUF\\|DLL\\)\"" 1 'factor-font-lock-parsing-word) + (,fuel-syntax--parsing-words-regex . 'factor-font-lock-parsing-word))) (defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax) (set (make-local-variable 'comment-start) "! ") (set (make-local-variable 'parse-sexp-lookup-properties) t) - (set (make-local-variable 'font-lock-comment-face) 'factor-font-lock-comment) - (set (make-local-variable 'font-lock-string-face) 'factor-font-lock-string) (set (make-local-variable 'font-lock-defaults) `(,(or keywords 'fuel-font-lock--font-lock-keywords) nil nil nil nil ,@(if no-syntax nil (list (cons 'font-lock-syntactic-keywords - fuel-syntax--syntactic-keywords)))))) + fuel-syntax--syntactic-keywords) + (cons 'font-lock-syntactic-face-function + 'fuel-font-lock--syntactic-face)))))) +;;; Fontify strings as Factor code: + +(defun fuel-font-lock--font-lock-buffer () + (let ((name " *fuel font lock*")) + (or (get-buffer name) + (let ((buffer (get-buffer-create name))) + (set-buffer buffer) + (set-syntax-table fuel-syntax--syntax-table) + (fuel-font-lock--font-lock-setup) + buffer)))) + +(defun fuel-font-lock--factor-str (str) + (save-current-buffer + (set-buffer (fuel-font-lock--font-lock-buffer)) + (erase-buffer) + (insert str) + (let ((font-lock-verbose nil)) (font-lock-fontify-buffer)) + (buffer-string))) + + (provide 'fuel-font-lock) ;;; fuel-font-lock.el ends here diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 227778934a..a82de388da 100644 --- a/misc/fuel/fuel-help.el +++ b/misc/fuel/fuel-help.el @@ -1,6 +1,6 @@ ;;; fuel-help.el -- accessing Factor's help system -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -14,264 +14,352 @@ ;;; Code: -(require 'fuel-base) -(require 'fuel-font-lock) +(require 'fuel-edit) (require 'fuel-eval) +(require 'fuel-markup) +(require 'fuel-autodoc) +(require 'fuel-completion) +(require 'fuel-syntax) +(require 'fuel-font-lock) +(require 'fuel-popup) +(require 'fuel-base) + +(require 'button) ;;; Customization: (defgroup fuel-help nil - "Options controlling FUEL's help system" + "Options controlling FUEL's help system." :group 'fuel) -(defcustom fuel-help-minibuffer-font-lock t - "Whether to use font lock for info messages in the minibuffer." - :group 'fuel-help - :type 'boolean) - (defcustom fuel-help-always-ask t "When enabled, always ask for confirmation in help prompts." :type 'boolean :group 'fuel-help) -(defcustom fuel-help-use-minibuffer t - "When enabled, use the minibuffer for short help messages." - :type 'boolean - :group 'fuel-help) - -(defcustom fuel-help-mode-hook nil - "Hook run by `factor-help-mode'." - :type 'hook - :group 'fuel-help) - (defcustom fuel-help-history-cache-size 50 "Maximum number of pages to keep in the help browser cache." :type 'integer :group 'fuel-help) -(defface fuel-help-font-lock-headlines '((t (:bold t :weight bold))) - "Face for headlines in help buffers." - :group 'fuel-help - :group 'faces) - - -;;; Autodoc mode: - -(defvar fuel-help--font-lock-buffer - (let ((buffer (get-buffer-create " *fuel help minibuffer messages*"))) - (set-buffer buffer) - (fuel-font-lock--font-lock-setup) - buffer)) - -(defun fuel-help--font-lock-str (str) - (set-buffer fuel-help--font-lock-buffer) - (erase-buffer) - (insert str) - (let ((font-lock-verbose nil)) (font-lock-fontify-buffer)) - (buffer-string)) - -(defun fuel-help--word-synopsis (&optional word) - (let ((word (or word (fuel-syntax-symbol-at-point))) - (fuel-eval--log t)) - (when word - (let* ((str (format "\\ %s synopsis fuel-eval-set-result" word)) - (cmd (fuel-eval--cmd/string str t t)) - (ret (fuel-eval--send/wait cmd 20))) - (when (and ret (not (fuel-eval--retort-error ret))) - (if fuel-help-minibuffer-font-lock - (fuel-help--font-lock-str (fuel-eval--retort-result ret)) - (fuel-eval--retort-result ret))))))) - -(make-variable-buffer-local - (defvar fuel-autodoc-mode-string " A" - "Modeline indicator for fuel-autodoc-mode")) - -(define-minor-mode fuel-autodoc-mode - "Toggle Fuel's Autodoc mode. -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. - -When Autodoc mode is enabled, a synopsis of the word at point is -displayed in the minibuffer." - :init-value nil - :lighter fuel-autodoc-mode-string - :group 'fuel - - (set (make-local-variable 'eldoc-documentation-function) - (when fuel-autodoc-mode 'fuel-help--word-synopsis)) - (set (make-local-variable 'eldoc-minor-mode-string) nil) - (eldoc-mode fuel-autodoc-mode) - (message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled"))) +(defcustom fuel-help-bookmarks nil + "Bookmars. Maintain this list using the help browser." + :type 'list + :group 'fuel-help) ;;; Help browser history: -(defvar fuel-help--history - (list nil - (make-ring fuel-help-history-cache-size) - (make-ring fuel-help-history-cache-size))) +(defun fuel-help--make-history () + (list nil ; current + (make-ring fuel-help-history-cache-size) ; previous + (make-ring fuel-help-history-cache-size))) ; next -(defvar fuel-help--history-idx 0) +(defsubst fuel-help--history-current () + (car fuel-help--history)) -(defun fuel-help--history-push (term) - (when (car fuel-help--history) - (ring-insert (nth 1 fuel-help--history) (car fuel-help--history))) - (setcar fuel-help--history term)) +(defun fuel-help--history-push (link) + (unless (equal link (car fuel-help--history)) + (let ((next (fuel-help--history-next))) + (unless (equal link next) + (when next (fuel-help--history-previous)) + (ring-insert (nth 1 fuel-help--history) (car fuel-help--history)) + (setcar fuel-help--history link)))) + link) -(defun fuel-help--history-next () +(defun fuel-help--history-next (&optional forget-current) (when (not (ring-empty-p (nth 2 fuel-help--history))) - (when (car fuel-help--history) + (when (and (car fuel-help--history) (not forget-current)) (ring-insert (nth 1 fuel-help--history) (car fuel-help--history))) (setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0)))) -(defun fuel-help--history-previous () +(defun fuel-help--history-previous (&optional forget-current) (when (not (ring-empty-p (nth 1 fuel-help--history))) - (when (car fuel-help--history) + (when (and (car fuel-help--history) (not forget-current)) (ring-insert (nth 2 fuel-help--history) (car fuel-help--history))) (setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0)))) +(defvar fuel-help--history (fuel-help--make-history)) + + +;;; Page cache: + +(defun fuel-help--history-current-content () + (fuel-help--cache-get (car fuel-help--history))) + +(defvar fuel-help--cache (make-hash-table :weakness 'key :test 'equal)) + +(defsubst fuel-help--cache-get (name) + (gethash name fuel-help--cache)) + +(defsubst fuel-help--cache-insert (name str) + (puthash name str fuel-help--cache)) + +(defsubst fuel-help--cache-clear () + (clrhash fuel-help--cache)) + ;;; Fuel help buffer and internals: -(defun fuel-help--help-buffer () - (with-current-buffer (get-buffer-create "*fuel-help*") - (fuel-help-mode) - (current-buffer))) +(fuel-popup--define fuel-help--buffer + "*fuel help*" 'fuel-help-mode) + (defvar fuel-help--prompt-history nil) -(defun fuel-help--show-help (&optional see word) - (let* ((def (or word (fuel-syntax-symbol-at-point))) +(make-local-variable + (defvar fuel-help--buffer-link nil)) + +(defun fuel-help--read-word (see) + (let* ((def (fuel-syntax-symbol-at-point)) (prompt (format "See%s help on%s: " (if see " short" "") (if def (format " (%s)" def) ""))) - (ask (or (not (memq major-mode '(factor-mode fuel-help-mode))) - (not def) - fuel-help-always-ask)) - (def (if ask (read-string prompt nil 'fuel-help--prompt-history def) - def)) - (cmd (format "\\ %s %s" def (if see "see" "help")))) - (message "Looking up '%s' ..." def) - (fuel-eval--send (fuel-eval--cmd/string cmd t t) - `(lambda (r) (fuel-help--show-help-cont ,def r))))) - -(defun fuel-help--show-help-cont (def ret) - (let ((out (fuel-eval--retort-output ret))) - (if (or (fuel-eval--retort-error ret) (empty-string-p out)) - (message "No help for '%s'" def) - (fuel-help--insert-contents def out)))) - -(defun fuel-help--insert-contents (def str &optional nopush) - (let ((hb (fuel-help--help-buffer)) + (ask (or (not def) fuel-help-always-ask))) + (if ask + (fuel-completion--read-word prompt + def + 'fuel-help--prompt-history + t) + def))) + +(defun fuel-help--word-help (&optional see word) + (let ((def (or word (fuel-help--read-word see)))) + (when def + (let ((cmd `(:fuel* (,def ,(if see 'fuel-word-see 'fuel-word-help)) + "fuel" t))) + (message "Looking up '%s' ..." def) + (let* ((ret (fuel-eval--send/wait cmd)) + (res (fuel-eval--retort-result ret))) + (if (not res) + (message "No help for '%s'" def) + (fuel-help--insert-contents (list def def 'word) res))))))) + +(defun fuel-help--get-article (name label) + (message "Retrieving article ...") + (let* ((name (if (listp name) (cons :seq name) name)) + (cmd `(:fuel* ((,name fuel-get-article)) "fuel" t)) + (ret (fuel-eval--send/wait cmd)) + (res (fuel-eval--retort-result ret))) + (if (not res) + (message "Article '%s' not found" label) + (fuel-help--insert-contents (list name label 'article) res) + (message "")))) + +(defun fuel-help--get-vocab (name) + (message "Retrieving help vocabulary for vocabulary '%s' ..." name) + (let* ((cmd `(:fuel* ((,name fuel-vocab-help)) "fuel" (,name))) + (ret (fuel-eval--send/wait cmd)) + (res (fuel-eval--retort-result ret))) + (if (not res) + (message "No help available for vocabulary '%s'" name) + (fuel-help--insert-contents (list name name 'vocab) res) + (message "")))) + +(defun fuel-help--get-vocab/author (author) + (message "Retrieving vocabularies by %s ..." author) + (let* ((cmd `(:fuel* ((,author fuel-get-vocabs/author)) "fuel" t)) + (ret (fuel-eval--send/wait cmd)) + (res (fuel-eval--retort-result ret))) + (if (not res) + (message "No vocabularies by %s" author) + (fuel-help--insert-contents (list author author 'author) res) + (message "")))) + +(defun fuel-help--get-vocab/tag (tag) + (message "Retrieving vocabularies tagged '%s' ..." tag) + (let* ((cmd `(:fuel* ((,tag fuel-get-vocabs/tag)) "fuel" t)) + (ret (fuel-eval--send/wait cmd)) + (res (fuel-eval--retort-result ret))) + (if (not res) + (message "No vocabularies tagged '%s'" tag) + (fuel-help--insert-contents (list tag tag 'tag) res) + (message "")))) + +(defun fuel-help--follow-link (link label type &optional no-cache) + (let* ((llink (list link label type)) + (cached (and (not no-cache) (fuel-help--cache-get llink)))) + (if (not cached) + (let ((fuel-help-always-ask nil)) + (cond ((eq type 'word) (fuel-help--word-help nil link)) + ((eq type 'article) (fuel-help--get-article link label)) + ((eq type 'vocab) (fuel-help--get-vocab link)) + ((eq type 'author) (fuel-help--get-vocab/author label)) + ((eq type 'tag) (fuel-help--get-vocab/tag label)) + ((eq type 'bookmarks) (fuel-help-display-bookmarks)) + (t (error "Links of type %s not yet implemented" type)))) + (fuel-help--insert-contents llink cached)))) + +(defun fuel-help--insert-contents (key content) + (let ((hb (fuel-help--buffer)) (inhibit-read-only t) (font-lock-verbose nil)) (set-buffer hb) (erase-buffer) - (insert str) - (goto-char (point-min)) - (when (re-search-forward (format "^%s" def) nil t) - (beginning-of-line) - (kill-region (point-min) (point)) - (next-line) - (open-line 1)) + (if (stringp content) + (insert content) + (fuel-markup--print content) + (fuel-markup--insert-newline) + (delete-blank-lines) + (fuel-help--cache-insert key (buffer-string))) + (fuel-help--history-push key) + (setq fuel-help--buffer-link key) (set-buffer-modified-p nil) - (unless nopush (fuel-help--history-push (cons def str))) - (pop-to-buffer hb) + (fuel-popup--display) (goto-char (point-min)) - (message "%s" def))) + (message ""))) + + +;;; Bookmarks: + +(defun fuel-help-bookmark-page () + "Add current help page to bookmarks." + (interactive) + (let ((link fuel-help--buffer-link)) + (unless link (error "No link associated to this page")) + (add-to-list 'fuel-help-bookmarks link) + (customize-save-variable 'fuel-help-bookmarks fuel-help-bookmarks) + (message "Bookmark '%s' saved" (cadr link)))) + +(defun fuel-help-delete-bookmark () + "Delete link at point from bookmarks." + (interactive) + (let ((link (fuel-markup--link-at-point))) + (unless link (error "No link at point")) + (unless (member link fuel-help-bookmarks) + (error "'%s' is not bookmarked" (cadr link))) + (customize-save-variable 'fuel-help-bookmarks + (remove link fuel-help-bookmarks)) + (message "Bookmark '%s' delete" (cadr link)) + (fuel-help-display-bookmarks))) + +(defun fuel-help-display-bookmarks () + "Display bookmarked pages." + (interactive) + (let ((links (mapcar (lambda (l) (cons '$subsection l)) fuel-help-bookmarks))) + (unless links (error "No links to display")) + (fuel-help--insert-contents '("bookmarks" "Bookmars" bookmarks) + `(article "Bookmarks" ,links)))) ;;; Interactive help commands: -(defun fuel-help-short (&optional arg) - "See a help summary of symbol at point. -By default, the information is shown in the minibuffer. When -called with a prefix argument, the information is displayed in a -separate help buffer." - (interactive "P") - (if (if fuel-help-use-minibuffer (not arg) arg) - (fuel-help--word-synopsis) - (fuel-help--show-help t))) +(defun fuel-help-short () + "See help summary of symbol at point." + (interactive) + (fuel-help--word-help t)) (defun fuel-help () "Show extended help about the symbol at point, using a help buffer." (interactive) - (fuel-help--show-help)) + (fuel-help--word-help)) + +(defun fuel-help-vocab (vocab) + "Ask for a vocabulary name and show its help page." + (interactive (list (fuel-edit--read-vocabulary-name nil))) + (fuel-help--get-vocab vocab)) + +(defun fuel-help-next (&optional forget-current) + "Go to next page in help browser. +With prefix, the current page is deleted from history." + (interactive "P") + (let ((item (fuel-help--history-next forget-current))) + (unless item (error "No next page")) + (apply 'fuel-help--follow-link item))) + +(defun fuel-help-previous (&optional forget-current) + "Go to previous page in help browser. +With prefix, the current page is deleted from history." + (interactive "P") + (let ((item (fuel-help--history-previous forget-current))) + (unless item (error "No previous page")) + (apply 'fuel-help--follow-link item))) + +(defun fuel-help-kill-page () + "Kill current page if a previous or next one exists." + (interactive) + (condition-case nil + (fuel-help-previous t) + (error (fuel-help-next t)))) -(defun fuel-help-next () - "Go to next page in help browser." +(defun fuel-help-refresh () + "Refresh the contents of current page." (interactive) - (let ((item (fuel-help--history-next)) - (fuel-help-always-ask nil)) - (unless item - (error "No next page")) - (fuel-help--insert-contents (car item) (cdr item) t))) - -(defun fuel-help-previous () - "Go to next page in help browser." + (when fuel-help--buffer-link + (apply 'fuel-help--follow-link (append fuel-help--buffer-link '(t))))) + +(defun fuel-help-clean-history () + "Clean up the help browser cache of visited pages." + (interactive) + (when (y-or-n-p "Clean browsing history? ") + (fuel-help--cache-clear) + (setq fuel-help--history (fuel-help--make-history)) + (fuel-help-refresh)) + (message "")) + +(defun fuel-help-edit () + "Edit the current article or word help." (interactive) - (let ((item (fuel-help--history-previous)) - (fuel-help-always-ask nil)) - (unless item - (error "No previous page")) - (fuel-help--insert-contents (car item) (cdr item) t))) + (let ((link (car fuel-help--buffer-link)) + (type (nth 2 fuel-help--buffer-link))) + (cond ((eq type 'word) (fuel-edit-word-doc-at-point nil link)) + ((member type '(article vocab)) (fuel-edit--edit-article link)) + (t (error "No document associated with this page"))))) -;;;; Factor help mode: +;;;; Help mode map: (defvar fuel-help-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-m" 'fuel-help) - (define-key map "q" 'bury-buffer) - (define-key map "b" 'fuel-help-previous) - (define-key map "f" 'fuel-help-next) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + (define-key map "a" 'fuel-apropos) + (define-key map "ba" 'fuel-help-bookmark-page) + (define-key map "bb" 'fuel-help-display-bookmarks) + (define-key map "bd" 'fuel-help-delete-bookmark) + (define-key map "c" 'fuel-help-clean-history) + (define-key map "e" 'fuel-help-edit) + (define-key map "h" 'fuel-help) + (define-key map "k" 'fuel-help-kill-page) + (define-key map "n" 'fuel-help-next) + (define-key map "l" 'fuel-help-previous) + (define-key map "p" 'fuel-help-previous) + (define-key map "r" 'fuel-help-refresh) + (define-key map "v" 'fuel-help-vocab) (define-key map (kbd "SPC") 'scroll-up) (define-key map (kbd "S-SPC") 'scroll-down) + (define-key map "\M-." 'fuel-edit-word-at-point) + (define-key map "\C-cz" 'run-factor) + (define-key map "\C-c\C-z" 'run-factor) map)) -(defconst fuel-help--headlines - (regexp-opt '("Class description" - "Definition" - "Errors" - "Examples" - "Generic word contract" - "Inputs and outputs" - "Methods" - "Notes" - "Parent topics:" - "See also" - "Syntax" - "Variable description" - "Variable value" - "Vocabulary" - "Warning" - "Word description") - t)) - -(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines)) - -(defconst fuel-help--font-lock-keywords - `(,@fuel-font-lock--font-lock-keywords - (,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines))) + +;;; IN: support + +(defun fuel-help--find-in () + (save-excursion + (or (fuel-syntax--find-in) + (and (goto-char (point-min)) + (re-search-forward "Vocabulary: \\(.+\\)$" nil t) + (match-string-no-properties 1))))) + + +;;; Help mode definition: (defun fuel-help-mode () "Major mode for browsing Factor documentation. \\{fuel-help-mode-map}" (interactive) (kill-all-local-variables) + (buffer-disable-undo) (use-local-map fuel-help-mode-map) - (setq mode-name "Factor Help") + (set-syntax-table fuel-syntax--syntax-table) + (setq mode-name "FUEL Help") (setq major-mode 'fuel-help-mode) - - (fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t) - - (setq fuel-autodoc-mode-string "") - (fuel-autodoc-mode) - - (run-mode-hooks 'fuel-help-mode-hook) - (toggle-read-only 1)) + (setq fuel-syntax--current-vocab-function 'fuel-help--find-in) + (setq fuel-markup--follow-link-function 'fuel-help--follow-link) + (setq buffer-read-only t)) (provide 'fuel-help) diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index c72f66b21c..d0898de04f 100644 --- a/misc/fuel/fuel-listener.el +++ b/misc/fuel/fuel-listener.el @@ -1,6 +1,6 @@ ;;; fuel-listener.el --- starting the fuel listener -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -13,23 +13,36 @@ ;;; Code: +(require 'fuel-stack) +(require 'fuel-completion) +(require 'fuel-xref) (require 'fuel-eval) +(require 'fuel-connection) +(require 'fuel-syntax) (require 'fuel-base) + (require 'comint) ;;; Customization: (defgroup fuel-listener nil - "Interacting with a Factor listener inside Emacs" + "Interacting with a Factor listener inside Emacs." :group 'fuel) -(defcustom fuel-listener-factor-binary "~/factor/factor" +(defcustom fuel-listener-factor-binary + (expand-file-name (cond ((eq system-type 'windows-nt) + "factor.exe") + ((eq system-type 'darwin) + "Factor.app/Contents/MacOS/factor") + (t "factor")) + fuel-factor-root-dir) "Full path to the factor executable to use when starting a listener." :type '(file :must-match t) :group 'fuel-listener) -(defcustom fuel-listener-factor-image "~/factor/factor.image" +(defcustom fuel-listener-factor-image + (expand-file-name "factor.image" fuel-factor-root-dir) "Full path to the factor image to use when starting a listener." :type '(file :must-match t) :group 'fuel-listener) @@ -49,29 +62,45 @@ buffer." ;;; Fuel listener buffer/process: -(defvar fuel-listener-buffer nil +(defvar fuel-listener--buffer nil "The buffer in which the Factor listener is running.") +(defun fuel-listener--buffer () + (if (buffer-live-p fuel-listener--buffer) + fuel-listener--buffer + (with-current-buffer (get-buffer-create "*fuel listener*") + (fuel-listener-mode) + (setq fuel-listener--buffer (current-buffer))))) + (defun fuel-listener--start-process () (let ((factor (expand-file-name fuel-listener-factor-binary)) - (image (expand-file-name fuel-listener-factor-image))) + (image (expand-file-name fuel-listener-factor-image)) + (comint-redirect-perform-sanity-check nil)) (unless (file-executable-p factor) (error "Could not run factor: %s is not executable" factor)) (unless (file-readable-p image) (error "Could not run factor: image file %s not readable" image)) - (setq fuel-listener-buffer (get-buffer-create "*fuel listener*")) - (with-current-buffer fuel-listener-buffer - (fuel-listener-mode) - (message "Starting FUEL listener ...") - (comint-exec fuel-listener-buffer "factor" - factor nil `("-run=fuel" ,(format "-i=%s" image))) - (fuel-listener--wait-for-prompt 20) - (fuel-eval--send/wait "USE: fuel") - (message "FUEL listener up and running!")))) + (message "Starting FUEL listener (this may take a while) ...") + (pop-to-buffer (fuel-listener--buffer)) + (make-comint-in-buffer "fuel listener" (current-buffer) factor nil + "-run=listener" (format "-i=%s" image)) + (fuel-listener--wait-for-prompt 10000) + (fuel-con--setup-connection (current-buffer)))) + +(defun fuel-listener--connect-process (port) + (message "Connecting to remote listener ...") + (pop-to-buffer (fuel-listener--buffer)) + (let ((process (get-buffer-process (current-buffer)))) + (when (or (not process) + (y-or-n-p "Kill current listener? ")) + (make-comint-in-buffer "fuel listener" (current-buffer) + (cons "localhost" port)) + (fuel-listener--wait-for-prompt 10000) + (fuel-con--setup-connection (current-buffer))))) (defun fuel-listener--process (&optional start) - (or (and (buffer-live-p fuel-listener-buffer) - (get-buffer-process fuel-listener-buffer)) + (or (and (buffer-live-p (fuel-listener--buffer)) + (get-buffer-process (fuel-listener--buffer))) (if (not start) (error "No running factor listener (try M-x run-factor)") (fuel-listener--start-process) @@ -79,25 +108,19 @@ buffer." (setq fuel-eval--default-proc-function 'fuel-listener--process) - -;;; Prompt chasing - -(defun fuel-listener--wait-for-prompt (&optional timeout) - (let ((proc (get-buffer-process fuel-listener-buffer))) - (with-current-buffer fuel-listener-buffer - (goto-char (or comint-last-input-end (point-min))) - (let ((seen (re-search-forward comint-prompt-regexp nil t))) - (while (and (not seen) - (accept-process-output proc (or timeout 10) nil t)) - (sleep-for 0 1) - (goto-char comint-last-input-end) - (setq seen (re-search-forward comint-prompt-regexp nil t))) - (pop-to-buffer fuel-listener-buffer) - (goto-char (point-max)) - (unless seen (error "No prompt found!")))))) +(defun fuel-listener--wait-for-prompt (timeout) + (let ((p (point)) (seen)) + (while (and (not seen) (> timeout 0)) + (sleep-for 0.1) + (setq timeout (- timeout 100)) + (goto-char p) + (setq seen (re-search-forward comint-prompt-regexp nil t))) + (goto-char (point-max)) + (unless seen (error "No prompt found!")))) + -;;; Interface: starting fuel listener +;;; Interface: starting and interacting with fuel listener: (defalias 'switch-to-factor 'run-factor) (defalias 'switch-to-fuel-listener 'run-factor) @@ -111,24 +134,85 @@ buffer." (pop-to-buffer buf) (switch-to-buffer buf)))) +(defun connect-to-factor (&optional arg) + "Connects to a remote listener running in the same host. +Without prefix argument, the default port, 9000, is used. +Otherwise, you'll be prompted for it. To make this work, in the +remote listener you need to issue the words +'fuel-start-remote-listener*' or 'port +fuel-start-remote-listener', from the fuel vocabulary." + (interactive "P") + (let ((port (if (not arg) 9000 (read-number "Port: ")))) + (fuel-listener--connect-process port))) + +(defun fuel-listener-nuke () + "Try this command if the listener becomes unresponsive." + (interactive) + (goto-char (point-max)) + (comint-kill-region comint-last-input-start (point)) + (comint-redirect-cleanup) + (fuel-con--setup-connection fuel-listener--buffer)) + +(defun fuel-refresh-all () + "Switch to the listener buffer and invokes Factor's refresh-all. +With prefix, you're teletransported to the listener's buffer." + (interactive) + (let ((buf (process-buffer (fuel-listener--process)))) + (pop-to-buffer buf) + (comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush") + (comint-send-string nil " refresh-all \"Done!\" write nl flush\n"))) + + +;;; Completion support + +(defsubst fuel-listener--current-vocab () nil) +(defsubst fuel-listener--usings () nil) + +(defun fuel-listener--setup-completion () + (setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab) + (setq fuel-syntax--usings-function 'fuel-listener--usings)) + + +;;; Stack mode support + +(defun fuel-listener--stack-region () + (fuel--region-to-string (if (zerop (fuel-syntax--brackets-depth)) + (comint-line-beginning-position) + (1+ (fuel-syntax--brackets-start))))) + +(defun fuel-listener--setup-stack-mode () + (setq fuel-stack--region-function 'fuel-listener--stack-region)) + ;;; Fuel listener mode: -(defconst fuel-listener--prompt-regex "( [^)]* ) ") +(defun fuel-listener--bol () + (interactive) + (when (= (point) (comint-bol)) (beginning-of-line))) +;;;###autoload (define-derived-mode fuel-listener-mode comint-mode "Fuel Listener" "Major mode for interacting with an inferior Factor listener process. \\{fuel-listener-mode-map}" - (set (make-local-variable 'comint-prompt-regexp) - fuel-listener--prompt-regex) + (set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex) + (set (make-local-variable 'comint-use-prompt-regexp) t) (set (make-local-variable 'comint-prompt-read-only) t) - (setq fuel-listener--compilation-begin nil)) + (fuel-listener--setup-completion) + (fuel-listener--setup-stack-mode)) (define-key fuel-listener-mode-map "\C-cz" 'run-factor) (define-key fuel-listener-mode-map "\C-c\C-z" 'run-factor) +(define-key fuel-listener-mode-map "\C-a" 'fuel-listener--bol) +(define-key fuel-listener-mode-map "\C-ca" 'fuel-autodoc-mode) (define-key fuel-listener-mode-map "\C-ch" 'fuel-help) +(define-key fuel-listener-mode-map "\C-cr" 'fuel-refresh-all) +(define-key fuel-listener-mode-map "\C-cs" 'fuel-stack-mode) +(define-key fuel-listener-mode-map "\C-cp" 'fuel-apropos) (define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point) +(define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary) +(define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary) (define-key fuel-listener-mode-map "\C-ck" 'fuel-run-file) +(define-key fuel-listener-mode-map (kbd "TAB") 'fuel-completion--complete-symbol) (provide 'fuel-listener) diff --git a/misc/fuel/fuel-log.el b/misc/fuel/fuel-log.el new file mode 100644 index 0000000000..fee762d09a --- /dev/null +++ b/misc/fuel/fuel-log.el @@ -0,0 +1,77 @@ +;;; fuel-log.el -- logging utilities + +;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Sun Dec 14, 2008 01:00 + +;;; Comentary: + +;; Some utilities for maintaining a simple log buffer, mainly for +;; debugging purposes. + +;;; Code: + +(require 'fuel-base) + + +;;; Customization: + +(defvar fuel-log--buffer-name "*fuel messages*" + "Name of the log buffer") + +(defvar fuel-log--max-buffer-size 32000 + "Maximum size of the Factor messages log") + +(defvar fuel-log--max-message-size 512 + "Maximum size of individual log messages") + +(defvar fuel-log--verbose-p t + "Log level for Factor messages") + +(defvar fuel-log--inhibit-p nil + "Set this to t to inhibit all log messages") + +(define-derived-mode factor-messages-mode fundamental-mode "FUEL Messages" + "Simple mode to log interactions with the factor listener" + (kill-all-local-variables) + (buffer-disable-undo) + (set (make-local-variable 'comint-redirect-subvert-readonly) t) + (add-hook 'after-change-functions + '(lambda (b e len) + (let ((inhibit-read-only t)) + (when (> b fuel-log--max-buffer-size) + (delete-region (point-min) b)))) + nil t) + (setq buffer-read-only t)) + +(defun fuel-log--buffer () + (or (get-buffer fuel-log--buffer-name) + (save-current-buffer + (set-buffer (get-buffer-create fuel-log--buffer-name)) + (factor-messages-mode) + (current-buffer)))) + +(defun fuel-log--msg (type &rest args) + (unless fuel-log--inhibit-p + (with-current-buffer (fuel-log--buffer) + (let ((inhibit-read-only t)) + (insert + (fuel--shorten-str (format "\n%s: %s\n" type (apply 'format args)) + fuel-log--max-message-size)))))) + +(defsubst fuel-log--warn (&rest args) + (apply 'fuel-log--msg 'WARNING args)) + +(defsubst fuel-log--error (&rest args) + (apply 'fuel-log--msg 'ERROR args)) + +(defsubst fuel-log--info (&rest args) + (when fuel-log--verbose-p + (apply 'fuel-log--msg 'INFO args) "")) + + +(provide 'fuel-log) +;;; fuel-log.el ends here diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el new file mode 100644 index 0000000000..7a8fa0c234 --- /dev/null +++ b/misc/fuel/fuel-markup.el @@ -0,0 +1,602 @@ +;;; fuel-markup.el -- printing factor help markup + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Thu Jan 01, 2009 21:43 + +;;; Comentary: + +;; Utilities for printing Factor's help markup. + +;;; Code: + +(require 'fuel-eval) +(require 'fuel-font-lock) +(require 'fuel-base) +(require 'fuel-table) + +(require 'button) + + +;;; Customization: + +(fuel-font-lock--defface fuel-font-lock-markup-title + 'bold fuel-help "article titles in help buffers") + +(fuel-font-lock--defface fuel-font-lock-markup-heading + 'bold fuel-help "headlines in help buffers") + +(fuel-font-lock--defface fuel-font-lock-markup-link + 'link fuel-help "links to topics in help buffers") + +(fuel-font-lock--defface fuel-font-lock-markup-emphasis + 'italic fuel-help "emphasized words in help buffers") + +(fuel-font-lock--defface fuel-font-lock-markup-strong + 'link fuel-help "bold words in help buffers") + + +;;; Links: + +(make-variable-buffer-local + (defvar fuel-markup--follow-link-function 'fuel-markup--echo-link)) + +(define-button-type 'fuel-markup--button + 'action 'fuel-markup--follow-link + 'face 'fuel-font-lock-markup-link + 'follow-link t) + +(defun fuel-markup--follow-link (button) + (when fuel-markup--follow-link-function + (funcall fuel-markup--follow-link-function + (button-get button 'markup-link) + (button-get button 'markup-label) + (button-get button 'markup-link-type)))) + +(defun fuel-markup--echo-link (link label type) + (message "Link %s pointing to %s named %s" label type link)) + +(defun fuel-markup--insert-button (label link type) + (let ((label (format "%s" label)) + (link (if (listp link) link (format "%s" link)))) + (insert-text-button label + :type 'fuel-markup--button + 'markup-link link + 'markup-label label + 'markup-link-type type + 'help-echo (format "%s (%s)" label type)))) + +(defun fuel-markup--article-title (name) + (let ((name (if (listp name) (cons :seq name) name))) + (fuel-eval--retort-result + (fuel-eval--send/wait `(:fuel* ((,name fuel-get-article-title)) "fuel"))))) + +(defun fuel-markup--link-at-point () + (let ((button (condition-case nil (forward-button 0) (error nil)))) + (when button + (list (button-get button 'markup-link) + (button-get button 'markup-label) + (button-get button 'markup-link-type))))) + + +;;; Markup printers: + +(defconst fuel-markup--printers + '(($all-tags . fuel-markup--all-tags) + ($all-authors . fuel-markup--all-authors) + ($author . fuel-markup--author) + ($authors . fuel-markup--authors) + ($class-description . fuel-markup--class-description) + ($code . fuel-markup--code) + ($command . fuel-markup--command) + ($command-map . fuel-markup--null) + ($contract . fuel-markup--contract) + ($curious . fuel-markup--curious) + ($definition . fuel-markup--definition) + ($describe-vocab . fuel-markup--describe-vocab) + ($description . fuel-markup--description) + ($doc-path . fuel-markup--doc-path) + ($emphasis . fuel-markup--emphasis) + ($error-description . fuel-markup--error-description) + ($errors . fuel-markup--errors) + ($example . fuel-markup--example) + ($examples . fuel-markup--examples) + ($heading . fuel-markup--heading) + ($index . fuel-markup--index) + ($instance . fuel-markup--instance) + ($io-error . fuel-markup--io-error) + ($link . fuel-markup--link) + ($links . fuel-markup--links) + ($list . fuel-markup--list) + ($low-level-note . fuel-markup--low-level-note) + ($markup-example . fuel-markup--markup-example) + ($maybe . fuel-markup--maybe) + ($methods . fuel-markup--methods) + ($nl . fuel-markup--newline) + ($notes . fuel-markup--notes) + ($operation . fuel-markup--link) + ($parsing-note . fuel-markup--parsing-note) + ($predicate . fuel-markup--predicate) + ($prettyprinting-note . fuel-markup--prettyprinting-note) + ($quotation . fuel-markup--quotation) + ($references . fuel-markup--references) + ($related . fuel-markup--related) + ($see . fuel-markup--see) + ($see-also . fuel-markup--see-also) + ($shuffle . fuel-markup--shuffle) + ($side-effects . fuel-markup--side-effects) + ($slot . fuel-markup--snippet) + ($snippet . fuel-markup--snippet) + ($strong . fuel-markup--strong) + ($subheading . fuel-markup--subheading) + ($subsection . fuel-markup--subsection) + ($synopsis . fuel-markup--synopsis) + ($syntax . fuel-markup--syntax) + ($table . fuel-markup--table) + ($tag . fuel-markup--tag) + ($tags . fuel-markup--tags) + ($unchecked-example . fuel-markup--example) + ($value . fuel-markup--value) + ($values . fuel-markup--values) + ($values-x/y . fuel-markup--values-x/y) + ($var-description . fuel-markup--var-description) + ($vocab-link . fuel-markup--vocab-link) + ($vocab-links . fuel-markup--vocab-links) + ($vocab-subsection . fuel-markup--vocab-subsection) + ($vocabulary . fuel-markup--vocabulary) + ($warning . fuel-markup--warning) + (article . fuel-markup--article) + (describe-words . fuel-markup--describe-words) + (vocab-list . fuel-markup--vocab-list))) + +(make-variable-buffer-local + (defvar fuel-markup--maybe-nl nil)) + +(defun fuel-markup--print (e) + (cond ((null e) (insert "f")) + ((stringp e) (fuel-markup--insert-string e)) + ((and (listp e) (symbolp (car e)) + (assoc (car e) fuel-markup--printers)) + (funcall (cdr (assoc (car e) fuel-markup--printers)) e)) + ((and (symbolp e) + (assoc e fuel-markup--printers)) + (funcall (cdr (assoc e fuel-markup--printers)) e)) + ((listp e) (mapc 'fuel-markup--print e)) + ((symbolp e) (fuel-markup--print (list '$link e))) + (t (insert (format "\n%S\n" e))))) + +(defun fuel-markup--print-str (e) + (with-temp-buffer + (fuel-markup--print e) + (buffer-string))) + +(defun fuel-markup--maybe-nl () + (setq fuel-markup--maybe-nl (point))) + +(defun fuel-markup--insert-newline (&optional justification nosqueeze) + (fill-region (save-excursion (beginning-of-line) (point)) + (point) + (or justification 'left) + nosqueeze) + (newline)) + +(defsubst fuel-markup--insert-nl-if-nb (&optional no-fill) + (unless (eq (save-excursion (beginning-of-line) (point)) (point)) + (if no-fill (newline) (fuel-markup--insert-newline)))) + +(defsubst fuel-markup--put-face (txt face) + (put-text-property 0 (length txt) 'font-lock-face face txt) + txt) + +(defun fuel-markup--insert-heading (txt &optional no-nl) + (fuel-markup--insert-nl-if-nb) + (delete-blank-lines) + (unless (bobp) (newline)) + (fuel-markup--put-face txt 'fuel-font-lock-markup-heading) + (fuel-markup--insert-string txt) + (unless no-nl (newline))) + +(defun fuel-markup--insert-string (str) + (when fuel-markup--maybe-nl + (newline 2) + (setq fuel-markup--maybe-nl nil)) + (insert str)) + +(defun fuel-markup--article (e) + (setq fuel-markup--maybe-nl nil) + (insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title)) + (newline 2) + (fuel-markup--print (car (cddr e)))) + +(defun fuel-markup--heading (e) + (fuel-markup--insert-heading (cadr e))) + +(defun fuel-markup--subheading (e) + (fuel-markup--insert-heading (cadr e))) + +(defun fuel-markup--subsection (e) + (fuel-markup--insert-nl-if-nb) + (insert " - ") + (fuel-markup--link (cons '$link (cdr e))) + (fuel-markup--maybe-nl)) + +(defun fuel-markup--vocab-subsection (e) + (fuel-markup--insert-nl-if-nb) + (insert " - ") + (fuel-markup--vocab-link (cons '$vocab-link (cdr e))) + (fuel-markup--maybe-nl)) + +(defun fuel-markup--newline (e) + (fuel-markup--insert-newline) + (newline)) + +(defun fuel-markup--doc-path (e) + (fuel-markup--insert-heading "Related topics") + (insert " ") + (dolist (art (cdr e)) + (fuel-markup--insert-button (car art) (cadr art) 'article) + (insert ", ")) + (delete-backward-char 2) + (fuel-markup--insert-newline 'left)) + +(defun fuel-markup--emphasis (e) + (when (stringp (cadr e)) + (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-emphasis) + (insert (cadr e)))) + +(defun fuel-markup--strong (e) + (when (stringp (cadr e)) + (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-strong) + (insert (cadr e)))) + +(defun fuel-markup--snippet (e) + (insert (mapconcat '(lambda (s) + (if (stringp s) + (fuel-font-lock--factor-str s) + (fuel-markup--print-str s))) + (cdr e) + " "))) + +(defun fuel-markup--code (e) + (fuel-markup--insert-nl-if-nb) + (newline) + (dolist (snip (cdr e)) + (if (stringp snip) + (insert (fuel-font-lock--factor-str snip)) + (fuel-markup--print snip)) + (newline)) + (newline)) + +(defun fuel-markup--command (e) + (fuel-markup--snippet (list '$snippet (nth 3 e)))) + +(defun fuel-markup--syntax (e) + (fuel-markup--insert-heading "Syntax") + (fuel-markup--print (cons '$code (cdr e))) + (newline)) + +(defun fuel-markup--example (e) + (fuel-markup--insert-newline) + (dolist (s (cdr e)) + (fuel-markup--snippet (list '$snippet s)) + (newline))) + +(defun fuel-markup--markup-example (e) + (fuel-markup--insert-newline) + (fuel-markup--snippet (cons '$snippet (cdr e)))) + +(defun fuel-markup--link (e) + (let* ((link (or (nth 1 e) 'f)) + (type (or (nth 3 e) (if (symbolp link) 'word 'article))) + (label (or (nth 2 e) + (and (eq type 'article) + (fuel-markup--article-title link)) + link))) + (fuel-markup--insert-button label link type))) + +(defun fuel-markup--links (e) + (dolist (link (cdr e)) + (fuel-markup--link (list '$link link)) + (insert ", ")) + (delete-backward-char 2)) + +(defun fuel-markup--index-quotation (q) + (cond ((null q) null) + ((listp q) (vconcat (mapcar 'fuel-markup--index-quotation q))) + (t q))) + +(defun fuel-markup--index (e) + (let* ((q (fuel-markup--index-quotation (cadr e))) + (cmd `(:fuel* ((,q fuel-index)) "fuel" + ("builtins" "help" "help.topics" "classes" + "classes.builtin" "classes.tuple" + "classes.singleton" "classes.union" + "classes.intersection" "classes.predicate"))) + (subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200)))) + (when subs + (let ((start (point)) + (sort-fold-case nil)) + (fuel-markup--print subs) + (sort-lines nil start (point)))))) + +(defun fuel-markup--vocab-link (e) + (fuel-markup--insert-button (cadr e) (cadr e) 'vocab)) + +(defun fuel-markup--vocab-links (e) + (dolist (link (cdr e)) + (insert " ") + (fuel-markup--vocab-link (list '$vocab-link link)) + (insert " "))) + +(defun fuel-markup--vocab-list (e) + (let ((rows (mapcar '(lambda (elem) + (list (car elem) + (list '$vocab-link (cadr elem)) + (caddr elem))) + (cdr e)))) + (fuel-markup--table (cons '$table rows)))) + +(defun fuel-markup--describe-vocab (e) + (fuel-markup--insert-nl-if-nb) + (let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t)) + (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (when res (fuel-markup--print res)))) + +(defun fuel-markup--vocabulary (e) + (fuel-markup--insert-heading "Vocabulary: " t) + (fuel-markup--vocab-link (cons '$vocab-link (cdr e))) + (newline)) + +(defun fuel-markup--parse-classes () + (let ((elems)) + (while (looking-at ".+ classes$") + (let ((heading `($heading ,(match-string-no-properties 0))) + (rows)) + (forward-line) + (when (looking-at "Class *.+$") + (push (split-string (match-string-no-properties 0) nil t) rows) + (forward-line)) + (while (not (looking-at "$")) + (let* ((objs (split-string (thing-at-point 'line) nil t)) + (class (list '$link (car objs) (car objs) 'word)) + (super (and (cadr objs) + (list (list '$link (cadr objs) (cadr objs) 'word)))) + (slots (when (cddr objs) + (list (mapcar '(lambda (s) (list s " ")) (cddr objs)))))) + (push `(,class ,@super ,@slots) rows)) + (forward-line)) + (push `(,heading ($table ,@(reverse rows))) elems)) + (forward-line)) + (reverse elems))) + +(defun fuel-markup--parse-words () + (let ((elems)) + (while (looking-at ".+ words\\|Primitives$") + (let ((heading `($heading ,(match-string-no-properties 0))) + (rows)) + (forward-line) + (when (looking-at "Word *\\(Stack effect\\|Syntax\\)$") + (push (list "Word" (match-string-no-properties 1)) rows) + (forward-line)) + (while (looking-at "\\(.+?\\)\\( +\\(.+\\)\\)?$") + (let ((word `($link ,(match-string-no-properties 1) + ,(match-string-no-properties 1) + word)) + (se (and (match-string-no-properties 3) + `(($snippet ,(match-string-no-properties 3)))))) + (push `(,word ,@se) rows)) + (forward-line)) + (push `(,heading ($table ,@(reverse rows))) elems)) + (forward-line)) + (reverse elems))) + +(defun fuel-markup--parse-words-desc (desc) + (with-temp-buffer + (insert desc) + (goto-char (point-min)) + (when (re-search-forward "^Words$" nil t) + (forward-line 2) + (let ((elems '(($heading "Words")))) + (push (fuel-markup--parse-classes) elems) + (push (fuel-markup--parse-words) elems) + (reverse elems))))) + +(defun fuel-markup--describe-words (e) + (when (cadr e) + (fuel-markup--print (fuel-markup--parse-words-desc (cadr e))))) + +(defun fuel-markup--tag (e) + (fuel-markup--link (list '$link (cadr e) (cadr e) 'tag))) + +(defun fuel-markup--tags (e) + (when (cdr e) + (fuel-markup--insert-heading "Tags: " t) + (dolist (tag (cdr e)) + (fuel-markup--tag (list '$tag tag)) + (insert ", ")) + (delete-backward-char 2) + (fuel-markup--insert-newline))) + +(defun fuel-markup--all-tags (e) + (let* ((cmd `(:fuel* (all-tags :get) "fuel" t)) + (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (fuel-markup--list + (cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags))))) + +(defun fuel-markup--author (e) + (fuel-markup--link (list '$link (cadr e) (cadr e) 'author))) + +(defun fuel-markup--authors (e) + (when (cdr e) + (fuel-markup--insert-heading "Authors: " t) + (dolist (a (cdr e)) + (fuel-markup--author (list '$author a)) + (insert ", ")) + (delete-backward-char 2) + (fuel-markup--insert-newline))) + +(defun fuel-markup--all-authors (e) + (let* ((cmd `(:fuel* (all-authors :get) "fuel" t)) + (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (fuel-markup--list + (cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors))))) + +(defun fuel-markup--list (e) + (fuel-markup--insert-nl-if-nb) + (dolist (elt (cdr e)) + (insert " - ") + (fuel-markup--print elt) + (fuel-markup--insert-newline))) + +(defun fuel-markup--table (e) + (fuel-markup--insert-newline) + (delete-blank-lines) + (newline) + (fuel-table--insert + (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e))) + (newline)) + +(defun fuel-markup--instance (e) + (insert " an instance of ") + (fuel-markup--print (cadr e))) + +(defun fuel-markup--maybe (e) + (fuel-markup--instance (cons '$instance (cdr e))) + (insert " or f ")) + +(defun fuel-markup--values (e) + (fuel-markup--insert-heading "Inputs and outputs") + (dolist (val (cdr e)) + (insert " " (car val) " - ") + (fuel-markup--print (cdr val)) + (newline))) + +(defun fuel-markup--predicate (e) + (fuel-markup--values '($values ("object" object) ("?" "a boolean"))) + (let ((word (make-symbol (substring (format "%s" (cadr e)) 0 -1)))) + (fuel-markup--description + `($description "Tests if the object is an instance of the " + ($link ,word) " class.")))) + +(defun fuel-markup--side-effects (e) + (fuel-markup--insert-heading "Side effects") + (insert "Modifies ") + (fuel-markup--print (cdr e)) + (fuel-markup--insert-newline)) + +(defun fuel-markup--definition (e) + (fuel-markup--insert-heading "Definition") + (fuel-markup--code (cons '$code (cdr e)))) + +(defun fuel-markup--methods (e) + (fuel-markup--insert-heading "Methods") + (fuel-markup--code (cons '$code (cdr e)))) + +(defun fuel-markup--value (e) + (fuel-markup--insert-heading "Variable value") + (insert "Current value in global namespace: ") + (fuel-markup--snippet (cons '$snippet (cdr e))) + (newline)) + +(defun fuel-markup--values-x/y (e) + (fuel-markup--values '($values ("x" "number") ("y" "number")))) + +(defun fuel-markup--curious (e) + (fuel-markup--insert-heading "For the curious...") + (fuel-markup--print (cdr e))) + +(defun fuel-markup--references (e) + (fuel-markup--insert-heading "References") + (dolist (ref (cdr e)) + (if (listp ref) + (fuel-markup--print ref) + (fuel-markup--subsection (list '$subsection ref))))) + +(defun fuel-markup--see-also (e) + (fuel-markup--insert-heading "See also") + (fuel-markup--links (cons '$links (cdr e)))) + +(defun fuel-markup--related (e) + (fuel-markup--insert-heading "See also") + (fuel-markup--links (cons '$links (cadr e)))) + +(defun fuel-markup--shuffle (e) + (insert "\nShuffle word. Re-arranges the stack " + "according to the stack effect pattern.") + (fuel-markup--insert-newline)) + +(defun fuel-markup--low-level-note (e) + (fuel-markup--print '($notes "Calling this word directly is not necessary " + "in most cases. " + "Higher-level words call it automatically."))) + +(defun fuel-markup--parsing-note (e) + (fuel-markup--insert-nl-if-nb) + (insert "This word should only be called from parsing words.") + (fuel-markup--insert-newline)) + +(defun fuel-markup--io-error (e) + (fuel-markup--errors '($errors "Throws an error if the I/O operation fails."))) + +(defun fuel-markup--prettyprinting-note (e) + (fuel-markup--print '($notes ("This word should only be called within the " + ($link with-pprint) " combinator.")))) + +(defun fuel-markup--elem-with-heading (elem heading) + (fuel-markup--insert-heading heading) + (fuel-markup--print (cdr elem)) + (fuel-markup--insert-newline)) + +(defun fuel-markup--quotation (e) + (insert "a ") + (fuel-markup--link (list '$link 'quotation 'quotation 'word)) + (insert " with stack effect ") + (fuel-markup--snippet (list '$snippet (nth 1 e)))) + +(defun fuel-markup--warning (e) + (fuel-markup--elem-with-heading e "Warning")) + +(defun fuel-markup--description (e) + (fuel-markup--elem-with-heading e "Word description")) + +(defun fuel-markup--class-description (e) + (fuel-markup--elem-with-heading e "Class description")) + +(defun fuel-markup--error-description (e) + (fuel-markup--elem-with-heading e "Error description")) + +(defun fuel-markup--var-description (e) + (fuel-markup--elem-with-heading e "Variable description")) + +(defun fuel-markup--contract (e) + (fuel-markup--elem-with-heading e "Generic word contract")) + +(defun fuel-markup--errors (e) + (fuel-markup--elem-with-heading e "Errors")) + +(defun fuel-markup--examples (e) + (fuel-markup--elem-with-heading e "Examples")) + +(defun fuel-markup--notes (e) + (fuel-markup--elem-with-heading e "Notes")) + +(defun fuel-markup--see (e) + (let* ((word (nth 1 e)) + (cmd (and word `(:fuel* (,(format "%s" word) fuel-word-see) "fuel" t))) + (res (and cmd + (fuel-eval--retort-result (fuel-eval--send/wait cmd 100))))) + (if res + (fuel-markup--code (list '$code res)) + (fuel-markup--snippet (list '$snippet word))))) + +(defun fuel-markup--null (e)) + +(defun fuel-markup--synopsis (e) + (insert (format " %S " e))) + + +(provide 'fuel-markup) +;;; fuel-markup.el ends here diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index feaea1548e..88ad73864a 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -1,6 +1,6 @@ ;;; fuel-mode.el -- Minor mode enabling FUEL niceties -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -14,14 +14,20 @@ ;;; Code: -(require 'factor-mode) -(require 'fuel-base) -(require 'fuel-syntax) -(require 'fuel-font-lock) +(require 'fuel-listener) +(require 'fuel-completion) (require 'fuel-debug) -(require 'fuel-help) +(require 'fuel-debug-uses) (require 'fuel-eval) -(require 'fuel-listener) +(require 'fuel-help) +(require 'fuel-xref) +(require 'fuel-refactor) +(require 'fuel-stack) +(require 'fuel-autodoc) +(require 'fuel-font-lock) +(require 'fuel-edit) +(require 'fuel-syntax) +(require 'fuel-base) ;;; Customization: @@ -31,54 +37,75 @@ :group 'fuel) (defcustom fuel-mode-autodoc-p t - "Whether `fuel-autodoc-mode' gets enable by default in fuel buffers." + "Whether `fuel-autodoc-mode' gets enabled by default in factor buffers." :group 'fuel-mode + :group 'fuel-autodoc + :type 'boolean) + +(defcustom fuel-mode-stack-p nil + "Whether `fuel-stack-mode' gets enabled by default in factor buffers." + :group 'fuel-mode + :group 'fuel-stack :type 'boolean) ;;; User commands -(defun fuel-run-file (&optional arg) - "Sends the current file to Factor for compilation. -With prefix argument, ask for the file to run." - (interactive "P") +(defun fuel-mode--read-file (arg) (let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t)) (buffer-file-name))) (file (expand-file-name file)) (buffer (find-file-noselect file))) + (when (and buffer + (buffer-modified-p buffer) + (y-or-n-p "Save file? ")) + (save-buffer buffer)) + (cons file buffer))) + +(defun fuel-run-file (&optional arg) + "Sends the current file to Factor for compilation. +With prefix argument, ask for the file to run." + (interactive "P") + (let* ((f/b (fuel-mode--read-file arg)) + (file (car f/b)) + (buffer (cdr f/b))) (when buffer (with-current-buffer buffer - (message "Compiling %s ..." file) - (fuel-eval--send (fuel-eval--cmd/string (format "%S fuel-run-file" file)) - `(lambda (r) (fuel--run-file-cont r ,file))))))) + (let ((msg (format "Compiling %s ..." file))) + (fuel-debug--prepare-compilation file msg) + (message msg) + (fuel-eval--send `(:fuel (,file fuel-run-file)) + `(lambda (r) (fuel--run-file-cont r ,file)))))))) (defun fuel--run-file-cont (ret file) - (if (fuel-debug--display-retort ret - (format "%s successfully compiled" file) - nil - file) + (if (fuel-debug--display-retort ret (format "%s successfully compiled" file)) (message "Compiling %s ... OK!" file) (message ""))) (defun fuel-eval-region (begin end &optional arg) "Sends region to Fuel's listener for evaluation. -Unless called with a prefix, switchs to the compilation results +Unless called with a prefix, switches to the compilation results buffer in case of errors." (interactive "r\nP") - (fuel-debug--display-retort - (fuel-eval--send/wait (fuel-eval--cmd/region begin end) 10000) - (format "%s%s" - (if fuel-syntax--current-vocab - (format "IN: %s " fuel-syntax--current-vocab) - "") - (fuel--shorten-region begin end 70)) - arg - (buffer-file-name))) + (let* ((rstr (buffer-substring begin end)) + (lines (split-string (substring-no-properties rstr) + "[\f\n\r\v]+" + t)) + (cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines)))) + (cv (fuel-syntax--current-vocab))) + (fuel-debug--prepare-compilation (buffer-file-name) + (format "Evaluating:\n\n%s" rstr)) + (fuel-debug--display-retort + (fuel-eval--send/wait cmd 10000) + (format "%s%s" + (if cv (format "IN: %s " cv) "") + (fuel--shorten-region begin end 70)) + arg))) (defun fuel-eval-extended-region (begin end &optional arg) - "Sends region extended outwards to nearest definitions, + "Sends region, extended outwards to nearest definition, to Fuel's listener for evaluation. -Unless called with a prefix, switchs to the compilation results +Unless called with a prefix, switches to the compilation results buffer in case of errors." (interactive "r\nP") (fuel-eval-region (save-excursion (goto-char begin) (mark-defun) (point)) @@ -87,7 +114,7 @@ buffer in case of errors." (defun fuel-eval-definition (&optional arg) "Sends definition around point to Fuel's listener for evaluation. -Unless called with a prefix, switchs to the compilation results +Unless called with a prefix, switches to the compilation results buffer in case of errors." (interactive "P") (save-excursion @@ -97,29 +124,13 @@ buffer in case of errors." (unless (< begin end) (error "No evaluable definition around point")) (fuel-eval-region begin end arg)))) -(defun fuel-edit-word-at-point (&optional arg) - "Opens a new window visiting the definition of the word at point. -With prefix, asks for the word to edit." +(defun fuel-update-usings (&optional arg) + "Asks factor for the vocabularies needed by this file, +optionally updating the its USING: line. +With prefix argument, ask for the file name." (interactive "P") - (let* ((word (fuel-syntax-symbol-at-point)) - (ask (or arg (not word))) - (word (if ask - (read-string nil - (format "Edit word%s: " - (if word (format " (%s)" word) "")) - word) - word))) - (let* ((str (fuel-eval--cmd/string - (format "\\ %s fuel-get-edit-location" word))) - (ret (fuel-eval--send/wait str)) - (err (fuel-eval--retort-error ret)) - (loc (fuel-eval--retort-result ret))) - (when (or err (not loc) (not (listp loc)) (not (stringp (car loc)))) - (error "Couldn't find edit location for '%s'" word)) - (unless (file-readable-p (car loc)) - (error "Couldn't open '%s' for read" (car loc))) - (find-file-other-window (car loc)) - (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))) + (let ((file (car (fuel-mode--read-file arg)))) + (when file (fuel-debug--uses-for-file file)))) ;;; Minor mode definition: @@ -146,7 +157,10 @@ interacting with a factor listener is at your disposal. :keymap fuel-mode-map (setq fuel-autodoc-mode-string "/A") - (when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode))) + (when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode)) + + (setq fuel-stack-mode-string "/S") + (when fuel-mode-stack-p (fuel-stack-mode fuel-mode))) ;;; Keys: @@ -159,24 +173,44 @@ interacting with a factor listener is at your disposal. (define-key fuel-mode-map (vector '(control ?c) `(control ,p) k) c) (define-key fuel-mode-map (vector '(control ?c) `(control ,p) `(control ,k)) c)) -(fuel-mode--key-1 ?z 'run-factor) - (fuel-mode--key-1 ?k 'fuel-run-file) -(fuel-mode--key ?e ?k 'fuel-run-file) +(fuel-mode--key-1 ?l 'fuel-run-file) +(fuel-mode--key-1 ?r 'fuel-refresh-all) +(fuel-mode--key-1 ?z 'run-factor) +(fuel-mode--key-1 ?s 'fuel-switch-to-buffer) +(define-key fuel-mode-map "\C-x4s" 'fuel-switch-to-buffer-other-window) +(define-key fuel-mode-map "\C-x5s" 'fuel-switch-to-buffer-other-frame) (define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition) -(fuel-mode--key ?e ?x 'fuel-eval-definition) - -(fuel-mode--key-1 ?r 'fuel-eval-region) -(fuel-mode--key ?e ?r 'fuel-eval-region) - (define-key fuel-mode-map "\C-\M-r" 'fuel-eval-extended-region) +(define-key fuel-mode-map "\M-." 'fuel-edit-word-at-point) +(define-key fuel-mode-map "\M-," 'fuel-edit-pop-edit-word-stack) +(define-key fuel-mode-map "\C-c\M-<" 'fuel-show-callers) +(define-key fuel-mode-map "\C-c\M->" 'fuel-show-callees) +(define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol) + +(fuel-mode--key ?e ?d 'fuel-edit-word-doc-at-point) (fuel-mode--key ?e ?e 'fuel-eval-extended-region) +(fuel-mode--key ?e ?l 'fuel-run-file) +(fuel-mode--key ?e ?r 'fuel-eval-region) +(fuel-mode--key ?e ?u 'fuel-update-usings) +(fuel-mode--key ?e ?v 'fuel-edit-vocabulary) +(fuel-mode--key ?e ?w 'fuel-edit-word) +(fuel-mode--key ?e ?x 'fuel-eval-definition) -(define-key fuel-mode-map "\M-." 'fuel-edit-word-at-point) +(fuel-mode--key ?x ?i 'fuel-refactor-inline-word) +(fuel-mode--key ?x ?r 'fuel-refactor-extract-region) +(fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp) +(fuel-mode--key ?x ?v 'fuel-refactor-extract-vocab) +(fuel-mode--key ?x ?w 'fuel-refactor-rename-word) +(fuel-mode--key ?d ?> 'fuel-show-callees) +(fuel-mode--key ?d ?< 'fuel-show-callers) +(fuel-mode--key ?d ?v 'fuel-show-file-words) (fuel-mode--key ?d ?a 'fuel-autodoc-mode) +(fuel-mode--key ?d ?p 'fuel-apropos) (fuel-mode--key ?d ?d 'fuel-help) +(fuel-mode--key ?d ?e 'fuel-stack-effect-sexp) (fuel-mode--key ?d ?s 'fuel-help-short) diff --git a/misc/fuel/fuel-popup.el b/misc/fuel/fuel-popup.el new file mode 100644 index 0000000000..b8a967d3b0 --- /dev/null +++ b/misc/fuel/fuel-popup.el @@ -0,0 +1,69 @@ +;;; fuel-popup.el -- popup windows + +;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Sun Dec 21, 2008 14:37 + +;;; Comentary: + +;; A minor mode to pop up windows and restore configurations +;; afterwards. + +;;; Code: + +(make-variable-buffer-local + (defvar fuel-popup--created-window nil)) + +(make-variable-buffer-local + (defvar fuel-popup--selected-window nil)) + +(defun fuel-popup--display (&optional buffer) + (when buffer (set-buffer buffer)) + (let ((selected-window (selected-window)) + (buffer (current-buffer))) + (unless (eq selected-window (get-buffer-window buffer)) + (let ((windows)) + (walk-windows (lambda (w) (push w windows)) nil t) + (prog1 (pop-to-buffer buffer) + (set (make-local-variable 'fuel-popup--created-window) + (unless (memq (selected-window) windows) (selected-window))) + (set (make-local-variable 'fuel-popup--selected-window) + selected-window)))))) + +(defun fuel-popup--quit () + (interactive) + (let ((selected fuel-popup--selected-window) + (created fuel-popup--created-window)) + (bury-buffer) + (when (eq created (selected-window)) (delete-window created)) + (when (window-live-p selected) (select-window selected)))) + +(define-minor-mode fuel-popup-mode + "Mode for displaying read only stuff" + nil nil + '(("q" . fuel-popup--quit)) + (setq buffer-read-only t)) + +(defmacro fuel-popup--define (fun name mode) + `(defun ,fun () + (or (get-buffer ,name) + (with-current-buffer (get-buffer-create ,name) + (funcall ,mode) + (fuel-popup-mode) + (current-buffer))))) + +(put 'fuel-popup--define 'lisp-indent-function 1) + +(defmacro fuel--with-popup (buffer &rest body) + `(with-current-buffer ,buffer + (let ((inhibit-read-only t)) + ,@body))) + +(put 'fuel--with-popup 'lisp-indent-function 1) + + +(provide 'fuel-popup) +;;; fuel-popup.el ends here diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el new file mode 100644 index 0000000000..061adbb82c --- /dev/null +++ b/misc/fuel/fuel-refactor.el @@ -0,0 +1,237 @@ +;;; fuel-refactor.el -- code refactoring support + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Thu Jan 08, 2009 00:57 + +;;; Comentary: + +;; Utilities performing refactoring on factor code. + +;;; Code: + +(require 'fuel-scaffold) +(require 'fuel-stack) +(require 'fuel-syntax) +(require 'fuel-base) + +(require 'etags) + + +;;; Word definitions in buffer + +(defconst fuel-refactor--next-defun-regex + (format "^\\(:\\|MEMO:\\|MACRO:\\):? +\\(\\w+\\)\\(%s\\)\\([^;]+?\\) ;\\_>" + fuel-syntax--stack-effect-regex)) + +(defun fuel-refactor--previous-defun () + (let ((pos) (result)) + (while (and (not result) + (setq pos (fuel-syntax--beginning-of-defun))) + (setq result (looking-at fuel-refactor--next-defun-regex))) + (when (and result pos) + (let ((name (match-string-no-properties 2)) + (body (match-string-no-properties 4)) + (end (match-end 0))) + (list (split-string body nil t) name pos end))))) + +(defun fuel-refactor--find (code to) + (let ((candidate) (result)) + (while (and (not result) + (setq candidate (fuel-refactor--previous-defun)) + (> (point) to)) + (when (equal (car candidate) code) + (setq result (cdr candidate)))) + result)) + +(defun fuel-refactor--reuse-p (word) + (save-excursion + (mark-defun) + (move-overlay fuel-stack--overlay (1+ (point)) (mark)) + (unwind-protect + (and (y-or-n-p (format "Use existing word '%s'? " word)) word) + (delete-overlay fuel-stack--overlay)))) + +(defun fuel-refactor--code-rx (code) + (let ((words (split-string code nil t))) + (mapconcat 'regexp-quote words "[ \n\f\r]+"))) + + +;;; Extract word: + +(defun fuel-refactor--reuse-existing (code) + (save-excursion + (mark-defun) + (let ((code (split-string (substring-no-properties code) nil t)) + (down (mark)) + (found) + (result)) + (while (and (not result) + (setq found (fuel-refactor--find code (point-min)))) + (when found (setq result (fuel-refactor--reuse-p (car found))))) + (goto-char (point-max)) + (while (and (not result) + (setq found (fuel-refactor--find code down))) + (when found (setq result (fuel-refactor--reuse-p (car found))))) + (and result found)))) + +(defun fuel-refactor--insert-word (word stack-effect code) + (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point))) + (end (save-excursion + (re-search-backward fuel-syntax--end-of-def-regex nil t) + (forward-line 1) + (skip-syntax-forward "-")))) + (let ((start (goto-char (max beg end)))) + (open-line 1) + (insert ": " word " " stack-effect "\n" code " ;\n") + (indent-region start (point)) + (move-overlay fuel-stack--overlay start (point))))) + +(defun fuel-refactor--extract-other (start end code) + (unwind-protect + (when (y-or-n-p "Apply refactoring to rest of buffer? ") + (save-excursion + (let ((rx (fuel-refactor--code-rx code)) + (end (point))) + (query-replace-regexp rx word t (point-min) start) + (query-replace-regexp rx word t end (point-max))))) + (delete-overlay fuel-stack--overlay))) + +(defun fuel-refactor--extract (begin end) + (unless (< begin end) (error "No proper region to extract")) + (let* ((code (buffer-substring begin end)) + (existing (fuel-refactor--reuse-existing code)) + (code-str (or existing (fuel--region-to-string begin end))) + (word (or (car existing) (read-string "New word name: "))) + (stack-effect (or existing + (fuel-stack--infer-effect code-str) + (read-string "Stack effect: ")))) + (goto-char begin) + (delete-region begin end) + (insert word) + (indent-region begin (point)) + (save-excursion + (let ((start (or (cadr existing) (point)))) + (unless existing + (fuel-refactor--insert-word word stack-effect code)) + (fuel-refactor--extract-other start + (or (car (cddr existing)) (point)) + code))))) + +(defun fuel-refactor-extract-region (begin end) + "Extracts current region as a separate word." + (interactive "r") + (let ((begin (save-excursion + (goto-char begin) + (when (zerop (skip-syntax-backward "w")) + (skip-syntax-forward "-")) + (point))) + (end (save-excursion + (goto-char end) + (skip-syntax-forward "w") + (point)))) + (fuel-refactor--extract begin end))) + +(defun fuel-refactor-extract-sexp () + "Extracts current innermost sexp (up to point) as a separate +word." + (interactive) + (fuel-refactor-extract-region (1+ (fuel-syntax--beginning-of-sexp-pos)) + (if (looking-at-p ";") (point) + (fuel-syntax--end-of-symbol-pos)))) + + +;;; Inline word: + +(defun fuel-refactor--word-def (word) + (let ((def (fuel-eval--retort-result + (fuel-eval--send/wait `(:fuel* (,word fuel-word-def) "fuel"))))) + (when def + (substring (substring def 2) 0 -2)))) + +(defun fuel-refactor-inline-word () + "Inserts definition of word at point." + (interactive) + (let ((word (fuel-syntax-symbol-at-point))) + (unless word (error "No word at point")) + (let ((code (fuel-refactor--word-def word))) + (unless code (error "Word's definition not found")) + (fuel-syntax--beginning-of-symbol) + (kill-word 1) + (let ((start (point))) + (insert code) + (save-excursion (font-lock-fontify-region start (point))) + (indent-region start (point)))))) + + +;;; Rename word: + +(defsubst fuel-refactor--rename-word (from to file) + (let ((files (fuel-xref--word-callers-files from))) + (tags-query-replace from to t `(cons ,file ',files)) + files)) + +(defun fuel-refactor--def-word () + (save-excursion + (fuel-syntax--beginning-of-defun) + (or (and (looking-at fuel-syntax--method-definition-regex) + (match-string-no-properties 2)) + (and (looking-at fuel-syntax--word-definition-regex) + (match-string-no-properties 2))))) + +(defun fuel-refactor-rename-word (&optional arg) + "Rename globally the word whose definition point is at. +With prefix argument, use word at point instead." + (interactive "P") + (let* ((from (if arg (fuel-syntax-symbol-at-point) (fuel-refactor--def-word))) + (from (read-string "Rename word: " from)) + (to (read-string (format "Rename '%s' to: " from))) + (buffer (current-buffer))) + (fuel-refactor--rename-word from to (buffer-file-name)))) + + +;;; Extract vocab: + +(defun fuel-refactor--insert-using (vocab) + (save-excursion + (goto-char (point-min)) + (let ((usings (sort (cons vocab (fuel-syntax--usings)) 'string<))) + (fuel-debug--replace-usings (buffer-file-name) usings)))) + +(defun fuel-refactor--vocab-root (vocab) + (let ((cmd `(:fuel* (,vocab fuel-scaffold-get-root) "fuel"))) + (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + +(defun fuel-refactor--extract-vocab (begin end) + (when (< begin end) + (let* ((str (buffer-substring begin end)) + (buffer (current-buffer)) + (vocab (fuel-syntax--current-vocab)) + (vocab-hint (and vocab (format "%s." vocab))) + (root-hint (fuel-refactor--vocab-root vocab)) + (vocab (fuel-scaffold-vocab t vocab-hint root-hint))) + (with-current-buffer buffer + (delete-region begin end) + (fuel-refactor--insert-using vocab)) + (newline) + (insert str) + (newline) + (save-buffer) + (fuel-update-usings)))) + +(defun fuel-refactor-extract-vocab (begin end) + "Creates a new vocab with the words in current region. +The region is extended to the closest definition boundaries." + (interactive "r") + (fuel-refactor--extract-vocab (save-excursion (goto-char begin) + (mark-defun) + (point)) + (save-excursion (goto-char end) + (mark-defun) + (mark)))) + +(provide 'fuel-refactor) +;;; fuel-refactor.el ends here diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el new file mode 100644 index 0000000000..05d825593c --- /dev/null +++ b/misc/fuel/fuel-scaffold.el @@ -0,0 +1,85 @@ +;;; fuel-scaffold.el -- interaction with tools.scaffold + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Sun Jan 11, 2009 18:40 + +;;; Comentary: + +;; Utilities for creating new vocabulary files and other boilerplate. +;; Mainly, an interface to Factor's tools.scaffold. + +;;; Code: + +(require 'fuel-eval) +(require 'fuel-edit) +(require 'fuel-syntax) +(require 'fuel-base) + + +;;; Customisation: + +(defgroup fuel-scaffold nil + "Options for FUEL's scaffolding." + :group 'fuel) + +(defcustom fuel-scaffold-developer-name user-full-name + "The name to be inserted as yours in scaffold templates." + :type 'string + :group 'fuel-scaffold) + + +;;; Auxiliary functions: + +(defun fuel-scaffold--vocab-roots () + (let ((cmd '(:fuel* (vocab-roots get :get) "fuel"))) + (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + + +;;; User interface: + +(defun fuel-scaffold-vocab (&optional other-window name-hint root-hint) + "Creates a directory in the given root for a new vocabulary and +adds source, tests and authors.txt files. + +You can configure `fuel-scaffold-developer-name' (set by default to +`user-full-name') for the name to be inserted in the generated files." + (interactive) + (let* ((name (read-string "Vocab name: " name-hint)) + (root (completing-read "Vocab root: " + (fuel-scaffold--vocab-roots) + nil t (or root-hint "resource:"))) + (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name) + (fuel-scaffold-vocab)) "fuel")) + (ret (fuel-eval--send/wait cmd)) + (file (fuel-eval--retort-result ret))) + (unless file + (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret)))) + (if other-window (find-file-other-window file) (find-file file)) + (goto-char (point-max)) + name)) + +(defun fuel-scaffold-help (&optional arg) + "Creates, if it does not already exist, a help file with +scaffolded help for each word in the current vocabulary. + +With prefix argument, ask for the vocabulary name. +You can configure `fuel-scaffold-developer-name' (set by default to +`user-full-name') for the name to be inserted in the generated file." + (interactive "P") + (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab)) + (fuel-edit--read-vocabulary-name nil))) + (cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-help) + "fuel")) + (ret (fuel-eval--send/wait cmd)) + (file (fuel-eval--retort-result ret))) + (unless file + (error "Error creating help file" (car (fuel-eval--retort-error ret)))) + (find-file file))) + + +(provide 'fuel-scaffold) +;;; fuel-scaffold.el ends here diff --git a/misc/fuel/fuel-stack.el b/misc/fuel/fuel-stack.el new file mode 100644 index 0000000000..7329848aa2 --- /dev/null +++ b/misc/fuel/fuel-stack.el @@ -0,0 +1,138 @@ +;;; fuel-stack.el -- stack inference help + +;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Sat Dec 20, 2008 01:08 + +;;; Comentary: + +;; Utilities and a minor mode to show inferred stack effects in the +;; echo area. + +;;; Code: + +(require 'fuel-autodoc) +(require 'fuel-syntax) +(require 'fuel-eval) +(require 'fuel-font-lock) +(require 'fuel-base) + + +;;; Customization + +(defgroup fuel-stack nil + "Customization for FUEL's stack inference engine." + :group 'fuel) + +(fuel-font-lock--defface fuel-font-lock-stack-region + 'highlight fuel-stack "highlighting the stack effect region") + +(defcustom fuel-stack-highlight-period 2.0 + "Time, in seconds, the region is highlighted when showing its +stack effect. + +Set it to 0 to disable highlighting." + :group 'fuel-stack + :type 'float) + +(defcustom fuel-stack-mode-show-sexp-p t + "Whether to show in the echo area the sexp together with its stack effect." + :group 'fuel-stack + :type 'boolean) + + +;;; Querying for stack effects + +(defun fuel-stack--infer-effect (str) + (let ((cmd `(:fuel* + ((:using stack-checker effects) + ([ (:factor ,str) ] infer effect>string :get))))) + (fuel-eval--retort-result (fuel-eval--send/wait cmd 500)))) + +(defsubst fuel-stack--infer-effect/prop (str) + (let ((e (fuel-stack--infer-effect str))) + (when e + (put-text-property 0 (length e) 'face 'factor-font-lock-stack-effect e)) + e)) + +(defvar fuel-stack--overlay + (let ((overlay (make-overlay 0 0))) + (overlay-put overlay 'face 'fuel-font-lock-stack-region) + (delete-overlay overlay) + overlay)) + +(defun fuel-stack-effect-region (begin end) + "Displays the inferred stack effect of the code in current region." + (interactive "r") + (when (> fuel-stack-highlight-period 0) + (move-overlay fuel-stack--overlay begin end)) + (condition-case nil + (let* ((str (fuel--region-to-string begin end)) + (effect (fuel-stack--infer-effect/prop str))) + (if effect (message "%s" effect) + (message "Couldn't infer effect for '%s'" + (fuel--shorten-region begin end 60))) + (sit-for fuel-stack-highlight-period)) + (error)) + (delete-overlay fuel-stack--overlay)) + +(defun fuel-stack-effect-sexp (&optional arg) + "Displays the inferred stack effect for the current sexp. +With prefix argument, use current region instead" + (interactive "P") + (if arg + (call-interactively 'fuel-stack-effect-region) + (fuel-stack-effect-region (1+ (fuel-syntax--beginning-of-sexp-pos)) + (if (looking-at-p ";") (point) + (fuel-syntax--end-of-symbol-pos))))) + + +;;; Stack mode: + +(make-variable-buffer-local + (defvar fuel-stack-mode-string " S" + "Modeline indicator for fuel-stack-mode")) + +(make-variable-buffer-local + (defvar fuel-stack--region-function + '(lambda () + (fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos)))))) + +(defun fuel-stack--eldoc () + (when (looking-at-p " \\|$") + (let* ((r (funcall fuel-stack--region-function)) + (e (and r + (not (string-match "^ *$" r)) + (fuel-stack--infer-effect/prop r)))) + (when e + (if fuel-stack-mode-show-sexp-p + (concat (fuel--shorten-str r 30) " -> " e) + e))))) + +(define-minor-mode fuel-stack-mode + "Toggle Fuel's Stack mode. +With no argument, this command toggles the mode. +Non-null prefix argument turns on the mode. +Null prefix argument turns off the mode. + +When Stack mode is enabled, inferred stack effects for current +sexp are automatically displayed in the echo area." + :init-value nil + :lighter fuel-stack-mode-string + :group 'fuel-stack + + (setq fuel-autodoc--fallback-function + (when fuel-stack-mode 'fuel-stack--eldoc)) + (set (make-local-variable 'eldoc-minor-mode-string) nil) + (unless fuel-autodoc-mode + (set (make-local-variable 'eldoc-documentation-function) + (when fuel-stack-mode 'fuel-stack--eldoc)) + (eldoc-mode fuel-stack-mode) + (message "Fuel Stack Autodoc %s" (if fuel-stack-mode "enabled" "disabled")))) + + +(provide 'fuel-stack) +;;; fuel-stack.el ends here diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index a0485f9183..ad5a025a88 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -1,6 +1,6 @@ ;;; fuel-syntax.el --- auxiliar definitions for factor code navigation. -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -19,13 +19,17 @@ (defun fuel-syntax--beginning-of-symbol () "Move point to the beginning of the current symbol." - (while (eq (char-before) ?:) (backward-char)) - (skip-syntax-backward "w_")) + (skip-syntax-backward "w_()")) + +(defsubst fuel-syntax--beginning-of-symbol-pos () + (save-excursion (fuel-syntax--beginning-of-symbol) (point))) (defun fuel-syntax--end-of-symbol () "Move point to the end of the current symbol." - (skip-syntax-forward "w_") - (while (looking-at ":") (forward-char))) + (skip-syntax-forward "w_()")) + +(defsubst fuel-syntax--end-of-symbol-pos () + (save-excursion (fuel-syntax--end-of-symbol) (point))) (put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol) (put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol) @@ -34,53 +38,105 @@ (let ((s (substring-no-properties (thing-at-point 'factor-symbol)))) (and (> (length s) 0) s))) + ;;; Regexps galore: (defconst fuel-syntax--parsing-words - '("{" "}" "^:" "^::" ";" "<<" ">" - "BIN:" "BV{" "B{" "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CS{" "C{" - "DEFER:" "ERROR:" "EXCLUDE:" "FORGET:" - "GENERIC#" "GENERIC:" "HEX:" "HOOK:" "H{" - "IN:" "INSTANCE:" "INTERSECTION:" - "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "METHOD:" "MIXIN:" - "OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:" - "REQUIRE:" "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:" - "TUPLE:" "T{" "t\\??" "TYPEDEF:" - "UNION:" "USE:" "USING:" "V{" "VARS:" "W{")) - -(defconst fuel-syntax--parsing-words-ext-regex - (regexp-opt '("B" "call-next-method" "delimiter" "f" "initial:" "read-only") - 'words)) + '(":" "::" ";" "&:" "<<" ">" + "ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:" + "B" "BIN:" + "C:" "C-ENUM:" "C-STRUCT:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method" + "DEFER:" + "ERROR:" "EXCLUDE:" + "f" "FORGET:" "FROM:" "FUNCTION:" + "GENERIC#" "GENERIC:" + "HELP:" "HEX:" "HOOK:" + "IN:" "initial:" "INSTANCE:" "INTERSECTION:" + "LIBRARY:" + "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:" + "OCT:" + "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:" + "QUALIFIED-WITH:" "QUALIFIED:" + "read-only" "RENAME:" "REQUIRE:" "REQUIRES:" + "SINGLETON:" "SINGLETONS:" "SLOT:" "SYMBOL:" "SYMBOLS:" + "TUPLE:" "t" "t?" "TYPEDEF:" + "UNION:" "USE:" "USING:" + "VARS:")) + +(defconst fuel-syntax--parsing-words-regex + (regexp-opt fuel-syntax--parsing-words 'words)) + +(defconst fuel-syntax--bracers + '("B" "BV" "C" "CS" "H" "T" "V" "W")) + +(defconst fuel-syntax--brace-words-regex + (format "%s{" (regexp-opt fuel-syntax--bracers t))) (defconst fuel-syntax--declaration-words - '("flushable" "foldable" "inline" "parsing" "recursive")) + '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter")) (defconst fuel-syntax--declaration-words-regex (regexp-opt fuel-syntax--declaration-words 'words)) (defsubst fuel-syntax--second-word-regex (prefixes) - (format "^%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t))) + (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t))) (defconst fuel-syntax--method-definition-regex "^M: +\\([^ ]+\\) +\\([^ ]+\\)") +(defconst fuel-syntax--integer-regex + "\\_<-?[0-9]+\\_>") + +(defconst fuel-syntax--raw-float-regex + "[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?") + +(defconst fuel-syntax--float-regex + (format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex)) + +(defconst fuel-syntax--number-regex + (format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex)) + +(defconst fuel-syntax--ratio-regex + (format "\\_<[+-]?%s/-?%s\\_>" + fuel-syntax--number-regex + fuel-syntax--number-regex)) + +(defconst fuel-syntax--bad-string-regex + "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n") + (defconst fuel-syntax--word-definition-regex - (fuel-syntax--second-word-regex '(":" "::" "GENERIC:"))) + (fuel-syntax--second-word-regex + '(":" "::" "GENERIC:" "DEFER:" "HOOK:" "MAIN:" "MATH:" "POSTPONE:" + "SYMBOL:" "RENAME:"))) + +(defconst fuel-syntax--alias-definition-regex + "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)") + +(defconst fuel-syntax--vocab-ref-regexp + (fuel-syntax--second-word-regex + '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:"))) + +(defconst fuel-syntax--int-constant-def-regex + (fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:"))) (defconst fuel-syntax--type-definition-regex - (fuel-syntax--second-word-regex '("TUPLE:" "SINGLETON:"))) + (fuel-syntax--second-word-regex + '("C-STRUCT:" "C-UNION:" "MIXIN:" "TUPLE:" "SINGLETON:" "UNION:"))) -(defconst fuel-syntax--parent-type-regex "^TUPLE: +[^ ]+ +< +\\([^ ]+\\)") +(defconst fuel-syntax--tuple-decl-regex + "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>") (defconst fuel-syntax--constructor-regex "<[^ >]+>") -(defconst fuel-syntax--setter-regex "\\W>>[^ ]+\\b") +(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>") +(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>") (defconst fuel-syntax--symbol-definition-regex - (fuel-syntax--second-word-regex '("SYMBOL:" "VAR:"))) + (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:"))) -(defconst fuel-syntax--stack-effect-regex " ( .* )") +(defconst fuel-syntax--stack-effect-regex + "\\( ( .* )\\)\\|\\( (( .* ))\\)") (defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);") @@ -90,23 +146,60 @@ (defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$") -(defconst fuel-syntax--definition-starters-regex - (regexp-opt '("VARS" "TUPLE" "MACRO" "MACRO:" "M" ":" ""))) +(defconst fuel-syntax--alien-function-regex + "\\_" "" "" table) +(defconst fuel-syntax--constructor-decl-regex + "\\_ +\\(\\w+\\)\\( .*\\)?$") - ;; Strings - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?\\ "/" table) - table) - "Syntax table used while in Factor mode.") + +;;; Factor syntax table + +(setq fuel-syntax--syntax-table + (let ((table (make-syntax-table))) + ;; Default is word constituent + (dotimes (i 256) + (modify-syntax-entry i "w" table)) + ;; Whitespace (TAB is not whitespace) + (modify-syntax-entry ?\f " " table) + (modify-syntax-entry ?\r " " table) + (modify-syntax-entry ?\ " " table) + (modify-syntax-entry ?\n " " table) + table)) (defconst fuel-syntax--syntactic-keywords - `(("\\(#!\\)" (1 "<")) - (" \\(!\\)" (1 "<")) - ("^\\(!\\)" (1 "<")) - ("\\(!(\\) .* \\()\\)" (1 "<") (2 ">")) - ("\\([[({]\\)\\([^ \"\n]\\)" (1 "_") (2 "_")) - ("\\([^ \"\n]\\)\\([])}]\\)" (1 "_") (2 "_")))) + `(;; CHARs: + ("\\(CHAR:\\|POSTPONE:\\|\\\\\\) \\(.\\)\\( \\|$\\)" (2 "w")) + ;; Comments: + ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">")) + ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">")) + (" \\((\\)( \\([^\n]*\\) )\\()\\)\\( \\|\n\\)" (1 "b")) + (" \\((\\) \\([^\n]*\\) \\()\\)\\( \\|\n\\)" (1 "b")) + ;; Strings + ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" + (3 "\"") (5 "\"")) + ("\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "\"") (3 "\"")) + ("\\_<<\\(\"\\)\\_>" (1 "\\_>" (1 ">b")) + ;; Multiline constructs + ("\\_<\\(U\\)SING: \\(;\\)" (1 "b")) + ("\\_b")) + ("\\_\\)" + (2 "" (1 ">b")) + ;; Let and lambda: + ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">")) + ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]")) + ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|")) + (" \\(|\\) " (1 "(|")) + (" \\(|\\)$" (1 ")")) + ;; Opening brace words: + ("\\_<\\w*\\({\\)\\_>" (1 "(}")) + ("\\_<\\(}\\)\\_>" (1 "){")) + ;; Parenthesis: + ("\\_<\\((\\)\\_>" (1 "()")) + ("\\_<\\()\\)\\_>" (1 ")(")) + ;; Quotations: + ("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried + ("\\_<\\(\\[\\)\\_>" (1 "(]")) + ("\\_<\\(\\]\\)\\_>" (1 ")[")))) ;;; Source code analysis: @@ -202,20 +308,51 @@ (defsubst fuel-syntax--at-begin-of-def () (looking-at fuel-syntax--begin-of-def-regex)) +(defsubst fuel-syntax--at-begin-of-indent-def () + (looking-at fuel-syntax--indent-def-start-regex)) + (defsubst fuel-syntax--at-end-of-def () (looking-at fuel-syntax--end-of-def-regex)) (defsubst fuel-syntax--looking-at-emptiness () - (looking-at "^[ \t]*$")) + (looking-at "^[ ]*$\\|$")) + +(defsubst fuel-syntax--is-last-char (pos) + (save-excursion + (goto-char (1+ pos)) + (fuel-syntax--looking-at-emptiness))) + +(defsubst fuel-syntax--line-offset (pos) + (- pos (save-excursion + (goto-char pos) + (beginning-of-line) + (point)))) + +(defun fuel-syntax--previous-non-blank () + (forward-line -1) + (while (and (not (bobp)) (fuel-syntax--looking-at-emptiness)) + (forward-line -1))) + +(defun fuel-syntax--beginning-of-block-pos () + (save-excursion + (if (> (fuel-syntax--brackets-depth) 0) + (fuel-syntax--brackets-start) + (fuel-syntax--beginning-of-defun) + (point)))) (defun fuel-syntax--at-setter-line () (save-excursion (beginning-of-line) - (if (not (fuel-syntax--looking-at-emptiness)) - (re-search-forward fuel-syntax--setter-regex (line-end-position) t) - (forward-line -1) - (or (fuel-syntax--at-constructor-line) - (fuel-syntax--at-setter-line))))) + (when (re-search-forward fuel-syntax--setter-regex + (line-end-position) + t) + (let* ((to (match-beginning 0)) + (from (fuel-syntax--beginning-of-block-pos))) + (goto-char from) + (let ((depth (fuel-syntax--brackets-depth))) + (and (or (re-search-forward fuel-syntax--constructor-regex to t) + (re-search-forward fuel-syntax--setter-regex to t)) + (= depth (fuel-syntax--brackets-depth)))))))) (defun fuel-syntax--at-constructor-line () (save-excursion @@ -225,56 +362,75 @@ (defsubst fuel-syntax--at-using () (looking-at fuel-syntax--using-lines-regex)) +(defun fuel-syntax--in-using () + (let ((p (point))) + (save-excursion + (and (re-search-backward "^USING: " nil t) + (re-search-forward " ;" nil t) + (< p (match-end 0)))))) + (defsubst fuel-syntax--beginning-of-defun (&optional times) (re-search-backward fuel-syntax--begin-of-def-regex nil t times)) (defsubst fuel-syntax--end-of-defun () (re-search-forward fuel-syntax--end-of-def-regex nil t)) +(defsubst fuel-syntax--end-of-defun-pos () + (save-excursion + (re-search-forward fuel-syntax--end-of-def-regex nil t) + (point))) + +(defun fuel-syntax--beginning-of-body () + (let ((p (point))) + (and (fuel-syntax--beginning-of-defun) + (re-search-forward fuel-syntax--defun-signature-regex p t) + (not (re-search-forward fuel-syntax--end-of-def-regex p t))))) + +(defun fuel-syntax--beginning-of-sexp () + (if (> (fuel-syntax--brackets-depth) 0) + (goto-char (fuel-syntax--brackets-start)) + (fuel-syntax--beginning-of-body))) + +(defsubst fuel-syntax--beginning-of-sexp-pos () + (save-excursion (fuel-syntax--beginning-of-sexp) (point))) + ;;; USING/IN: (make-variable-buffer-local - (defvar fuel-syntax--current-vocab nil)) + (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in)) -(make-variable-buffer-local - (defvar fuel-syntax--usings nil)) - -(defun fuel-syntax--current-vocab () - (let ((ip - (save-excursion - (when (re-search-backward fuel-syntax--current-vocab-regex nil t) - (setq fuel-syntax--current-vocab (match-string-no-properties 1)) - (point))))) - (when ip - (let ((pp (save-excursion - (when (re-search-backward fuel-syntax--sub-vocab-regex ip t) - (point))))) - (when (and pp (> pp ip)) - (let ((sub (match-string-no-properties 1))) - (unless (save-excursion (search-backward (format "%s>" sub) pp t)) - (setq fuel-syntax--current-vocab - (format "%s.%s" fuel-syntax--current-vocab (downcase sub))))))))) - fuel-syntax--current-vocab) - -(defun fuel-syntax--usings-update () - (save-excursion - (setq fuel-syntax--usings (list (fuel-syntax--current-vocab))) - (while (re-search-backward fuel-syntax--using-lines-regex nil t) - (dolist (u (split-string (match-string-no-properties 1) nil t)) - (push u fuel-syntax--usings))) - fuel-syntax--usings)) +(defsubst fuel-syntax--current-vocab () + (funcall fuel-syntax--current-vocab-function)) -(defsubst fuel-syntax--usings-update-hook () - (fuel-syntax--usings-update) - nil) +(defun fuel-syntax--find-in () + (save-excursion + (when (re-search-backward fuel-syntax--current-vocab-regex nil t) + (match-string-no-properties 1)))) -(defun fuel-syntax--enable-usings () - (add-hook 'before-save-hook 'fuel-syntax--usings-update-hook nil t) - (fuel-syntax--usings-update)) +(make-variable-buffer-local + (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings)) (defsubst fuel-syntax--usings () - (or fuel-syntax--usings (fuel-syntax--usings-update))) + (funcall fuel-syntax--usings-function)) + +(defun fuel-syntax--file-has-private () + (save-excursion + (goto-char (point-min)) + (and (re-search-forward "\\_<" nil t) + (re-search-forward "\\_\\_>" nil t)))) + +(defun fuel-syntax--find-usings (&optional no-private) + (save-excursion + (let ((usings)) + (goto-char (point-max)) + (while (re-search-backward fuel-syntax--using-lines-regex nil t) + (dolist (u (split-string (match-string-no-properties 1) nil t)) + (push u usings))) + (when (and (not no-private) (fuel-syntax--file-has-private)) + (goto-char (point-max)) + (push (concat (fuel-syntax--find-in) ".private") usings)) + usings))) (provide 'fuel-syntax) diff --git a/misc/fuel/fuel-table.el b/misc/fuel/fuel-table.el new file mode 100644 index 0000000000..a00b21bf2f --- /dev/null +++ b/misc/fuel/fuel-table.el @@ -0,0 +1,93 @@ +;;; fuel-table.el -- table creation + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Tue Jan 06, 2009 13:44 + +;;; Comentary: + +;; Utilities to insert ascii tables. + +;;; Code: + +(defun fuel-table--col-widths (rows) + (let* ((col-no (length (car rows))) + (available (- (window-width) 2 (* 2 col-no))) + (widths) + (c 0)) + (while (< c col-no) + (let ((width 0) + (av-width (- available (* 5 (- col-no c))))) + (dolist (row rows) + (setq width + (min av-width + (max width (length (nth c row)))))) + (push width widths) + (setq available (- available width))) + (setq c (1+ c))) + (reverse widths))) + +(defun fuel-table--pad-str (str width) + (let ((len (length str))) + (cond ((= len width) str) + ((> len width) (concat (substring str 0 (- width 3)) "...")) + (t (concat str (make-string (- width (length str)) ?\ )))))) + +(defun fuel-table--str-lines (str width) + (if (<= (length str) width) + (list (fuel-table--pad-str str width)) + (with-temp-buffer + (let ((fill-column width)) + (insert str) + (fill-region (point-min) (point-max)) + (mapcar '(lambda (s) (fuel-table--pad-str s width)) + (split-string (buffer-string) "\n")))))) + +(defun fuel-table--pad-row (row) + (let* ((max-ln (apply 'max (mapcar 'length row))) + (result)) + (dolist (lines row) + (let ((ln (length lines))) + (if (= ln max-ln) (push lines result) + (let ((lines (reverse lines)) + (l 0) + (blank (make-string (length (car lines)) ?\ ))) + (while (< l ln) + (push blank lines) + (setq l (1+ l))) + (push (reverse lines) result))))) + (reverse result))) + +(defun fuel-table--format-rows (rows widths) + (let ((col-no (length (car rows))) + (frows)) + (dolist (row rows) + (let ((c 0) (frow)) + (while (< c col-no) + (push (fuel-table--str-lines (nth c row) (nth c widths)) frow) + (setq c (1+ c))) + (push (fuel-table--pad-row (reverse frow)) frows))) + (reverse frows))) + +(defun fuel-table--insert (rows) + (let* ((widths (fuel-table--col-widths rows)) + (rows (fuel-table--format-rows rows widths)) + (ls (concat "+" (mapconcat (lambda (n) (make-string n ?-)) widths "-+") "-+"))) + (insert ls "\n") + (dolist (r rows) + (let ((ln (length (car r))) + (l 0)) + (while (< l ln) + (insert (concat "|" (mapconcat 'identity + (mapcar `(lambda (x) (nth ,l x)) r) + " |") + " |\n")) + (setq l (1+ l)))) + (insert ls "\n")))) + + +(provide 'fuel-table) +;;; fuel-table.el ends here diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el new file mode 100644 index 0000000000..4d444ebe3e --- /dev/null +++ b/misc/fuel/fuel-xref.el @@ -0,0 +1,283 @@ +;;; fuel-xref.el -- showing cross-reference info + +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Sat Dec 20, 2008 22:00 + +;;; Comentary: + +;; A mode and utilities for showing cross-reference information. + +;;; Code: + +(require 'fuel-edit) +(require 'fuel-completion) +(require 'fuel-help) +(require 'fuel-eval) +(require 'fuel-syntax) +(require 'fuel-popup) +(require 'fuel-font-lock) +(require 'fuel-base) + +(require 'button) + + +;;; Customization: + +(defgroup fuel-xref nil + "FUEL's cross-referencing engine." + :group 'fuel) + +(defcustom fuel-xref-follow-link-to-word-p t + "Whether, when following a link to a caller, we position the +cursor at the first ocurrence of the used word." + :group 'fuel-xref + :type 'boolean) + +(fuel-edit--define-custom-visit + fuel-xref-follow-link-method + fuel-xref + "How new buffers are opened when following a crossref link.") + +(fuel-font-lock--defface fuel-font-lock-xref-link + 'link fuel-xref "highlighting links in cross-reference buffers") + +(fuel-font-lock--defface fuel-font-lock-xref-vocab + 'italic fuel-xref "vocabulary names in cross-reference buffers") + + +;;; Buttons: + +(define-button-type 'fuel-xref--button-type + 'action 'fuel-xref--follow-link + 'follow-link t + 'face 'fuel-font-lock-xref-link) + +(defun fuel-xref--follow-link (button) + (let ((file (button-get button 'file)) + (line (button-get button 'line))) + (when (not file) + (error "No file for this ref")) + (when (not (file-readable-p file)) + (error "File '%s' is not readable" file)) + (let ((word fuel-xref--word)) + (fuel-edit--visit-file file fuel-xref-follow-link-method) + (when (numberp line) (goto-line line)) + (when (and word fuel-xref-follow-link-to-word-p) + (and (re-search-forward (format "\\_<%s\\_>" word) + (fuel-syntax--end-of-defun-pos) + t) + (goto-char (match-beginning 0))))))) + + +;;; The xref buffer: + +(fuel-popup--define fuel-xref--buffer + "*fuel xref*" 'fuel-xref-mode) + +(make-local-variable (defvar fuel-xref--word nil)) + +(defvar fuel-xref--help-string + "(Press RET or click to follow crossrefs, or h for help on word at point)") + +(defun fuel-xref--title (word cc count thing) + (put-text-property 0 (length word) 'font-lock-face 'bold word) + (cond ((zerop count) (format "No known %s %s %s" thing cc word)) + ((= 1 count) (format "1 %s %s %s:" thing cc word)) + (t (format "%s %ss %s %s:" count thing cc word)))) + +(defun fuel-xref--insert-ref (ref &optional no-vocab) + (when (and (stringp (first ref)) + (stringp (third ref)) + (numberp (fourth ref))) + (insert " ") + (insert-text-button (first ref) + :type 'fuel-xref--button-type + 'help-echo (format "File: %s (%s)" + (third ref) + (fourth ref)) + 'file (third ref) + 'line (fourth ref)) + (when (and (not no-vocab) (stringp (second ref))) + (insert (format " (in %s)" (second ref)))) + (newline) + t)) + +(defun fuel-xref--fill-buffer (word cc refs &optional no-vocab app thing) + (let ((inhibit-read-only t) + (count 0)) + (with-current-buffer (fuel-xref--buffer) + (let ((start (if app (goto-char (point-max)) + (erase-buffer) + (point-min)))) + (dolist (ref refs) + (when (fuel-xref--insert-ref ref no-vocab) (setq count (1+ count)))) + (newline) + (goto-char start) + (save-excursion + (insert (fuel-xref--title word cc count (or thing "word")) "\n\n")) + count)))) + +(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab thing) + (let ((count (fuel-xref--fill-buffer word cc refs no-vocab nil (or thing "word")))) + (if (zerop count) + (error (fuel-xref--title word cc 0 (or thing "word"))) + (message "") + (fuel-popup--display (fuel-xref--buffer))))) + +(defun fuel-xref--callers (word) + (let ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))) + (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + +(defun fuel-xref--show-callers (word) + (let ((refs (fuel-xref--callers word))) + (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word word)) + (fuel-xref--fill-and-display word "using" refs))) + +(defun fuel-xref--word-callers-files (word) + (mapcar 'third (fuel-xref--callers word))) + +(defun fuel-xref--show-callees (word) + (let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref)))) + (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) + (fuel-xref--fill-and-display word "used by" res))) + +(defun fuel-xref--apropos (str) + (let* ((cmd `(:fuel* ((,str fuel-apropos-xref)))) + (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) + (fuel-xref--fill-and-display str "containing" res))) + +(defun fuel-xref--show-vocab (vocab &optional app) + (let* ((cmd `(:fuel* ((,vocab fuel-vocab-xref)) ,vocab)) + (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) + (fuel-xref--fill-buffer vocab "in vocabulary" res t app))) + +(defun fuel-xref--show-vocab-words (vocab &optional private) + (fuel-xref--show-vocab vocab) + (when private + (fuel-xref--show-vocab (format "%s.private" (substring-no-properties vocab)) + t)) + (fuel-popup--display (fuel-xref--buffer)) + (goto-char (point-min))) + +(defun fuel-xref--show-vocab-usage (vocab) + (let* ((cmd `(:fuel* ((,vocab fuel-vocab-usage-xref)))) + (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) + (fuel-xref--fill-and-display vocab "using" res t "vocab"))) + +(defun fuel-xref--show-vocab-uses (vocab) + (let* ((cmd `(:fuel* ((,vocab fuel-vocab-uses-xref)))) + (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) + (fuel-xref--fill-and-display vocab "used by" res t "vocab"))) + + +;;; User commands: + +(defvar fuel-xref--word-history nil) + +(defun fuel-show-callers (&optional arg) + "Show a list of callers of word or vocabulary at point. +With prefix argument, ask for word." + (interactive "P") + (let ((word (if arg (fuel-completion--read-word "Find callers for: " + (fuel-syntax-symbol-at-point) + fuel-xref--word-history) + (fuel-syntax-symbol-at-point)))) + (when word + (message "Looking up %s's users ..." word) + (if (and (not arg) + (fuel-edit--looking-at-vocab)) + (fuel-xref--show-vocab-usage word) + (fuel-xref--show-callers word))))) + +(defun fuel-show-callees (&optional arg) + "Show a list of callers of word or vocabulary at point. +With prefix argument, ask for word." + (interactive "P") + (let ((word (if arg (fuel-completion--read-word "Find callees for: " + (fuel-syntax-symbol-at-point) + fuel-xref--word-history) + (fuel-syntax-symbol-at-point)))) + (when word + (message "Looking up %s's callees ..." word) + (if (and (not arg) + (fuel-edit--looking-at-vocab)) + (fuel-xref--show-vocab-uses word) + (fuel-xref--show-callees word))))) + +(defvar fuel-xref--vocab-history nil) + +(defun fuel-vocab-uses (&optional arg) + "Show a list of vocabularies used by a given one. +With prefix argument, force reload of vocabulary list." + (interactive "P") + (let ((vocab (fuel-completion--read-vocab arg + (fuel-syntax-symbol-at-point) + fuel-xref--vocab-history))) + (fuel-xref--show-vocab-uses vocab))) + +(defun fuel-vocab-usage (&optional arg) + "Show a list of vocabularies that use a given one. +With prefix argument, force reload of vocabulary list." + (interactive "P") + (let ((vocab (fuel-completion--read-vocab arg + (fuel-syntax-symbol-at-point) + fuel-xref--vocab-history))) + (fuel-xref--show-vocab-usage vocab))) + +(defun fuel-apropos (str) + "Show a list of words containing the given substring." + (interactive "MFind words containing: ") + (message "Looking up %s's references ..." str) + (fuel-xref--apropos str)) + +(defun fuel-show-file-words (&optional arg) + "Show a list of words in current file. +With prefix argument, ask for the vocab." + (interactive "P") + (let ((vocab (or (and (not arg) (fuel-syntax--current-vocab)) + (fuel-edit--read-vocabulary-name)))) + (when vocab + (fuel-xref--show-vocab-words vocab + (fuel-syntax--file-has-private))))) + + + +;;; Xref mode: + +(defun fuel-xref-show-help () + (interactive) + (let ((fuel-help-always-ask nil)) + (fuel-help))) + +(defvar fuel-xref-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + (define-key map "h" 'fuel-xref-show-help) + map)) + +(defun fuel-xref-mode () + "Mode for displaying FUEL cross-reference information. +\\{fuel-xref-mode-map}" + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map fuel-xref-mode-map) + (set-syntax-table fuel-syntax--syntax-table) + (setq mode-name "FUEL Xref") + (setq major-mode 'fuel-xref-mode) + (font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab))) + (setq buffer-read-only t)) + + +(provide 'fuel-xref) +;;; fuel-xref.el ends here diff --git a/misc/vim/README b/misc/vim/README new file mode 100644 index 0000000000..bede151458 --- /dev/null +++ b/misc/vim/README @@ -0,0 +1,29 @@ +Vim support for Factor +---------------------- + +This directory contains various support files that make editing Factor code +more pleasant in Vim. The file-layout exactly matches the Vim runtime +structure, so you can install them by copying the contents of this directory +into ~/.vim/ or the equivalent path on other platforms (Open Vim and type +":help 'runtimepath'" for details). + +The current set of files is as follows: + + ftdetect/factor.vim + Teach Vim when to load Factor support files. + ftplugin/factor_settings.vim + Teach Vim to follow the Factor Coding Style guidelines. + syntax/factor.vim + Syntax highlighting for Factor code. + +Note: The syntax-highlighting file is automatically generated to include the +names of all the vocabularies Factor knows about. To regenerate it manually, +run the following code in the listener: + + USE: editors.vim.generate-syntax + + generate-vim-syntax + +...or run it from the command-line: + + factor -run=editors.vim.generate-syntax diff --git a/misc/vim/ftdetect/factor.vim b/misc/vim/ftdetect/factor.vim new file mode 100644 index 0000000000..eb9c0deda6 --- /dev/null +++ b/misc/vim/ftdetect/factor.vim @@ -0,0 +1 @@ +autocmd BufRead,BufNewFile *.factor,{,.}factor*-rc set filetype=factor diff --git a/misc/vim/ftplugin/factor_settings.vim b/misc/vim/ftplugin/factor_settings.vim new file mode 100644 index 0000000000..ced9e85719 --- /dev/null +++ b/misc/vim/ftplugin/factor_settings.vim @@ -0,0 +1,17 @@ +" Code formatting settings loosely adapted from: +" http://concatenative.org/wiki/view/Factor/Coding%20Style + +" Tabs are not allowed in Factor source files; use four spaces instead. +setlocal expandtab tabstop=4 shiftwidth=4 softtabstop=4 + +" Try to limit lines to 64 characters, except for documentation, which can be +" any length. +if expand("%:t") !~ "-docs\.factor$" + setlocal textwidth=64 + + " Mark anything in column 64 or beyond as a syntax error. + match Error /\%>63v.\+/ +endif + +" Teach Vim what comments look like. +setlocal comments+=b:!,b:#! diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim new file mode 100644 index 0000000000..90a3d46d50 --- /dev/null +++ b/misc/vim/syntax/factor.vim @@ -0,0 +1,265 @@ +" Vim syntax file +" Language: factor +" Maintainer: Alex Chapman +" Last Change: 2008 Apr 28 + +" For version 5.x: Clear all syntax items +" For version 6.x: Quit when a syntax file was already loaded +if version < 600 + syntax clear +elseif exists("b:current_syntax") + finish +endif + +" factor is case sensitive. +syn case match + +" make all of these characters part of a word (useful for skipping over words with w, e, and b) +if version >= 600 + setlocal iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255 +else + set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255 +endif + +syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple + +syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained +syn match factorComment /\<#! .*/ contains=factorTodo +syn match factorComment /\/ end=/\<;\>/ contains=@factorDefnContents +syn region factorMethod matchgroup=factorMethodDelims start=/\/ end=/\<;\>/ contains=@factorDefnContents +syn region factorGeneric matchgroup=factorGenericDelims start=/\/ end=/$/ contains=factorStackEffect +syn region factorGenericN matchgroup=factorGenericNDelims start=/\/ end=/$/ contains=factorStackEffect + +syn region factorPrivateDefn matchgroup=factorPrivateDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained +syn region factorPrivateMethod matchgroup=factorPrivateMethodDelims start=/\/ end=/\<;\>/ contains=@factorDefnContents contained +syn region factorPGeneric matchgroup=factorPGenericDelims start=/\/ end=/$/ contains=factorStackEffect contained +syn region factorPGenericN matchgroup=factorPGenericNDelims start=/\/ end=/$/ contains=factorStackEffect + +syn region None matchgroup=factorPrivate start=/\</ end=/\\>/ contains=@factorDefnContents,factorPrivateDefn,factorPrivateMethod,factorPGeneric,factorPGenericN + + +syn keyword factorBoolean boolean f general-t t +syn keyword factorCompileDirective inline foldable parsing + + + +" kernel vocab keywords +syn keyword factorKeyword or construct-delegate set-slots tuck 2bi 2tri while wrapper nip bi* wrapper? hashcode callstack>array both? die set-delegate dupd callstack callstack? 3dup tri@ pick curry build prepose 3bi >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep construct clear 2dup when not tuple? 3compose dup 2bi* call object bi@ wrapped unless* if* >r curry-quot drop when* retainstack -rot 2bi@ delegate boa with 3slip slip compose-first compose-second 3drop either? bi curry? datastack curry-obj over 3curry roll throw swap and 2nip set-retainstack (clone) hashcode* get-slots compose spin if 3tri unless compose? tuple keep 2curry equal? set-datastack 2slip tri 2drop most identity-tuple? null r> new set-callstack dip xor rot -roll identity-tuple +syn keyword factorKeyword assoc? assoc-clone-like delete-any assoc= delete-at* new-assoc subassoc? assoc-size map>assoc search-alist assoc-like key? assoc-intersect update assoc-union at* assoc-empty? at+ set-enum-seq set-at assoc-all? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at (assoc-stack) enum? at cache assoc>map assoc-contains? assoc assoc-map assoc-pusher (assoc>map) enum assoc-push-if remove-all >alist (substitute) substitute-here clear-assoc assoc-stack substitute assoc-filter delete-at assoc-find enum-seq keys +syn keyword factorKeyword case dispatch-case-quot with-datastack no-cond no-case? 3cleave>quot (distribute-buckets) contiguous-range? 2cleave cond>quot no-cond? cleave>quot no-case recursive-hashcode case>quot 3cleave alist>quot dispatch-case hash-case-table hash-case-quot case-find cond cleave distribute-buckets 2cleave>quot linear-case-quot spread spread>quot hash-dispatch-quot +syn keyword factorKeyword byte-array>bignum sgn >bignum number= each-integer next-power-of-2 ?1+ imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum (all-integers?) times denominator find-last-integer (each-integer) bit? * + power-of-2? - / >= bitand find-integer complex < real > log2 integer? number bits>double double>bits bitor 2/ zero? rem all-integers? (find-integer) real-part align bits>float float? shift float 1+ 1- fp-nan? ratio? bitxor even? ratio <= /mod >integer odd? rational? bitnot real? >fixnum complex? (next-power-of-2) /i numerator /f +syn keyword factorKeyword slice-to append left-trim find-last-from clone-like 3sequence map-as last-index-from reversed index-from pad-left cut* nth sequence slice? tail-slice empty? tail* find-from member? virtual-sequence? unclip set-length drop-prefix bounds-error? set-slice-seq map start open-slice midpoint@ set-immutable-seq move-forward rest-slice prepend fourth delete set-slice-to new-sequence follow all-eq? monotonic? set-reversed-seq like delete-nth first4 repetition-len (open-slice) reverse slice padding virtual@ repetition? index 4sequence max-length set-second first2 first3 (3append) supremum unclip-slice move-backward tail 3append sequence-hashcode-step right-trim reversed-seq pad-right suffix concat set-slice-from flip filter sum immutable? 2sequence delete-all start* immutable-sequence? (append) check-slice sequence? head set-slice-error-reason reduce set-bounds-error-index reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check immutable find remove ((append)) set-fourth peek contains? reversed? shorter? push-new find-last head-slice pop* immutable-seq tail-slice* accumulate each pusher all-equal? new-resizable cut-slice head-slice* 2reverse-each pop memq? set-nth ?nth second change-each join set-repetition-len all? virtual-sequence set-repetition-elt subseq? immutable-sequence slice-error-reason new-like length last-index push-if 2all? lengthen joined-length copy set-bounds-error-seq cache-nth move third first slice-from repetition-elt tail? set-first prefix bounds-error bounds-error-seq bounds-error-index unfold exchange slice-seq cut 2reduce change-nth min-length set-third (delete) push-all head? delete-slice rest sum-lengths 2each head* infimum sequence-hashcode slice-error subseq replace-slice repetition push trim mismatch +syn keyword factorKeyword global +@ set-namestack with-variable on set bind dec namestack get get-global change init-namespaces with-scope off set-global namespace % make , inc counter building make-assoc +syn keyword factorKeyword 3array >array 4array pair? array pair 2array 1array resize-array array? +syn keyword factorKeyword readln stream-read-until stream-read-partial stderr with-stream read with-stream* print contents make-span-stream write1 stream-write1 stream-format make-block-stream stream-copy with-cell stream-write format with-row stream-print stream-read with-nesting (stream-copy) bl write-object nl stream-nl write stdio flush read-until tabular-output make-cell-stream write-cell stream-flush read1 lines stream-read1 stream-write-table with-style stream-readln +syn keyword factorKeyword resize-string >string 1string string string? +syn keyword factorKeyword vector? ?push vector >vector 1vector +syn keyword factorKeyword rethrow-restarts restarts recover set-restart-name set-continuation-name condition-continuation ifcc continuation-name condition-error set-restart-continuation ignore-errors continuation-retain continue restart-continuation with-disposal set-continuation-catch set-condition-error restart-obj error thread-error-hook set-continuation-retain continuation rethrow callcc1 callcc0 condition continuation? continuation-call continuation-data set-condition-restarts set-catchstack >continuation< error-continuation cleanup restart? compute-restarts condition? error-thread set-continuation-call set-condition-continuation set-restart-obj dispose set-continuation-data throw-restarts catchstack continue-with attempt-all restart restart-name continuation-catch condition-restarts + + +syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal +syn cluster factorNumber contains=@factorReal,factorComplex +syn cluster factorNumErr contains=factorBinErr,factorHexErr,factorOctErr +syn match factorInt /\<-\=\d\+\>/ +syn match factorFloat /\<-\=\d*\.\d\+\>/ +syn match factorRatio /\<-\=\d*\.*\d\+\/-\=\d*\.*\d\+\>/ +syn region factorComplex start=/\/ end=/\<}\>/ contains=@factorReal +syn match factorBinErr /\/ +syn match factorBinary /\/ +syn match factorHexErr /\/ +syn match factorHex /\/ +syn match factorOctErr /\/ +syn match factorOctal /\/ + +syn match factorIn /\/ +syn match factorUse /\/ + +syn match factorCharErr /\/ + +syn match factorBackslash /\<\\\>\s\+\S\+\>/ + +syn region factorUsing start=/\/ end=/;/ +syn region factorRequires start=/\/ end=/;/ + +syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor +syn match factorSymbol /\/ +syn match factorPostpone /\/ +syn match factorDefer /\/ +syn match factorForget /\/ +syn match factorMixin /\/ +syn match factorInstance /\/ +syn match factorHook /\/ +syn match factorMain /\/ +syn match factorConstructor /\/ + +syn match factorAlien /\/ + +syn region factorTuple start=/\/ end=/\<;\>/ + +"TODO: +"misc: +" HELP: +" ARTICLE: +"literals: +" PRIMITIVE: + +"C interface: +" FIELD: +" BEGIN-STRUCT: +" C-ENUM: +" FUNCTION: +" END-STRUCT +" DLL" +" TYPEDEF: +" LIBRARY: +" C-UNION: + +syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline +syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline + +syn region factorMultiString matchgroup=factorMultiStringDelims start=/\/ end=/^;$/ contains=factorMultiStringContents +syn match factorMultiStringContents /.*/ contained + +"syn match factorStackEffectErr /\<)\>/ +"syn region factorStackEffectErr start=/\<(\>/ end=/\<)\>/ +syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained + +"adapted from lisp.vim +if exists("g:factor_norainbow") + syn region factorQuotation0 matchgroup=factorDelimiter start=/\<\'\?\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL +else + syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1 + syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2 + syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3 + syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4 + syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5 + syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6 + syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7 + syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8 + syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9 + syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0 +endif + +if exists("g:factor_norainbow") + syn region factorArray matchgroup=factorDelimiter start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL +else + syn region factorArray0 matchgroup=hlLevel0 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1 + syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2 + syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3 + syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4 + syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5 + syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6 + syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7 + syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8 + syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9 + syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0 +endif + +syn match factorBracketErr /\<\]\>/ +syn match factorBracketErr /\<}\>/ + +syn sync lines=100 + +if version >= 508 || !exists("did_factor_syn_inits") + if version <= 508 + let did_factor_syn_inits = 1 + command -nargs=+ HiLink hi link + else + command -nargs=+ HiLink hi def link + endif + + HiLink factorComment Comment + HiLink factorStackEffect Typedef + HiLink factorTodo Todo + HiLink factorInclude Include + HiLink factorRepeat Repeat + HiLink factorConditional Conditional + HiLink factorKeyword Keyword + HiLink factorOperator Operator + HiLink factorBoolean Boolean + HiLink factorDefnDelims Typedef + HiLink factorMethodDelims Typedef + HiLink factorGenericDelims Typedef + HiLink factorGenericNDelims Typedef + HiLink factorConstructor Typedef + HiLink factorPrivate Special + HiLink factorPrivateDefnDelims Special + HiLink factorPrivateMethodDelims Special + HiLink factorPGenericDelims Special + HiLink factorPGenericNDelims Special + HiLink factorString String + HiLink factorSbuf String + HiLink factorMultiStringContents String + HiLink factorMultiStringDelims Typedef + HiLink factorBracketErr Error + HiLink factorComplex Number + HiLink factorRatio Number + HiLink factorBinary Number + HiLink factorBinErr Error + HiLink factorHex Number + HiLink factorHexErr Error + HiLink factorOctal Number + HiLink factorOctErr Error + HiLink factorFloat Float + HiLink factorInt Number + HiLink factorUsing Include + HiLink factorUse Include + HiLink factorRequires Include + HiLink factorIn Define + HiLink factorChar Character + HiLink factorCharErr Error + HiLink factorDelimiter Delimiter + HiLink factorBackslash Special + HiLink factorCompileDirective Typedef + HiLink factorSymbol Define + HiLink factorMixin Typedef + HiLink factorInstance Typedef + HiLink factorHook Typedef + HiLink factorMain Define + HiLink factorPostpone Define + HiLink factorDefer Define + HiLink factorForget Define + HiLink factorAlien Define + HiLink factorTuple Typedef + + if &bg == "dark" + hi hlLevel0 ctermfg=red guifg=red1 + hi hlLevel1 ctermfg=yellow guifg=orange1 + hi hlLevel2 ctermfg=green guifg=yellow1 + hi hlLevel3 ctermfg=cyan guifg=greenyellow + hi hlLevel4 ctermfg=magenta guifg=green1 + hi hlLevel5 ctermfg=red guifg=springgreen1 + hi hlLevel6 ctermfg=yellow guifg=cyan1 + hi hlLevel7 ctermfg=green guifg=slateblue1 + hi hlLevel8 ctermfg=cyan guifg=magenta1 + hi hlLevel9 ctermfg=magenta guifg=purple1 + else + hi hlLevel0 ctermfg=red guifg=red3 + hi hlLevel1 ctermfg=darkyellow guifg=orangered3 + hi hlLevel2 ctermfg=darkgreen guifg=orange2 + hi hlLevel3 ctermfg=blue guifg=yellow3 + hi hlLevel4 ctermfg=darkmagenta guifg=olivedrab4 + hi hlLevel5 ctermfg=red guifg=green4 + hi hlLevel6 ctermfg=darkyellow guifg=paleturquoise3 + hi hlLevel7 ctermfg=darkgreen guifg=deepskyblue4 + hi hlLevel8 ctermfg=blue guifg=darkslateblue + hi hlLevel9 ctermfg=darkmagenta guifg=darkviolet + endif + + delcommand HiLink +endif + +let b:current_syntax = "factor" + +set sw=4 +set ts=4 +set expandtab +set autoindent " annoying? + +" vim: syntax=vim + diff --git a/unfinished/benchmark/richards/richards.factor b/unfinished/benchmark/richards/richards.factor index 894948e44f..90d4304eee 100644 --- a/unfinished/benchmark/richards/richards.factor +++ b/unfinished/benchmark/richards/richards.factor @@ -47,13 +47,13 @@ TUPLE: packet link id kind a1 a2 ; : HOLDBIT 4 ; inline : S_RUN 0 ; inline -: S_RUNPKT { PKTBIT } flags ; inline -: S_WAIT { WAITBIT } flags ; inline -: S_WAITPKT { WAITBIT PKTBIT } flags ; inline -: S_HOLD { HOLDBIT } flags ; inline -: S_HOLDPKT { HOLDBIT PKTBIT } flags ; inline -: S_HOLDWAIT { HOLDBIT WAITBIT } flags ; inline -: S_HOLDWAITPKT { HOLDBIT WAITBIT PKTBIT } flags ; inline +: S_RUNPKT ( -- n ) { PKTBIT } flags ; inline +: S_WAIT ( -- n ) { WAITBIT } flags ; inline +: S_WAITPKT ( -- n ) { WAITBIT PKTBIT } flags ; inline +: S_HOLD ( -- n ) { HOLDBIT } flags ; inline +: S_HOLDPKT ( -- n ) { HOLDBIT PKTBIT } flags ; inline +: S_HOLDWAIT ( -- n ) { HOLDBIT WAITBIT } flags ; inline +: S_HOLDWAITPKT ( -- n ) { HOLDBIT WAITBIT PKTBIT } flags ; inline : task-tab-size 10 ; inline diff --git a/unmaintained/4DNav/4DNav-docs.factor b/unmaintained/4DNav/4DNav-docs.factor new file mode 100755 index 0000000000..d4bf1db87d --- /dev/null +++ b/unmaintained/4DNav/4DNav-docs.factor @@ -0,0 +1,400 @@ +! Copyright (C) 2008 Jean-François Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations strings ; +IN: 4DNav + +HELP: (mvt-4D) +{ $values + { "quot" quotation } +} +{ $description "" } ; + +HELP: 4D-Rxw +{ $values + { "angle" null } + { "Rz" null } +} +{ $description "" } ; + +HELP: 4D-Rxy +{ $values + { "angle" null } + { "Rx" null } +} +{ $description "" } ; + +HELP: 4D-Rxz +{ $values + { "angle" null } + { "Ry" null } +} +{ $description "" } ; + +HELP: 4D-Ryw +{ $values + { "angle" null } + { "Ry" null } +} +{ $description "" } ; + +HELP: 4D-Ryz +{ $values + { "angle" null } + { "Rx" null } +} +{ $description "" } ; + +HELP: 4D-Rzw +{ $values + { "angle" null } + { "Rz" null } +} +{ $description "" } ; + +HELP: 4DNav +{ $description "" } ; + +HELP: >observer3d +{ $values + { "value" null } +} +{ $description "" } ; + +HELP: >present-space +{ $values + { "value" null } +} +{ $description "" } ; + + +HELP: >view1 +{ $values + { "value" null } +} +{ $description "" } ; + +HELP: >view2 +{ $values + { "value" null } +} +{ $description "" } ; + +HELP: >view3 +{ $values + { "value" null } +} +{ $description "" } ; + +HELP: >view4 +{ $values + { "value" null } +} +{ $description "" } ; + +HELP: add-keyboard-delegate +{ $values + { "obj" object } + { "obj" object } +} +{ $description "" } ; + +HELP: button* +{ $values + { "string" string } { "quot" quotation } + { "button" null } +} +{ $description "" } ; + +HELP: camera-action +{ $values + { "quot" quotation } + { "quot" quotation } +} +{ $description "" } ; + +HELP: camera-button +{ $values + { "string" string } { "quot" quotation } + { "button" null } +} +{ $description "" } ; + +HELP: controller-window* +{ $values + { "gadget" "a gadget" } +} +{ $description "" } ; + + +HELP: init-models +{ $description "" } ; + +HELP: init-variables +{ $description "" } ; + +HELP: menu-3D +{ $values + { "gadget" null } +} +{ $description "The menu dedicated to 3D movements of the camera" } ; + +HELP: menu-4D +{ $values + + { "gadget" null } +} +{ $description "The menu dedicated to 4D movements of space" } ; + +HELP: menu-bar +{ $values + + { "gadget" null } +} +{ $description "return gadget containing menu buttons" } ; + +HELP: model-projection +{ $values + { "x" null } + { "space" null } +} +{ $description "Project space following coordinate x" } ; + +HELP: mvt-3D-1 +{ $values + + { "quot" quotation } +} +{ $description "return a quotation to orientate space to see it from first point of view" } ; + +HELP: mvt-3D-2 +{ $values + + { "quot" quotation } +} +{ $description "return a quotation to orientate space to see it from second point of view" } ; + +HELP: mvt-3D-3 +{ $values + + { "quot" quotation } +} +{ $description "return a quotation to orientate space to see it from third point of view" } ; + +HELP: mvt-3D-4 +{ $values + + { "quot" quotation } +} +{ $description "return a quotation to orientate space to see it from first point of view" } ; + +HELP: observer3d +{ $description "" } ; + +HELP: observer3d> +{ $values + + { "value" null } +} +{ $description "" } ; + +HELP: present-space +{ $description "" } ; + +HELP: present-space> +{ $values + + { "value" null } +} +{ $description "" } ; + +HELP: load-model-file +{ $description "load space from file" } ; + +HELP: rotation-4D +{ $values + { "m" "a rotation matrix" } +} +{ $description "Apply a 4D rotation matrix" } ; + +HELP: translation-4D +{ $values + { "v" null } +} +{ $description "" } ; + +HELP: update-model-projections +{ $description "" } ; + +HELP: update-observer-projections +{ $description "" } ; + +HELP: view1 +{ $description "" } ; + +HELP: view1> +{ $values + + { "value" null } +} +{ $description "" } ; + +HELP: view2 +{ $description "" } ; + +HELP: view2> +{ $values + + { "value" null } +} +{ $description "" } ; + +HELP: view3 +{ $description "" } ; + +HELP: view3> +{ $values + + { "value" null } +} +{ $description "" } ; + +HELP: view4 +{ $description "" } ; + +HELP: view4> +{ $values + + { "value" null } +} +{ $description "" } ; + +HELP: viewer-windows* +{ $description "" } ; + +HELP: win3D +{ $values + { "text" null } { "gadget" null } +} +{ $description "" } ; + +HELP: windows +{ $description "" } ; + +ARTICLE: "Space file" "Create a new space file" +"\nTo build a new space, create an XML file using " { $vocab-link "adsoda" } " model description. \nAn example is:" +$nl + +"\n" +"\n" +"\n 4" +"\n " +"\n 4cube1" +"\n 4" +"\n 1,0,0,0,100" +"\n -1,0,0,0,-150" +"\n 0,1,0,0,100" +"\n 0,-1,0,0,-150" +"\n 0,0,1,0,100" +"\n 0,0,-1,0,-150" +"\n 0,0,0,1,100" +"\n 0,0,0,-1,-150" +"\n 1,0,0" +"\n " +"\n " +"\n 4triancube" +"\n 4" +"\n 1,0,0,0,160" +"\n -0.4999999999999998,-0.8660254037844387,0,0,-130" +"\n -0.5000000000000004,0.8660254037844384,0,0,-130" +"\n 0,0,1,0,140" +"\n 0,0,-1,0,-180" +"\n 0,0,0,1,110" +"\n 0,0,0,-1,-180" +"\n 0,1,0" +"\n " +"\n " +"\n triangone" +"\n 4" +"\n 1,0,0,0,60" +"\n 0.5,0.8660254037844386,0,0,60" +"\n -0.5,0.8660254037844387,0,0,-20" +"\n -1.0,0,0,0,-100" +"\n -0.5,-0.8660254037844384,0,0,-100" +"\n 0.5,-0.8660254037844387,0,0,-20" +"\n 0,0,1,0,120" +"\n 0,0,-0.4999999999999998,-0.8660254037844387,-120" +"\n 0,0,-0.5000000000000004,0.8660254037844384,-120" +"\n 0,1,1" +"\n " +"\n " +"\n 1,1,1,1" +"\n 0.2,0.2,0.6" +"\n " +"\n 0.8,0.9,0.9" +"\n" +"\n" + + +; + +ARTICLE: "TODO" "Todo" +{ $list + "A file chooser" + "A vocab to initialize parameters" + "an editor mode" + { $list "add a face to a solid" + "add a solid to the space" + "move a face" + "move a solid" + "select a solid in a list" + "select a face" + "display selected face" + "edit a solid color" + "add a light" + "edit a light color" + "move a light" + } + "add a tool wich give an hyperplane normal vector with enought points. Will use adsoda.intersect-hyperplanes with { { 0 } { 0 } { 1 } } " + "decorrelate 3D camera and activate them with select buttons" + + + +} ; + + +ARTICLE: "4DNav" "4DNav" +{ $vocab-link "4DNav" } +$nl +{ $heading "4D Navigator" } +"4DNav is a simple tool to visualize 4 dimensionnal objects." +"\n" +"It uses " { $vocab-link "adsoda" } " library to display a 4D space and navigate thru it." + +"It will display:" +{ $list + { "a menu window" } + { "4 visualization windows" } +} +"Each window represents the projection of the 4D space on a particular 3D space." +$nl + +{ $heading "Initialization" } +"put the space file " { $strong "space-exemple.xml" } " in temp directory" +" and then type:" { $code "\"4DNav\" run" } +{ $heading "Navigation" } +"4D submenu move the space in translations and rotation." +"\n3D submenu move the camera in 3D space. Cameras in every 3D spaces are manipulated as a single one" +$nl + + + + +{ $heading "Links" } +{ $subsection "Space file" } + +{ $subsection "TODO" } + + +; + +ABOUT: "4DNav" diff --git a/unmaintained/4DNav/4DNav.factor b/unmaintained/4DNav/4DNav.factor new file mode 100755 index 0000000000..3a0543df1a --- /dev/null +++ b/unmaintained/4DNav/4DNav.factor @@ -0,0 +1,524 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: kernel +namespaces +accessors +make +math +math.functions +math.trig +math.parser +hashtables +sequences +combinators +continuations +colors +prettyprint +vars +quotations +io +io.directories +io.pathnames +help.markup +io.files +ui.gadgets.panes + ui + ui.gadgets + ui.traverse + ui.gadgets.borders + ui.gadgets.handler + ui.gadgets.slate + ui.gadgets.theme + ui.gadgets.frames + ui.gadgets.tracks + ui.gadgets.labels + ui.gadgets.labelled + ui.gadgets.lists + ui.gadgets.buttons + ui.gadgets.packs + ui.gadgets.grids + ui.gestures + ui.tools.workspace + ui.gadgets.scrollers +splitting +vectors +math.vectors +rewrite-closures +self +values +4DNav.turtle +4DNav.window3D +4DNav.deep +4DNav.space-file-decoder +models +fry +adsoda +adsoda.tools +; + +IN: 4DNav +VALUE: selected-file +VALUE: translation-step +VALUE: rotation-step + +3 to: translation-step +5 to: rotation-step + +VAR: selected-file-model +VAR: observer3d +VAR: view1 +VAR: view2 +VAR: view3 +VAR: view4 +VAR: present-space + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! replacement of namespaces.lib + +: make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! waiting for deep-cleave-quots + +: 4D-Rxy ( angle -- Rx ) deg>rad +[ 1.0 , 0.0 , 0.0 , 0.0 , + 0.0 , 1.0 , 0.0 , 0.0 , + 0.0 , 0.0 , dup cos , dup sin neg , + 0.0 , 0.0 , dup sin , dup cos , ] 4 make-matrix nip ; + +: 4D-Rxz ( angle -- Ry ) deg>rad +[ 1.0 , 0.0 , 0.0 , 0.0 , + 0.0 , dup cos , 0.0 , dup sin neg , + 0.0 , 0.0 , 1.0 , 0.0 , + 0.0 , dup sin , 0.0 , dup cos , ] 4 make-matrix nip ; + +: 4D-Rxw ( angle -- Rz ) deg>rad +[ 1.0 , 0.0 , 0.0 , 0.0 , + 0.0 , dup cos , dup sin neg , 0.0 , + 0.0 , dup sin , dup cos , 0.0 , + 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ; + +: 4D-Ryz ( angle -- Rx ) deg>rad +[ dup cos , 0.0 , 0.0 , dup sin neg , + 0.0 , 1.0 , 0.0 , 0.0 , + 0.0 , 0.0 , 1.0 , 0.0 , + dup sin , 0.0 , 0.0 , dup cos , ] 4 make-matrix nip ; + +: 4D-Ryw ( angle -- Ry ) deg>rad +[ dup cos , 0.0 , dup sin neg , 0.0 , + 0.0 , 1.0 , 0.0 , 0.0 , + dup sin , 0.0 , dup cos , 0.0 , + 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ; + +: 4D-Rzw ( angle -- Rz ) deg>rad +[ dup cos , dup sin neg , 0.0 , 0.0 , + dup sin , dup cos , 0.0 , 0.0 , + 0.0 , 0.0 , 1.0 , 0.0 , + 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! UI +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: button* ( string quot -- button ) closed-quot ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: model-projection-chooser ( -- gadget ) + observer3d> projection-mode>> + { { 1 "perspective" } { 0 "orthogonal" } } ; + +: collision-detection-chooser ( -- gadget ) + observer3d> collision-mode>> + { { t "on" } { f "off" } } +; + +: model-projection ( x -- space ) present-space> swap space-project ; + +: update-observer-projections ( -- ) + view1> relayout-1 + view2> relayout-1 + view3> relayout-1 + view4> relayout-1 ; + +: update-model-projections ( -- ) + 0 model-projection view1> (>>model) + 1 model-projection view2> (>>model) + 2 model-projection view3> (>>model) + 3 model-projection view4> (>>model) ; + +: camera-action ( quot -- quot ) + [ drop [ ] observer3d> with-self update-observer-projections ] + make* closed-quot ; + +: win3D ( text gadget -- ) "navigateur 4D : " rot append open-window ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! 4D object manipulation +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: (mvt-4D) ( quot -- ) + present-space> + swap call space-ensure-solids + >present-space + update-model-projections + update-observer-projections ; + +: rotation-4D ( m -- ) + '[ _ [ [ middle-of-space dup vneg ] keep swap space-translate ] dip + space-transform + swap space-translate + ] (mvt-4D) ; + +: translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! menu +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: menu-rotations-4D ( -- gadget ) + + 1 >>fill + "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] button* add-gadget + "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] button* add-gadget + @top-left grid-add + 1 >>fill + "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] button* add-gadget + "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] button* add-gadget + @top grid-add + 1 >>fill + "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] button* add-gadget + "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] button* add-gadget + @center grid-add + 1 >>fill + "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] button* add-gadget + "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] button* add-gadget + @top-right grid-add + 1 >>fill + "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] button* add-gadget + "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] button* add-gadget + @right grid-add + 1 >>fill + "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] button* add-gadget + "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] button* add-gadget + @bottom-right grid-add +; + +: menu-translations-4D ( -- gadget ) + + 1 >>fill + 1 >>fill + "X+" [ drop { 1 0 0 0 } translation-step v*n translation-4D ] + button* add-gadget + "X-" [ drop { -1 0 0 0 } translation-step v*n translation-4D ] + button* add-gadget + add-gadget + "YZW"