steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
John Benediktsson 2009-05-04 12:49:13 +00:00
parent a646d5c101 034dcc9c3b
commit e6448b4126
340 changed files with 8918 additions and 8478 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
Makefile
View File

@ -1,4 +1,5 @@
CC = gcc
CPP = g++
AR = ar
LD = ld
@ -9,7 +10,7 @@ VERSION = 0.92
BUNDLE = Factor.app
LIBPATH = -L/usr/X11R6/lib
CFLAGS = -Wall -Werror
CFLAGS = -Wall
ifdef DEBUG
CFLAGS += -g -DFACTOR_DEBUG
@ -35,6 +36,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/code_block.o \
vm/code_gc.o \
vm/code_heap.o \
vm/contexts.o \
vm/data_gc.o \
vm/data_heap.o \
vm/debug.o \
@ -45,6 +47,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/inline_cache.o \
vm/io.o \
vm/jit.o \
vm/local_roots.o \
vm/math.o \
vm/primitives.o \
vm/profiler.o \
@ -53,7 +56,8 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/strings.o \
vm/tuples.o \
vm/utilities.o \
vm/words.o
vm/words.o \
vm/write_barrier.o
EXE_OBJS = $(PLAF_EXE_OBJS)
@ -161,12 +165,12 @@ macosx.app: factor
$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
$(LINKER) $(ENGINE) $(DLL_OBJS)
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
$(LINKER) $(ENGINE) $(DLL_OBJS)
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
$(TEST_LIBRARY): vm/ffi_test.o
@ -174,7 +178,13 @@ $(TEST_LIBRARY): vm/ffi_test.o
clean:
rm -f vm/*.o
rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib} Factor.app/Contents/Frameworks/libfactor.dylib
rm -f factor.dll
rm -f libfactor.*
rm -f libfactor-ffi-test.*
rm -f Factor.app/Contents/Frameworks/libfactor.dylib
tags:
etags vm/*.{cpp,hpp,mm,S,c}
vm/resources.o:
$(WINDRES) vm/factor.rs vm/resources.o
@ -185,10 +195,15 @@ vm/ffi_test.o: vm/ffi_test.c
.c.o:
$(CC) -c $(CFLAGS) -o $@ $<
.cpp.o:
$(CPP) -c $(CFLAGS) -o $@ $<
.S.o:
$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
.m.o:
$(CC) -c $(CFLAGS) -o $@ $<
.mm.o:
$(CPP) -c $(CFLAGS) -o $@ $<
.PHONY: factor
.PHONY: factor tags clean
.SUFFIXES: .mm

4
README.txt
View File

@ -20,7 +20,7 @@ implementation. It is not an introduction to the language itself.
* Compiling the Factor VM
The Factor runtime is written in GNU C99, and is built with GNU make and
The Factor runtime is written in GNU C++, and is built with GNU make and
gcc.
Factor supports various platforms. For an up-to-date list, see
@ -138,7 +138,7 @@ usage documentation, enter the following in the UI listener:
The Factor source tree is organized as follows:
build-support/ - scripts used for compiling Factor
vm/ - sources for the Factor VM, written in C
vm/ - sources for the Factor VM, written in C++
core/ - Factor core library
basis/ - Factor basis library, compiler, tools
extra/ - more libraries and applications

65
basis/alien/arrays/arrays.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays alien.c-types alien.structs
sequences math kernel namespaces fry libc cpu.architecture ;
USING: alien alien.strings alien.c-types alien.accessors alien.structs
arrays words sequences math kernel namespaces fry libc cpu.architecture
io.encodings.utf8 io.encodings.utf16n ;
IN: alien.arrays
UNION: value-type array struct-type ;
@ -38,3 +39,61 @@ M: value-type c-type-getter
M: value-type c-type-setter ( type -- quot )
[ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
'[ @ swap @ _ memcpy ] ;
PREDICATE: string-type < pair
first2 [ "char*" = ] [ word? ] bi* and ;
M: string-type c-type ;
M: string-type c-type-class
drop object ;
M: string-type heap-size
drop "void*" heap-size ;
M: string-type c-type-align
drop "void*" c-type-align ;
M: string-type c-type-stack-align?
drop "void*" c-type-stack-align? ;
M: string-type unbox-parameter
drop "void*" unbox-parameter ;
M: string-type unbox-return
drop "void*" unbox-return ;
M: string-type box-parameter
drop "void*" box-parameter ;
M: string-type box-return
drop "void*" box-return ;
M: string-type stack-size
drop "void*" stack-size ;
M: string-type c-type-reg-class
drop int-regs ;
M: string-type c-type-boxer
drop "void*" c-type-boxer ;
M: string-type c-type-unboxer
drop "void*" c-type-unboxer ;
M: string-type c-type-boxer-quot
second '[ _ alien>string ] ;
M: string-type c-type-unboxer-quot
second '[ _ string>alien ] ;
M: string-type c-type-getter
drop [ alien-cell ] ;
M: string-type c-type-setter
drop [ set-alien-cell ] ;
{ "char*" utf8 } "char*" typedef
"char*" "uchar*" typedef
{ "char*" utf16n } "wchar_t*" typedef

36
basis/alien/c-types/c-types-docs.factor
View File

@ -1,7 +1,7 @@
IN: alien.c-types
USING: alien help.syntax help.markup libc kernel.private
byte-arrays math strings hashtables alien.syntax
debugger destructors ;
byte-arrays math strings hashtables alien.syntax alien.strings sequences
io.encodings.string debugger destructors ;
HELP: <c-type>
{ $values { "type" hashtable } }
@ -114,6 +114,38 @@ HELP: define-out
{ $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
{ string>alien alien>string malloc-string } related-words
HELP: malloc-string
{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
{ $errors "Throws an error if one of the following conditions occurs:"
{ $list
"the string contains null code points"
"the string contains characters not representable using the encoding specified"
"memory allocation fails"
}
} ;
ARTICLE: "c-strings" "C strings"
"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
$nl
"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
$nl
"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
$nl
"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
$nl
"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
{ $subsection string>alien }
{ $subsection malloc-string }
"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
$nl
"A word to read strings from arbitrary addresses:"
{ $subsection alien>string }
"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
"The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."
$nl

16
basis/alien/c-types/c-types.factor
View File

@ -2,9 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays arrays assocs kernel kernel.private libc math
namespaces make parser sequences strings words assocs splitting
math.parser cpu.architecture alien alien.accessors quotations
layouts system compiler.units io.files io.encodings.binary
accessors combinators effects continuations fry classes ;
math.parser cpu.architecture alien alien.accessors alien.strings
quotations layouts system compiler.units io io.files
io.encodings.binary io.streams.memory accessors combinators effects
continuations fry classes ;
IN: alien.c-types
DEFER: <int>
@ -213,6 +214,15 @@ M: f byte-length drop 0 ;
: memory>byte-array ( alien len -- byte-array )
[ nip (byte-array) dup ] 2keep memcpy ;
: malloc-string ( string encoding -- alien )
string>alien malloc-byte-array ;
M: memory-stream stream-read
[
[ index>> ] [ alien>> ] bi <displaced-alien>
swap memory>byte-array
] [ [ + ] change-index drop ] 2bi ;
: byte-array>memory ( byte-array base -- )
swap dup byte-length memcpy ;

8
basis/alien/libraries/libraries.factor
View File

@ -1,8 +1,12 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien assocs io.backend kernel namespaces ;
USING: accessors alien alien.strings assocs io.backend kernel namespaces ;
IN: alien.libraries
: dlopen ( path -- dll ) native-string>alien (dlopen) ;
: dlsym ( name dll -- alien ) [ native-string>alien ] dip (dlsym) ;
SYMBOL: libraries
libraries [ H{ } clone ] initialize
@ -18,4 +22,4 @@ TUPLE: library path abi dll ;
library dup [ dll>> ] when ;
: add-library ( name path abi -- )
<library> swap libraries get set-at ;
<library> swap libraries get set-at ;

52
basis/alien/strings/strings-docs.factor
View File

@ -1,52 +0,0 @@
USING: help.markup help.syntax strings byte-arrays alien libc
debugger io.encodings.string sequences ;
IN: alien.strings
HELP: string>alien
{ $values { "string" string } { "encoding" "an encoding descriptor" } { "byte-array" byte-array } }
{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated byte array." }
{ $errors "Throws an error if the string contains null characters, or characters not representable in the given encoding." } ;
{ string>alien alien>string malloc-string } related-words
HELP: alien>string
{ $values { "c-ptr" c-ptr } { "encoding" "an encoding descriptor" } { "string/f" "a string or " { $link f } } }
{ $description "Reads a null-terminated C string from the specified address with the given encoding." } ;
HELP: malloc-string
{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
{ $errors "Throws an error if one of the following conditions occurs:"
{ $list
"the string contains null code points"
"the string contains characters not representable using the encoding specified"
"memory allocation fails"
}
} ;
HELP: string>symbol
{ $values { "str" string } { "alien" alien } }
{ $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."
$nl
"On Windows CE, symbols are represented as UCS2 strings, and on all other platforms they are ASCII strings." } ;
ARTICLE: "c-strings" "C strings"
"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
$nl
"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
$nl
"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
$nl
"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
$nl
"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
{ $subsection string>alien }
{ $subsection malloc-string }
"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
$nl
"A word to read strings from arbitrary addresses:"
{ $subsection alien>string }
"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
ABOUT: "c-strings"

109
basis/alien/strings/strings.factor
View File

@ -1,109 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays sequences kernel accessors math alien.accessors
alien.c-types byte-arrays words io io.encodings
io.encodings.utf8 io.streams.byte-array io.streams.memory system
alien strings cpu.architecture fry vocabs.loader combinators ;
IN: alien.strings
GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
M: c-ptr alien>string
[ <memory-stream> ] [ <decoder> ] bi*
"\0" swap stream-read-until drop ;
M: f alien>string
drop ;
ERROR: invalid-c-string string ;
: check-string ( string -- )
0 over memq? [ invalid-c-string ] [ drop ] if ;
GENERIC# string>alien 1 ( string encoding -- byte-array )
M: c-ptr string>alien drop ;
M: string string>alien
over check-string
<byte-writer>
[ stream-write ]
[ 0 swap stream-write1 ]
[ stream>> >byte-array ]
tri ;
: malloc-string ( string encoding -- alien )
string>alien malloc-byte-array ;
PREDICATE: string-type < pair
first2 [ "char*" = ] [ word? ] bi* and ;
M: string-type c-type ;
M: string-type c-type-class
drop object ;
M: string-type heap-size
drop "void*" heap-size ;
M: string-type c-type-align
drop "void*" c-type-align ;
M: string-type c-type-stack-align?
drop "void*" c-type-stack-align? ;
M: string-type unbox-parameter
drop "void*" unbox-parameter ;
M: string-type unbox-return
drop "void*" unbox-return ;
M: string-type box-parameter
drop "void*" box-parameter ;
M: string-type box-return
drop "void*" box-return ;
M: string-type stack-size
drop "void*" stack-size ;
M: string-type c-type-reg-class
drop int-regs ;
M: string-type c-type-boxer
drop "void*" c-type-boxer ;
M: string-type c-type-unboxer
drop "void*" c-type-unboxer ;
M: string-type c-type-boxer-quot
second '[ _ alien>string ] ;
M: string-type c-type-unboxer-quot
second '[ _ string>alien ] ;
M: string-type c-type-getter
drop [ alien-cell ] ;
M: string-type c-type-setter
drop [ set-alien-cell ] ;
HOOK: alien>native-string os ( alien -- string )
HOOK: native-string>alien os ( string -- alien )
: dll-path ( dll -- string )
path>> alien>native-string ;
: string>symbol ( str -- alien )
dup string?
[ native-string>alien ]
[ [ native-string>alien ] map ] if ;
{ "char*" utf8 } "char*" typedef
"char*" "uchar*" typedef
{
{ [ os windows? ] [ "alien.strings.windows" require ] }
{ [ os unix? ] [ "alien.strings.unix" require ] }
} cond

1
basis/alien/strings/unix/summary.txt
View File

@ -1 +0,0 @@
Default string encoding on Unix

8
basis/alien/strings/unix/unix.factor
View File

@ -1,8 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings io.encodings.utf8 system ;
IN: alien.strings.unix
M: unix alien>native-string utf8 alien>string ;
M: unix native-string>alien utf8 string>alien ;

1
basis/alien/strings/windows/summary.txt
View File

@ -1 +0,0 @@
Default string encoding on Windows

1
basis/alien/strings/windows/tags.txt
View File

@ -1 +0,0 @@
unportable

13
basis/alien/strings/windows/windows.factor
View File

@ -1,13 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings alien.c-types io.encodings.utf8
io.encodings.utf16n system ;
IN: alien.strings.windows
M: windows alien>native-string utf16n alien>string ;
M: wince native-string>alien utf16n string>alien ;
M: winnt native-string>alien utf8 string>alien ;
{ "char*" utf16n } "wchar_t*" typedef

1
basis/bootstrap/stage2.factor
View File

@ -65,7 +65,6 @@ SYMBOL: bootstrap-time
"stage2: deployment mode" print
] [
"debugger" require
"alien.prettyprint" require
"inspector" require
"tools.errors" require
"listener" require

5
basis/bootstrap/tools/tools.factor
View File

@ -14,7 +14,8 @@ IN: bootstrap.tools
"tools.test"
"tools.time"
"tools.threads"
"tools.vocabs"
"tools.vocabs.monitor"
"vocabs.hierarchy"
"vocabs.refresh"
"vocabs.refresh.monitor"
"editors"
} [ require ] each

6
basis/command-line/command-line.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: init continuations hashtables io io.encodings.utf8
io.files io.pathnames kernel kernel.private namespaces parser
sequences strings system splitting vocabs.loader ;
sequences strings system splitting vocabs.loader alien.strings ;
IN: command-line
SYMBOL: script
SYMBOL: command-line
: (command-line) ( -- args ) 10 getenv sift ;
: (command-line) ( -- args ) 10 getenv sift [ alien>native-string ] map ;
: rc-path ( name -- path )
os windows? [ "." prepend ] unless

4
basis/compiler/tests/simple.factor
View File

@ -60,8 +60,8 @@ IN: compiler.tests.simple
! Make sure error reporting works
[ [ dup ] compile-call ] must-fail
[ [ drop ] compile-call ] must-fail
! [ [ dup ] compile-call ] must-fail
! [ [ drop ] compile-call ] must-fail
! Regression

24
basis/debugger/debugger.factor
View File

@ -1,14 +1,13 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! 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.pathnames vectors words system splitting math.parser
classes.mixin classes.tuple continuations continuations.private
combinators generic.math classes.builtin classes compiler.units
generic.standard generic.single vocabs init kernel.private io.encodings
accessors math.order destructors source-files parser
classes.tuple.parser effects.parser lexer
USING: slots arrays definitions generic hashtables summary io kernel
math namespaces make prettyprint prettyprint.config 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 generic.single vocabs init
kernel.private io.encodings accessors math.order destructors
source-files parser classes.tuple.parser effects.parser lexer
generic.parser strings.parser vocabs.loader vocabs.parser see
source-files.errors ;
IN: debugger
@ -17,6 +16,7 @@ GENERIC: error. ( error -- )
GENERIC: error-help ( error -- topic )
M: object error. . ;
M: object error-help drop f ;
M: tuple error-help class ;
@ -77,7 +77,7 @@ M: string error. print ;
"Object did not survive image save/load: " write third . ;
: io-error. ( error -- )
"I/O error: " write third print ;
"I/O error #" write third . ;
: type-check-error. ( obj -- )
"Type check error" print
@ -98,9 +98,7 @@ HOOK: signal-error. os ( obj -- )
"Cannot convert to C string: " write third . ;
: ffi-error. ( obj -- )
"FFI: " write
dup third [ write ": " write ] when*
fourth print ;
"FFI error" print drop ;
: heap-scan-error. ( obj -- )
"Cannot do next-object outside begin/end-scan" print drop ;

10
basis/editors/editors.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser lexer kernel namespaces sequences definitions io.files
io.backend io.pathnames io summary continuations tools.crossref
tools.vocabs prettyprint source-files source-files.errors assocs
vocabs vocabs.loader splitting accessors debugger prettyprint
help.topics ;
USING: parser lexer kernel namespaces sequences definitions
io.files io.backend io.pathnames io summary continuations
tools.crossref vocabs.hierarchy prettyprint source-files
source-files.errors assocs vocabs vocabs.loader splitting
accessors debugger prettyprint help.topics ;
IN: editors
TUPLE: no-edit-hook ;

20
basis/formatting/formatting.factor
View File

@ -4,7 +4,7 @@
USING: accessors arrays ascii assocs 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 ;
sequences splitting strings unicode.case vectors combinators.smart ;
IN: formatting
@ -113,7 +113,6 @@ MACRO: printf ( format-string -- )
: sprintf ( format-string -- result )
[ printf ] with-string-writer ; inline
<PRIVATE
: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-head ; inline
@ -129,12 +128,15 @@ MACRO: printf ( format-string -- )
[ 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
[
{
[ day-of-week day-abbreviation3 ]
[ month>> month-abbreviation ]
[ day>> pad-00 ]
[ >time ]
[ year>> number>string ]
} cleave
] output>array " " join ; inline
: (week-of-year) ( timestamp day -- n )
[ dup clone 1 >>month 1 >>day day-of-week dup ] dip > [ 7 swap - ] when
@ -187,5 +189,3 @@ PRIVATE>
MACRO: strftime ( format-string -- )
parse-strftime [ length ] keep [ ] join
'[ _ <vector> @ reverse concat nip ] ;

4
basis/help/apropos/apropos.factor
View File

@ -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: accessors arrays assocs fry help.markup help.topics io
kernel make math math.parser namespaces sequences sorting
summary tools.completion tools.vocabs help.vocabs
summary tools.completion vocabs.hierarchy help.vocabs
vocabs words unicode.case help ;
IN: help.apropos

3
basis/help/handbook/handbook.factor
View File

@ -281,7 +281,7 @@ ARTICLE: "handbook-tools-reference" "Developer tools"
{ $heading "Workflow" }
{ $subsection "listener" }
{ $subsection "editor" }
{ $subsection "tools.vocabs" }
{ $subsection "vocabs.refresh" }
{ $subsection "tools.test" }
{ $subsection "help" }
{ $heading "Debugging" }
@ -292,6 +292,7 @@ ARTICLE: "handbook-tools-reference" "Developer tools"
{ $heading "Browsing" }
{ $subsection "see" }
{ $subsection "tools.crossref" }
{ $subsection "vocabs.hierarchy" }
{ $heading "Performance" }
{ $subsection "timing" }
{ $subsection "profiling" }

2
basis/help/html/html.factor
View File

@ -3,7 +3,7 @@
USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
io.files io.files.temp io.directories html.streams help kernel
assocs sequences make words accessors arrays help.topics vocabs
tools.vocabs help.vocabs namespaces prettyprint io
vocabs.hierarchy help.vocabs namespaces prettyprint io
vocabs.loader serialize fry memoize ascii unicode.case math.order
sorting debugger html xml.syntax xml.writer math.parser ;
IN: help.html

2
basis/help/lint/lint.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: assocs continuations fry help help.lint.checks
help.topics io kernel namespaces parser sequences
source-files.errors tools.vocabs vocabs words classes
source-files.errors vocabs.hierarchy vocabs words classes
locals tools.errors ;
FROM: help.lint.checks => all-vocabs ;
IN: help.lint

2
basis/help/tutorial/tutorial.factor
View File

@ -1,6 +1,6 @@
USING: help.markup help.syntax ui.commands ui.operations
editors vocabs.loader kernel sequences prettyprint tools.test
tools.vocabs strings unicode.categories unicode.case
vocabs.refresh strings unicode.categories unicode.case
ui.tools.browser ui.tools.common ;
IN: help.tutorial

3
basis/help/vocabs/vocabs.factor
View File

@ -6,7 +6,8 @@ classes.singleton classes.tuple classes.union combinators
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 words.symbol definitions.icons ;
vocabs vocabs.files vocabs.hierarchy vocabs.loader
vocabs.metadata words words.symbol definitions.icons ;
IN: help.vocabs
: about ( vocab -- )

2
basis/http/server/server-docs.factor
View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax io.streams.string quotations strings urls http tools.vocabs math io.servers.connection ;
USING: help.markup help.syntax io.streams.string quotations strings urls http vocabs.refresh math io.servers.connection ;
IN: http.server
HELP: trivial-responder

4
basis/http/server/server.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences arrays namespaces splitting
vocabs.loader destructors assocs debugger continuations
combinators tools.vocabs tools.time math math.parser present
combinators vocabs.refresh tools.time math math.parser present
io vectors
io.sockets
io.sockets.secure

5
basis/io/encodings/iana/iana.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel strings values io.files assocs
splitting sequences io namespaces sets
io.encodings.ascii io.encodings.utf8 ;
io.encodings.ascii io.encodings.utf8 io.encodings.utf16 ;
IN: io.encodings.iana
<PRIVATE
@ -55,3 +55,6 @@ e>n-table [ initial-e>n ] initialize
] [ swap e>n-table get-global set-at ] 2bi ;
ascii "ANSI_X3.4-1968" register-encoding
utf16be "UTF-16BE" register-encoding
utf16le "UTF-16LE" register-encoding
utf16 "UTF-16" register-encoding

2
basis/json/reader/reader.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Peter Burns.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel peg peg.ebnf math.parser math.private strings math
USING: kernel peg peg.ebnf math.parser math.parser.private strings math
math.functions sequences arrays vectors hashtables assocs
prettyprint json ;
IN: json.reader

6
basis/literals/literals-tests.factor
View File

@ -19,3 +19,9 @@ IN: literals.tests
[ { 0.5 2.0 } ] [ { $[ 1.0 2.0 / ] 2.0 } ] unit-test
[ { 1.0 { 0.5 1.5 } 4.0 } ] [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test
<<
CONSTANT: constant-a 3
>>
[ { 3 10 "ftw" } ] [ ${ constant-a 10 "ftw" } ] unit-test

4
basis/literals/literals.factor
View File

@ -1,6 +1,8 @@
! (c) Joe Groff, see license for details
USING: accessors continuations kernel parser words quotations vectors ;
USING: accessors continuations kernel parser words quotations
combinators.smart vectors sequences ;
IN: literals
SYNTAX: $ scan-word [ def>> call ] curry with-datastack >vector ;
SYNTAX: $[ parse-quotation with-datastack >vector ;
SYNTAX: ${ \ } [ [ ?execute ] { } map-as ] parse-literal ;

2
basis/present/present-tests.factor
View File

@ -1,5 +1,5 @@
IN: present.tests
USING: tools.test present math vocabs tools.vocabs sequences kernel ;
USING: tools.test present math vocabs sequences kernel ;
[ "3" ] [ 3 present ] unit-test
[ "Hi" ] [ "Hi" present ] unit-test

21
basis/prettyprint/backend/backend.factor
View File

@ -1,11 +1,10 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! Copyright (C) 2003, 2009 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 vectors
USING: accessors arrays byte-arrays byte-vectors generic hashtables io
assocs 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 ;
quotations io io.pathnames io.styles math.parser effects classes.tuple
math.order classes.tuple.private classes combinators colors ;
IN: prettyprint.backend
M: effect pprint* effect>string "(" ")" surround text ;
@ -135,8 +134,8 @@ M: pathname pprint*
[ text ] [ f <inset pprint* block> ] bi*
\ } pprint-word block> ;
M: tuple pprint*
boa-tuples? get [ call-next-method ] [
: pprint-tuple ( tuple -- )
boa-tuples? get [ pprint-object ] [
[
<flow
\ T{ pprint-word
@ -149,6 +148,9 @@ M: tuple pprint*
] check-recursion
] if ;
M: tuple pprint*
pprint-tuple ;
: do-length-limit ( seq -- trimmed n/f )
length-limit get dup [
over length over [-]
@ -165,6 +167,7 @@ M: curry pprint-delims drop \ [ \ ] ;
M: compose pprint-delims drop \ [ \ ] ;
M: array pprint-delims drop \ { \ } ;
M: byte-array pprint-delims drop \ B{ \ } ;
M: byte-vector pprint-delims drop \ BV{ \ } ;
M: vector pprint-delims drop \ V{ \ } ;
M: hashtable pprint-delims drop \ H{ \ } ;
M: tuple pprint-delims drop \ T{ \ } ;
@ -173,6 +176,7 @@ M: callstack pprint-delims drop \ CS{ \ } ;
M: object >pprint-sequence ;
M: vector >pprint-sequence ;
M: byte-vector >pprint-sequence ;
M: curry >pprint-sequence ;
M: compose >pprint-sequence ;
M: hashtable >pprint-sequence >alist ;
@ -202,6 +206,7 @@ M: object pprint-object ( obj -- )
M: object pprint* pprint-object ;
M: vector pprint* pprint-object ;
M: byte-vector pprint* pprint-object ;
M: hashtable pprint* pprint-object ;
M: curry pprint* pprint-object ;
M: compose pprint* pprint-object ;

38
basis/stack-checker/known-words/known-words.factor
View File

@ -1,16 +1,16 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors alien alien.accessors arrays byte-arrays
classes sequences.private continuations.private effects generic
hashtables hashtables.private io io.backend io.files
io.files.private io.streams.c kernel kernel.private math
math.private memory namespaces namespaces.private parser
quotations quotations.private sbufs sbufs.private
sequences sequences.private slots.private strings
USING: fry accessors alien alien.accessors arrays byte-arrays classes
sequences.private continuations.private effects generic hashtables
hashtables.private io io.backend io.files io.files.private
io.streams.c kernel kernel.private math math.private
math.parser.private memory memory.private namespaces
namespaces.private parser quotations quotations.private sbufs
sbufs.private sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
classes.tuple.private vectors vectors.private words definitions
assocs summary compiler.units system.private
combinators combinators.short-circuit locals locals.backend locals.types
classes.tuple.private vectors vectors.private words definitions assocs
summary compiler.units system.private combinators
combinators.short-circuit locals locals.backend locals.types
quotations.private combinators.private stack-checker.values
generic.single generic.single.private
alien.libraries
@ -290,11 +290,11 @@ M: object infer-call*
\ bignum>float { bignum } { float } define-primitive
\ bignum>float make-foldable
\ string>float { string } { float } define-primitive
\ string>float make-foldable
\ (string>float) { byte-array } { float } define-primitive
\ (string>float) make-foldable
\ float>string { float } { string } define-primitive
\ float>string make-foldable
\ (float>string) { float } { byte-array } define-primitive
\ (float>string) make-foldable
\ float>bits { real } { integer } define-primitive
\ float>bits make-foldable
@ -465,9 +465,9 @@ M: object infer-call*
\ gc-stats { } { array } define-primitive
\ save-image { string } { } define-primitive
\ (save-image) { byte-array } { } define-primitive
\ save-image-and-exit { string } { } define-primitive
\ (save-image-and-exit) { byte-array } { } define-primitive
\ data-room { } { integer integer array } define-primitive
\ data-room make-flushable
@ -481,9 +481,9 @@ M: object infer-call*
\ tag { object } { fixnum } define-primitive
\ tag make-foldable
\ dlopen { string } { dll } define-primitive
\ (dlopen) { byte-array } { dll } define-primitive
\ dlsym { string object } { c-ptr } define-primitive
\ (dlsym) { byte-array object } { c-ptr } define-primitive
\ dlclose { dll } { } define-primitive
@ -598,7 +598,7 @@ M: object infer-call*
\ die { } { } define-primitive
\ fopen { string string } { alien } define-primitive
\ (fopen) { byte-array byte-array } { alien } define-primitive
\ fgetc { alien } { object } define-primitive

8
basis/tools/completion/completion.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel arrays sequences math namespaces
strings io fry vectors words assocs combinators sorting
unicode.case unicode.categories math.order vocabs
tools.vocabs unicode.data locals ;
USING: accessors kernel arrays sequences math namespaces strings io
fry vectors words assocs combinators sorting unicode.case
unicode.categories math.order vocabs vocabs.hierarchy unicode.data
locals ;
IN: tools.completion
:: (fuzzy) ( accum i full ch -- accum i full ? )

2
basis/tools/deploy/config/editor/editor.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs io.pathnames kernel parser prettyprint sequences
splitting tools.deploy.config tools.vocabs vocabs.loader ;
splitting tools.deploy.config vocabs.loader vocabs.metadata ;
IN: tools.deploy.config.editor
: deploy-config-path ( vocab -- string )

2
basis/tools/deploy/shaker/shaker.factor
View File

@ -37,7 +37,7 @@ IN: tools.deploy.shaker
] when
strip-dictionary? [
"compiler.units" init-hooks get delete-at
"tools.vocabs" init-hooks get delete-at
"vocabs.cache" init-hooks get delete-at
] when ;
: strip-debugger ( -- )

6
basis/tools/test/test.factor
View File

@ -4,9 +4,9 @@ USING: accessors arrays assocs combinators compiler.units
continuations debugger effects fry generalizations io io.files
io.styles kernel lexer locals macros math.parser namespaces
parser prettyprint quotations sequences source-files splitting
stack-checker summary unicode.case vectors vocabs vocabs.loader words
tools.vocabs tools.errors source-files.errors io.streams.string make
compiler.errors ;
stack-checker summary unicode.case vectors vocabs vocabs.loader
vocabs.files words tools.errors source-files.errors
io.streams.string make compiler.errors ;
IN: tools.test
TUPLE: test-failure < source-file-error continuation ;

1
basis/tools/vocabs/summary.txt
View File

@ -1 +0,0 @@
Reloading vocabularies and cross-referencing vocabularies

75
basis/tools/vocabs/vocabs-docs.factor
View File

@ -1,75 +0,0 @@
USING: help.markup help.syntax strings ;
IN: tools.vocabs
ARTICLE: "tools.vocabs" "Vocabulary tools"
"Reloading source files changed on disk:"
{ $subsection refresh }
{ $subsection refresh-all }
"Vocabulary summaries:"
{ $subsection vocab-summary }
{ $subsection set-vocab-summary }
"Vocabulary tags:"
{ $subsection vocab-tags }
{ $subsection set-vocab-tags }
{ $subsection add-vocab-tags }
"Getting and setting vocabulary meta-data:"
{ $subsection vocab-file-contents }
{ $subsection set-vocab-file-contents }
"Global meta-data:"
{ $subsection all-vocabs }
{ $subsection all-vocabs-seq }
{ $subsection all-tags }
{ $subsection all-authors }
"Because loading the above data is expensive, it is cached. The cache is flushed by the " { $vocab-link "tools.vocabs.monitor" } " vocabulary. It can also be flushed manually when file system change monitors are not available:"
{ $subsection reset-cache } ;
ABOUT: "tools.vocabs"
HELP: vocab-files
{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
{ $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
HELP: vocab-tests
{ $values { "vocab" "a vocabulary specifier" } { "tests" "a sequence of pathname strings" } }
{ $description "Outputs a sequence of pathnames where the unit tests for " { $snippet "vocab" } " are located." } ;
HELP: source-modified?
{ $values { "path" "a pathname string" } { "?" "a boolean" } }
{ $description "Tests if the source file has been modified since it was last loaded. This compares the file's CRC32 checksum of the file's contents against the previously-recorded value." } ;
HELP: refresh
{ $values { "prefix" string } }
{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
HELP: refresh-all
{ $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
{ refresh refresh-all } related-words
HELP: vocab-file-contents
{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
HELP: set-vocab-file-contents
{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;
HELP: vocab-summary
{ $values { "vocab" "a vocabulary specifier" } { "summary" "a string or " { $link f } } }
{ $description "Outputs a one-line string description of the vocabulary's intended purpose from the " { $snippet "summary.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-summary
{ $values { "string" "a string or " { $link f } } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a one-line string description of the vocabulary to the " { $snippet "summary.txt" } " file in the vocabulary's directory." } ;
HELP: vocab-tags
{ $values { "vocab" "a vocabulary specifier" } { "tags" "a sequence of strings" } }
{ $description "Outputs a list of short tags classifying the vocabulary from the " { $snippet "tags.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-tags
{ $values { "tags" "a sequence of strings" } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a list of short tags classifying the vocabulary to the " { $snippet "tags.txt" } " file in the vocabulary's directory." } ;
HELP: all-vocabs
{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;

9
basis/tools/vocabs/vocabs-tests.factor
View File

@ -1,9 +0,0 @@
IN: tools.vocabs.tests
USING: tools.test tools.vocabs namespaces continuations ;
[ ] [
changed-vocabs get-global
f changed-vocabs set-global
[ t ] [ "kernel" changed-vocab? ] unit-test
[ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup
] unit-test

296
basis/tools/vocabs/vocabs.factor
View File

@ -1,296 +0,0 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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-tests-file ( vocab -- path )
dup "-tests.factor" vocab-dir+ vocab-append-path dup
[ dup exists? [ drop f ] unless ] [ drop f ] if ;
: vocab-tests-dir ( vocab -- paths )
dup vocab-dir "tests" append-path vocab-append-path dup [
dup exists? [
dup directory-files [ ".factor" tail? ] filter
[ append-path ] with map
] [ drop f ] if
] [ drop f ] if ;
: vocab-tests ( vocab -- tests )
[
[ vocab-tests-file [ , ] when* ]
[ vocab-tests-dir [ % ] when* ] bi
] { } make ;
: vocab-files ( vocab -- seq )
[
[ vocab-source-path [ , ] when* ]
[ vocab-docs-path [ , ] when* ]
[ vocab-tests % ] tri
] { } make ;
: vocab-heading. ( vocab -- )
nl
"==== " write
[ vocab-name ] [ vocab write-object ] bi ":" print
nl ;
: load-error. ( triple -- )
[ first vocab-heading. ] [ second print-error ] bi ;
: load-failures. ( failures -- )
[ load-error. nl ] each ;
SYMBOL: failures
: require-all ( vocabs -- failures )
[
V{ } clone blacklist set
V{ } clone failures set
[
[ require ]
[ swap vocab-name failures get set-at ]
recover
] each
failures get
] with-scope ;
: source-modified? ( path -- ? )
dup source-files get at [
dup path>>
dup exists? [
utf8 file-lines crc32 checksum-lines
swap checksum>> = not
] [
2drop f
] if
] [
exists?
] ?if ;
SYMBOL: changed-vocabs
: changed-vocab ( vocab -- )
dup vocab changed-vocabs get and
[ dup changed-vocabs get set-at ] [ drop ] if ;
: unchanged-vocab ( vocab -- )
changed-vocabs get delete-at ;
: unchanged-vocabs ( vocabs -- )
[ unchanged-vocab ] each ;
: changed-vocab? ( vocab -- ? )
changed-vocabs get dup [ key? ] [ 2drop t ] if ;
: filter-changed ( vocabs -- vocabs' )
[ changed-vocab? ] filter ;
SYMBOL: modified-sources
SYMBOL: modified-docs
: (to-refresh) ( vocab variable loaded? path -- )
dup [
swap [
pick changed-vocab? [
source-modified? [ get push ] [ 2drop ] if
] [ 3drop ] if
] [ drop get push ] if
] [ 2drop 2drop ] if ;
: to-refresh ( prefix -- modified-sources modified-docs unchanged )
[
V{ } clone modified-sources set
V{ } clone modified-docs set
child-vocabs [
[
[
[ modified-sources ]
[ vocab source-loaded?>> ]
[ vocab-source-path ]
tri (to-refresh)
] [
[ modified-docs ]
[ vocab docs-loaded?>> ]
[ vocab-docs-path ]
tri (to-refresh)
] bi
] each
modified-sources get
modified-docs get
]
[ modified-docs get modified-sources get append diff ] bi
] with-scope ;
: do-refresh ( modified-sources modified-docs unchanged -- )
unchanged-vocabs
[
[ [ vocab f >>source-loaded? drop ] each ]
[ [ vocab f >>docs-loaded? drop ] each ] bi*
]
[
append prune
[ unchanged-vocabs ]
[ require-all load-failures. ] bi
] 2bi ;
: refresh ( prefix -- ) to-refresh do-refresh ;
: refresh-all ( -- ) "" refresh ;
MEMO: vocab-file-contents ( vocab name -- seq )
vocab-append-path dup
[ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
: set-vocab-file-contents ( seq vocab name -- )
dupd vocab-append-path [
utf8 set-file-lines
\ vocab-file-contents reset-memoized
] [
"The " swap vocab-name
" vocabulary was not loaded from the file system"
3append throw
] ?if ;
: vocab-summary-path ( vocab -- string )
vocab-dir "summary.txt" append-path ;
: vocab-summary ( vocab -- summary )
dup dup vocab-summary-path vocab-file-contents
[
vocab-name " vocabulary" append
] [
nip first
] if-empty ;
M: vocab summary
[
dup vocab-summary %
" (" %
words>> assoc-size #
" words)" %
] "" make ;
M: vocab-link summary vocab-summary ;
: set-vocab-summary ( string vocab -- )
[ 1array ] dip
dup vocab-summary-path
set-vocab-file-contents ;
: vocab-tags-path ( vocab -- string )
vocab-dir "tags.txt" append-path ;
: vocab-tags ( vocab -- tags )
dup vocab-tags-path vocab-file-contents harvest ;
: set-vocab-tags ( tags vocab -- )
dup vocab-tags-path set-vocab-file-contents ;
: add-vocab-tags ( tags vocab -- )
[ vocab-tags append prune ] keep set-vocab-tags ;
: vocab-authors-path ( vocab -- string )
vocab-dir "authors.txt" append-path ;
: vocab-authors ( vocab -- authors )
dup vocab-authors-path vocab-file-contents harvest ;
: set-vocab-authors ( authors vocab -- )
dup vocab-authors-path set-vocab-file-contents ;
: subdirs ( dir -- dirs )
[
[ link-info directory? ] filter
] with-directory-files natural-sort ;
: (all-child-vocabs) ( root name -- vocabs )
[
vocab-dir append-path dup exists?
[ subdirs ] [ drop { } ] if
] keep [
swap [ "." glue ] with map
] unless-empty ;
: vocab-dir? ( root name -- ? )
over
[ ".factor" vocab-dir+ append-path exists? ]
[ 2drop f ]
if ;
: vocabs-in-dir ( root name -- )
dupd (all-child-vocabs) [
2dup vocab-dir? [ dup >vocab-link , ] when
vocabs-in-dir
] with each ;
: all-vocabs ( -- assoc )
vocab-roots get [
dup [ "" vocabs-in-dir ] { } make
] { } map>assoc ;
MEMO: all-vocabs-seq ( -- seq )
all-vocabs values concat ;
: unportable? ( name -- ? )
vocab-tags "unportable" swap member? ;
: filter-unportable ( seq -- seq' )
[ vocab-name unportable? not ] filter ;
: try-everything ( -- failures )
all-vocabs-seq
filter-unportable
require-all ;
: load-everything ( -- )
try-everything load-failures. ;
: unrooted-child-vocabs ( prefix -- seq )
dup empty? [ CHAR: . suffix ] unless
vocabs
[ find-vocab-root not ] filter
[
vocab-name swap ?head CHAR: . rot member? not and
] with filter
[ vocab ] map ;
: all-child-vocabs ( prefix -- assoc )
vocab-roots get [
dup pick (all-child-vocabs) [ >vocab-link ] map
] { } map>assoc
swap unrooted-child-vocabs f swap 2array suffix ;
: all-child-vocabs-seq ( prefix -- assoc )
vocab-roots get swap [
dupd (all-child-vocabs)
[ vocab-dir? ] with filter
] curry map concat ;
MEMO: all-tags ( -- seq )
all-vocabs-seq [ vocab-tags ] gather natural-sort ;
MEMO: all-authors ( -- seq )
all-vocabs-seq [ vocab-authors ] gather natural-sort ;
: reset-cache ( -- )
root-cache get-global clear-assoc
\ vocab-file-contents reset-memoized
\ all-vocabs-seq reset-memoized
\ all-authors reset-memoized
\ all-tags reset-memoized ;
SINGLETON: cache-observer
M: cache-observer vocabs-changed drop reset-cache ;
[
f changed-vocabs set-global
cache-observer add-vocab-observer
] "tools.vocabs" add-init-hook

3
basis/ui/backend/cocoa/tools/tools.factor
View File

@ -4,7 +4,8 @@ USING: alien.syntax cocoa cocoa.nibs cocoa.application
cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.subclassing
core-foundation core-foundation.strings help.topics kernel
memory namespaces parser system ui ui.tools.browser
ui.tools.listener ui.backend.cocoa eval locals tools.vocabs ;
ui.tools.listener ui.backend.cocoa eval locals
vocabs.refresh ;
IN: ui.backend.cocoa.tools
: finder-run-files ( alien -- )

2
basis/ui/backend/cocoa/views/views.factor
View File

@ -9,7 +9,7 @@ threads combinators math.rectangles ;
IN: ui.backend.cocoa.views
: send-mouse-moved ( view event -- )
[ mouse-location ] [ drop window ] 2bi move-hand fire-motion ;
[ mouse-location ] [ drop window ] 2bi move-hand fire-motion yield ;
: button ( event -- n )
#! Cocoa -> Factor UI button mapping

6
basis/ui/gadgets/gadgets.factor
View File

@ -3,7 +3,8 @@
USING: accessors arrays hashtables kernel models math namespaces
make sequences quotations math.vectors combinators sorting
binary-search vectors dlists deques models threads
concurrency.flags math.order math.rectangles fry locals ;
concurrency.flags math.order math.rectangles fry locals
prettyprint.backend prettyprint.custom ;
IN: ui.gadgets
! Values for orientation slot
@ -27,6 +28,9 @@ interior
boundary
model ;
! Don't print gadgets with RECT: syntax
M: gadget pprint* pprint-tuple ;
M: gadget equal? 2drop f ;
M: gadget hashcode* nip [ [ \ gadget counter ] unless* ] change-id id>> ;

4
basis/ui/gadgets/status-bar/status-bar-docs.factor
View File

@ -18,7 +18,7 @@ HELP: <status-bar>
{ $notes "If the " { $snippet "model" } " is " { $snippet "status" } ", this gadget will display mouse over help for " { $link "ui.gadgets.presentations" } "." } ;
HELP: open-status-window
{ $values { "gadget" gadget } { "title" string } }
{ $values { "gadget" gadget } { "title/attributes" { "a " { $link string } " or a " { $link world-attributes } " tuple" } } }
{ $description "Like " { $link open-window } ", with the additional feature that the new window iwll have a status bar displaying the value stored in the world's " { $slot "status" } " slot." }
{ $see-also show-status hide-status } ;
@ -30,4 +30,4 @@ ARTICLE: "ui.gadgets.status-bar" "Status bars and mouse-over help"
{ $subsection hide-status }
{ $link "ui.gadgets.presentations" } " use the status bar to display object summary." ;
ABOUT: "ui.gadgets.status-bar"
ABOUT: "ui.gadgets.status-bar"

8
basis/ui/gadgets/status-bar/status-bar.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors models models.delay models.arrow
sequences ui.gadgets.labels ui.gadgets.tracks
ui.gadgets.worlds ui.gadgets ui kernel calendar summary ;
ui.gadgets.worlds ui.gadgets ui ui.private kernel calendar summary ;
IN: ui.gadgets.status-bar
: <status-bar> ( model -- gadget )
@ -10,9 +10,9 @@ IN: ui.gadgets.status-bar
reverse-video-theme
t >>root? ;
: open-status-window ( gadget title -- )
f <model> [ <world> ] keep
<status-bar> f track-add
: open-status-window ( gadget title/attributes -- )
?attributes f <model> >>status <world>
dup status>> <status-bar> f track-add
open-world-window ;
: show-summary ( object gadget -- )

31
basis/ui/gadgets/worlds/worlds-docs.factor
View File

@ -48,8 +48,8 @@ HELP: world
} ;
HELP: <world>
{ $values { "gadget" gadget } { "title" string } { "status" model } { "world" "a new " { $link world } } }
{ $description "Creates a new " { $link world } " delegating to the given gadget." } ;
{ $values { "world-attributes" world-attributes } { "world" "a new " { $link world } } }
{ $description "Creates a new " { $link world } " or world subclass with the given attributes." } ;
HELP: find-world
{ $values { "gadget" gadget } { "world/f" { $maybe world } } }
@ -65,6 +65,30 @@ HELP: find-gl-context
{ $description "Makes the OpenGL context of the gadget's containing native window the current OpenGL context." }
{ $notes "This word should be called from " { $link graft* } " and " { $link ungraft* } " methods which need to allocate and deallocate OpenGL resources, such as textures, display lists, and so on." } ;
HELP: begin-world
{ $values { "world" world } }
{ $description "Called immediately after " { $snippet "world" } "'s OpenGL context has been created. The world's OpenGL context is current when this method is called." } ;
HELP: end-world
{ $values { "world" world } }
{ $description "Called immediately before " { $snippet "world" } "'s OpenGL context is destroyed. The world's OpenGL context is current when this method is called." } ;
HELP: resize-world
{ $values { "world" world } }
{ $description "Called when the window containing " { $snippet "world" } " is resized. The " { $snippet "loc" } " and " { $snippet "dim" } " slots of " { $snippet "world" } " will be updated with the world's new position and size. The world's OpenGL context is current when this method is called." } ;
HELP: draw-world*
{ $values { "world" world } }
{ $description "Called when " { $snippet "world" } " needs to be redrawn. The world's OpenGL context is current when this method is called." } ;
ARTICLE: "ui.gadgets.worlds-subclassing" "Subclassing worlds"
"The " { $link world } " gadget can be subclassed, giving Factor code full control of the window's OpenGL context. The following generic words can be overridden to replace standard UI behavior:"
{ $subsection begin-world }
{ $subsection end-world }
{ $subsection resize-world }
{ $subsection draw-world* }
"See the " { $vocab-link "spheres" } " and " { $vocab-link "bunny" } " demos for examples." ;
ARTICLE: "ui-paint-custom" "Implementing custom drawing logic"
"The UI uses OpenGL to render gadgets. Custom rendering logic can be plugged in with the " { $link "ui-pen-protocol" } ", or by implementing a generic word:"
{ $subsection draw-gadget* }
@ -72,7 +96,8 @@ ARTICLE: "ui-paint-custom" "Implementing custom drawing logic"
$nl
"Gadgets which need to allocate and deallocate OpenGL resources such as textures, display lists, and so on, should perform the allocation in the " { $link graft* } " method, and the deallocation in the " { $link ungraft* } " method. Since those words are not necessarily called with the gadget's OpenGL context active, a utility word can be used to find and make the correct OpenGL context current:"
{ $subsection find-gl-context }
"OpenGL state must not be altered as a result of drawing a gadget, so any flags which were enabled should be disabled, and vice versa."
"OpenGL state must not be altered as a result of drawing a gadget, so any flags which were enabled should be disabled, and vice versa. To take full control of the OpenGL context, see " { $link "ui.gadgets.worlds-subclassing" } "."
{ $subsection "ui-paint-coord" }
{ $subsection "ui.gadgets.worlds-subclassing" }
{ $subsection "gl-utilities" }
{ $subsection "text-rendering" } ;

96
basis/ui/gadgets/worlds/worlds.factor
View File

@ -4,15 +4,28 @@ USING: accessors arrays assocs continuations kernel math models
namespaces opengl opengl.textures sequences io combinators
combinators.short-circuit fry math.vectors math.rectangles cache
ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
ui.commands ui.pixel-formats destructors ;
ui.commands ui.pixel-formats destructors literals ;
IN: ui.gadgets.worlds
CONSTANT: default-world-pixel-format-attributes
{ windowed double-buffered T{ depth-bits { value 16 } } }
TUPLE: world < track
active? focused?
layers
title status status-owner
text-handle handle images
window-loc ;
active? focused?
layers
title status status-owner
text-handle handle images
window-loc
pixel-format-attributes ;
TUPLE: world-attributes
{ world-class initial: world }
title
status
gadgets
{ pixel-format-attributes initial: $ default-world-pixel-format-attributes } ;
C: <world-attributes> world-attributes
: find-world ( gadget -- world/f ) [ world? ] find-parent ;
@ -45,18 +58,23 @@ M: world request-focus-on ( child gadget -- )
2dup eq?
[ 2drop ] [ dup focused?>> (request-focus) ] if ;
: new-world ( gadget title status class -- world )
: new-world ( class -- world )
vertical swap new-track
t >>root?
t >>active?
{ 0 0 } >>window-loc
swap >>status
swap >>title
swap 1 track-add
dup request-focus ;
{ 0 0 } >>window-loc ;
: <world> ( gadget title status -- world )
world new-world ;
: apply-world-attributes ( world attributes -- world )
{
[ title>> >>title ]
[ status>> >>status ]
[ pixel-format-attributes>> >>pixel-format-attributes ]
[ gadgets>> [ 1 track-add ] each ]
} cleave ;
: <world> ( world-attributes -- world )
[ world-class>> new-world ] keep apply-world-attributes
dup request-focus ;
: as-big-as-possible ( world gadget -- )
dup [ { 0 0 } >>loc over dim>> >>dim ] when 2drop ; inline
@ -77,17 +95,36 @@ SYMBOL: flush-layout-cache-hook
flush-layout-cache-hook [ [ ] ] initialize
: (draw-world) ( world -- )
dup handle>> [
check-extensions
{
[ init-gl ]
[ draw-gadget ]
[ text-handle>> [ purge-cache ] when* ]
[ images>> [ purge-cache ] when* ]
} cleave
] with-gl-context
flush-layout-cache-hook get call( -- ) ;
GENERIC: begin-world ( world -- )
GENERIC: end-world ( world -- )
GENERIC: resize-world ( world -- )
M: world begin-world
drop ;
M: world end-world
drop ;
M: world resize-world
drop ;
M: world (>>dim)
[ call-next-method ]
[
dup handle>>
[ select-gl-context resize-world ]
[ drop ] if*
] bi ;
GENERIC: draw-world* ( world -- )
M: world draw-world*
check-extensions
{
[ init-gl ]
[ draw-gadget ]
[ text-handle>> [ purge-cache ] when* ]
[ images>> [ purge-cache ] when* ]
} cleave ;
: draw-world? ( world -- ? )
#! We don't draw deactivated worlds, or those with 0 size.
@ -108,7 +145,10 @@ ui-error-hook [ [ rethrow ] ] initialize
: draw-world ( world -- )
dup draw-world? [
dup world [
[ (draw-world) ] [
[
dup handle>> [ draw-world* ] with-gl-context
flush-layout-cache-hook get call( -- )
] [
over <world-error> ui-error
f >>active? drop
] recover
@ -151,8 +191,7 @@ M: world handle-gesture ( gesture gadget -- ? )
[ get-global find-world eq? ] keep '[ f _ set-global ] when ;
M: world world-pixel-format-attributes
drop
{ windowed double-buffered T{ depth-bits { value 16 } } } ;
pixel-format-attributes>> ;
M: world check-world-pixel-format
2drop ;
@ -160,3 +199,4 @@ M: world check-world-pixel-format
: with-world-pixel-format ( world quot -- )
[ dup dup world-pixel-format-attributes <pixel-format> ]
dip [ 2dup check-world-pixel-format ] prepose with-disposal ; inline

16
basis/ui/pixel-formats/pixel-formats-docs.factor
View File

@ -91,29 +91,29 @@ HELP: backing-store
{ double-buffered backing-store } related-words
HELP: multisampled
{ $class-description "Requests a pixel format with multisampled antialiasing enabled. The " { $link sample-buffers } " and " { $link samples } " attributes must also be specified to specify the level of multisampling." }
{ $class-description "Requests a pixel format with multisampled antialiasing enabled. The " { $link sample-buffers } " and " { $link samples } " attributes must also be provided to specify the level of multisampling." }
{ $notes "On some window systems this is not distinct from " { $link supersampled } "." } ;
HELP: supersampled
{ $class-description "Requests a pixel format with supersampled antialiasing enabled. The " { $link sample-buffers } " and " { $link samples } " attributes must also be specified to specify the level of supersampling." }
{ $class-description "Requests a pixel format with supersampled antialiasing enabled. The " { $link sample-buffers } " and " { $link samples } " attributes must also be provided to specify the level of supersampling." }
{ $notes "On some window systems this is not distinct from " { $link multisampled } "." } ;
HELP: sample-alpha
{ $class-description "Used with " { $link multisampled } " or " { $link supersampled } " to request more accurate multisampling of alpha values." } ;
HELP: color-float
{ $class-description "Requests a pixel format where the pixels are stored in floating-point format." } ;
{ $class-description "Requests a pixel format where the color buffer is stored in floating-point format." } ;
HELP: color-bits
{ $class-description "Requests a pixel format of at least " { $snippet "value" } " bits per pixel." } ;
{ $class-description "Requests a pixel format with a color buffer of at least " { $snippet "value" } " bits per pixel." } ;
HELP: red-bits
{ $class-description "Requests a pixel format with at least " { $snippet "value" } " red bits per pixel." } ;
{ $class-description "Requests a pixel format with a color buffer with at least " { $snippet "value" } " red bits per pixel." } ;
HELP: green-bits
{ $class-description "Requests a pixel format with at least " { $snippet "value" } " green bits per pixel." } ;
{ $class-description "Requests a pixel format with a color buffer with at least " { $snippet "value" } " green bits per pixel." } ;
HELP: blue-bits
{ $class-description "Requests a pixel format with at least " { $snippet "value" } " blue bits per pixel." } ;
{ $class-description "Requests a pixel format with a color buffer with at least " { $snippet "value" } " blue bits per pixel." } ;
HELP: alpha-bits
{ $class-description "Requests a pixel format with at least " { $snippet "value" } " alpha bits per pixel." } ;
{ $class-description "Requests a pixel format with a color buffer with at least " { $snippet "value" } " alpha bits per pixel." } ;
{ color-float color-bits red-bits green-bits blue-bits alpha-bits } related-words

2
basis/ui/tools/listener/listener-docs.factor
View File

@ -1,7 +1,7 @@
USING: help.markup help.syntax ui.commands ui.operations
ui.gadgets.editors ui.gadgets.panes listener io words
ui.tools.listener.completion ui.tools.common help.tips
tools.vocabs vocabs ;
vocabs vocabs.refresh ;
IN: ui.tools.listener
HELP: interactor

5
basis/ui/tools/listener/listener.factor
View File

@ -6,14 +6,15 @@ compiler.units help.tips concurrency.flags concurrency.mailboxes
continuations destructors documents documents.elements fry hashtables
help help.markup io io.styles kernel lexer listener math models sets
models.delay models.arrow namespaces parser prettyprint quotations
sequences strings threads tools.vocabs vocabs vocabs.loader
sequences strings threads vocabs vocabs.refresh vocabs.loader
vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets
ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
ui.operations ui.tools.browser ui.tools.common ui.tools.debugger
ui.tools.listener.completion ui.tools.listener.popups
ui.tools.listener.history ui.images ui.tools.error-list tools.errors.model ;
ui.tools.listener.history ui.images ui.tools.error-list
tools.errors.model ;
FROM: source-files.errors => all-errors ;
IN: ui.tools.listener

2
basis/ui/tools/operations/operations.factor
View File

@ -4,7 +4,7 @@ USING: continuations definitions generic help.topics threads
stack-checker summary io.pathnames io.styles kernel namespaces parser
prettyprint quotations tools.crossref tools.annotations editors
tools.profiler tools.test tools.time tools.walker vocabs vocabs.loader
words sequences tools.vocabs classes compiler.errors compiler.units
words sequences classes compiler.errors compiler.units
accessors vocabs.parser macros.expander ui ui.tools.browser
ui.tools.listener ui.tools.listener.completion ui.tools.profiler
ui.tools.inspector ui.tools.traceback ui.commands ui.gadgets.editors

2
basis/ui/tools/tools.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: memory system kernel tools.vocabs ui.tools.operations
USING: memory system kernel vocabs.refresh ui.tools.operations
ui.tools.listener ui.tools.browser ui.tools.common ui.tools.error-list
ui.tools.walker ui.commands ui.gestures ui ui.private ;
IN: ui.tools

19
basis/ui/ui-docs.factor
View File

@ -2,17 +2,28 @@ USING: help.markup help.syntax strings quotations debugger
namespaces ui.backend ui.gadgets ui.gadgets.worlds
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids
ui.gadgets.private math.rectangles colors ui.text fonts
kernel ui.private ;
kernel ui.private classes sequences ;
IN: ui
HELP: windows
{ $var-description "Global variable holding an association list mapping native window handles to " { $link world } " instances." } ;
{ windows open-window find-window } related-words
{ windows open-window find-window world-attributes } related-words
HELP: open-window
{ $values { "gadget" gadget } { "title" string } }
{ $description "Opens a native window with the specified title." } ;
{ $values { "gadget" gadget } { "title/attributes" { "a " { $link string } " or a " { $link world-attributes } " tuple" } } }
{ $description "Opens a native window containing " { $snippet "gadget" } " with the specified attributes. If a string is provided, it is used as the window title; otherwise, the window attributes are specified in a " { $link world-attributes } " tuple." } ;
HELP: world-attributes
{ $values { "world-class" class } { "title" string } { "status" gadget } { "gadgets" sequence } { "pixel-format-attributes" sequence } }
{ $class-description "Tuples of this class can be passed to " { $link open-window } " to control attributes of the window opened. The following attributes can be set:" }
{ $list
{ { $snippet "world-class" } " specifies the class of world to construct. " { $link world } " is the default." }
{ { $snippet "title" } " is the window title." }
{ { $snippet "status" } ", if specified, is a gadget that will be used as the window's status bar." }
{ { $snippet "gadgets" } " is a sequence of gadgets that will be placed inside the window." }
{ { $snippet "pixel-format-attributes" } " is a sequence of " { $link "ui.pixel-formats-attributes" } " that the window will request for its OpenGL pixel format." }
} ;
HELP: set-fullscreen?
{ $values { "?" "a boolean" } { "gadget" gadget } }

26
basis/ui/ui.factor
View File

@ -4,7 +4,8 @@ USING: arrays assocs io kernel math models namespaces make dlists
deques sequences threads sequences words continuations init
combinators combinators.short-circuit hashtables concurrency.flags
sets accessors calendar fry destructors ui.gadgets ui.gadgets.private
ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render ;
ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render
strings ;
IN: ui
<PRIVATE
@ -49,8 +50,20 @@ SYMBOL: windows
f >>focused?
focus-path f swap focus-gestures ;
: try-to-open-window ( world -- )
{
[ (open-window) ]
[ handle>> select-gl-context ]
[
[ begin-world ]
[ [ handle>> (close-window) ] [ ui-error ] bi* ]
recover
]
[ resize-world ]
} cleave ;
M: world graft*
[ (open-window) ]
[ try-to-open-window ]
[ [ title>> ] keep set-title ]
[ request-focus ] tri ;
@ -66,6 +79,7 @@ M: world graft*
[ images>> [ dispose ] when* ]
[ hand-clicked close-global ]
[ hand-gadget close-global ]
[ end-world ]
} cleave ;
M: world ungraft*
@ -166,13 +180,17 @@ PRIVATE>
: restore-windows? ( -- ? )
windows get empty? not ;
: ?attributes ( gadget title/attributes -- attributes )
dup string? [ world-attributes new swap >>title ] when
swap [ [ [ 1array ] [ f ] if* ] curry unless* ] curry change-gadgets ;
PRIVATE>
: open-world-window ( world -- )
dup pref-dim >>dim dup relayout graft ;
: open-window ( gadget title -- )
f <world> open-world-window ;
: open-window ( gadget title/attributes -- )
?attributes <world> open-world-window ;
: set-fullscreen? ( ? gadget -- )
find-world set-fullscreen* ;

1
basis/vocabs/cache/authors.txt vendored Normal file
View File

@ -0,0 +1 @@
Slava Pestov

21
basis/vocabs/cache/cache.factor vendored Normal file
View File

@ -0,0 +1,21 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel namespaces memoize init vocabs
vocabs.hierarchy vocabs.loader vocabs.metadata vocabs.refresh ;
IN: vocabs.cache
: reset-cache ( -- )
root-cache get-global clear-assoc
\ vocab-file-contents reset-memoized
\ all-vocabs-seq reset-memoized
\ all-authors reset-memoized
\ all-tags reset-memoized ;
SINGLETON: cache-observer
M: cache-observer vocabs-changed drop reset-cache ;
[
f changed-vocabs set-global
cache-observer add-vocab-observer
] "vocabs.cache" add-init-hook

1
basis/vocabs/cache/summary.txt vendored Normal file
View File

@ -0,0 +1 @@
Caching vocabulary data from disk

1
basis/vocabs/errors/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

35
basis/vocabs/errors/errors.factor Normal file
View File

@ -0,0 +1,35 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs continuations debugger io io.styles kernel
namespaces sequences vocabs vocabs.loader ;
IN: vocabs.errors
<PRIVATE
: vocab-heading. ( vocab -- )
nl
"==== " write
[ vocab-name ] [ vocab write-object ] bi ":" print
nl ;
: load-error. ( triple -- )
[ first vocab-heading. ] [ second print-error ] bi ;
SYMBOL: failures
PRIVATE>
: load-failures. ( failures -- )
[ load-error. nl ] each ;
: require-all ( vocabs -- failures )
[
V{ } clone blacklist set
V{ } clone failures set
[
[ require ]
[ swap vocab-name failures get set-at ]
recover
] each
failures get
] with-scope ;

1
basis/vocabs/errors/summary.txt Normal file
View File

@ -0,0 +1 @@
Loading vocabularies and batching errors

1
basis/vocabs/files/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

11
basis/vocabs/files/files-docs.factor Normal file
View File

@ -0,0 +1,11 @@
USING: help.markup help.syntax strings ;
IN: vocabs.files
HELP: vocab-files
{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
{ $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
HELP: vocab-tests
{ $values { "vocab" "a vocabulary specifier" } { "tests" "a sequence of pathname strings" } }
{ $description "Outputs a sequence of pathnames where the unit tests for " { $snippet "vocab" } " are located." } ;

34
basis/vocabs/files/files.factor Normal file
View File

@ -0,0 +1,34 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.directories io.files io.pathnames kernel make
sequences vocabs.loader ;
IN: vocabs.files
<PRIVATE
: vocab-tests-file ( vocab -- path )
dup "-tests.factor" vocab-dir+ vocab-append-path dup
[ dup exists? [ drop f ] unless ] [ drop f ] if ;
: vocab-tests-dir ( vocab -- paths )
dup vocab-dir "tests" append-path vocab-append-path dup [
dup exists? [
dup directory-files [ ".factor" tail? ] filter
[ append-path ] with map
] [ drop f ] if
] [ drop f ] if ;
PRIVATE>
: vocab-tests ( vocab -- tests )
[
[ vocab-tests-file [ , ] when* ]
[ vocab-tests-dir [ % ] when* ] bi
] { } make ;
: vocab-files ( vocab -- seq )
[
[ vocab-source-path [ , ] when* ]
[ vocab-docs-path [ , ] when* ]
[ vocab-tests % ] tri
] { } make ;

1
basis/vocabs/files/summary.txt Normal file
View File

@ -0,0 +1 @@
Getting a list of files in a vocabulary

33
basis/vocabs/hierarchy/hierarchy-docs.factor Normal file
View File

@ -0,0 +1,33 @@
USING: help.markup help.syntax strings vocabs.loader ;
IN: vocabs.hierarchy
ARTICLE: "vocabs.hierarchy" "Vocabulary hierarchy tools"
"These tools operate on all vocabularies found in the current set of " { $link vocab-roots } ", loaded or not."
$nl
"Loading vocabulary hierarchies:"
{ $subsection load }
{ $subsection load-all }
"Getting all vocabularies on disk:"
{ $subsection all-vocabs }
{ $subsection all-vocabs-seq }
"Getting " { $link "vocabs.metadata" } " for all vocabularies on disk:"
{ $subsection all-tags }
{ $subsection all-authors } ;
ABOUT: "vocabs.hierarchy"
HELP: all-vocabs
{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;
HELP: load
{ $values { "prefix" string } }
{ $description "Load all vocabularies that match the provided prefix." }
{ $notes "This word differs from " { $link require } " in that it loads all subvocabularies, not just the given one." } ;
HELP: load-all
{ $description "Load all vocabularies in the source tree." } ;
HELP: all-vocabs-under
{ $values { "prefix" string } }
{ $description "Return a sequence of vocab or vocab-links for each vocab matching the provided prefix. Unlike " { $link all-child-vocabs } " this word will return both loaded and unloaded vocabularies." } ;

12
basis/vocabs/hierarchy/hierarchy-tests.factor Normal file
View File

@ -0,0 +1,12 @@
IN: vocabs.hierarchy.tests
USING: continuations namespaces tools.test vocabs.hierarchy vocabs.hierarchy.private ;
[ ] [
changed-vocabs get-global
f changed-vocabs set-global
[ t ] [ "kernel" changed-vocab? ] unit-test
[ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup
] unit-test
[ t ] [ "some-vocab" valid-vocab-dirname ] unit-test
[ f ] [ ".git" valid-vocab-dirname ] unit-test

99
basis/vocabs/hierarchy/hierarchy.factor Normal file
View File

@ -0,0 +1,99 @@
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators.short-circuit fry
io.directories io.files io.files.info io.pathnames kernel make
memoize namespaces sequences sorting splitting vocabs sets
vocabs.loader vocabs.metadata vocabs.errors ;
IN: vocabs.hierarchy
<PRIVATE
: vocab-subdirs ( dir -- dirs )
[
[
{ [ link-info directory? ] [ "." head? not ] } 1&&
] filter
] with-directory-files natural-sort ;
: (all-child-vocabs) ( root name -- vocabs )
[
vocab-dir append-path dup exists?
[ vocab-subdirs ] [ drop { } ] if
] keep
[ '[ [ _ "." ] dip 3append ] map ] unless-empty ;
: vocab-dir? ( root name -- ? )
over
[ ".factor" vocab-dir+ append-path exists? ]
[ 2drop f ]
if ;
: vocabs-in-dir ( root name -- )
dupd (all-child-vocabs) [
2dup vocab-dir? [ dup >vocab-link , ] when
vocabs-in-dir
] with each ;
PRIVATE>
: all-vocabs ( -- assoc )
vocab-roots get [
dup [ "" vocabs-in-dir ] { } make
] { } map>assoc ;
: all-vocabs-under ( prefix -- vocabs )
[
[ vocab-roots get ] dip '[ _ vocabs-in-dir ] each
] { } make ;
MEMO: all-vocabs-seq ( -- seq )
"" all-vocabs-under ;
<PRIVATE
: unrooted-child-vocabs ( prefix -- seq )
dup empty? [ CHAR: . suffix ] unless
vocabs
[ find-vocab-root not ] filter
[
vocab-name swap ?head CHAR: . rot member? not and
] with filter
[ vocab ] map ;
PRIVATE>
: all-child-vocabs ( prefix -- assoc )
vocab-roots get [
dup pick (all-child-vocabs) [ >vocab-link ] map
] { } map>assoc
swap unrooted-child-vocabs f swap 2array suffix ;
: all-child-vocabs-seq ( prefix -- assoc )
vocab-roots get swap '[
dup _ (all-child-vocabs)
[ vocab-dir? ] with filter
] map concat ;
<PRIVATE
: filter-unportable ( seq -- seq' )
[ vocab-name unportable? not ] filter ;
PRIVATE>
: (load) ( prefix -- failures )
all-vocabs-under
filter-unportable
require-all ;
: load ( prefix -- )
(load) load-failures. ;
: load-all ( -- )
"" load ;
MEMO: all-tags ( -- seq )
all-vocabs-seq [ vocab-tags ] gather natural-sort ;
MEMO: all-authors ( -- seq )
all-vocabs-seq [ vocab-authors ] gather natural-sort ;

1
basis/vocabs/hierarchy/summary.txt Normal file
View File

@ -0,0 +1 @@
Searching for vocabularies on disk

1
basis/vocabs/metadata/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

44
basis/vocabs/metadata/metadata-docs.factor Normal file
View File

@ -0,0 +1,44 @@
USING: help.markup help.syntax strings ;
IN: vocabs.metadata
ARTICLE: "vocabs.metadata" "Vocabulary metadata"
"Vocabulary summaries:"
{ $subsection vocab-summary }
{ $subsection set-vocab-summary }
"Vocabulary authors:"
{ $subsection vocab-authors }
{ $subsection set-vocab-authors }
"Vocabulary tags:"
{ $subsection vocab-tags }
{ $subsection set-vocab-tags }
{ $subsection add-vocab-tags }
"Getting and setting arbitrary vocabulary metadata:"
{ $subsection vocab-file-contents }
{ $subsection set-vocab-file-contents } ;
ABOUT: "vocabs.metadata"
HELP: vocab-file-contents
{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
HELP: set-vocab-file-contents
{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;
HELP: vocab-summary
{ $values { "vocab" "a vocabulary specifier" } { "summary" "a string or " { $link f } } }
{ $description "Outputs a one-line string description of the vocabulary's intended purpose from the " { $snippet "summary.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-summary
{ $values { "string" "a string or " { $link f } } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a one-line string description of the vocabulary to the " { $snippet "summary.txt" } " file in the vocabulary's directory." } ;
HELP: vocab-tags
{ $values { "vocab" "a vocabulary specifier" } { "tags" "a sequence of strings" } }
{ $description "Outputs a list of short tags classifying the vocabulary from the " { $snippet "tags.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-tags
{ $values { "tags" "a sequence of strings" } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a list of short tags classifying the vocabulary to the " { $snippet "tags.txt" } " file in the vocabulary's directory." } ;

70
basis/vocabs/metadata/metadata.factor Normal file
View File

@ -0,0 +1,70 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs io.encodings.utf8 io.files
io.pathnames kernel make math.parser memoize sequences sets
sorting summary vocabs vocabs.loader ;
IN: vocabs.metadata
MEMO: vocab-file-contents ( vocab name -- seq )
vocab-append-path dup
[ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
: set-vocab-file-contents ( seq vocab name -- )
dupd vocab-append-path [
utf8 set-file-lines
\ vocab-file-contents reset-memoized
] [
"The " swap vocab-name
" vocabulary was not loaded from the file system"
3append throw
] ?if ;
: vocab-summary-path ( vocab -- string )
vocab-dir "summary.txt" append-path ;
: vocab-summary ( vocab -- summary )
dup dup vocab-summary-path vocab-file-contents
[
vocab-name " vocabulary" append
] [
nip first
] if-empty ;
M: vocab summary
[
dup vocab-summary %
" (" %
words>> assoc-size #
" words)" %
] "" make ;
M: vocab-link summary vocab-summary ;
: set-vocab-summary ( string vocab -- )
[ 1array ] dip
dup vocab-summary-path
set-vocab-file-contents ;
: vocab-tags-path ( vocab -- string )
vocab-dir "tags.txt" append-path ;
: vocab-tags ( vocab -- tags )
dup vocab-tags-path vocab-file-contents harvest ;
: set-vocab-tags ( tags vocab -- )
dup vocab-tags-path set-vocab-file-contents ;
: add-vocab-tags ( tags vocab -- )
[ vocab-tags append prune ] keep set-vocab-tags ;
: vocab-authors-path ( vocab -- string )
vocab-dir "authors.txt" append-path ;
: vocab-authors ( vocab -- authors )
dup vocab-authors-path vocab-file-contents harvest ;
: set-vocab-authors ( authors vocab -- )
dup vocab-authors-path set-vocab-file-contents ;
: unportable? ( vocab -- ? )
vocab-tags "unportable" swap member? ;

1
basis/vocabs/metadata/summary.txt Normal file
View File

@ -0,0 +1 @@
Managing vocabulary author, tag and summary information

1
basis/vocabs/refresh/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

0
basis/tools/vocabs/monitor/authors.txt → basis/vocabs/refresh/monitor/authors.txt
View File

4
basis/tools/vocabs/monitor/monitor-tests.factor → basis/vocabs/refresh/monitor/monitor-tests.factor
View File

@ -1,5 +1,5 @@
USING: tools.test tools.vocabs.monitor io.pathnames ;
IN: tools.vocabs.monitor.tests
USING: tools.test vocabs.refresh.monitor io.pathnames ;
IN: vocabs.refresh.monitor.tests
[ "kernel" ] [ "core/kernel/kernel.factor" path>vocab ] unit-test
[ "kernel" ] [ "core/kernel/" path>vocab ] unit-test

12
basis/tools/vocabs/monitor/monitor.factor → basis/vocabs/refresh/monitor/monitor.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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 accessors ;
IN: tools.vocabs.monitor
USING: accessors assocs command-line concurrency.messaging
continuations init io.backend io.files io.monitors io.pathnames
kernel namespaces sequences sets splitting threads
tr vocabs vocabs.loader vocabs.refresh vocabs.cache ;
IN: vocabs.refresh.monitor
TR: convert-separators "/\\" ".." ;
@ -56,4 +56,4 @@ TR: convert-separators "/\\" ".." ;
[
"-no-monitors" (command-line) member?
[ start-monitor-thread ] unless
] "tools.vocabs.monitor" add-init-hook
] "vocabs.refresh.monitor" add-init-hook

0
basis/tools/vocabs/monitor/summary.txt → basis/vocabs/refresh/monitor/summary.txt
View File

22
basis/vocabs/refresh/refresh-docs.factor Normal file
View File

@ -0,0 +1,22 @@
USING: help.markup help.syntax strings ;
IN: vocabs.refresh
HELP: source-modified?
{ $values { "path" "a pathname string" } { "?" "a boolean" } }
{ $description "Tests if the source file has been modified since it was last loaded. This compares the file's CRC32 checksum of the file's contents against the previously-recorded value." } ;
HELP: refresh
{ $values { "prefix" string } }
{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
HELP: refresh-all
{ $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
{ refresh refresh-all } related-words
ARTICLE: "vocabs.refresh" "Runtime code reloading"
"Reloading source files changed on disk:"
{ $subsection refresh }
{ $subsection refresh-all } ;
ABOUT: "vocabs.refresh"

91
basis/vocabs/refresh/refresh.factor Normal file
View File

@ -0,0 +1,91 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs checksums checksums.crc32
io.encodings.utf8 io.files kernel namespaces sequences sets
source-files vocabs vocabs.errors vocabs.loader ;
IN: vocabs.refresh
: source-modified? ( path -- ? )
dup source-files get at [
dup path>>
dup exists? [
utf8 file-lines crc32 checksum-lines
swap checksum>> = not
] [
2drop f
] if
] [
exists?
] ?if ;
SYMBOL: changed-vocabs
: changed-vocab ( vocab -- )
dup vocab changed-vocabs get and
[ dup changed-vocabs get set-at ] [ drop ] if ;
: unchanged-vocab ( vocab -- )
changed-vocabs get delete-at ;
: unchanged-vocabs ( vocabs -- )
[ unchanged-vocab ] each ;
: changed-vocab? ( vocab -- ? )
changed-vocabs get dup [ key? ] [ 2drop t ] if ;
: filter-changed ( vocabs -- vocabs' )
[ changed-vocab? ] filter ;
SYMBOL: modified-sources
SYMBOL: modified-docs
: (to-refresh) ( vocab variable loaded? path -- )
dup [
swap [
pick changed-vocab? [
source-modified? [ get push ] [ 2drop ] if
] [ 3drop ] if
] [ drop get push ] if
] [ 2drop 2drop ] if ;
: to-refresh ( prefix -- modified-sources modified-docs unchanged )
[
V{ } clone modified-sources set
V{ } clone modified-docs set
child-vocabs [
[
[
[ modified-sources ]
[ vocab source-loaded?>> ]
[ vocab-source-path ]
tri (to-refresh)
] [
[ modified-docs ]
[ vocab docs-loaded?>> ]
[ vocab-docs-path ]
tri (to-refresh)
] bi
] each
modified-sources get
modified-docs get
]
[ modified-docs get modified-sources get append diff ] bi
] with-scope ;
: do-refresh ( modified-sources modified-docs unchanged -- )
unchanged-vocabs
[
[ [ vocab f >>source-loaded? drop ] each ]
[ [ vocab f >>docs-loaded? drop ] each ] bi*
]
[
append prune
[ unchanged-vocabs ]
[ require-all load-failures. ] bi
] 2bi ;
: refresh ( prefix -- ) to-refresh do-refresh ;
: refresh-all ( -- ) "" refresh ;

1
basis/vocabs/refresh/summary.txt Normal file
View File

@ -0,0 +1 @@
Reloading changed vocabularies from disk

14
basis/windows/errors/errors.factor
View File

@ -1,7 +1,7 @@
USING: alien.c-types kernel locals math math.bitwise
windows.kernel32 sequences byte-arrays unicode.categories
io.encodings.string io.encodings.utf16n alien.strings
arrays ;
arrays literals ;
IN: windows.errors
CONSTANT: ERROR_SUCCESS 0
@ -732,11 +732,13 @@ ERROR: error-message-failed id ;
win32-error-string throw
] when ;
: expected-io-errors ( -- seq )
ERROR_SUCCESS
ERROR_IO_INCOMPLETE
ERROR_IO_PENDING
WAIT_TIMEOUT 4array ; foldable
CONSTANT: expected-io-errors
${
ERROR_SUCCESS
ERROR_IO_INCOMPLETE
ERROR_IO_PENDING
WAIT_TIMEOUT
}
: expected-io-error? ( error-code -- ? )
expected-io-errors member? ;

20
core/alien/strings/strings-docs.factor Normal file
View File

@ -0,0 +1,20 @@
USING: help.markup help.syntax strings byte-arrays alien libc
debugger io.encodings.string sequences ;
IN: alien.strings
HELP: string>alien
{ $values { "string" string } { "encoding" "an encoding descriptor" } { "byte-array" byte-array } }
{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated byte array." }
{ $errors "Throws an error if the string contains null characters, or characters not representable in the given encoding." } ;
HELP: alien>string
{ $values { "c-ptr" c-ptr } { "encoding" "an encoding descriptor" } { "string/f" "a string or " { $link f } } }
{ $description "Reads a null-terminated C string from the specified address with the given encoding." } ;
HELP: string>symbol
{ $values { "str" string } { "alien" alien } }
{ $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."
$nl
"On Windows CE, symbols are represented as UCS2 strings, and on all other platforms they are ASCII strings." } ;
ABOUT: "c-strings"

0
basis/alien/strings/strings-tests.factor → core/alien/strings/strings-tests.factor
View File

61
core/alien/strings/strings.factor Normal file
View File

@ -0,0 +1,61 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays sequences kernel kernel.private accessors math
alien.accessors byte-arrays io io.encodings io.encodings.utf8
io.encodings.utf16n io.streams.byte-array io.streams.memory system
system.private alien strings combinators namespaces init ;
IN: alien.strings
GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
M: c-ptr alien>string
[ <memory-stream> ] [ <decoder> ] bi*
"\0" swap stream-read-until drop ;
M: f alien>string
drop ;
ERROR: invalid-c-string string ;
: check-string ( string -- )
0 over memq? [ invalid-c-string ] [ drop ] if ;
GENERIC# string>alien 1 ( string encoding -- byte-array )
M: c-ptr string>alien drop ;
M: string string>alien
over check-string
<byte-writer>
[ stream-write ]
[ 0 swap stream-write1 ]
[ stream>> >byte-array ]
tri ;
HOOK: alien>native-string os ( alien -- string )
HOOK: native-string>alien os ( string -- alien )
M: windows alien>native-string utf16n alien>string ;
M: wince native-string>alien utf16n string>alien ;
M: winnt native-string>alien utf8 string>alien ;
M: unix alien>native-string utf8 alien>string ;
M: unix native-string>alien utf8 string>alien ;
: dll-path ( dll -- string )
path>> alien>native-string ;
: string>symbol ( str -- alien )
dup string?
[ native-string>alien ]
[ [ native-string>alien ] map ] if ;
[
8 getenv utf8 alien>string string>cpu \ cpu set-global
9 getenv utf8 alien>string string>os \ os set-global
] "alien.strings" add-init-hook

0
basis/alien/strings/summary.txt → core/alien/strings/summary.txt
View File

68
core/bootstrap/primitives.factor
View File

@ -82,8 +82,10 @@ bootstrapping? on
"kernel"
"kernel.private"
"math"
"math.parser.private"
"math.private"
"memory"
"memory.private"
"quotations"
"quotations.private"
"sbufs"
@ -366,8 +368,8 @@ tuple
{ "float>bignum" "math.private" (( x -- y )) }
{ "fixnum>float" "math.private" (( x -- y )) }
{ "bignum>float" "math.private" (( x -- y )) }
{ "string>float" "math.private" (( str -- n/f )) }
{ "float>string" "math.private" (( n -- str )) }
{ "(string>float)" "math.parser.private" (( str -- n/f )) }
{ "(float>string)" "math.parser.private" (( n -- str )) }
{ "float>bits" "math" (( x -- n )) }
{ "double>bits" "math" (( x -- n )) }
{ "bits>float" "math" (( n -- x )) }
@ -414,8 +416,8 @@ tuple
{ "(exists?)" "io.files.private" (( path -- ? )) }
{ "gc" "memory" (( -- )) }
{ "gc-stats" "memory" f }
{ "save-image" "memory" (( path -- )) }
{ "save-image-and-exit" "memory" (( path -- )) }
{ "(save-image)" "memory.private" (( path -- )) }
{ "(save-image-and-exit)" "memory.private" (( path -- )) }
{ "datastack" "kernel" (( -- ds )) }
{ "retainstack" "kernel" (( -- rs )) }
{ "callstack" "kernel" (( -- cs )) }
@ -427,38 +429,38 @@ tuple
{ "code-room" "memory" (( -- code-free code-total )) }
{ "micros" "system" (( -- us )) }
{ "modify-code-heap" "compiler.units" (( alist -- )) }
{ "dlopen" "alien.libraries" (( path -- dll )) }
{ "dlsym" "alien.libraries" (( name dll -- alien )) }
{ "(dlopen)" "alien.libraries" (( path -- dll )) }
{ "(dlsym)" "alien.libraries" (( name dll -- alien )) }
{ "dlclose" "alien.libraries" (( dll -- )) }
{ "<byte-array>" "byte-arrays" (( n -- byte-array )) }
{ "(byte-array)" "byte-arrays" (( n -- byte-array )) }
{ "<displaced-alien>" "alien" (( displacement c-ptr -- alien )) }
{ "alien-signed-cell" "alien.accessors" f }
{ "set-alien-signed-cell" "alien.accessors" f }
{ "alien-unsigned-cell" "alien.accessors" f }
{ "set-alien-unsigned-cell" "alien.accessors" f }
{ "alien-signed-8" "alien.accessors" f }
{ "set-alien-signed-8" "alien.accessors" f }
{ "alien-unsigned-8" "alien.accessors" f }
{ "set-alien-unsigned-8" "alien.accessors" f }
{ "alien-signed-4" "alien.accessors" f }
{ "set-alien-signed-4" "alien.accessors" f }
{ "alien-unsigned-4" "alien.accessors" f }
{ "set-alien-unsigned-4" "alien.accessors" f }
{ "alien-signed-2" "alien.accessors" f }
{ "set-alien-signed-2" "alien.accessors" f }
{ "alien-unsigned-2" "alien.accessors" f }
{ "set-alien-unsigned-2" "alien.accessors" f }
{ "alien-signed-1" "alien.accessors" f }
{ "set-alien-signed-1" "alien.accessors" f }
{ "alien-unsigned-1" "alien.accessors" f }
{ "set-alien-unsigned-1" "alien.accessors" f }
{ "alien-float" "alien.accessors" f }
{ "set-alien-float" "alien.accessors" f }
{ "alien-double" "alien.accessors" f }
{ "set-alien-double" "alien.accessors" f }
{ "alien-cell" "alien.accessors" f }
{ "set-alien-cell" "alien.accessors" f }
{ "alien-signed-cell" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-signed-cell" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-unsigned-cell" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-unsigned-cell" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-signed-8" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-signed-8" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-unsigned-8" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-unsigned-8" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-signed-4" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-signed-4" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-unsigned-4" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-unsigned-4" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-signed-2" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-signed-2" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-unsigned-2" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-unsigned-2" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-signed-1" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-signed-1" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-unsigned-1" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-unsigned-1" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-float" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-float" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-double" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-double" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-cell" "alien.accessors" (( c-ptr n -- value )) }
{ "set-alien-cell" "alien.accessors" (( value c-ptr n -- )) }
{ "alien-address" "alien" (( c-ptr -- addr )) }
{ "set-slot" "slots.private" (( value obj n -- )) }
{ "string-nth" "strings.private" (( n string -- ch )) }
@ -472,7 +474,7 @@ tuple
{ "end-scan" "memory" (( -- )) }
{ "size" "memory" (( obj -- n )) }
{ "die" "kernel" (( -- )) }
{ "fopen" "io.streams.c" (( path mode -- alien )) }
{ "(fopen)" "io.streams.c" (( path mode -- alien )) }
{ "fgetc" "io.streams.c" (( alien -- ch/f )) }
{ "fread" "io.streams.c" (( n alien -- str/f )) }
{ "fputc" "io.streams.c" (( ch alien -- )) }

1
core/bootstrap/syntax.factor
View File

@ -16,6 +16,7 @@ IN: bootstrap.syntax
"<PRIVATE"
"BIN:"
"B{"
"BV{"
"C:"
"CHAR:"
"DEFER:"

0
basis/byte-vectors/byte-vectors-docs.factor → core/byte-vectors/byte-vectors-docs.factor
View File

0
basis/byte-vectors/byte-vectors-tests.factor → core/byte-vectors/byte-vectors-tests.factor
View File

9
basis/byte-vectors/byte-vectors.factor → core/byte-vectors/byte-vectors.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel kernel.private math sequences
sequences.private growable byte-arrays accessors parser
prettyprint.custom ;
sequences.private growable byte-arrays accessors ;
IN: byte-vectors
TUPLE: byte-vector
@ -42,10 +41,4 @@ M: byte-array like
M: byte-array new-resizable drop <byte-vector> ;
SYNTAX: BV{ \ } [ >byte-vector ] parse-literal ;
M: byte-vector pprint* pprint-object ;
M: byte-vector pprint-delims drop \ BV{ \ } ;
M: byte-vector >pprint-sequence ;
INSTANCE: byte-vector growable

0
basis/byte-vectors/summary.txt → core/byte-vectors/summary.txt
View File

0
basis/byte-vectors/tags.txt → core/byte-vectors/tags.txt
View File

9
core/classes/algebra/algebra-tests.factor
View File

@ -305,7 +305,16 @@ SINGLETON: sc
[ sa ] [ sa { sa sb sc } min-class ] unit-test
[ f ] [ sa sb classes-intersect? ] unit-test
[ +lt+ ] [ integer sequence class<=> ] unit-test
[ +lt+ ] [ sequence object class<=> ] unit-test
[ +gt+ ] [ object sequence class<=> ] unit-test
[ +eq+ ] [ integer integer class<=> ] unit-test
! Limitations:
! UNION: u1 sa sb ;
! UNION: u2 sc ;
! [ f ] [ u1 u2 classes-intersect? ] unit-test

2
core/generic/standard/standard.factor
View File

@ -44,7 +44,7 @@ M: standard-combination inline-cache-quot ( word methods -- )
#! Direct calls to the generic word (not tail calls or indirect calls)
#! will jump to the inline cache entry point instead of the megamorphic
#! dispatch entry point.
combination get #>> [ f inline-cache-miss ] 3curry [ ] like ;
combination get #>> [ { } inline-cache-miss ] 3curry [ ] like ;
: make-empty-cache ( -- array )
mega-cache-size get f <array> ;

0
basis/io/encodings/utf16/authors.txt → core/io/encodings/utf16/authors.txt
View File

0
basis/io/encodings/utf16/summary.txt → core/io/encodings/utf16/summary.txt
View File

0
basis/io/encodings/utf16/utf16-docs.factor → core/io/encodings/utf16/utf16-docs.factor
View File

Some files were not shown because too many files have changed in this diff Show More