- is signed -vs- unsigned pointers an issue?\r
\r
- command line parsing cleanup\r
+- > 1 ( ) inside word def\r
\r
-- BIN: 2: bad\r
-\r
+- when* compilation\r
- compile word twice; no more 'cannot compile' error!\r
- doc comments in assoc, image, inferior\r
- styles - could use some cleanup\r
- perhaps /i should work with all numbers\r
- profiler is inaccurate: wrong word on cs\r
- buffer change handler in sidekick is screwed\r
-- dec> bin> oct> hex> throw errors\r
-- parse-number doesn't\r
- eval with multilien strings and #!\r
- quit responder breaks with multithreading\r
- nicer way to combine two paths\r
--- /dev/null
+! :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.
+
+IN: math
+USE: combinators
+USE: math
+USE: stack
+
+: quadratic-complete ( a b c -- a b c a b )
+ >r 2dup r> -rot ;
+
+: quadratic-d ( c a b -- sqrt[b^2 - 4*a*c] )
+ sq -rot 4 * * - sqrt ;
+
+: quadratic-root ( x y -- -y/x/2 )
+ neg swap / 2 / ;
+
+: quadratic-roots ( a b d -- alpha beta )
+ 3dup - quadratic-root >r + quadratic-root r> ;
+
+: quadratic ( a b c -- alpha beta )
+ #! Finds both roots of the polynomial a*x^2 + b*x + c using
+ #! the quadratic formula.
+ quadratic-complete quadratic-d quadratic-roots ;
--- /dev/null
+! :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.
+
+IN: math
+USE: combinators
+USE: kernel
+USE: lists
+USE: logic
+USE: math
+USE: stack
+
+: multiplier ( n -- 2|4 )
+ odd? 4 2 ? ;
+
+: (multipliers) ( list n -- list )
+ dup 2 <= [
+ drop
+ ] [
+ dup >r multiplier swons r> pred (multipliers)
+ ] ifte ;
+
+: multipliers ( n -- list )
+ #! The value n must be odd. Makes a list like [ 1 4 2 4 1 ]
+ [ 1 ] swap (multipliers) 1 swons ;
+
+: x-values ( lower upper n -- list )
+ #! The value n must be odd.
+ pred >r over - r> dup succ count [
+ >r 3dup r> swap / * +
+ ] map >r 3drop r> ;
+
+: y-values ( lower upper n quot -- values )
+ >r x-values r> map ;
+
+: (simpson) ( lower upper n quot -- value )
+ over multipliers >r y-values r> *|+ ;
+
+: h ( lower upper n -- h )
+ transp - swap pred / 3 / ;
+
+: simpson ( lower upper n quot -- value )
+ #! Compute the integral between the lower and upper bound,
+ #! using Simpson's method with n steps. The value of n must
+ #! be odd. The quotation must have stack effect
+ #! ( x -- f(x) ).
+ >r 3dup r> (simpson) >r h r> * ;
public class FactorInterpreter implements FactorObject, Runnable
{
- public static final String VERSION = "0.66";
+ public static final String VERSION = "0.67";
public static final Cons DEFAULT_USE = new Cons("builtins",
new Cons("syntax",new Cons("scratchpad",null)));
[ ] (read-header) ;
: content-length ( alist -- length )
- "Content-Length" swap assoc dec> ;
+ "Content-Length" swap assoc parse-number ;
: query>alist ( query -- alist )
dup [
IN: url-encoding
USE: combinators
+USE: errors
USE: kernel
USE: logic
USE: format
dup url-quotable? [ "%" swap >hex 2 digits cat2 ] unless
] str-map ;
+: catch-hex> ( str -- n )
+ #! Push f if string is not a valid hex literal.
+ [ hex> ] [ [ drop f ] when ] catch ;
+
: url-decode-hex ( index str -- )
2dup str-length 2 - >= [
2drop
] [
- ! Note that hex> will push f if there is an invalid
- ! hex literal
- >r succ dup 2 + r> substring hex> [ >char % ] when*
+ >r succ dup 2 + r> substring
+ catch-hex> [ >char % ] when*
] ifte ;
: url-decode-% ( index str -- index str )
: value. ( max name value -- )
>r var-name. ": " write r> . ;
-: ?unparse ( obj -- str )
- dup string? [ unparse ] unless ;
-
: alist-keys>str ( alist -- alist )
- #! Unparse non-string keys.
- [ unswons ?unparse swons ] map ;
+ [ unswons unparse swons ] map ;
: name-padding ( alist -- col )
[ car ] map max-str-length ;
-: (describe-assoc) ( alist -- )
+: describe-assoc ( alist -- )
dup name-padding swap
[ dupd uncons value. ] each drop ;
-: describe-assoc ( alist -- )
- alist-keys>str (describe-assoc) ;
+: alist-sort ( list -- list )
+ [ swap car swap car str-lexi> ] sort ;
+
+: describe-assoc* ( alist -- )
+ #! Used to describe alists made from hashtables and
+ #! namespaces.
+ alist-keys>str alist-sort describe-assoc ;
: describe-namespace ( namespace -- )
- [ vars-values ] bind describe-assoc ;
+ [ vars-values ] bind describe-assoc* ;
: describe-hashtable ( hashtables -- )
- hash>alist describe-assoc ;
+ hash>alist describe-assoc* ;
: describe ( obj -- )
[
#! Push each element of a proper list in turn, and apply a
#! quotation to each element.
#!
- #! In order to compile, the quotation must consume one more
- #! value than it produces.
- over [
- >r uncons r> tuck >r >r call r> r> each
- ] [
- 2drop
- ] ifte ; inline interpret-only
+ #! The quotation must consume one more value than it
+ #! produces.
+ over [ >r uncons r> tuck 2slip each ] [ 2drop ] ifte ;
+ inline interpret-only
: map ( list code -- list )
#! Applies the code to each item, returns a list that
#! contains the result of each application.
#!
- #! In order to compile, the quotation must consume as many
- #! values as it produces.
+ #! The quotation must consume as many values as it
+ #! produces.
f transp [
- ( accum code elem -- accum code )
+ ! accum code elem -- accum code
transp over >r >r call r> cons r>
] each drop nreverse ; inline interpret-only
uncons >r >r uncons r> swap r> ;
: 2each-step ( list list quot -- cdr cdr )
- >r 2uncons r> -rot >r >r call r> r> ; inline interpret-only
+ >r 2uncons r> -rot 2slip ; inline interpret-only
: 2each ( list list quot -- )
#! Apply the quotation to each pair of elements from the
] ifte ; inline interpret-only
: 2map-step ( accum quot elt elt -- accum )
- 2swap swap >r call r> cons ;
+ 2swap swap slip cons ;
: <2map ( list list quot -- accum quot list list )
>r f -rot r> -rot ;
#!
#! In order to compile, the code must produce as many values
#! as it consumes.
- tuck >r dup 0 <= [
- r> 3drop
- ] [
- pred slip r> times
- ] ifte ; inline interpret-only
+ tuck >r dup 0 <= [ r> 3drop ] [ pred slip r> times ] ifte ;
+ inline interpret-only
: (times) ( limit n quot -- )
pick pick <= [
+++ /dev/null
-! :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.
-
-IN: math
-USE: combinators
-USE: math
-USE: stack
-
-: quadratic-complete ( a b c -- a b c a b )
- >r 2dup r> -rot ;
-
-: quadratic-d ( c a b -- sqrt[b^2 - 4*a*c] )
- sq -rot 4 * * - sqrt ;
-
-: quadratic-root ( x y -- -y/x/2 )
- neg swap / 2 / ;
-
-: quadratic-roots ( a b d -- alpha beta )
- 3dup - quadratic-root >r + quadratic-root r> ;
-
-: quadratic ( a b c -- alpha beta )
- #! Finds both roots of the polynomial a*x^2 + b*x + c using
- #! the quadratic formula.
- quadratic-complete quadratic-d quadratic-roots ;
+++ /dev/null
-! :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.
-
-IN: math
-USE: combinators
-USE: kernel
-USE: lists
-USE: logic
-USE: math
-USE: stack
-
-: multiplier ( n -- 2|4 )
- odd? 4 2 ? ;
-
-: (multipliers) ( list n -- list )
- dup 2 <= [
- drop
- ] [
- dup >r multiplier swons r> pred (multipliers)
- ] ifte ;
-
-: multipliers ( n -- list )
- #! The value n must be odd. Makes a list like [ 1 4 2 4 1 ]
- [ 1 ] swap (multipliers) 1 swons ;
-
-: x-values ( lower upper n -- list )
- #! The value n must be odd.
- pred >r over - r> dup succ count [
- >r 3dup r> swap / * +
- ] map >r 3drop r> ;
-
-: y-values ( lower upper n quot -- values )
- >r x-values r> map ;
-
-: (simpson) ( lower upper n quot -- value )
- over multipliers >r y-values r> *|+ ;
-
-: h ( lower upper n -- h )
- transp - swap pred / 3 / ;
-
-: simpson ( lower upper n quot -- value )
- #! Compute the integral between the lower and upper bound,
- #! using Simpson's method with n steps. The value of n must
- #! be odd. The quotation must have stack effect
- #! ( x -- f(x) ).
- >r 3dup r> (simpson) >r h r> * ;
"/library/math/pow.factor" run-resource ! math
"/library/math/trig-hyp.factor" run-resource ! math
"/library/math/arc-trig-hyp.factor" run-resource ! math
-"/library/math/quadratic.factor" run-resource ! math
"/library/math/list-math.factor" run-resource ! math
-"/library/math/simpson.factor" run-resource ! math
!!! Development tools.
"/library/platform/jvm/processes.factor" run-resource ! processes
"/library/math/pow.factor"
"/library/math/trig-hyp.factor"
"/library/math/arc-trig-hyp.factor"
- "/library/math/quadratic.factor"
"/library/math/list-math.factor"
- "/library/math/simpson.factor"
"/library/extend-stream.factor"
"/library/platform/native/in-thread.factor"
: set ( value variable -- ) namespace set* ;
: put ( variable value -- ) namespace put* ;
-: alist-sort ( list -- list )
- [ swap car swap car str-lexi> ] sort ;
-
-: vars-values ( -- list ) namespace hash>alist alist-sort ;
+: vars-values ( -- list ) namespace hash>alist ;
: vars ( -- list ) vars-values [ car ] map ;
: values ( -- list ) vars-values [ cdr ] map ;
] cond ;
: digit ( num digit base -- num )
- 2dup <= [ rot * + ] [ not-a-number ] ifte ;
+ 2dup < [ rot * + ] [ not-a-number ] ifte ;
-: (str>integer) ( str base -- num )
- over str-length 0 = [
+: (base>) ( base str -- num )
+ dup str-length 0 = [
not-a-number
] [
- 0 rot [ digit> pick digit ] str-each nip
+ 0 swap [ digit> pick digit ] str-each nip
] ifte ;
-: str>integer ( str base -- num )
- swap "-" ?str-head [
- swap (str>integer) neg
- ] [
- swap (str>integer)
- ] ifte ;
+: base> ( str base -- num )
+ #! Convert a string to an integer. Throw an error if
+ #! conversion fails.
+ swap "-" ?str-head [ (base>) neg ] [ (base>) ] ifte ;
: str>ratio ( str -- num )
- dup CHAR: / index-of str//
- swap 10 str>integer swap 10 str>integer / ;
+ dup CHAR: / index-of str// swap 10 base> swap 10 base> / ;
: str>number ( str -- num )
- #! Affected by "base" variable.
+ #! Convert a string to a number; throws errors.
[
- [ "/" swap str-contains? ] [ str>ratio ]
- [ "." swap str-contains? ] [ str>float ]
- [ drop t ] [ 10 str>integer ]
+ [ "/" swap str-contains? ] [ str>ratio ]
+ [ "." swap str-contains? ] [ str>float ]
+ [ drop t ] [ 10 base> ]
] cond ;
-: base> ( str base -- num/f )
- [ str>integer ] [ [ 2drop f ] when ] catch ;
-
-: bin> ( str -- num )
- #! Convert a binary string to a number.
- 2 base> ;
-
-: oct> ( str -- num )
- #! Convert an octal string to a number.
- 8 base> ;
-
-: dec> ( str -- num )
- #! Convert a decimal string to a number.
- 10 base> ;
-
-: hex> ( str -- num )
- #! Convert a hexadecimal string to a number.
- 16 base> ;
-
-! Something really sucks about these words here
: parse-number ( str -- num )
+ #! Convert a string to a number; return f on error.
[ str>number ] [ [ drop f ] when ] catch ;
+
+: bin> 2 base> ;
+: oct> 8 base> ;
+: dec> 10 base> ;
+: hex> 16 base> ;
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-IN: syntax
+IN: parser
USE: combinators
USE: errors
USE: vectors
USE: unparser
+! Colon defs
+: CREATE ( -- word )
+ scan "in" get create dup set-word
+ f over "documentation" set-word-property
+ f over "stack-effect" set-word-property ;
+
+: remember-where ( word -- )
+ "line-number" get over "line" set-word-property
+ "col" get over "col" set-word-property
+ "file" get over "file" set-word-property
+ drop ;
+
+! \x
+: unicode-escape>ch ( -- esc )
+ #! Read \u....
+ next-ch digit> 16 *
+ next-ch digit> + 16 *
+ next-ch digit> + 16 *
+ next-ch digit> + ;
+
+: ascii-escape>ch ( ch -- esc )
+ [
+ [ CHAR: e | CHAR: \e ]
+ [ CHAR: n | CHAR: \n ]
+ [ CHAR: r | CHAR: \r ]
+ [ CHAR: t | CHAR: \t ]
+ [ CHAR: s | CHAR: \s ]
+ [ CHAR: \s | CHAR: \s ]
+ [ CHAR: 0 | CHAR: \0 ]
+ [ CHAR: \\ | CHAR: \\ ]
+ [ CHAR: \" | CHAR: \" ]
+ ] assoc ;
+
+: escape ( ch -- esc )
+ dup CHAR: u = [
+ drop unicode-escape>ch
+ ] [
+ ascii-escape>ch
+ ] ifte ;
+
+: parse-escape ( -- )
+ next-ch escape dup [ drop "Bad escape" throw ] unless ;
+
+: parse-ch ( ch -- ch )
+ dup CHAR: \\ = [ drop parse-escape ] when ;
+
+: doc-comment-here? ( parsed -- ? )
+ not "in-definition" get and ;
+
+: parsed-stack-effect ( parsed str -- parsed )
+ over doc-comment-here? [
+ word "stack-effect" set-word-property
+ ] [
+ drop
+ ] ifte ;
+
+: documentation+ ( str word -- )
+ [
+ "documentation" word-property [
+ swap "\n" swap cat3
+ ] when*
+ ] keep
+ "documentation" set-word-property ;
+
+: parsed-documentation ( parsed str -- parsed )
+ over doc-comment-here? [
+ word documentation+
+ ] [
+ drop
+ ] ifte ;
+
+IN: syntax
+
! The variable "in-definition" is set inside a : ... ;.
! ( and #! then add "stack-effect" and "documentation"
! properties to the current word if it is set.
! Do not execute parsing word
: POSTPONE: ( -- ) scan-word parsed ; parsing
-! Colon defs
-: CREATE ( -- word )
- scan "in" get create dup set-word
- f over "documentation" set-word-property
- f over "stack-effect" set-word-property ;
-
-: remember-where ( word -- )
- "line-number" get over "line" set-word-property
- "col" get over "col" set-word-property
- "file" get over "file" set-word-property
- drop ;
-
: :
#! Begin a word definition. Word name follows.
CREATE dup remember-where [ ]
: USE: scan "use" cons@ ; parsing
: IN: scan dup "use" cons@ "in" set ; parsing
-! \x
-: unicode-escape>ch ( -- esc )
- #! Read \u....
- next-ch digit> 16 *
- next-ch digit> + 16 *
- next-ch digit> + 16 *
- next-ch digit> + ;
-
-: ascii-escape>ch ( ch -- esc )
- [
- [ CHAR: e | CHAR: \e ]
- [ CHAR: n | CHAR: \n ]
- [ CHAR: r | CHAR: \r ]
- [ CHAR: t | CHAR: \t ]
- [ CHAR: s | CHAR: \s ]
- [ CHAR: \s | CHAR: \s ]
- [ CHAR: 0 | CHAR: \0 ]
- [ CHAR: \\ | CHAR: \\ ]
- [ CHAR: \" | CHAR: \" ]
- ] assoc ;
-
-: escape ( ch -- esc )
- dup CHAR: u = [
- drop unicode-escape>ch
- ] [
- ascii-escape>ch
- ] ifte ;
-
-: parse-escape ( -- )
- next-ch escape dup [ drop "Bad escape" throw ] unless ;
-
-: parse-ch ( ch -- ch )
- dup CHAR: \\ = [ drop parse-escape ] when ;
-
! Char literal
: CHAR: ( -- ) next-word-ch parse-ch parsed ; parsing
scan str>number scan str>number rect> "}" expect parsed ;
! Comments
-: doc-comment-here? ( parsed -- ? )
- not "in-definition" get and ;
-
-: parsed-stack-effect ( parsed str -- parsed )
- over doc-comment-here? [
- word "stack-effect" set-word-property
- ] [
- drop
- ] ifte ;
-
: ( ")" until parsed-stack-effect ; parsing
: ! until-eol drop ; parsing
-: documentation+ ( str word -- )
- [
- "documentation" word-property [
- swap "\n" swap cat3
- ] when*
- ] keep
- "documentation" set-word-property ;
-
-: parsed-documentation ( parsed str -- parsed )
- over doc-comment-here? [
- word documentation+
- ] [
- drop
- ] ifte ;
-
: #! until-eol parsed-documentation ; parsing
! Reading numbers in other bases
[ "66/200" ]
[ parse-number unparse ]
test-word
+
+[ "12" bin> ] unit-test-fails
+[ "fdsf" bin> ] unit-test-fails
+[ 3 ] [ "11" bin> ] unit-test
USE: errors
USE: kernel
USE: lists
+USE: logic
USE: math
USE: namespaces
USE: parser
= assert
] keep-datastack 2drop ;
+: unit-test-fails ( quot -- )
+ #! Assert that the quotation throws an error.
+ [ [ not ] catch ] cons [ f ] swap unit-test ;
+
: test-word ( output input word -- )
#! Old-style test.
append unit-test ;
] each
native? [
- [
- "threads"
- "x86-compiler/simple"
- "x86-compiler/ifte"
- "x86-compiler/generic"
- ] [
- test
- ] each
+ "threads" test
+
+ cpu "x86" = [
+ [
+ "x86-compiler/simple"
+ "x86-compiler/ifte"
+ "x86-compiler/generic"
+ ] [
+ test
+ ] each
+ ] when
] when
java? [
projects / factor.git / commitdiff