Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
e6448b4126
basis
alien
arrays
libraries
bootstrap
command-line
compiler/tests
debugger
editors
formatting
help
apropos
handbook
html
lint
tutorial
vocabs
http/server
io/encodings/iana
json/reader
present
prettyprint/backend
stack-checker/known-words
tools
completion
deploy
config/editor
shaker
test
ui
backend/cocoa
tools
views
gadgets
pixel-formats
tools
vocabs
windows/errors
core
bootstrap
classes/algebra
generic/standard
io/encodings/utf16
31
Makefile
31
Makefile
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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"
|
||||
|
|
@ -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 +0,0 @@
|
|||
Default string encoding on Unix
|
||||
|
|
@ -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 +0,0 @@
|
|||
Default string encoding on Windows
|
||||
|
|
@ -1 +0,0 @@
|
|||
unportable
|
||||
|
|
@ -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
|
||||
|
|
@ -65,7 +65,6 @@ SYMBOL: bootstrap-time
|
|||
"stage2: deployment mode" print
|
||||
] [
|
||||
"debugger" require
|
||||
"alien.prettyprint" require
|
||||
"inspector" require
|
||||
"tools.errors" require
|
||||
"listener" require
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ] ;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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" }
|
||||
|
|
|
|||
|
|
@ -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,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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ? )
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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 ( -- )
|
||||
|
|
|
|||
|
|
@ -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 +0,0 @@
|
|||
Reloading vocabularies and cross-referencing vocabularies
|
||||
|
|
@ -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." } ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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 -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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>> ;
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
|
|
|
|||
|
|
@ -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" } ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 } }
|
||||
|
|
|
|||
|
|
@ -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* ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
Caching vocabulary data from disk
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Loading vocabularies and batching errors
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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." } ;
|
||||
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Getting a list of files in a vocabulary
|
||||
|
|
@ -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." } ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Searching for vocabularies on disk
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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." } ;
|
||||
|
||||
|
|
@ -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? ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Managing vocabulary author, tag and summary information
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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
|
||||
|
|
@ -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,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"
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Reloading changed vocabularies from disk
|
||||
|
|
@ -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? ;
|
||||
|
|
|
|||
|
|
@ -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,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
|
||||
|
||||
|
|
@ -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 -- )) }
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ IN: bootstrap.syntax
|
|||
"<PRIVATE"
|
||||
"BIN:"
|
||||
"B{"
|
||||
"BV{"
|
||||
"C:"
|
||||
"CHAR:"
|
||||
"DEFER:"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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> ;
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue