tuple dispatch compiled, adding USING: to more files, inference terminator cleanup, jedit cleanup, new reload word to reload a word's source file
parent
88ba22ff6c
commit
a8c34f50a8
|
@ -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
|
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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 -- )
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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> ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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< ;
|
||||||
|
|
|
@ -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= [
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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());
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue