From a8c34f50a83712ae67c30aa9ba8849ee26721324 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Feb 2005 03:02:44 +0000 Subject: [PATCH] tuple dispatch compiled, adding USING: to more files, inference terminator cleanup, jedit cleanup, new reload word to reload a word's source file --- TODO.FACTOR.txt | 95 ++++++++++---------------- library/bootstrap/boot-stage2.factor | 8 +-- library/compiler/alien-types.factor | 50 ++++---------- library/generic/tuple.factor | 69 ++++++++++++++----- library/inference/branches.factor | 30 +++++---- library/inference/inference.factor | 23 ++++++- library/inference/types.factor | 12 +++- library/inference/words.factor | 36 +++++++--- library/io/files.factor | 39 ++--------- library/io/stream-impl.factor | 13 +++- library/math/arc-trig-hyp.factor | 33 +--------- library/math/complex.factor | 38 ++--------- library/math/constants.factor | 29 +------- library/math/float.factor | 33 +--------- library/math/integer.factor | 33 +--------- library/math/math.factor | 33 +--------- library/math/pow.factor | 33 +--------- library/math/ratio.factor | 37 ++--------- library/math/trig-hyp.factor | 33 +--------- library/namespaces.factor | 14 +++- library/sbuf.factor | 11 ---- library/sdl/sdl-ttf.factor | 48 ++++---------- library/sdl/sdl-utils.factor | 6 +- library/test/tuple.factor | 8 +++ library/tools/jedit.factor | 99 ++++++---------------------- library/tools/word-tools.factor | 54 +++++---------- library/ui/gadgets.factor | 2 +- native/string.c | 7 ++ native/string.h | 1 + 29 files changed, 301 insertions(+), 626 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 1cd6fb96c0..47916b3e91 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -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 - keep a list of getter/setter words - default constructor - 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 -- unicode strings - out parameters -- figure out how to load an image referring to missing libraries - is signed -vs- unsigned pointers an issue? - bitfields in C structs - SDL_Rect** type - struct membres that are not * - 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: - stream server can hang because of exception handler limitations - better i/o scheduler - nicer way to combine two paths - add a socket timeout -- rename f* words to stream-* +- unix ffi i/o + kernel: -- ppc register decls - cat, reverse-cat primitives - -+ misc: - +- generational gc +- 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 -- perhaps /i should work with all numbers -- jedit ==> jedit-word, jedit takes a file name -- browser responder for word links in HTTPd - 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 diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index c7341c7fee..33df1d16fc 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -146,10 +146,10 @@ os "win32" = [ cpu "x86" = [ [ - "/library/compiler/x86/assembler.factor" - "/library/compiler/x86/stack.factor" - "/library/compiler/x86/generator.factor" - "/library/compiler/x86/fixnum.factor" + "/library/compiler/x86/assembler.factor" + "/library/compiler/x86/stack.factor" + "/library/compiler/x86/generator.factor" + "/library/compiler/x86/fixnum.factor" "/library/ui/line-editor.factor" "/library/ui/console.factor" diff --git a/library/compiler/alien-types.factor b/library/compiler/alien-types.factor index 1aad3c6033..a978f30d13 100644 --- a/library/compiler/alien-types.factor +++ b/library/compiler/alien-types.factor @@ -1,42 +1,8 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: alien -USE: assembler -USE: compiler -USE: errors -USE: hashtables -USE: kernel -USE: lists -USE: math -USE: namespaces -USE: parser -USE: strings -USE: words +USING: assembler compiler errors hashtables kernel lists math +namespaces parser strings words ; ! Some code for interfacing with C structures. @@ -218,6 +184,14 @@ global [ "c-types" set ] bind "unbox_c_string" "unboxer" set ] "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 [ 1 0 ? set-alien-4 ] "setter" set diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 265e345ef5..a52b6eb806 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: generic USING: words parser kernel namespaces lists strings -kernel-internals math hashtables errors ; +kernel-internals math hashtables errors vectors ; : make-tuple ( class -- tuple ) dup "tuple-size" word-property @@ -102,28 +102,63 @@ kernel-internals math hashtables errors ; ] ifte ] [ drop f - ] ifte ; inline + ] ifte ; -: lookup-method ( class selector -- method ) - "methods" word-property hash* ; inline +: alist>quot ( default alist -- quot ) + #! 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 -- ) - over class over lookup-method [ - cdr call ( method is defined ) +: (hash>quot) ( default hash -- quot ) + [ + \ 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 [ - cdr call + (hash>quot) + ] 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 [ - rot drop swap execute ( check delegate ) - ] [ - undefined-method ( no delegate ) - ] ifte* - ] ?ifte - ] ?ifte ; + 2drop [ dup tuple-delegate ] swap + dup unit swap + unit [ car ] cons [ undefined-method ] append + \ ?ifte 3list append + ] 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 -- ) - >r unit [ car tuple-dispatch ] cons tuple r> set-vtable ; + >r tuple-dispatch-quot tuple r> set-vtable ; : clone-tuple ( tuple -- tuple ) #! Make a shallow copy of a tuple, without cloning its diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 322ce0e1ee..00d53ac459 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -64,12 +64,15 @@ strings vectors words hashtables prettyprint ; meta-r set drop ; : filter-terminators ( list -- list ) - [ [ d-in get meta-d get and ] bind ] subset [ - "No branch has a stack effect" throw - ] unless* ; + #! Remove branches that unconditionally throw errors. + [ [ active? ] bind ] subset ; : unify-effects ( list -- ) - filter-terminators dup datastack-effect callstack-effect ; + filter-terminators [ + dup datastack-effect callstack-effect + ] [ + terminate + ] ifte* ; SYMBOL: cloned @@ -93,14 +96,6 @@ SYMBOL: cloned d-in [ deep-clone-vector ] change 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 ]] -- ) #! Type propagation is chained. [ @@ -109,13 +104,20 @@ SYMBOL: cloned ] when* ; : 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. [ uncons propagate-type dup value-recursion recursive-state set copy-inference literal-value dup infer-quot - #values values-node - handle-terminator + active? [ + #values values-node + handle-terminator + ] [ + drop + ] ifte ] extend ; : (infer-branches) ( branchlist -- list ) diff --git a/library/inference/inference.factor b/library/inference/inference.factor index c46c0d2fa4..bf8d7bd905 100644 --- a/library/inference/inference.factor +++ b/library/inference/inference.factor @@ -162,10 +162,31 @@ DEFER: apply-word #! Apply the object's stack effect to the inferencer state. 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 -- ) #! Recursive calls to this word are made for nested #! quotations. - [ apply-object ] each ; + active? [ + [ unswons apply-object infer-quot ] when* + ] [ + drop + ] ifte ; : check-return ( -- ) #! Raise an error if word leaves values on return stack. diff --git a/library/inference/types.factor b/library/inference/types.factor index c1d378964a..ff91178f57 100644 --- a/library/inference/types.factor +++ b/library/inference/types.factor @@ -27,14 +27,20 @@ lists math namespaces strings vectors words stdio prettyprint ; \ >string \ string infer-check ] "infer" set-word-property -! \ slot [ -! [ object fixnum ] ensure-d +! : literal-slot ( -- ) ! dataflow-drop, pop-d literal-value ! peek-d value-class builtin-supertypes dup length 1 = [ ! cons \ slot [ [ object ] [ object ] ] (consume/produce) ! ] [ ! "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 : type-value-map ( value -- ) diff --git a/library/inference/words.factor b/library/inference/words.factor index 416322e074..6a07495b72 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -62,23 +62,37 @@ strings vectors words hashtables parser prettyprint ; #! we infer its stack effect inside a new 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 #! instance. [ - recursive-state get init-inference - dup dup inline-compound drop present-effect - [ "infer-effect" set-word-property ] keep - ] with-scope consume/produce ; + [ + recursive-state get init-inference + dup dup inline-compound drop present-effect + [ "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) M: compound (apply-word) ( word -- ) #! Infer a compound word's stack effect. - dup "inline" word-property [ - inline-compound 2drop + dup "no-effect" word-property [ + no-effect ] [ - infer-compound + dup "inline" word-property [ + inline-compound 2drop + ] [ + infer-compound + ] ifte ] ifte ; M: promise (apply-word) ( word -- ) @@ -141,14 +155,16 @@ M: symbol (apply-word) ( word -- ) gensym dup [ drop pop-d dup value-recursion recursive-state set - literal-value infer-quot - ] with-block drop ; + literal-value + dup infer-quot + ] with-block drop handle-terminator ; \ call [ infer-call ] "infer" set-word-property ! These hacks will go away soon \ * [ [ 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 [ [ object word ] [ ] ] "infer-effect" set-word-property diff --git a/library/io/files.factor b/library/io/files.factor index 5740658fa7..d66f7967f4 100644 --- a/library/io/files.factor +++ b/library/io/files.factor @@ -1,39 +1,8 @@ -! :folding=indent:collapseFolds=1: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: files -USE: kernel -USE: hashtables -USE: lists -USE: namespaces -USE: presentation -USE: stdio -USE: strings -USE: unparser +USING: kernel hashtables lists namespaces presentation stdio +strings unparser ; : exists? ( file -- ? ) stat >boolean ; diff --git a/library/io/stream-impl.factor b/library/io/stream-impl.factor index 55db952403..0e25cc5931 100644 --- a/library/io/stream-impl.factor +++ b/library/io/stream-impl.factor @@ -1,11 +1,18 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! 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 DEFER: stdio IN: streams -USING: io-internals errors hashtables kernel stdio strings -namespaces generic ; TUPLE: fd-stream in out ; @@ -56,4 +63,4 @@ C: fd-stream ( in out -- stream ) "resource-path" get [ "." ] unless* ; : ( path -- stream ) - resource-path swap cat2 ; + resource-path swap path+ ; diff --git a/library/math/arc-trig-hyp.factor b/library/math/arc-trig-hyp.factor index 7b093f741b..3467a7d8d1 100644 --- a/library/math/arc-trig-hyp.factor +++ b/library/math/arc-trig-hyp.factor @@ -1,34 +1,7 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: math -USE: kernel -USE: math -USE: math-internals +USING: kernel math math-internals ; ! Inverse trigonometric functions: ! acos asec asin acosec atan acot diff --git a/library/math/complex.factor b/library/math/complex.factor index 87e0362660..9f5e950c0f 100644 --- a/library/math/complex.factor +++ b/library/math/complex.factor @@ -1,38 +1,10 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: errors DEFER: throw IN: math-internals -USE: generic -USE: kernel -USE: kernel-internals -USE: math +USING: generic kernel kernel-internals math ; : (rect>) ( xr xi -- x ) #! Does not perform a check that the arguments are reals. @@ -54,7 +26,7 @@ M: complex imaginary 1 slot %real ; (rect>) ] [ "Complex number must have real components" throw drop - ] ifte ; inline + ] ifte ; : >rect ( x -- xr xi ) dup real swap imaginary ; inline @@ -88,7 +60,7 @@ IN: math-internals : 2>rect ( x y -- xr yr xi yi ) [ swap real swap real ] 2keep - swap imaginary swap imaginary ; inline + swap imaginary swap imaginary ; M: complex number= ( x y -- ? ) 2>rect number= [ number= ] [ 2drop f ] ifte ; diff --git a/library/math/constants.factor b/library/math/constants.factor index cc73722929..e0430a8535 100644 --- a/library/math/constants.factor +++ b/library/math/constants.factor @@ -1,30 +1,5 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: math USE: kernel diff --git a/library/math/float.factor b/library/math/float.factor index b05d1be45f..c37182f63a 100644 --- a/library/math/float.factor +++ b/library/math/float.factor @@ -1,34 +1,7 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: math-internals -USE: generic -USE: kernel -USE: math +USING: generic kernel math ; M: float number= float= ; M: float < float< ; diff --git a/library/math/integer.factor b/library/math/integer.factor index 520feaef39..4787234df5 100644 --- a/library/math/integer.factor +++ b/library/math/integer.factor @@ -1,37 +1,10 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: errors DEFER: throw IN: math-internals -USE: generic -USE: kernel -USE: math +USING: generic kernel math ; : fraction> ( a b -- a/b ) dup 1 number= [ diff --git a/library/math/math.factor b/library/math/math.factor index a9cf936670..2cb9bb145d 100644 --- a/library/math/math.factor +++ b/library/math/math.factor @@ -1,34 +1,7 @@ -! :folding=indent:collapseFolds=0: - -! $Id$ -! ! Copyright (C) 2003, 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. - +! See http://factor.sf.net/license.txt for BSD license. IN: math -USE: generic -USE: kernel -USE: math-internals +USING: generic kernel math-internals ; ! Math operations 2GENERIC: number= ( x y -- ? ) @@ -92,7 +65,7 @@ M: number = ( n n -- ? ) number= ; : rem ( x y -- x%y ) #! 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 ) #! Push the sign of a real number. diff --git a/library/math/pow.factor b/library/math/pow.factor index a2d4529c55..eaf68852bb 100644 --- a/library/math/pow.factor +++ b/library/math/pow.factor @@ -1,34 +1,7 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: math -USE: math -USE: math-internals -USE: kernel +USING: math math-internals kernel ; ! Power-related functions: ! exp log sqrt pow diff --git a/library/math/ratio.factor b/library/math/ratio.factor index 3ba3151547..18d793801f 100644 --- a/library/math/ratio.factor +++ b/library/math/ratio.factor @@ -1,36 +1,7 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: math -USE: generic -USE: kernel -USE: kernel-internals -USE: math -USE: math-internals +USING: generic kernel kernel-internals math math-internals ; GENERIC: numerator ( a/b -- a ) M: integer numerator ; @@ -50,7 +21,7 @@ M: ratio number= ( a/b c/d -- ? ) 2>fraction number= [ number= ] [ 2drop f ] ifte ; : 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 ) denominator swap denominator * ; inline diff --git a/library/math/trig-hyp.factor b/library/math/trig-hyp.factor index b1c4d2a367..7c7bbf7c06 100644 --- a/library/math/trig-hyp.factor +++ b/library/math/trig-hyp.factor @@ -1,34 +1,7 @@ -! :folding=indent:collapseFolds=0: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: math -USE: kernel -USE: math -USE: math-internals +USING: kernel math math-internals ; ! Trigonometric functions: ! cos sec sin cosec tan cot diff --git a/library/namespaces.factor b/library/namespaces.factor index 1519c2fdd0..2a94d0939b 100644 --- a/library/namespaces.factor +++ b/library/namespaces.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2003, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. 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. ! Factor has similar concepts. @@ -125,6 +126,17 @@ SYMBOL: list-buffer #! was called. 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 ) #! Return a vector whose entries are in the same order that #! , was called. diff --git a/library/sbuf.factor b/library/sbuf.factor index 3a9ab2c8cf..a21fcd2566 100644 --- a/library/sbuf.factor +++ b/library/sbuf.factor @@ -2,17 +2,6 @@ ! See http://factor.sf.net/license.txt for BSD license. 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 ) #! Push a string that consists of the same character #! repeated. diff --git a/library/sdl/sdl-ttf.factor b/library/sdl/sdl-ttf.factor index 3627e10e6e..6c2590247d 100644 --- a/library/sdl/sdl-ttf.factor +++ b/library/sdl/sdl-ttf.factor @@ -1,30 +1,5 @@ -! :folding=indent:collapseFolds=1: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: sdl-ttf USE: alien @@ -82,20 +57,23 @@ BEGIN-STRUCT: int-box FIELD: int i END-STRUCT -: TTF_SizeText ( font text w h -- ? ) - "bool" "sdl-ttf" "TTF_SizeText" [ "void*" "char*" "int-box*" "int-box*" ] alien-invoke ; +: TTF_SizeUNICODE ( font text w h -- ? ) + "bool" "sdl-ttf" "TTF_SizeUNICODE" [ "void*" "ushort*" "int-box*" "int-box*" ] alien-invoke ; -: TTF_RenderText_Solid ( font text fg -- surface ) - "surface*" "sdl-ttf" "TTF_RenderText_Solid" [ "void*" "char*" "int" ] alien-invoke ; +: TTF_RenderUNICODE_Solid ( font text fg -- surface ) + "surface*" "sdl-ttf" "TTF_RenderUNICODE_Solid" [ "void*" "ushort*" "int" ] alien-invoke ; -: TTF_RenderText_Shaded ( font text fg bg -- surface ) - "surface*" "sdl-ttf" "TTF_RenderText_Shaded" [ "void*" "char*" "int" "int" ] alien-invoke ; +: TTF_RenderGlyph_Solid ( font text fg -- surface ) + "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 ) "surface*" "sdl-ttf" "TTF_RenderGlyph_Shaded" [ "void*" "ushort" "int" "int" ] alien-invoke ; -: TTF_RenderText_Blended ( font text fg -- surface ) - "surface*" "sdl-ttf" "TTF_RenderText_Blended" [ "void*" "char*" "int" ] alien-invoke ; +: TTF_RenderUNICODE_Blended ( font text fg -- surface ) + "surface*" "sdl-ttf" "TTF_RenderUNICODE_Blended" [ "void*" "ushort*" "int" ] alien-invoke ; : TTF_RenderGlyph_Blended ( font text fg -- surface ) "surface*" "sdl-ttf" "TTF_RenderGlyph_Blended" [ "void*" "ushort" "int" ] alien-invoke ; diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor index 28bd0be72c..49c003bc2f 100644 --- a/library/sdl/sdl-utils.factor +++ b/library/sdl/sdl-utils.factor @@ -103,7 +103,7 @@ SYMBOL: surface ] with-scope ; inline : event-loop ( event -- ) - dup SDL_WaitEvent 1 = [ + dup SDL_WaitEvent [ dup event-type SDL_QUIT = [ drop ] [ @@ -171,7 +171,7 @@ global [ over str-length 0 = [ 2drop 3drop 0 ] [ - TTF_RenderText_Blended + TTF_RenderUNICODE_Blended [ draw-surface ] keep [ surface-w ] keep SDL_FreeSurface @@ -181,7 +181,7 @@ global [ dup str-length 0 = [ drop TTF_FontHeight 0 swap ] [ - [ TTF_SizeText drop ] 2keep + [ TTF_SizeUNICODE drop ] 2keep swap int-box-i swap int-box-i ] ifte ; diff --git a/library/test/tuple.factor b/library/test/tuple.factor index 6dc28a26dd..cd2e3ebe5e 100644 --- a/library/test/tuple.factor +++ b/library/test/tuple.factor @@ -23,3 +23,11 @@ M: quux-tuple delegation-test drop 4 ; WRAPPER: quuux-tuple [ 3 ] [ 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 ] [ delegation-test-2 ] unit-test diff --git a/library/tools/jedit.factor b/library/tools/jedit.factor index 5d30a9105b..b8dd959ed2 100644 --- a/library/tools/jedit.factor +++ b/library/tools/jedit.factor @@ -1,40 +1,8 @@ -! :folding=indent:collapseFolds=1: - -! $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. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: jedit -USE: kernel -USE: lists -USE: namespaces -USE: parser -USE: streams -USE: stdio -USE: strings -USE: unparser -USE: words +USING: files kernel lists namespaces parser streams stdio +strings unparser words ; : jedit-server-file ( -- path ) "jedit-server-file" get @@ -47,26 +15,13 @@ USE: words read parse-number ] with-stream ; -: bool, ( ? -- str ) - "true" "false" ? , ; - -: list>bsh-array, ( list -- code ) - "new String[] {" , - [ unparse , "," , ] each - "null}" , ; - -: make-jedit-request ( files dir params -- code ) +: make-jedit-request ( files params -- code ) [ - [ - "EditServer.handleClient(" , - "restore" get bool, "," , - "newView" get bool, "," , - "newPlainView" get bool, "," , - ( 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 ; + "EditServer.handleClient(false,false,false,null," , + "new String[] {" , + [ unparse , "," , ] each + "null});\n" , + ] make-string ; : send-jedit-request ( request -- ) jedit-server-info swap "localhost" swap [ @@ -75,33 +30,17 @@ USE: words write flush ] with-stream ; -: jedit-line/file ( line dir file -- ) - rot "+line:" swap unparse cat2 unit cons swap - [ - "restore" off - "newView" off - "newPlainView" off - ] extend make-jedit-request send-jedit-request ; +: jedit-line/file ( file line -- ) + unparse "+line:" swap cat2 2list + make-jedit-request send-jedit-request ; -: word-file ( path -- dir file ) - dup [ - "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-file ( file -- ) + unit make-jedit-request send-jedit-request ; : jedit ( word -- ) - word-line/file dup [ - jedit-line/file + #! Note that line numbers here start from 1 + dup word-file dup [ + swap "line" word-property jedit-line/file ] [ - 3drop "Unknown source" print + 2drop "Unknown source" print ] ifte ; diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor index 14a38b0943..1bf8fb7c22 100644 --- a/library/tools/word-tools.factor +++ b/library/tools/word-tools.factor @@ -1,42 +1,9 @@ -! :folding=indent:collapseFolds=1: - -! $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. - +! Copyright (C) 2003, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: words -USE: generic -USE: inspector -USE: lists -USE: kernel -USE: namespaces -USE: prettyprint -USE: stdio -USE: strings -USE: unparser -USE: math -USE: hashtables +USING: files generic inspector lists kernel namespaces +prettyprint stdio streams strings unparser math hashtables +parser ; GENERIC: word-uses? ( of in -- ? ) M: word word-uses? 2drop f ; @@ -107,3 +74,14 @@ M: generic word-uses? ( of in -- ? ) : words. ( vocab -- ) 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 ; diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor index 2bcfe53cc8..4aeb29e489 100644 --- a/library/ui/gadgets.factor +++ b/library/ui/gadgets.factor @@ -67,7 +67,7 @@ C: gadget ( shape -- gadget ) ] ifte ] [ 2drop - ] ifte ; + ] ifte ; inline : screen-pos ( gadget -- point ) #! The position of the gadget on the screen. diff --git a/native/string.c b/native/string.c index c790fdb337..e5a88bd7a5 100644 --- a/native/string.c +++ b/native/string.c @@ -136,6 +136,13 @@ BYTE* unbox_c_string(void) 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) { F_STRING* string = untag_string(dpop()); diff --git a/native/string.h b/native/string.h index db05d73bb6..1087193118 100644 --- a/native/string.h +++ b/native/string.h @@ -24,6 +24,7 @@ DLLEXPORT void box_c_string(const BYTE* c_string); F_STRING* from_c_string(const BYTE* c_string); void primitive_memory_to_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)