tuple dispatch compiled, adding USING: to more files, inference terminator cleanup, jedit cleanup, new reload word to reload a word's source file

cvs
Slava Pestov 2005-02-09 03:02:44 +00:00
parent 88ba22ff6c
commit a8c34f50a8
29 changed files with 301 additions and 626 deletions

View File

@ -1,86 +1,63 @@
+ ui: 72/73:
- if gadgets are moved, added or deleted, update hand.
- keyboard focus
- keyboard gestures
- text fields
- finish check boxes
+ compiler:
- type inference fails with some assembler words;
displaced, register and other predicates need to inherit from list
not cons, and need stronger branch partial eval
- more accurate type inference in some cases
- optimize away dispatch
- goal: to compile hash* optimally
- type check/not-check entry points for compiled words
- getenv/setenv: if literal arg, compile as a load/store
- compile tuple dispatch
+ oop:
- make see work with union, builtin, predicate
- doc comments of generics
- proper ordering for classes
- tuples: gracefully handle changing shape - tuples: gracefully handle changing shape
- keep a list of getter/setter words - keep a list of getter/setter words
- default constructor - default constructor
- move tuple to generic vocab - move tuple to generic vocab
- update plugin docs
- extract word keeps indent
- word preview for remote words
- support USING:
- special completion for USE:/IN:
- prettyprint: detect circular structure
- vectors: ensure its ok with bignum indices
- parsing words don't print readably
- if gadgets are moved, added or deleted, update hand.
- keyboard focus
- keyboard gestures
- text fields
- code gc
- type inference fails with some assembler words;
displaced, register and other predicates need to inherit from list
not cons, and need stronger branch partial eval
- print warning on null class
- optimize away dispatch
- layouts with gaps
- alignment of gadgets inside their bounding boxes needs thought
- WordPreview calls markTokens() -> NPE
- faster completion
- ppc register decls
- rename f* words to stream-*
+ ffi: - ffi unicode strings: null char security hole
- utf16 string boxing
- slot compile problem
- nulls at the end of utf16 strings
+ compiler/ffi:
- value type structs - value type structs
- unicode strings
- out parameters - out parameters
- figure out how to load an image referring to missing libraries
- is signed -vs- unsigned pointers an issue? - is signed -vs- unsigned pointers an issue?
- bitfields in C structs - bitfields in C structs
- SDL_Rect** type - SDL_Rect** type
- struct membres that are not * - struct membres that are not *
- FFI float types - FFI float types
+ listener/plugin:
- command to turn repl session into a source file
- update plugin docs
- extract word keeps indent
- word preview for remote words
- WordPreview calls markTokens() -> NPE
- listener should be multithreaded
- faster completion
- NPE in ErrorHighlight
- maple-like: press enter at old commands to evaluate there
- completion in the listener
- special completion for USE:/IN:
- support USING:
- command to prettyprint word def at caret, or selection
+ i/o: + i/o:
- stream server can hang because of exception handler limitations - stream server can hang because of exception handler limitations
- better i/o scheduler - better i/o scheduler
- nicer way to combine two paths - nicer way to combine two paths
- add a socket timeout - add a socket timeout
- rename f* words to stream-* - unix ffi i/o
+ kernel: + kernel:
- ppc register decls
- cat, reverse-cat primitives - cat, reverse-cat primitives
- generational gc
+ misc: - make see work with union, builtin, predicate
- doc comments of generics
- proper ordering for classes
- make-vector and make-string should not need a reverse step - make-vector and make-string should not need a reverse step
- perhaps /i should work with all numbers
- jedit ==> jedit-word, jedit takes a file name
- browser responder for word links in HTTPd
- worddef props - worddef props
- prettyprint: detect circular structure
- vectors: ensure its ok with bignum indices
- parsing words don't print readably
+ httpd:
- log with date
- file responder; last-modified field

View File

@ -146,10 +146,10 @@ os "win32" = [
cpu "x86" = [ cpu "x86" = [
[ [
"/library/compiler/x86/assembler.factor" "/library/compiler/x86/assembler.factor"
"/library/compiler/x86/stack.factor" "/library/compiler/x86/stack.factor"
"/library/compiler/x86/generator.factor" "/library/compiler/x86/generator.factor"
"/library/compiler/x86/fixnum.factor" "/library/compiler/x86/fixnum.factor"
"/library/ui/line-editor.factor" "/library/ui/line-editor.factor"
"/library/ui/console.factor" "/library/ui/console.factor"

View File

@ -1,42 +1,8 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: alien IN: alien
USE: assembler USING: assembler compiler errors hashtables kernel lists math
USE: compiler namespaces parser strings words ;
USE: errors
USE: hashtables
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: parser
USE: strings
USE: words
! Some code for interfacing with C structures. ! Some code for interfacing with C structures.
@ -218,6 +184,14 @@ global [ <namespace> "c-types" set ] bind
"unbox_c_string" "unboxer" set "unbox_c_string" "unboxer" set
] "char*" define-c-type ] "char*" define-c-type
[
[ alien-4 ] "getter" set
[ set-alien-4 ] "setter" set
cell "width" set
"box_utf16_string" "boxer" set
"unbox_utf16_string" "unboxer" set
] "ushort*" define-c-type
[ [
[ alien-4 0 = not ] "getter" set [ alien-4 0 = not ] "getter" set
[ 1 0 ? set-alien-4 ] "setter" set [ 1 0 ? set-alien-4 ] "setter" set

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: generic IN: generic
USING: words parser kernel namespaces lists strings USING: words parser kernel namespaces lists strings
kernel-internals math hashtables errors ; kernel-internals math hashtables errors vectors ;
: make-tuple ( class -- tuple ) : make-tuple ( class -- tuple )
dup "tuple-size" word-property <tuple> dup "tuple-size" word-property <tuple>
@ -102,28 +102,63 @@ kernel-internals math hashtables errors ;
] ifte ] ifte
] [ ] [
drop f drop f
] ifte ; inline ] ifte ;
: lookup-method ( class selector -- method ) : alist>quot ( default alist -- quot )
"methods" word-property hash* ; inline #! Turn an association list that maps values to quotations
#! into a quotation that executes a quotation depending on
#! the value on the stack.
[
[
unswons
\ dup , unswons literal, \ = , \ drop swons ,
alist>quot , \ ifte ,
] make-list
] when* ;
: tuple-dispatch ( object selector -- ) : (hash>quot) ( default hash -- quot )
over class over lookup-method [ [
cdr call ( method is defined ) \ dup , \ hashcode , dup bucket-count , \ rem ,
buckets>list [ alist>quot ] map-with list>vector ,
\ dispatch ,
] make-list ;
: hash>quot ( default hash -- quot )
#! Turn a hash table that maps values to quotations into a
#! quotation that executes a quotation depending on the
#! value on the stack.
dup hash-size 4 <= [
hash>alist alist>quot
] [ ] [
object over lookup-method [ (hash>quot)
cdr call ] ifte ;
: default-tuple-method ( generic -- quot )
#! If the generic does not define a specific method for a
#! tuple, execute the return value of this.
dup "methods" word-property
tuple over hash dup [
2nip
] [
drop object over hash dup [
2nip
] [ ] [
over tuple-delegate [ 2drop [ dup tuple-delegate ] swap
rot drop swap execute ( check delegate ) dup unit swap
] [ unit [ car ] cons [ undefined-method ] append
undefined-method ( no delegate ) \ ?ifte 3list append
] ifte* ] ifte
] ?ifte ] ifte ;
] ?ifte ;
: tuple-dispatch-quot ( generic -- quot )
#! Generate a quotation that performs tuple class dispatch
#! for methods defined on the given generic.
dup default-tuple-method \ drop swons
swap "methods" word-property hash>quot
[ dup class ] swap append ;
: add-tuple-dispatch ( word vtable -- ) : add-tuple-dispatch ( word vtable -- )
>r unit [ car tuple-dispatch ] cons tuple r> set-vtable ; >r tuple-dispatch-quot tuple r> set-vtable ;
: clone-tuple ( tuple -- tuple ) : clone-tuple ( tuple -- tuple )
#! Make a shallow copy of a tuple, without cloning its #! Make a shallow copy of a tuple, without cloning its

View File

@ -64,12 +64,15 @@ strings vectors words hashtables prettyprint ;
meta-r set drop ; meta-r set drop ;
: filter-terminators ( list -- list ) : filter-terminators ( list -- list )
[ [ d-in get meta-d get and ] bind ] subset [ #! Remove branches that unconditionally throw errors.
"No branch has a stack effect" throw [ [ active? ] bind ] subset ;
] unless* ;
: unify-effects ( list -- ) : unify-effects ( list -- )
filter-terminators dup datastack-effect callstack-effect ; filter-terminators [
dup datastack-effect callstack-effect
] [
terminate
] ifte* ;
SYMBOL: cloned SYMBOL: cloned
@ -93,14 +96,6 @@ SYMBOL: cloned
d-in [ deep-clone-vector ] change d-in [ deep-clone-vector ] change
dataflow-graph off ; dataflow-graph off ;
: terminator? ( obj -- ? )
dup word? [ "terminator" word-property ] [ drop f ] ifte ;
: handle-terminator ( quot -- )
[ terminator? ] some? [
meta-d off meta-r off d-in off
] when ;
: propagate-type ( [[ value class ]] -- ) : propagate-type ( [[ value class ]] -- )
#! Type propagation is chained. #! Type propagation is chained.
[ [
@ -109,13 +104,20 @@ SYMBOL: cloned
] when* ; ] when* ;
: infer-branch ( value -- namespace ) : infer-branch ( value -- namespace )
#! Return a namespace with inferencer variables:
#! meta-d, meta-r, d-in. They are set to f if
#! terminate was called.
<namespace> [ <namespace> [
uncons propagate-type uncons propagate-type
dup value-recursion recursive-state set dup value-recursion recursive-state set
copy-inference copy-inference
literal-value dup infer-quot literal-value dup infer-quot
#values values-node active? [
handle-terminator #values values-node
handle-terminator
] [
drop
] ifte
] extend ; ] extend ;
: (infer-branches) ( branchlist -- list ) : (infer-branches) ( branchlist -- list )

View File

@ -162,10 +162,31 @@ DEFER: apply-word
#! Apply the object's stack effect to the inferencer state. #! Apply the object's stack effect to the inferencer state.
dup word? [ apply-word ] [ apply-literal ] ifte ; dup word? [ apply-word ] [ apply-literal ] ifte ;
: active? ( -- ? )
#! Is this branch not terminated?
d-in get meta-d get and ;
: terminate ( -- )
#! Ignore this branch's stack effect.
meta-d off meta-r off d-in off ;
: terminator? ( obj -- ? )
#! Does it throw an error?
dup word? [ "terminator" word-property ] [ drop f ] ifte ;
: handle-terminator ( quot -- )
#! If the quotation throws an error, do not count its stack
#! effect.
[ terminator? ] some? [ terminate ] when ;
: infer-quot ( quot -- ) : infer-quot ( quot -- )
#! Recursive calls to this word are made for nested #! Recursive calls to this word are made for nested
#! quotations. #! quotations.
[ apply-object ] each ; active? [
[ unswons apply-object infer-quot ] when*
] [
drop
] ifte ;
: check-return ( -- ) : check-return ( -- )
#! Raise an error if word leaves values on return stack. #! Raise an error if word leaves values on return stack.

View File

@ -27,14 +27,20 @@ lists math namespaces strings vectors words stdio prettyprint ;
\ >string \ string infer-check \ >string \ string infer-check
] "infer" set-word-property ] "infer" set-word-property
! \ slot [ ! : literal-slot ( -- )
! [ object fixnum ] ensure-d
! dataflow-drop, pop-d literal-value ! dataflow-drop, pop-d literal-value
! peek-d value-class builtin-supertypes dup length 1 = [ ! peek-d value-class builtin-supertypes dup length 1 = [
! cons \ slot [ [ object ] [ object ] ] (consume/produce) ! cons \ slot [ [ object ] [ object ] ] (consume/produce)
! ] [ ! ] [
! "slot called without static type knowledge" throw ! "slot called without static type knowledge" throw
! ] ifte ! ] ifte ;
!
! : computed-slot ( -- )
! \ slot dup "infer-effect" word-property consume/produce ;
!
! \ slot [
! [ object fixnum ] ensure-d
! peek-d literal? [ literal-slot ] [ computed-slot ] ifte
! ] "infer" set-word-property ! ] "infer" set-word-property
: type-value-map ( value -- ) : type-value-map ( value -- )

View File

@ -62,23 +62,37 @@ strings vectors words hashtables parser prettyprint ;
#! we infer its stack effect inside a new block. #! we infer its stack effect inside a new block.
gensym [ word-parameter infer-quot effect ] with-block ; gensym [ word-parameter infer-quot effect ] with-block ;
: infer-compound ( word -- effect ) : infer-compound ( word -- )
#! Infer a word's stack effect in a separate inferencer #! Infer a word's stack effect in a separate inferencer
#! instance. #! instance.
[ [
recursive-state get init-inference [
dup dup inline-compound drop present-effect recursive-state get init-inference
[ "infer-effect" set-word-property ] keep dup dup inline-compound drop present-effect
] with-scope consume/produce ; [ "infer-effect" set-word-property ] keep
] with-scope consume/produce
] [
[
>r branches-can-fail? [
drop
] [
t "no-effect" set-word-property
] ifte r> rethrow
] when*
] catch ;
GENERIC: (apply-word) GENERIC: (apply-word)
M: compound (apply-word) ( word -- ) M: compound (apply-word) ( word -- )
#! Infer a compound word's stack effect. #! Infer a compound word's stack effect.
dup "inline" word-property [ dup "no-effect" word-property [
inline-compound 2drop no-effect
] [ ] [
infer-compound dup "inline" word-property [
inline-compound 2drop
] [
infer-compound
] ifte
] ifte ; ] ifte ;
M: promise (apply-word) ( word -- ) M: promise (apply-word) ( word -- )
@ -141,14 +155,16 @@ M: symbol (apply-word) ( word -- )
gensym dup [ gensym dup [
drop pop-d dup drop pop-d dup
value-recursion recursive-state set value-recursion recursive-state set
literal-value infer-quot literal-value
] with-block drop ; dup infer-quot
] with-block drop handle-terminator ;
\ call [ infer-call ] "infer" set-word-property \ call [ infer-call ] "infer" set-word-property
! These hacks will go away soon ! These hacks will go away soon
\ * [ [ number number ] [ number ] ] "infer-effect" set-word-property \ * [ [ number number ] [ number ] ] "infer-effect" set-word-property
\ - [ [ number number ] [ number ] ] "infer-effect" set-word-property \ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
\ = [ [ object object ] [ object ] ] "infer-effect" set-word-property
\ undefined-method t "terminator" set-word-property \ undefined-method t "terminator" set-word-property
\ undefined-method [ [ object word ] [ ] ] "infer-effect" set-word-property \ undefined-method [ [ object word ] [ ] ] "infer-effect" set-word-property

View File

@ -1,39 +1,8 @@
! :folding=indent:collapseFolds=1: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: files IN: files
USE: kernel USING: kernel hashtables lists namespaces presentation stdio
USE: hashtables strings unparser ;
USE: lists
USE: namespaces
USE: presentation
USE: stdio
USE: strings
USE: unparser
: exists? ( file -- ? ) : exists? ( file -- ? )
stat >boolean ; stat >boolean ;

View File

@ -1,11 +1,18 @@
! Copyright (C) 2004, 2005 Slava Pestov. ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: files
USING: io-internals errors hashtables kernel stdio strings
namespaces generic ;
! We need this early during bootstrap.
: path+ ( path path -- path )
#! Combine two paths. This will be implemented later.
"/" swap cat3 ;
IN: stdio IN: stdio
DEFER: stdio DEFER: stdio
IN: streams IN: streams
USING: io-internals errors hashtables kernel stdio strings
namespaces generic ;
TUPLE: fd-stream in out ; TUPLE: fd-stream in out ;
@ -56,4 +63,4 @@ C: fd-stream ( in out -- stream )
"resource-path" get [ "." ] unless* ; "resource-path" get [ "." ] unless* ;
: <resource-stream> ( path -- stream ) : <resource-stream> ( path -- stream )
resource-path swap cat2 <file-reader> ; resource-path swap path+ <file-reader> ;

View File

@ -1,34 +1,7 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math IN: math
USE: kernel USING: kernel math math-internals ;
USE: math
USE: math-internals
! Inverse trigonometric functions: ! Inverse trigonometric functions:
! acos asec asin acosec atan acot ! acos asec asin acosec atan acot

View File

@ -1,38 +1,10 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: errors IN: errors
DEFER: throw DEFER: throw
IN: math-internals IN: math-internals
USE: generic USING: generic kernel kernel-internals math ;
USE: kernel
USE: kernel-internals
USE: math
: (rect>) ( xr xi -- x ) : (rect>) ( xr xi -- x )
#! Does not perform a check that the arguments are reals. #! Does not perform a check that the arguments are reals.
@ -54,7 +26,7 @@ M: complex imaginary 1 slot %real ;
(rect>) (rect>)
] [ ] [
"Complex number must have real components" throw drop "Complex number must have real components" throw drop
] ifte ; inline ] ifte ;
: >rect ( x -- xr xi ) dup real swap imaginary ; inline : >rect ( x -- xr xi ) dup real swap imaginary ; inline
@ -88,7 +60,7 @@ IN: math-internals
: 2>rect ( x y -- xr yr xi yi ) : 2>rect ( x y -- xr yr xi yi )
[ swap real swap real ] 2keep [ swap real swap real ] 2keep
swap imaginary swap imaginary ; inline swap imaginary swap imaginary ;
M: complex number= ( x y -- ? ) M: complex number= ( x y -- ? )
2>rect number= [ number= ] [ 2drop f ] ifte ; 2>rect number= [ number= ] [ 2drop f ] ifte ;

View File

@ -1,30 +1,5 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2003, 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math IN: math
USE: kernel USE: kernel

View File

@ -1,34 +1,7 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math-internals IN: math-internals
USE: generic USING: generic kernel math ;
USE: kernel
USE: math
M: float number= float= ; M: float number= float= ;
M: float < float< ; M: float < float< ;

View File

@ -1,37 +1,10 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: errors IN: errors
DEFER: throw DEFER: throw
IN: math-internals IN: math-internals
USE: generic USING: generic kernel math ;
USE: kernel
USE: math
: fraction> ( a b -- a/b ) : fraction> ( a b -- a/b )
dup 1 number= [ dup 1 number= [

View File

@ -1,34 +1,7 @@
! :folding=indent:collapseFolds=0:
! $Id$
!
! Copyright (C) 2003, 2005 Slava Pestov. ! Copyright (C) 2003, 2005 Slava Pestov.
! ! See http://factor.sf.net/license.txt for BSD license.
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math IN: math
USE: generic USING: generic kernel math-internals ;
USE: kernel
USE: math-internals
! Math operations ! Math operations
2GENERIC: number= ( x y -- ? ) 2GENERIC: number= ( x y -- ? )
@ -92,7 +65,7 @@ M: number = ( n n -- ? ) number= ;
: rem ( x y -- x%y ) : rem ( x y -- x%y )
#! Like modulus, but always gives a positive result. #! Like modulus, but always gives a positive result.
[ mod ] keep over 0 < [ + ] [ drop ] ifte ; inline [ mod ] keep over 0 < [ + ] [ drop ] ifte ;
: sgn ( n -- -1/0/1 ) : sgn ( n -- -1/0/1 )
#! Push the sign of a real number. #! Push the sign of a real number.

View File

@ -1,34 +1,7 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math IN: math
USE: math USING: math math-internals kernel ;
USE: math-internals
USE: kernel
! Power-related functions: ! Power-related functions:
! exp log sqrt pow ! exp log sqrt pow

View File

@ -1,36 +1,7 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math IN: math
USE: generic USING: generic kernel kernel-internals math math-internals ;
USE: kernel
USE: kernel-internals
USE: math
USE: math-internals
GENERIC: numerator ( a/b -- a ) GENERIC: numerator ( a/b -- a )
M: integer numerator ; M: integer numerator ;
@ -50,7 +21,7 @@ M: ratio number= ( a/b c/d -- ? )
2>fraction number= [ number= ] [ 2drop f ] ifte ; 2>fraction number= [ number= ] [ 2drop f ] ifte ;
: scale ( a/b c/d -- a*d b*c ) : scale ( a/b c/d -- a*d b*c )
2>fraction >r * swap r> * swap ; inline 2>fraction >r * swap r> * swap ;
: ratio+d ( a/b c/d -- b*d ) : ratio+d ( a/b c/d -- b*d )
denominator swap denominator * ; inline denominator swap denominator * ; inline

View File

@ -1,34 +1,7 @@
! :folding=indent:collapseFolds=0: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math IN: math
USE: kernel USING: kernel math math-internals ;
USE: math
USE: math-internals
! Trigonometric functions: ! Trigonometric functions:
! cos sec sin cosec tan cot ! cos sec sin cosec tan cot

View File

@ -1,7 +1,8 @@
! Copyright (C) 2003, 2005 Slava Pestov. ! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: namespaces IN: namespaces
USING: hashtables kernel kernel-internals lists vectors math ; USING: hashtables kernel kernel-internals lists strings vectors
math ;
! Other languages have classes, objects, variables, etc. ! Other languages have classes, objects, variables, etc.
! Factor has similar concepts. ! Factor has similar concepts.
@ -125,6 +126,17 @@ SYMBOL: list-buffer
#! was called. #! was called.
make-rlist reverse ; inline make-rlist reverse ; inline
: make-string ( quot -- string )
#! Call a quotation. The quotation can call , to prepend
#! objects to the list that is returned when the quotation
#! is done.
make-list cat ; inline
: make-rstring ( quot -- string )
#! Return a string whose entries are in the same order that ,
#! was called.
make-rlist cat ; inline
: make-vector ( quot -- list ) : make-vector ( quot -- list )
#! Return a vector whose entries are in the same order that #! Return a vector whose entries are in the same order that
#! , was called. #! , was called.

View File

@ -2,17 +2,6 @@
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: strings USING: kernel lists math namespaces strings ; IN: strings USING: kernel lists math namespaces strings ;
: make-string ( quot -- string )
#! Call a quotation. The quotation can call , to prepend
#! objects to the list that is returned when the quotation
#! is done.
make-list cat ; inline
: make-rstring ( quot -- string )
#! Return a string whose entries are in the same order that ,
#! was called.
make-rlist cat ; inline
: fill ( count char -- string ) : fill ( count char -- string )
#! Push a string that consists of the same character #! Push a string that consists of the same character
#! repeated. #! repeated.

View File

@ -1,30 +1,5 @@
! :folding=indent:collapseFolds=1: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2005 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: sdl-ttf IN: sdl-ttf
USE: alien USE: alien
@ -82,20 +57,23 @@ BEGIN-STRUCT: int-box
FIELD: int i FIELD: int i
END-STRUCT END-STRUCT
: TTF_SizeText ( font text w h -- ? ) : TTF_SizeUNICODE ( font text w h -- ? )
"bool" "sdl-ttf" "TTF_SizeText" [ "void*" "char*" "int-box*" "int-box*" ] alien-invoke ; "bool" "sdl-ttf" "TTF_SizeUNICODE" [ "void*" "ushort*" "int-box*" "int-box*" ] alien-invoke ;
: TTF_RenderText_Solid ( font text fg -- surface ) : TTF_RenderUNICODE_Solid ( font text fg -- surface )
"surface*" "sdl-ttf" "TTF_RenderText_Solid" [ "void*" "char*" "int" ] alien-invoke ; "surface*" "sdl-ttf" "TTF_RenderUNICODE_Solid" [ "void*" "ushort*" "int" ] alien-invoke ;
: TTF_RenderText_Shaded ( font text fg bg -- surface ) : TTF_RenderGlyph_Solid ( font text fg -- surface )
"surface*" "sdl-ttf" "TTF_RenderText_Shaded" [ "void*" "char*" "int" "int" ] alien-invoke ; "surface*" "sdl-ttf" "TTF_RenderText_Solid" [ "void*" "ushort" "int" ] alien-invoke ;
: TTF_RenderUNICODE_Shaded ( font text fg bg -- surface )
"surface*" "sdl-ttf" "TTF_RenderUNICODE_Shaded" [ "void*" "ushort*" "int" "int" ] alien-invoke ;
: TTF_RenderGlyph_Shaded ( font text fg bg -- surface ) : TTF_RenderGlyph_Shaded ( font text fg bg -- surface )
"surface*" "sdl-ttf" "TTF_RenderGlyph_Shaded" [ "void*" "ushort" "int" "int" ] alien-invoke ; "surface*" "sdl-ttf" "TTF_RenderGlyph_Shaded" [ "void*" "ushort" "int" "int" ] alien-invoke ;
: TTF_RenderText_Blended ( font text fg -- surface ) : TTF_RenderUNICODE_Blended ( font text fg -- surface )
"surface*" "sdl-ttf" "TTF_RenderText_Blended" [ "void*" "char*" "int" ] alien-invoke ; "surface*" "sdl-ttf" "TTF_RenderUNICODE_Blended" [ "void*" "ushort*" "int" ] alien-invoke ;
: TTF_RenderGlyph_Blended ( font text fg -- surface ) : TTF_RenderGlyph_Blended ( font text fg -- surface )
"surface*" "sdl-ttf" "TTF_RenderGlyph_Blended" [ "void*" "ushort" "int" ] alien-invoke ; "surface*" "sdl-ttf" "TTF_RenderGlyph_Blended" [ "void*" "ushort" "int" ] alien-invoke ;

View File

@ -103,7 +103,7 @@ SYMBOL: surface
] with-scope ; inline ] with-scope ; inline
: event-loop ( event -- ) : event-loop ( event -- )
dup SDL_WaitEvent 1 = [ dup SDL_WaitEvent [
dup event-type SDL_QUIT = [ dup event-type SDL_QUIT = [
drop drop
] [ ] [
@ -171,7 +171,7 @@ global [
over str-length 0 = [ over str-length 0 = [
2drop 3drop 0 2drop 3drop 0
] [ ] [
TTF_RenderText_Blended TTF_RenderUNICODE_Blended
[ draw-surface ] keep [ draw-surface ] keep
[ surface-w ] keep [ surface-w ] keep
SDL_FreeSurface SDL_FreeSurface
@ -181,7 +181,7 @@ global [
dup str-length 0 = [ dup str-length 0 = [
drop TTF_FontHeight 0 swap drop TTF_FontHeight 0 swap
] [ ] [
<int-box> <int-box> [ TTF_SizeText drop ] 2keep <int-box> <int-box> [ TTF_SizeUNICODE drop ] 2keep
swap int-box-i swap int-box-i swap int-box-i swap int-box-i
] ifte ; ] ifte ;

View File

@ -23,3 +23,11 @@ M: quux-tuple delegation-test drop 4 ;
WRAPPER: quuux-tuple WRAPPER: quuux-tuple
[ 3 ] [ <quux-tuple> <quuux-tuple> delegation-test ] unit-test [ 3 ] [ <quux-tuple> <quuux-tuple> delegation-test ] unit-test
GENERIC: delegation-test-2
TUPLE: quux-tuple-2 ;
C: quux-tuple-2 ;
M: quux-tuple-2 delegation-test-2 drop 4 ;
WRAPPER: quuux-tuple-2
[ 4 ] [ <quux-tuple-2> <quuux-tuple-2> delegation-test-2 ] unit-test

View File

@ -1,40 +1,8 @@
! :folding=indent:collapseFolds=1: ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: jedit IN: jedit
USE: kernel USING: files kernel lists namespaces parser streams stdio
USE: lists strings unparser words ;
USE: namespaces
USE: parser
USE: streams
USE: stdio
USE: strings
USE: unparser
USE: words
: jedit-server-file ( -- path ) : jedit-server-file ( -- path )
"jedit-server-file" get "jedit-server-file" get
@ -47,26 +15,13 @@ USE: words
read parse-number read parse-number
] with-stream ; ] with-stream ;
: bool, ( ? -- str ) : make-jedit-request ( files params -- code )
"true" "false" ? , ;
: list>bsh-array, ( list -- code )
"new String[] {" ,
[ unparse , "," , ] each
"null}" , ;
: make-jedit-request ( files dir params -- code )
[ [
[ "EditServer.handleClient(false,false,false,null," ,
"EditServer.handleClient(" , "new String[] {" ,
"restore" get bool, "," , [ unparse , "," , ] each
"newView" get bool, "," , "null});\n" ,
"newPlainView" get bool, "," , ] make-string ;
( If the dir is not set, we don't want to send f )
dup [ unparse ] [ drop "null" ] ifte , "," ,
list>bsh-array, ");\n" ,
] make-string
] bind ;
: send-jedit-request ( request -- ) : send-jedit-request ( request -- )
jedit-server-info swap "localhost" swap <client> [ jedit-server-info swap "localhost" swap <client> [
@ -75,33 +30,17 @@ USE: words
write flush write flush
] with-stream ; ] with-stream ;
: jedit-line/file ( line dir file -- ) : jedit-line/file ( file line -- )
rot "+line:" swap unparse cat2 unit cons swap unparse "+line:" swap cat2 2list
<namespace> [ make-jedit-request send-jedit-request ;
"restore" off
"newView" off
"newPlainView" off
] extend make-jedit-request send-jedit-request ;
: word-file ( path -- dir file ) : jedit-file ( file -- )
dup [ unit make-jedit-request send-jedit-request ;
"resource:/" ?str-head [
resource-path swap
] [
f swap
] ifte
] [
f
] ifte ;
: word-line/file ( word -- line dir file )
#! Note that line numbers here start from 1
dup "line" word-property swap "file" word-property
word-file ;
: jedit ( word -- ) : jedit ( word -- )
word-line/file dup [ #! Note that line numbers here start from 1
jedit-line/file dup word-file dup [
swap "line" word-property jedit-line/file
] [ ] [
3drop "Unknown source" print 2drop "Unknown source" print
] ifte ; ] ifte ;

View File

@ -1,42 +1,9 @@
! :folding=indent:collapseFolds=1: ! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! $Id$
!
! Copyright (C) 2003, 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: words IN: words
USE: generic USING: files generic inspector lists kernel namespaces
USE: inspector prettyprint stdio streams strings unparser math hashtables
USE: lists parser ;
USE: kernel
USE: namespaces
USE: prettyprint
USE: stdio
USE: strings
USE: unparser
USE: math
USE: hashtables
GENERIC: word-uses? ( of in -- ? ) GENERIC: word-uses? ( of in -- ? )
M: word word-uses? 2drop f ; M: word word-uses? 2drop f ;
@ -107,3 +74,14 @@ M: generic word-uses? ( of in -- ? )
: words. ( vocab -- ) : words. ( vocab -- )
words . ; words . ;
: word-file ( word -- file )
"file" word-property dup [
"resource:/" ?str-head [
resource-path swap path+
] when
] when ;
: reload ( word -- )
#! Reload the source file the word originated from.
word-file run-resource ;

View File

@ -67,7 +67,7 @@ C: gadget ( shape -- gadget )
] ifte ] ifte
] [ ] [
2drop 2drop
] ifte ; ] ifte ; inline
: screen-pos ( gadget -- point ) : screen-pos ( gadget -- point )
#! The position of the gadget on the screen. #! The position of the gadget on the screen.

View File

@ -136,6 +136,13 @@ BYTE* unbox_c_string(void)
return to_c_string(untag_string(dpop())); return to_c_string(untag_string(dpop()));
} }
/* FFI calls this */
uint16_t* unbox_utf16_string(void)
{
/* Return pointer to first character */
return (uint16_t*)(untag_string(dpop()) + 1);
}
void primitive_string_nth(void) void primitive_string_nth(void)
{ {
F_STRING* string = untag_string(dpop()); F_STRING* string = untag_string(dpop());

View File

@ -24,6 +24,7 @@ DLLEXPORT void box_c_string(const BYTE* c_string);
F_STRING* from_c_string(const BYTE* c_string); F_STRING* from_c_string(const BYTE* c_string);
void primitive_memory_to_string(void); void primitive_memory_to_string(void);
DLLEXPORT BYTE* unbox_c_string(void); DLLEXPORT BYTE* unbox_c_string(void);
DLLEXPORT uint16_t* unbox_utf16_string(void);
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index * CHARS) #define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index * CHARS)