added foldable, flushable declarations in all relevant places
Slava Pestov
parent
c8eacd7b0b
commit
80c1553a5a
|
|
@ -1,6 +1,4 @@
|
|||
- fix bootstrap failure
|
||||
- flushing optimization
|
||||
- add foldable, flushable, inline to all relevant library words
|
||||
- new prettyprinter
|
||||
- limit output to n lines
|
||||
- limit sequences to n elements
|
||||
|
|
|
|||
|
|
@ -26,192 +26,185 @@ vocabularies get [
|
|||
reveal
|
||||
] bind
|
||||
|
||||
: set-stack-effect ( { vocab word effect } -- )
|
||||
3unseq >r unit search r> dup string? [
|
||||
"stack-effect" set-word-prop
|
||||
] [
|
||||
"infer-effect" set-word-prop
|
||||
] ifte ;
|
||||
|
||||
: make-primitive ( { vocab word effect } n -- )
|
||||
>r dup 2unseq create r> f define set-stack-effect ;
|
||||
: make-primitive ( { vocab word } n -- )
|
||||
>r 2unseq create r> f define ;
|
||||
|
||||
{
|
||||
{ "execute" "words" [ [ word ] [ ] ] }
|
||||
{ "call" "kernel" [ [ general-list ] [ ] ] }
|
||||
{ "ifte" "kernel" [ [ object general-list general-list ] [ ] ] }
|
||||
{ "dispatch" "kernel-internals" [ [ fixnum vector ] [ ] ] }
|
||||
{ "cons" "lists" [ [ object object ] [ cons ] ] }
|
||||
{ "<vector>" "vectors" [ [ integer ] [ vector ] ] }
|
||||
{ "rehash-string" "strings" [ [ string ] [ ] ] }
|
||||
{ "<sbuf>" "strings" [ [ integer ] [ sbuf ] ] }
|
||||
{ "sbuf>string" "strings" [ [ sbuf ] [ string ] ] }
|
||||
{ ">fixnum" "math" [ [ number ] [ fixnum ] ] }
|
||||
{ ">bignum" "math" [ [ number ] [ bignum ] ] }
|
||||
{ ">float" "math" [ [ number ] [ float ] ] }
|
||||
{ "(fraction>)" "math-internals" [ [ integer integer ] [ rational ] ] }
|
||||
{ "str>float" "parser" [ [ string ] [ float ] ] }
|
||||
{ "(unparse-float)" "unparser" [ [ float ] [ string ] ] }
|
||||
{ "float>bits" "math" [ [ real ] [ integer ] ] }
|
||||
{ "double>bits" "math" [ [ real ] [ integer ] ] }
|
||||
{ "bits>float" "math" [ [ integer ] [ float ] ] }
|
||||
{ "bits>double" "math" [ [ integer ] [ float ] ] }
|
||||
{ "<complex>" "math-internals" [ [ real real ] [ number ] ] }
|
||||
{ "fixnum+" "math-internals" [ [ fixnum fixnum ] [ integer ] ] }
|
||||
{ "fixnum-" "math-internals" [ [ fixnum fixnum ] [ integer ] ] }
|
||||
{ "fixnum*" "math-internals" [ [ fixnum fixnum ] [ integer ] ] }
|
||||
{ "fixnum/i" "math-internals" [ [ fixnum fixnum ] [ integer ] ] }
|
||||
{ "fixnum/f" "math-internals" [ [ fixnum fixnum ] [ integer ] ] }
|
||||
{ "fixnum-mod" "math-internals" [ [ fixnum fixnum ] [ fixnum ] ] }
|
||||
{ "fixnum/mod" "math-internals" [ [ fixnum fixnum ] [ integer fixnum ] ] }
|
||||
{ "fixnum-bitand" "math-internals" [ [ fixnum fixnum ] [ fixnum ] ] }
|
||||
{ "fixnum-bitor" "math-internals" [ [ fixnum fixnum ] [ fixnum ] ] }
|
||||
{ "fixnum-bitxor" "math-internals" [ [ fixnum fixnum ] [ fixnum ] ] }
|
||||
{ "fixnum-bitnot" "math-internals" [ [ fixnum ] [ fixnum ] ] }
|
||||
{ "fixnum-shift" "math-internals" [ [ fixnum fixnum ] [ integer ] ] }
|
||||
{ "fixnum<" "math-internals" [ [ fixnum fixnum ] [ boolean ] ] }
|
||||
{ "fixnum<=" "math-internals" [ [ fixnum fixnum ] [ boolean ] ] }
|
||||
{ "fixnum>" "math-internals" [ [ fixnum fixnum ] [ boolean ] ] }
|
||||
{ "fixnum>=" "math-internals" [ [ fixnum fixnum ] [ boolean ] ] }
|
||||
{ "bignum=" "math-internals" [ [ bignum bignum ] [ boolean ] ] }
|
||||
{ "bignum+" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum-" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum*" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum/i" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum/f" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum-mod" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum/mod" "math-internals" [ [ bignum bignum ] [ bignum bignum ] ] }
|
||||
{ "bignum-bitand" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum-bitor" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum-bitxor" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum-bitnot" "math-internals" [ [ bignum ] [ bignum ] ] }
|
||||
{ "bignum-shift" "math-internals" [ [ bignum bignum ] [ bignum ] ] }
|
||||
{ "bignum<" "math-internals" [ [ bignum bignum ] [ boolean ] ] }
|
||||
{ "bignum<=" "math-internals" [ [ bignum bignum ] [ boolean ] ] }
|
||||
{ "bignum>" "math-internals" [ [ bignum bignum ] [ boolean ] ] }
|
||||
{ "bignum>=" "math-internals" [ [ bignum bignum ] [ boolean ] ] }
|
||||
{ "float=" "math-internals" [ [ bignum bignum ] [ boolean ] ] }
|
||||
{ "float+" "math-internals" [ [ float float ] [ float ] ] }
|
||||
{ "float-" "math-internals" [ [ float float ] [ float ] ] }
|
||||
{ "float*" "math-internals" [ [ float float ] [ float ] ] }
|
||||
{ "float/f" "math-internals" [ [ float float ] [ float ] ] }
|
||||
{ "float<" "math-internals" [ [ float float ] [ boolean ] ] }
|
||||
{ "float<=" "math-internals" [ [ float float ] [ boolean ] ] }
|
||||
{ "float>" "math-internals" [ [ float float ] [ boolean ] ] }
|
||||
{ "float>=" "math-internals" [ [ float float ] [ boolean ] ] }
|
||||
{ "facos" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fasin" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fatan" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fatan2" "math-internals" [ [ real real ] [ float ] ] }
|
||||
{ "fcos" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fexp" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fcosh" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "flog" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fpow" "math-internals" [ [ real real ] [ float ] ] }
|
||||
{ "fsin" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fsinh" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "fsqrt" "math-internals" [ [ real ] [ float ] ] }
|
||||
{ "<word>" "words" [ [ ] [ word ] ] }
|
||||
{ "update-xt" "words" [ [ word ] [ ] ] }
|
||||
{ "compiled?" "words" [ [ word ] [ boolean ] ] }
|
||||
{ "drop" "kernel" [ [ object ] [ ] ] }
|
||||
{ "dup" "kernel" [ [ object ] [ object object ] ] }
|
||||
{ "swap" "kernel" [ [ object object ] [ object object ] ] }
|
||||
{ "over" "kernel" [ [ object object ] [ object object object ] ] }
|
||||
{ "pick" "kernel" [ [ object object object ] [ object object object object ] ] }
|
||||
{ ">r" "kernel" [ [ object ] [ ] ] }
|
||||
{ "r>" "kernel" [ [ ] [ object ] ] }
|
||||
{ "eq?" "kernel" [ [ object object ] [ boolean ] ] }
|
||||
{ "getenv" "kernel-internals" [ [ fixnum ] [ object ] ] }
|
||||
{ "setenv" "kernel-internals" [ [ object fixnum ] [ ] ] }
|
||||
{ "stat" "io" [ [ string ] [ general-list ] ] }
|
||||
{ "(directory)" "io" [ [ string ] [ general-list ] ] }
|
||||
{ "gc" "memory" [ [ fixnum ] [ ] ] }
|
||||
{ "gc-time" "memory" [ [ string ] [ ] ] }
|
||||
{ "save-image" "memory" [ [ string ] [ ] ] }
|
||||
{ "datastack" "kernel" " -- ds " }
|
||||
{ "callstack" "kernel" " -- cs " }
|
||||
{ "set-datastack" "kernel" " ds -- " }
|
||||
{ "set-callstack" "kernel" " cs -- " }
|
||||
{ "exit" "kernel" [ [ integer ] [ ] ] }
|
||||
{ "room" "memory" [ [ ] [ integer integer integer integer general-list ] ] }
|
||||
{ "os-env" "kernel" [ [ string ] [ object ] ] }
|
||||
{ "millis" "kernel" [ [ ] [ integer ] ] }
|
||||
{ "(random-int)" "math" [ [ ] [ integer ] ] }
|
||||
{ "type" "kernel" [ [ object ] [ fixnum ] ] }
|
||||
{ "tag" "kernel-internals" [ [ object ] [ fixnum ] ] }
|
||||
{ "cwd" "io" [ [ ] [ string ] ] }
|
||||
{ "cd" "io" [ [ string ] [ ] ] }
|
||||
{ "compiled-offset" "assembler" [ [ ] [ integer ] ] }
|
||||
{ "set-compiled-offset" "assembler" [ [ integer ] [ ] ] }
|
||||
{ "literal-top" "assembler" [ [ ] [ integer ] ] }
|
||||
{ "set-literal-top" "assembler" [ [ integer ] [ ] ] }
|
||||
{ "address" "memory" [ [ object ] [ integer ] ] }
|
||||
{ "dlopen" "alien" [ [ string ] [ dll ] ] }
|
||||
{ "dlsym" "alien" [ [ string object ] [ integer ] ] }
|
||||
{ "dlclose" "alien" [ [ dll ] [ ] ] }
|
||||
{ "<alien>" "alien" [ [ integer ] [ alien ] ] }
|
||||
{ "<byte-array>" "kernel-internals" [ [ integer ] [ byte-array ] ] }
|
||||
{ "<displaced-alien>" "alien" [ [ integer c-ptr ] [ displaced-alien ] ] }
|
||||
{ "alien-signed-cell" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-signed-cell" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-unsigned-cell" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-unsigned-cell" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-signed-8" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-signed-8" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-unsigned-8" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-unsigned-8" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-signed-4" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-signed-4" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-unsigned-4" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-unsigned-4" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-signed-2" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-signed-2" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-unsigned-2" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-unsigned-2" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-signed-1" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-signed-1" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-unsigned-1" "alien" [ [ c-ptr integer ] [ integer ] ] }
|
||||
{ "set-alien-unsigned-1" "alien" [ [ integer c-ptr integer ] [ ] ] }
|
||||
{ "alien-float" "alien" [ [ c-ptr integer ] [ float ] ] }
|
||||
{ "set-alien-float" "alien" [ [ float c-ptr integer ] [ ] ] }
|
||||
{ "alien-double" "alien" [ [ c-ptr integer ] [ float ] ] }
|
||||
{ "set-alien-double" "alien" [ [ float c-ptr integer ] [ ] ] }
|
||||
{ "alien-c-string" "alien" [ [ c-ptr integer ] [ string ] ] }
|
||||
{ "set-alien-c-string" "alien" [ [ string c-ptr integer ] [ ] ] }
|
||||
{ "throw" "errors" [ [ object ] [ ] ] }
|
||||
{ "string>memory" "kernel-internals" [ [ string integer ] [ ] ] }
|
||||
{ "memory>string" "kernel-internals" [ [ integer integer ] [ string ] ] }
|
||||
{ "alien-address" "alien" [ [ alien ] [ integer ] ] }
|
||||
{ "slot" "kernel-internals" [ [ object fixnum ] [ object ] ] }
|
||||
{ "set-slot" "kernel-internals" [ [ object object fixnum ] [ ] ] }
|
||||
{ "integer-slot" "kernel-internals" [ [ object fixnum ] [ integer ] ] }
|
||||
{ "set-integer-slot" "kernel-internals" [ [ integer object fixnum ] [ ] ] }
|
||||
{ "char-slot" "kernel-internals" [ [ object fixnum ] [ fixnum ] ] }
|
||||
{ "set-char-slot" "kernel-internals" [ [ integer object fixnum ] [ ] ] }
|
||||
{ "resize-array" "kernel-internals" [ [ integer array ] [ array ] ] }
|
||||
{ "resize-string" "strings" [ [ integer string ] [ string ] ] }
|
||||
{ "<hashtable>" "hashtables" [ [ number ] [ hashtable ] ] }
|
||||
{ "<array>" "kernel-internals" [ [ number ] [ array ] ] }
|
||||
{ "<tuple>" "kernel-internals" [ [ number ] [ tuple ] ] }
|
||||
{ "begin-scan" "memory" [ [ ] [ ] ] }
|
||||
{ "next-object" "memory" [ [ ] [ object ] ] }
|
||||
{ "end-scan" "memory" [ [ ] [ ] ] }
|
||||
{ "size" "memory" [ [ object ] [ fixnum ] ] }
|
||||
{ "die" "kernel" [ [ ] [ ] ] }
|
||||
{ "flush-icache" "assembler" f }
|
||||
[ "fopen" "io-internals" [ [ string string ] [ alien ] ] ]
|
||||
{ "fgetc" "io-internals" [ [ alien ] [ object ] ] }
|
||||
{ "fwrite" "io-internals" [ [ string alien ] [ ] ] }
|
||||
{ "fflush" "io-internals" [ [ alien ] [ ] ] }
|
||||
{ "fclose" "io-internals" [ [ alien ] [ ] ] }
|
||||
{ "expired?" "alien" [ [ object ] [ boolean ] ] }
|
||||
{ "<wrapper>" "kernel" [ [ object ] [ wrapper ] ] }
|
||||
} dup length 3 swap [ + ] map-with [
|
||||
make-primitive
|
||||
] 2each
|
||||
{ "execute" "words" }
|
||||
{ "call" "kernel" }
|
||||
{ "ifte" "kernel" }
|
||||
{ "dispatch" "kernel-internals" }
|
||||
{ "cons" "lists" }
|
||||
{ "<vector>" "vectors" }
|
||||
{ "rehash-string" "strings" }
|
||||
{ "<sbuf>" "strings" }
|
||||
{ "sbuf>string" "strings" }
|
||||
{ ">fixnum" "math" }
|
||||
{ ">bignum" "math" }
|
||||
{ ">float" "math" }
|
||||
{ "(fraction>)" "math-internals" }
|
||||
{ "str>float" "parser" }
|
||||
{ "(unparse-float)" "unparser" }
|
||||
{ "float>bits" "math" }
|
||||
{ "double>bits" "math" }
|
||||
{ "bits>float" "math" }
|
||||
{ "bits>double" "math" }
|
||||
{ "<complex>" "math-internals" }
|
||||
{ "fixnum+" "math-internals" }
|
||||
{ "fixnum-" "math-internals" }
|
||||
{ "fixnum*" "math-internals" }
|
||||
{ "fixnum/i" "math-internals" }
|
||||
{ "fixnum/f" "math-internals" }
|
||||
{ "fixnum-mod" "math-internals" }
|
||||
{ "fixnum/mod" "math-internals" }
|
||||
{ "fixnum-bitand" "math-internals" }
|
||||
{ "fixnum-bitor" "math-internals" }
|
||||
{ "fixnum-bitxor" "math-internals" }
|
||||
{ "fixnum-bitnot" "math-internals" }
|
||||
{ "fixnum-shift" "math-internals" }
|
||||
{ "fixnum<" "math-internals" }
|
||||
{ "fixnum<=" "math-internals" }
|
||||
{ "fixnum>" "math-internals" }
|
||||
{ "fixnum>=" "math-internals" }
|
||||
{ "bignum=" "math-internals" }
|
||||
{ "bignum+" "math-internals" }
|
||||
{ "bignum-" "math-internals" }
|
||||
{ "bignum*" "math-internals" }
|
||||
{ "bignum/i" "math-internals" }
|
||||
{ "bignum/f" "math-internals" }
|
||||
{ "bignum-mod" "math-internals" }
|
||||
{ "bignum/mod" "math-internals" }
|
||||
{ "bignum-bitand" "math-internals" }
|
||||
{ "bignum-bitor" "math-internals" }
|
||||
{ "bignum-bitxor" "math-internals" }
|
||||
{ "bignum-bitnot" "math-internals" }
|
||||
{ "bignum-shift" "math-internals" }
|
||||
{ "bignum<" "math-internals" }
|
||||
{ "bignum<=" "math-internals" }
|
||||
{ "bignum>" "math-internals" }
|
||||
{ "bignum>=" "math-internals" }
|
||||
{ "float=" "math-internals" }
|
||||
{ "float+" "math-internals" }
|
||||
{ "float-" "math-internals" }
|
||||
{ "float*" "math-internals" }
|
||||
{ "float/f" "math-internals" }
|
||||
{ "float<" "math-internals" }
|
||||
{ "float<=" "math-internals" }
|
||||
{ "float>" "math-internals" }
|
||||
{ "float>=" "math-internals" }
|
||||
{ "facos" "math-internals" }
|
||||
{ "fasin" "math-internals" }
|
||||
{ "fatan" "math-internals" }
|
||||
{ "fatan2" "math-internals" }
|
||||
{ "fcos" "math-internals" }
|
||||
{ "fexp" "math-internals" }
|
||||
{ "fcosh" "math-internals" }
|
||||
{ "flog" "math-internals" }
|
||||
{ "fpow" "math-internals" }
|
||||
{ "fsin" "math-internals" }
|
||||
{ "fsinh" "math-internals" }
|
||||
{ "fsqrt" "math-internals" }
|
||||
{ "<word>" "words" }
|
||||
{ "update-xt" "words" }
|
||||
{ "compiled?" "words" }
|
||||
{ "drop" "kernel" }
|
||||
{ "dup" "kernel" }
|
||||
{ "swap" "kernel" }
|
||||
{ "over" "kernel" }
|
||||
{ "pick" "kernel" }
|
||||
{ ">r" "kernel" }
|
||||
{ "r>" "kernel" }
|
||||
{ "eq?" "kernel" }
|
||||
{ "getenv" "kernel-internals" }
|
||||
{ "setenv" "kernel-internals" }
|
||||
{ "stat" "io" }
|
||||
{ "(directory)" "io" }
|
||||
{ "gc" "memory" }
|
||||
{ "gc-time" "memory" }
|
||||
{ "save-image" "memory" }
|
||||
{ "datastack" "kernel" }
|
||||
{ "callstack" "kernel" }
|
||||
{ "set-datastack" "kernel" }
|
||||
{ "set-callstack" "kernel" }
|
||||
{ "exit" "kernel" }
|
||||
{ "room" "memory" }
|
||||
{ "os-env" "kernel" }
|
||||
{ "millis" "kernel" }
|
||||
{ "(random-int)" "math" }
|
||||
{ "type" "kernel" }
|
||||
{ "tag" "kernel-internals" }
|
||||
{ "cwd" "io" }
|
||||
{ "cd" "io" }
|
||||
{ "compiled-offset" "assembler" }
|
||||
{ "set-compiled-offset" "assembler" }
|
||||
{ "literal-top" "assembler" }
|
||||
{ "set-literal-top" "assembler" }
|
||||
{ "address" "memory" }
|
||||
{ "dlopen" "alien" }
|
||||
{ "dlsym" "alien" }
|
||||
{ "dlclose" "alien" }
|
||||
{ "<alien>" "alien" }
|
||||
{ "<byte-array>" "kernel-internals" }
|
||||
{ "<displaced-alien>" "alien" }
|
||||
{ "alien-signed-cell" "alien" }
|
||||
{ "set-alien-signed-cell" "alien" }
|
||||
{ "alien-unsigned-cell" "alien" }
|
||||
{ "set-alien-unsigned-cell" "alien" }
|
||||
{ "alien-signed-8" "alien" }
|
||||
{ "set-alien-signed-8" "alien" }
|
||||
{ "alien-unsigned-8" "alien" }
|
||||
{ "set-alien-unsigned-8" "alien" }
|
||||
{ "alien-signed-4" "alien" }
|
||||
{ "set-alien-signed-4" "alien" }
|
||||
{ "alien-unsigned-4" "alien" }
|
||||
{ "set-alien-unsigned-4" "alien" }
|
||||
{ "alien-signed-2" "alien" }
|
||||
{ "set-alien-signed-2" "alien" }
|
||||
{ "alien-unsigned-2" "alien" }
|
||||
{ "set-alien-unsigned-2" "alien" }
|
||||
{ "alien-signed-1" "alien" }
|
||||
{ "set-alien-signed-1" "alien" }
|
||||
{ "alien-unsigned-1" "alien" }
|
||||
{ "set-alien-unsigned-1" "alien" }
|
||||
{ "alien-float" "alien" }
|
||||
{ "set-alien-float" "alien" }
|
||||
{ "alien-double" "alien" }
|
||||
{ "set-alien-double" "alien" }
|
||||
{ "alien-c-string" "alien" }
|
||||
{ "set-alien-c-string" "alien" }
|
||||
{ "throw" "errors" }
|
||||
{ "string>memory" "kernel-internals" }
|
||||
{ "memory>string" "kernel-internals" }
|
||||
{ "alien-address" "alien" }
|
||||
{ "slot" "kernel-internals" }
|
||||
{ "set-slot" "kernel-internals" }
|
||||
{ "integer-slot" "kernel-internals" }
|
||||
{ "set-integer-slot" "kernel-internals" }
|
||||
{ "char-slot" "kernel-internals" }
|
||||
{ "set-char-slot" "kernel-internals" }
|
||||
{ "resize-array" "kernel-internals" }
|
||||
{ "resize-string" "strings" }
|
||||
{ "<hashtable>" "hashtables" }
|
||||
{ "<array>" "kernel-internals" }
|
||||
{ "<tuple>" "kernel-internals" }
|
||||
{ "begin-scan" "memory" }
|
||||
{ "next-object" "memory" }
|
||||
{ "end-scan" "memory" }
|
||||
{ "size" "memory" }
|
||||
{ "die" "kernel" }
|
||||
{ "flush-icache" "assembler" }
|
||||
{ "fopen" "io-internals" }
|
||||
{ "fgetc" "io-internals" }
|
||||
{ "fwrite" "io-internals" }
|
||||
{ "fflush" "io-internals" }
|
||||
{ "fclose" "io-internals" }
|
||||
{ "expired?" "alien" }
|
||||
{ "<wrapper>" "kernel" }
|
||||
} dup length 3 swap [ + ] map-with [ make-primitive ] 2each
|
||||
|
||||
: set-stack-effect ( { vocab word effect } -- )
|
||||
3unseq >r unit search r> "stack-effect" set-word-prop ;
|
||||
|
||||
! These need a more descriptive comment.
|
||||
{
|
||||
{ "drop" "kernel" " x -- " }
|
||||
{ "dup" "kernel" " x -- x x " }
|
||||
|
|
@ -220,6 +213,11 @@ vocabularies get [
|
|||
{ "pick" "kernel" " x y z -- x y z x " }
|
||||
{ ">r" "kernel" " x -- r: x " }
|
||||
{ "r>" "kernel" " r: x -- x " }
|
||||
{ "datastack" "kernel" " -- ds " }
|
||||
{ "callstack" "kernel" " -- cs " }
|
||||
{ "set-datastack" "kernel" " ds -- " }
|
||||
{ "set-callstack" "kernel" " cs -- " }
|
||||
{ "flush-icache" "assembler" " -- " }
|
||||
} [
|
||||
set-stack-effect
|
||||
] each
|
||||
|
|
|
|||
|
|
@ -42,4 +42,4 @@ M: byte-array resize resize-array ;
|
|||
#! since you can fool the runtime and corrupt memory by
|
||||
#! specifying an incorrect size. Note that this word is also
|
||||
#! handled specially by the compiler's type inferencer.
|
||||
<tuple> [ 2 set-slot ] keep ;
|
||||
<tuple> [ 2 set-slot ] keep ; flushable
|
||||
|
|
|
|||
|
|
@ -2,12 +2,6 @@
|
|||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: lists USING: kernel sequences ;
|
||||
|
||||
: assoc? ( list -- ? )
|
||||
#! Push if the list appears to be an alist. An association
|
||||
#! list is a list of conses where the car of each cons is a
|
||||
#! key, and the cdr is a value.
|
||||
dup list? [ [ cons? ] all? ] [ drop f ] ifte ;
|
||||
|
||||
: assoc* ( key alist -- [[ key value ]] )
|
||||
#! Look up a key/value pair.
|
||||
[ car = ] find-with nip ;
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ M: general-list >list ( list -- list ) ;
|
|||
|
||||
: last ( list -- last )
|
||||
#! Last cons of a list.
|
||||
dup cdr cons? [ cdr last ] when ;
|
||||
dup cdr cons? [ cdr last ] when ; foldable
|
||||
|
||||
PREDICATE: general-list list ( list -- ? )
|
||||
#! Proper list test. A proper list is either f, or a cons
|
||||
|
|
@ -28,30 +28,32 @@ PREDICATE: general-list list ( list -- ? )
|
|||
: uncons ( [[ car cdr ]] -- car cdr ) dup car swap cdr ; inline
|
||||
: unswons ( [[ car cdr ]] -- cdr car ) dup cdr swap car ; inline
|
||||
|
||||
: swons ( cdr car -- [[ car cdr ]] ) swap cons ;
|
||||
: unit ( a -- [ a ] ) f cons ;
|
||||
: 2list ( a b -- [ a b ] ) unit cons ;
|
||||
: 2unlist ( [ a b ] -- a b ) uncons car ;
|
||||
: swons ( cdr car -- [[ car cdr ]] ) swap cons ; inline
|
||||
: unit ( a -- [ a ] ) f cons ; inline
|
||||
: 2list ( a b -- [ a b ] ) unit cons ; inline
|
||||
: 2unlist ( [ a b ] -- a b ) uncons car ; inline
|
||||
|
||||
: 2car ( cons cons -- car car ) swap car swap car ; inline
|
||||
: 2cdr ( cons cons -- car car ) swap cdr swap cdr ; inline
|
||||
|
||||
: unpair ( list -- list1 list2 )
|
||||
[ uncons uncons unpair rot swons >r cons r> ] [ f f ] ifte* ;
|
||||
flushable
|
||||
|
||||
: <queue> ( -- queue )
|
||||
#! Make a new functional queue.
|
||||
[[ [ ] [ ] ]] ;
|
||||
[[ [ ] [ ] ]] ; foldable
|
||||
|
||||
: queue-empty? ( queue -- ? )
|
||||
uncons or not ;
|
||||
uncons or not ; foldable
|
||||
|
||||
: enque ( obj queue -- queue )
|
||||
uncons >r cons r> cons ;
|
||||
uncons >r cons r> cons ; foldable
|
||||
|
||||
: deque ( queue -- obj queue )
|
||||
uncons
|
||||
[ uncons swapd cons ] [ reverse uncons f swons ] ifte* ;
|
||||
foldable
|
||||
|
||||
M: cons = ( obj cons -- ? )
|
||||
2dup eq? [
|
||||
|
|
|
|||
|
|
@ -50,9 +50,9 @@ IN: hashtables
|
|||
|
||||
: hash* ( key table -- [[ key value ]] )
|
||||
#! Look up a value in the hashtable.
|
||||
2dup (hashcode) swap hash-bucket assoc* ;
|
||||
2dup (hashcode) swap hash-bucket assoc* ; flushable
|
||||
|
||||
: hash ( key table -- value ) hash* cdr ;
|
||||
: hash ( key table -- value ) hash* cdr ; flushable
|
||||
|
||||
: set-hash* ( key hash quot -- )
|
||||
#! Apply the quotation to yield a new association list.
|
||||
|
|
@ -71,6 +71,7 @@ IN: hashtables
|
|||
: hash>alist ( hash -- alist )
|
||||
#! Push a list of key/value pairs in a hashtable.
|
||||
[ ] swap [ hash-bucket [ swons ] each ] each-bucket ;
|
||||
flushable
|
||||
|
||||
: (set-hash) ( value key hash -- )
|
||||
dup hash-size+ [ set-assoc ] set-hash* ;
|
||||
|
|
@ -106,13 +107,13 @@ IN: hashtables
|
|||
|
||||
: alist>hash ( alist -- hash )
|
||||
dup length 1 max <hashtable> swap
|
||||
[ unswons pick set-hash ] each ;
|
||||
[ unswons pick set-hash ] each ; foldable
|
||||
|
||||
: hash-keys ( hash -- list )
|
||||
hash>alist [ car ] map ;
|
||||
hash>alist [ car ] map ; flushable
|
||||
|
||||
: hash-values ( hash -- alist )
|
||||
hash>alist [ cdr ] map ;
|
||||
hash>alist [ cdr ] map ; flushable
|
||||
|
||||
: hash-each ( hash quot -- | quot: [[ k v ]] -- )
|
||||
swap hash-array [ swap each ] each-with ; inline
|
||||
|
|
@ -134,7 +135,7 @@ IN: hashtables
|
|||
] [
|
||||
r> 2drop f
|
||||
] ifte
|
||||
] hash-all-with? ;
|
||||
] hash-all-with? ; flushable
|
||||
|
||||
: hash-subset ( hash quot -- hash | quot: [[ k v ]] -- ? )
|
||||
>r hash>alist r> subset alist>hash ; inline
|
||||
|
|
@ -174,7 +175,7 @@ M: hashtable hashcode ( hash -- n )
|
|||
[ pick set-hash ] 2each ; inline
|
||||
|
||||
: ?hash ( key hash/f -- value/f )
|
||||
dup [ hash ] [ 2drop f ] ifte ;
|
||||
dup [ hash ] [ 2drop f ] ifte ; flushable
|
||||
|
||||
: ?set-hash ( value key hash/f -- hash )
|
||||
[ 1 <hashtable> ] unless* [ set-hash ] keep ;
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@ strings vectors words ;
|
|||
|
||||
: namespace ( -- namespace )
|
||||
#! Push the current namespace.
|
||||
namestack car ;
|
||||
namestack car ; inline
|
||||
|
||||
: >n ( namespace -- n:namespace )
|
||||
#! Push a namespace on the name stack.
|
||||
|
|
@ -44,7 +44,7 @@ strings vectors words ;
|
|||
|
||||
: <namespace> ( -- n )
|
||||
#! Create a new namespace.
|
||||
23 <hashtable> ;
|
||||
23 <hashtable> ; flushable
|
||||
|
||||
: (get) ( var ns -- value )
|
||||
#! Internal word for searching the namestack.
|
||||
|
|
@ -56,12 +56,12 @@ strings vectors words ;
|
|||
] ?ifte
|
||||
] [
|
||||
2drop f
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
: get ( variable -- value )
|
||||
#! Push the value of a variable by searching the namestack
|
||||
#! from the top down.
|
||||
namestack (get) ;
|
||||
namestack (get) ; flushable
|
||||
|
||||
: set ( value variable -- ) namespace set-hash ;
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ UNION: sequence array string sbuf vector ;
|
|||
swap >list swap >list =
|
||||
] [
|
||||
2dup length= [ 0 (sequence=) ] [ 2drop f ] ifte
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
M: sequence = ( obj seq -- ? )
|
||||
2dup eq? [
|
||||
|
|
|
|||
|
|
@ -108,15 +108,15 @@ M: object empty? ( seq -- ? ) length 0 = ;
|
|||
|
||||
M: object >list ( seq -- list ) dup length 0 rot (>list) ;
|
||||
|
||||
: conjunction ( v -- ? ) [ ] all? ;
|
||||
: disjunction ( v -- ? ) [ ] contains? ;
|
||||
: conjunction ( v -- ? ) [ ] all? ; flushable
|
||||
: disjunction ( v -- ? ) [ ] contains? ; flushable
|
||||
|
||||
: index ( obj seq -- n ) [ = ] find-with drop ;
|
||||
: index* ( obj i seq -- n ) [ = ] find-with* drop ;
|
||||
: member? ( obj seq -- ? ) [ = ] contains-with? ;
|
||||
: memq? ( obj seq -- ? ) [ eq? ] contains-with? ;
|
||||
: remove ( obj list -- list ) [ = not ] subset-with ;
|
||||
: remq ( obj list -- list ) [ eq? not ] subset-with ;
|
||||
: index ( obj seq -- n ) [ = ] find-with drop ; flushable
|
||||
: index* ( obj i seq -- n ) [ = ] find-with* drop ; flushable
|
||||
: member? ( obj seq -- ? ) [ = ] contains-with? ; flushable
|
||||
: memq? ( obj seq -- ? ) [ eq? ] contains-with? ; flushable
|
||||
: remove ( obj list -- list ) [ = not ] subset-with ; flushable
|
||||
: remq ( obj list -- list ) [ eq? not ] subset-with ; flushable
|
||||
|
||||
: copy-into ( start to from -- )
|
||||
dup length [ >r pick r> + pick set-nth ] 2each 2drop ;
|
||||
|
|
@ -128,15 +128,15 @@ M: object >list ( seq -- list ) dup length 0 rot (>list) ;
|
|||
|
||||
: append ( s1 s2 -- s1+s2 )
|
||||
#! Outputs a new sequence of the same type as s1.
|
||||
swap [ swap nappend ] immutable ;
|
||||
swap [ swap nappend ] immutable ; flushable
|
||||
|
||||
: add ( seq elt -- seq )
|
||||
#! Outputs a new sequence of the same type as seq.
|
||||
swap [ push ] immutable ;
|
||||
swap [ push ] immutable ; flushable
|
||||
|
||||
: append3 ( s1 s2 s3 -- s1+s2+s3 )
|
||||
#! Return a new sequence of the same type as s1.
|
||||
rot [ [ rot nappend ] keep swap nappend ] immutable ;
|
||||
rot [ [ rot nappend ] keep swap nappend ] immutable ; flushable
|
||||
|
||||
: concat ( seq -- seq )
|
||||
#! Append a sequence of sequences together. The new sequence
|
||||
|
|
@ -144,7 +144,7 @@ M: object >list ( seq -- list ) dup length 0 rot (>list) ;
|
|||
dup empty? [
|
||||
[ 1024 <vector> swap [ dupd nappend ] each ] keep
|
||||
first like
|
||||
] unless ;
|
||||
] unless ; flushable
|
||||
|
||||
M: object peek ( sequence -- element )
|
||||
#! Get value at end of sequence.
|
||||
|
|
@ -160,7 +160,7 @@ M: object peek ( sequence -- element )
|
|||
: prune ( seq -- seq )
|
||||
[
|
||||
dup length <vector> swap [ over push-new ] each
|
||||
] keep like ;
|
||||
] keep like ; flushable
|
||||
|
||||
: >pop> ( stack -- stack ) dup pop drop ;
|
||||
|
||||
|
|
@ -172,7 +172,7 @@ M: object peek ( sequence -- element )
|
|||
dup length <vector> swap
|
||||
[ over push 2dup push ] each nip >pop>
|
||||
concat
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
M: object reverse-slice ( seq -- seq ) <reversed> ;
|
||||
|
||||
|
|
@ -180,17 +180,17 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
|
|||
|
||||
! Set theoretic operations
|
||||
: seq-intersect ( seq1 seq2 -- seq1/\seq2 )
|
||||
[ swap member? ] subset-with ;
|
||||
[ swap member? ] subset-with ; flushable
|
||||
|
||||
: seq-diff ( seq1 seq2 -- seq2-seq1 )
|
||||
[ swap member? not ] subset-with ;
|
||||
[ swap member? not ] subset-with ; flushable
|
||||
|
||||
: seq-union ( seq1 seq2 -- seq1\/seq2 )
|
||||
append prune ;
|
||||
append prune ; flushable
|
||||
|
||||
: contained? ( seq1 seq2 -- ? )
|
||||
#! Is every element of seq1 in seq2
|
||||
swap [ swap member? ] all-with? ;
|
||||
swap [ swap member? ] all-with? ; flushable
|
||||
|
||||
! Lexicographic comparison
|
||||
: (lexi) ( seq seq i limit -- n )
|
||||
|
|
@ -202,24 +202,24 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
|
|||
] [
|
||||
r> drop - >r 3drop r>
|
||||
] ifte
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
: lexi ( s1 s2 -- n )
|
||||
#! Lexicographically compare two sequences of numbers
|
||||
#! (usually strings). Negative if s1<s2, zero if s1=s2,
|
||||
#! positive if s1>s2.
|
||||
0 pick length pick length min (lexi) ;
|
||||
0 pick length pick length min (lexi) ; flushable
|
||||
|
||||
: flip ( seq -- seq )
|
||||
#! An example illustrates this word best:
|
||||
#! { { 1 2 3 } { 4 5 6 } } ==> { { 1 2 } { 3 4 } { 5 6 } }
|
||||
dup empty? [
|
||||
dup first length [ swap [ nth ] map-with ] map-with
|
||||
] unless ;
|
||||
] unless ; flushable
|
||||
|
||||
: max-length ( seq -- n )
|
||||
#! Longest sequence length in a sequence of sequences.
|
||||
0 [ length max ] reduce ;
|
||||
0 [ length max ] reduce ; flushable
|
||||
|
||||
IN: kernel
|
||||
|
||||
|
|
|
|||
|
|
@ -11,19 +11,18 @@ USING: errors generic kernel math math-internals strings vectors ;
|
|||
! kernel-internals vocabulary, so don't use them unless you have
|
||||
! a good reason.
|
||||
|
||||
GENERIC: empty? ( sequence -- ? )
|
||||
GENERIC: length ( sequence -- n )
|
||||
GENERIC: set-length ( n sequence -- )
|
||||
GENERIC: nth ( n sequence -- obj )
|
||||
GENERIC: set-nth ( value n sequence -- obj )
|
||||
GENERIC: thaw ( seq -- mutable-seq )
|
||||
GENERIC: like ( seq seq -- seq )
|
||||
GENERIC: reverse ( seq -- seq )
|
||||
GENERIC: reverse-slice ( seq -- seq )
|
||||
GENERIC: peek ( seq -- elt )
|
||||
GENERIC: head ( n seq -- seq )
|
||||
GENERIC: tail ( n seq -- seq )
|
||||
GENERIC: concat ( seq -- seq )
|
||||
GENERIC: empty? ( sequence -- ? ) flushable
|
||||
GENERIC: length ( sequence -- n ) flushable
|
||||
GENERIC: set-length ( n sequence -- ) flushable
|
||||
GENERIC: nth ( n sequence -- obj ) flushable
|
||||
GENERIC: set-nth ( value n sequence -- obj ) flushable
|
||||
GENERIC: thaw ( seq -- mutable-seq ) flushable
|
||||
GENERIC: like ( seq seq -- seq ) flushable
|
||||
GENERIC: reverse ( seq -- seq ) flushable
|
||||
GENERIC: reverse-slice ( seq -- seq ) flushable
|
||||
GENERIC: peek ( seq -- elt ) flushable
|
||||
GENERIC: head ( n seq -- seq ) flushable
|
||||
GENERIC: tail ( n seq -- seq ) flushable
|
||||
GENERIC: resize ( n seq -- seq )
|
||||
|
||||
: immutable ( seq quot -- seq | quot: seq -- )
|
||||
|
|
@ -56,10 +55,10 @@ G: find ( seq quot -- i elt | quot: elt -- ? )
|
|||
: 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ; inline
|
||||
|
||||
: 2unseq ( { x y } -- x y )
|
||||
dup first swap second ;
|
||||
dup first swap second ; inline
|
||||
|
||||
: 3unseq ( { x y z } -- x y z )
|
||||
dup first over second rot third ;
|
||||
dup first over second rot third ; inline
|
||||
|
||||
TUPLE: bounds-error index seq ;
|
||||
: bounds-error <bounds-error> throw ;
|
||||
|
|
|
|||
|
|
@ -6,64 +6,64 @@ strings vectors ;
|
|||
|
||||
: head-slice ( n seq -- slice )
|
||||
#! n is an index from the start of the sequence.
|
||||
0 -rot <slice> ;
|
||||
0 -rot <slice> ; flushable
|
||||
|
||||
: head-slice* ( n seq -- slice )
|
||||
#! n is an index from the end of the sequence.
|
||||
[ length swap - ] keep head-slice ;
|
||||
[ length swap - ] keep head-slice ; flushable
|
||||
|
||||
: tail-slice ( n seq -- slice )
|
||||
#! n is an index from the start of the sequence.
|
||||
[ length ] keep <slice> ;
|
||||
[ length ] keep <slice> ; flushable
|
||||
|
||||
: tail-slice* ( n seq -- slice )
|
||||
#! n is an index from the end of the sequence.
|
||||
[ length swap - ] keep tail-slice ;
|
||||
[ length swap - ] keep tail-slice ; flushable
|
||||
|
||||
: subseq ( from to seq -- seq )
|
||||
#! Makes a new sequence with the same contents and type as
|
||||
#! the slice of another sequence.
|
||||
[ <slice> ] keep like ;
|
||||
[ <slice> ] keep like ; flushable
|
||||
|
||||
M: object head ( index seq -- seq )
|
||||
[ head-slice ] keep like ;
|
||||
|
||||
: head* ( n seq -- seq )
|
||||
[ head-slice* ] keep like ;
|
||||
[ head-slice* ] keep like ; flushable
|
||||
|
||||
M: object tail ( index seq -- seq )
|
||||
[ tail-slice ] keep like ;
|
||||
|
||||
: tail* ( n seq -- seq )
|
||||
[ tail-slice* ] keep like ;
|
||||
[ tail-slice* ] keep like ; flushable
|
||||
|
||||
: length< ( seq seq -- ? )
|
||||
swap length swap length < ;
|
||||
swap length swap length < ; flushable
|
||||
|
||||
: head? ( seq begin -- ? )
|
||||
2dup length< [
|
||||
2drop f
|
||||
] [
|
||||
dup length rot head-slice sequence=
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
: ?head ( seq begin -- str ? )
|
||||
2dup head? [ length swap tail t ] [ drop f ] ifte ;
|
||||
2dup head? [ length swap tail t ] [ drop f ] ifte ; flushable
|
||||
|
||||
: tail? ( seq end -- ? )
|
||||
2dup length< [
|
||||
2drop f
|
||||
] [
|
||||
dup length rot tail-slice* sequence=
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
: ?tail ( seq end -- seq ? )
|
||||
2dup tail? [ length swap head* t ] [ drop f ] ifte ;
|
||||
2dup tail? [ length swap head* t ] [ drop f ] ifte ; flushable
|
||||
|
||||
: cut ( index seq -- seq seq )
|
||||
#! Returns 2 sequences, that when concatenated yield the
|
||||
#! original sequence.
|
||||
[ head ] 2keep tail ;
|
||||
[ head ] 2keep tail ; flushable
|
||||
|
||||
: group-advance subseq , >r tuck + swap r> ;
|
||||
|
||||
|
|
@ -78,7 +78,7 @@ M: object tail ( index seq -- seq )
|
|||
|
||||
: group ( n seq -- list )
|
||||
#! Split a sequence into element chunks.
|
||||
[ 0 -rot (group) ] make-list ;
|
||||
[ 0 -rot (group) ] make-list ; flushable
|
||||
|
||||
: start-step ( subseq seq n -- subseq slice )
|
||||
pick length dupd + rot <slice> ;
|
||||
|
|
@ -92,20 +92,20 @@ M: object tail ( index seq -- seq )
|
|||
] [
|
||||
r> r> 1 + start*
|
||||
] ifte
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
: start ( subseq seq -- n )
|
||||
#! The index of a subsequence in a sequence.
|
||||
0 start* ;
|
||||
0 start* ; flushable
|
||||
|
||||
: subseq? ( subseq seq -- ? ) start -1 > ;
|
||||
: subseq? ( subseq seq -- ? ) start -1 > ; flushable
|
||||
|
||||
: split1 ( seq subseq -- before after )
|
||||
dup pick start dup -1 = [
|
||||
2drop f
|
||||
] [
|
||||
[ swap length + over tail ] keep rot head swap
|
||||
] ifte ;
|
||||
] ifte ; flushable
|
||||
|
||||
: split-next ( index seq subseq -- next )
|
||||
pick >r dup pick r> start* dup -1 = [
|
||||
|
|
@ -124,4 +124,4 @@ M: object tail ( index seq -- seq )
|
|||
: split ( seq subseq -- list )
|
||||
#! Split the sequence at each occurrence of subseq, and push
|
||||
#! a list of the pieces.
|
||||
[ 0 -rot (split) ] make-list ;
|
||||
[ 0 -rot (split) ] make-list ; flushable
|
||||
|
|
|
|||
|
|
@ -12,14 +12,16 @@ sequences strings ;
|
|||
|
||||
: padding ( string count char -- string )
|
||||
>r swap length - dup 0 <= [ r> 2drop "" ] [ r> fill ] ifte ;
|
||||
flushable
|
||||
|
||||
: pad-left ( string count char -- string )
|
||||
pick >r padding r> append ;
|
||||
pick >r padding r> append ; flushable
|
||||
|
||||
: pad-right ( string count char -- string )
|
||||
pick >r padding r> swap append ;
|
||||
pick >r padding r> swap append ; flushable
|
||||
|
||||
: ch>string ( ch -- str ) 1 <sbuf> [ push ] keep (sbuf>string) ;
|
||||
: ch>string ( ch -- str )
|
||||
1 <sbuf> [ push ] keep (sbuf>string) ; flushable
|
||||
|
||||
: >sbuf ( seq -- sbuf )
|
||||
dup length <sbuf> [ swap nappend ] keep ; inline
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ USING: generic kernel kernel-internals lists math sequences ;
|
|||
|
||||
M: string nth ( n str -- ch ) bounds-check char-slot ;
|
||||
|
||||
GENERIC: >string ( seq -- string )
|
||||
GENERIC: >string ( seq -- string ) flushable
|
||||
|
||||
M: string >string ;
|
||||
|
||||
|
|
@ -19,7 +19,7 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
|
|||
: quotable? ( ch -- ? )
|
||||
#! In a string literal, can this character be used without
|
||||
#! escaping?
|
||||
dup printable? swap "\"\\" member? not and ;
|
||||
dup printable? swap "\"\\" member? not and ; foldable
|
||||
|
||||
: url-quotable? ( ch -- ? )
|
||||
#! In a URL, can this character be used without
|
||||
|
|
@ -27,4 +27,4 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
|
|||
dup letter?
|
||||
over LETTER? or
|
||||
over digit? or
|
||||
swap "/_?." member? or ;
|
||||
swap "/_?." member? or ; foldable
|
||||
|
|
|
|||
|
|
@ -23,6 +23,6 @@ M: vector like drop >vector ;
|
|||
: (2vector) [ swapd push ] keep (1vector) ; inline
|
||||
: (3vector) [ >r rot r> push ] keep (2vector) ; inline
|
||||
|
||||
: 1vector ( x -- { x } ) 1 <vector> (1vector) ;
|
||||
: 2vector ( x y -- { x y } ) 2 <vector> (2vector) ;
|
||||
: 3vector ( x y z -- { x y z } ) 3 <vector> (3vector) ;
|
||||
: 1vector ( x -- { x } ) 1 <vector> (1vector) ; flushable
|
||||
: 2vector ( x y -- { x y } ) 2 <vector> (2vector) ; flushable
|
||||
: 3vector ( x y z -- { x y z } ) 3 <vector> (3vector) ; flushable
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
IN: inference
|
||||
USING: errors generic hashtables interpreter kernel
|
||||
kernel-internals lists math math-internals parser sequences
|
||||
vectors words ;
|
||||
USING: alien assembler errors generic hashtables interpreter io
|
||||
io-internals kernel kernel-internals lists math math-internals
|
||||
memory parser sequences strings unparser vectors words ;
|
||||
|
||||
! Primitive combinators
|
||||
\ call [
|
||||
|
|
@ -81,3 +81,455 @@ vectors words ;
|
|||
\ bitnot [ [ integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ real [ [ number ] [ real ] ] "infer-effect" set-word-prop
|
||||
\ imaginary [ [ number ] [ real ] ] "infer-effect" set-word-prop
|
||||
|
||||
! Stack effects for all primitives
|
||||
\ execute [ [ word ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ call [ [ general-list ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ ifte [ [ object general-list general-list ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ dispatch [ [ fixnum vector ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ cons [ [ object object ] [ cons ] ] "infer-effect" set-word-prop
|
||||
\ cons t "foldable" set-word-prop
|
||||
\ cons t "flushable" set-word-prop
|
||||
|
||||
\ <vector> [ [ integer ] [ vector ] ] "infer-effect" set-word-prop
|
||||
\ <vector> t "flushable" set-word-prop
|
||||
|
||||
\ rehash-string [ [ string ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ <sbuf> [ [ integer ] [ sbuf ] ] "infer-effect" set-word-prop
|
||||
\ <sbuf> t "flushable" set-word-prop
|
||||
|
||||
\ sbuf>string [ [ sbuf ] [ string ] ] "infer-effect" set-word-prop
|
||||
\ sbuf>string t "flushable" set-word-prop
|
||||
|
||||
\ >fixnum [ [ number ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ >fixnum t "flushable" set-word-prop
|
||||
\ >fixnum t "foldable" set-word-prop
|
||||
|
||||
\ >bignum [ [ number ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ >bignum t "flushable" set-word-prop
|
||||
\ >bignum t "foldable" set-word-prop
|
||||
|
||||
\ >float [ [ number ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ >float t "flushable" set-word-prop
|
||||
\ >float t "foldable" set-word-prop
|
||||
|
||||
\ (fraction>) [ [ integer integer ] [ rational ] ] "infer-effect" set-word-prop
|
||||
\ (fraction>) t "flushable" set-word-prop
|
||||
\ (fraction>) t "foldable" set-word-prop
|
||||
|
||||
\ str>float [ [ string ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ str>float t "flushable" set-word-prop
|
||||
\ str>float t "foldable" set-word-prop
|
||||
|
||||
\ (unparse-float) [ [ float ] [ string ] ] "infer-effect" set-word-prop
|
||||
\ (unparse-float) t "flushable" set-word-prop
|
||||
\ (unparse-float) t "foldable" set-word-prop
|
||||
|
||||
\ float>bits [ [ real ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ float>bits t "flushable" set-word-prop
|
||||
\ float>bits t "foldable" set-word-prop
|
||||
|
||||
\ double>bits [ [ real ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ double>bits t "flushable" set-word-prop
|
||||
\ double>bits t "foldable" set-word-prop
|
||||
|
||||
\ bits>float [ [ integer ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ bits>float t "flushable" set-word-prop
|
||||
\ bits>float t "foldable" set-word-prop
|
||||
|
||||
\ bits>double [ [ integer ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ bits>double t "flushable" set-word-prop
|
||||
\ bits>double t "foldable" set-word-prop
|
||||
|
||||
\ <complex> [ [ real real ] [ number ] ] "infer-effect" set-word-prop
|
||||
\ <complex> t "flushable" set-word-prop
|
||||
\ <complex> t "foldable" set-word-prop
|
||||
|
||||
\ fixnum+ [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ fixnum+ t "flushable" set-word-prop
|
||||
\ fixnum+ t "foldable" set-word-prop
|
||||
|
||||
\ fixnum- [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ fixnum- t "flushable" set-word-prop
|
||||
\ fixnum- t "foldable" set-word-prop
|
||||
|
||||
\ fixnum* [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ fixnum* t "flushable" set-word-prop
|
||||
\ fixnum* t "foldable" set-word-prop
|
||||
|
||||
\ fixnum/i [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ fixnum/i t "flushable" set-word-prop
|
||||
\ fixnum/i t "foldable" set-word-prop
|
||||
|
||||
\ fixnum/f [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ fixnum/f t "flushable" set-word-prop
|
||||
\ fixnum/f t "foldable" set-word-prop
|
||||
|
||||
\ fixnum-mod [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ fixnum-mod t "flushable" set-word-prop
|
||||
\ fixnum-mod t "foldable" set-word-prop
|
||||
|
||||
\ fixnum/mod [ [ fixnum fixnum ] [ integer fixnum ] ] "infer-effect" set-word-prop
|
||||
\ fixnum/mod t "flushable" set-word-prop
|
||||
\ fixnum/mod t "foldable" set-word-prop
|
||||
|
||||
\ fixnum-bitand [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ fixnum-bitand t "flushable" set-word-prop
|
||||
\ fixnum-bitand t "foldable" set-word-prop
|
||||
|
||||
\ fixnum-bitor [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ fixnum-bitor t "flushable" set-word-prop
|
||||
\ fixnum-bitor t "foldable" set-word-prop
|
||||
|
||||
\ fixnum-bitxor [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ fixnum-bitxor t "flushable" set-word-prop
|
||||
\ fixnum-bitxor t "foldable" set-word-prop
|
||||
|
||||
\ fixnum-bitnot [ [ fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ fixnum-bitnot t "flushable" set-word-prop
|
||||
\ fixnum-bitnot t "foldable" set-word-prop
|
||||
|
||||
\ fixnum-shift [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ fixnum-shift t "flushable" set-word-prop
|
||||
\ fixnum-shift t "foldable" set-word-prop
|
||||
|
||||
\ fixnum< [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ fixnum< t "flushable" set-word-prop
|
||||
\ fixnum< t "foldable" set-word-prop
|
||||
|
||||
\ fixnum<= [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ fixnum<= t "flushable" set-word-prop
|
||||
\ fixnum<= t "foldable" set-word-prop
|
||||
|
||||
\ fixnum> [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ fixnum> t "flushable" set-word-prop
|
||||
\ fixnum> t "foldable" set-word-prop
|
||||
|
||||
\ fixnum>= [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ fixnum>= t "flushable" set-word-prop
|
||||
\ fixnum>= t "foldable" set-word-prop
|
||||
|
||||
\ bignum= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ bignum= t "flushable" set-word-prop
|
||||
\ bignum= t "foldable" set-word-prop
|
||||
|
||||
\ bignum+ [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum+ t "flushable" set-word-prop
|
||||
\ bignum+ t "foldable" set-word-prop
|
||||
|
||||
\ bignum- [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum- t "flushable" set-word-prop
|
||||
\ bignum- t "foldable" set-word-prop
|
||||
|
||||
\ bignum* [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum* t "flushable" set-word-prop
|
||||
\ bignum* t "foldable" set-word-prop
|
||||
|
||||
\ bignum/i [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum/i t "flushable" set-word-prop
|
||||
\ bignum/i t "foldable" set-word-prop
|
||||
|
||||
\ bignum/f [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum/f t "flushable" set-word-prop
|
||||
\ bignum/f t "foldable" set-word-prop
|
||||
|
||||
\ bignum-mod [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum-mod t "flushable" set-word-prop
|
||||
\ bignum-mod t "foldable" set-word-prop
|
||||
|
||||
\ bignum/mod [ [ bignum bignum ] [ bignum bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum/mod t "flushable" set-word-prop
|
||||
\ bignum/mod t "foldable" set-word-prop
|
||||
|
||||
\ bignum-bitand [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum-bitand t "flushable" set-word-prop
|
||||
\ bignum-bitand t "foldable" set-word-prop
|
||||
|
||||
\ bignum-bitor [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum-bitor t "flushable" set-word-prop
|
||||
\ bignum-bitor t "foldable" set-word-prop
|
||||
|
||||
\ bignum-bitxor [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum-bitxor t "flushable" set-word-prop
|
||||
\ bignum-bitxor t "foldable" set-word-prop
|
||||
|
||||
\ bignum-bitnot [ [ bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum-bitnot t "flushable" set-word-prop
|
||||
\ bignum-bitnot t "foldable" set-word-prop
|
||||
|
||||
\ bignum-shift [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
|
||||
\ bignum-shift t "flushable" set-word-prop
|
||||
\ bignum-shift t "foldable" set-word-prop
|
||||
|
||||
\ bignum< [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ bignum< t "flushable" set-word-prop
|
||||
\ bignum< t "foldable" set-word-prop
|
||||
|
||||
\ bignum<= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ bignum<= t "flushable" set-word-prop
|
||||
\ bignum<= t "foldable" set-word-prop
|
||||
|
||||
\ bignum> [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ bignum> t "flushable" set-word-prop
|
||||
\ bignum> t "foldable" set-word-prop
|
||||
|
||||
\ bignum>= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ bignum>= t "flushable" set-word-prop
|
||||
\ bignum>= t "foldable" set-word-prop
|
||||
|
||||
\ float= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ float= t "flushable" set-word-prop
|
||||
\ float= t "foldable" set-word-prop
|
||||
|
||||
\ float+ [ [ float float ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ float+ t "flushable" set-word-prop
|
||||
\ float+ t "foldable" set-word-prop
|
||||
|
||||
\ float- [ [ float float ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ float- t "flushable" set-word-prop
|
||||
\ float- t "foldable" set-word-prop
|
||||
|
||||
\ float* [ [ float float ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ float* t "flushable" set-word-prop
|
||||
\ float* t "foldable" set-word-prop
|
||||
|
||||
\ float/f [ [ float float ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ float/f t "flushable" set-word-prop
|
||||
\ float/f t "foldable" set-word-prop
|
||||
|
||||
\ float< [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ float< t "flushable" set-word-prop
|
||||
\ float< t "foldable" set-word-prop
|
||||
|
||||
\ float<= [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ float<= t "flushable" set-word-prop
|
||||
\ float<= t "foldable" set-word-prop
|
||||
|
||||
\ float> [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ float> t "flushable" set-word-prop
|
||||
\ float> t "foldable" set-word-prop
|
||||
|
||||
\ float>= [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ float>= t "flushable" set-word-prop
|
||||
\ float>= t "foldable" set-word-prop
|
||||
|
||||
\ facos [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ facos t "flushable" set-word-prop
|
||||
\ facos t "foldable" set-word-prop
|
||||
|
||||
\ fasin [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fasin t "flushable" set-word-prop
|
||||
\ fasin t "foldable" set-word-prop
|
||||
|
||||
\ fatan [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fatan t "flushable" set-word-prop
|
||||
\ fatan t "foldable" set-word-prop
|
||||
|
||||
\ fatan2 [ [ real real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fatan2 t "flushable" set-word-prop
|
||||
\ fatan2 t "foldable" set-word-prop
|
||||
|
||||
\ fcos [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fcos t "flushable" set-word-prop
|
||||
\ fcos t "foldable" set-word-prop
|
||||
|
||||
\ fexp [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fexp t "flushable" set-word-prop
|
||||
\ fexp t "foldable" set-word-prop
|
||||
|
||||
\ fcosh [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fcosh t "flushable" set-word-prop
|
||||
\ fcosh t "foldable" set-word-prop
|
||||
|
||||
\ flog [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ flog t "flushable" set-word-prop
|
||||
\ flog t "foldable" set-word-prop
|
||||
|
||||
\ fpow [ [ real real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fpow t "flushable" set-word-prop
|
||||
\ fpow t "foldable" set-word-prop
|
||||
|
||||
\ fsin [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fsin t "flushable" set-word-prop
|
||||
\ fsin t "foldable" set-word-prop
|
||||
|
||||
\ fsinh [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fsinh t "flushable" set-word-prop
|
||||
\ fsinh t "foldable" set-word-prop
|
||||
|
||||
\ fsqrt [ [ real ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ fsqrt t "flushable" set-word-prop
|
||||
\ fsqrt t "foldable" set-word-prop
|
||||
|
||||
\ <word> [ [ ] [ word ] ] "infer-effect" set-word-prop
|
||||
\ <word> t "flushable" set-word-prop
|
||||
|
||||
\ update-xt [ [ word ] [ ] ] "infer-effect" set-word-prop
|
||||
\ compiled? [ [ word ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ drop [ [ object ] [ ] ] "infer-effect" set-word-prop
|
||||
\ dup [ [ object ] [ object object ] ] "infer-effect" set-word-prop
|
||||
\ swap [ [ object object ] [ object object ] ] "infer-effect" set-word-prop
|
||||
\ over [ [ object object ] [ object object object ] ] "infer-effect" set-word-prop
|
||||
\ pick [ [ object object object ] [ object object object object ] ] "infer-effect" set-word-prop
|
||||
\ >r [ [ object ] [ ] ] "infer-effect" set-word-prop
|
||||
\ r> [ [ ] [ object ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ eq? [ [ object object ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
\ eq? t "flushable" set-word-prop
|
||||
\ eq? t "foldable" set-word-prop
|
||||
|
||||
\ getenv [ [ fixnum ] [ object ] ] "infer-effect" set-word-prop
|
||||
\ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop
|
||||
\ stat [ [ string ] [ general-list ] ] "infer-effect" set-word-prop
|
||||
\ (directory) [ [ string ] [ general-list ] ] "infer-effect" set-word-prop
|
||||
\ gc [ [ fixnum ] [ ] ] "infer-effect" set-word-prop
|
||||
\ gc-time [ [ string ] [ ] ] "infer-effect" set-word-prop
|
||||
\ save-image [ [ string ] [ ] ] "infer-effect" set-word-prop
|
||||
\ exit [ [ integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ room [ [ ] [ integer integer integer integer general-list ] ] "infer-effect" set-word-prop
|
||||
\ os-env [ [ string ] [ object ] ] "infer-effect" set-word-prop
|
||||
\ millis [ [ ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ (random-int) [ [ ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ type [ [ object ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ type t "flushable" set-word-prop
|
||||
\ type t "foldable" set-word-prop
|
||||
|
||||
\ tag [ [ object ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ tag t "flushable" set-word-prop
|
||||
\ tag t "foldable" set-word-prop
|
||||
|
||||
\ cwd [ [ ] [ string ] ] "infer-effect" set-word-prop
|
||||
\ cd [ [ string ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ compiled-offset [ [ ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ compiled-offset t "flushable" set-word-prop
|
||||
|
||||
\ set-compiled-offset [ [ integer ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ literal-top [ [ ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ literal-top t "flushable" set-word-prop
|
||||
|
||||
\ set-literal-top [ [ integer ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ address [ [ object ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ address t "flushable" set-word-prop
|
||||
|
||||
\ dlopen [ [ string ] [ dll ] ] "infer-effect" set-word-prop
|
||||
\ dlsym [ [ string object ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ dlclose [ [ dll ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ <alien> [ [ integer ] [ alien ] ] "infer-effect" set-word-prop
|
||||
\ <alien> t "flushable" set-word-prop
|
||||
|
||||
\ <byte-array> [ [ integer ] [ byte-array ] ] "infer-effect" set-word-prop
|
||||
\ <byte-array> t "flushable" set-word-prop
|
||||
|
||||
\ <displaced-alien> [ [ integer c-ptr ] [ displaced-alien ] ] "infer-effect" set-word-prop
|
||||
\ <displaced-alien> t "flushable" set-word-prop
|
||||
|
||||
\ alien-signed-cell [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-cell t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-signed-cell [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-cell [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-cell t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-unsigned-cell [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-8 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-8 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-signed-8 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-8 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-8 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-unsigned-8 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-4 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-4 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-signed-4 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-4 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-4 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-unsigned-4 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-2 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-2 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-signed-2 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-2 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-2 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-unsigned-2 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-1 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-signed-1 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-signed-1 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-1 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ alien-unsigned-1 t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-unsigned-1 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-float [ [ c-ptr integer ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ alien-float t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-float [ [ float c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-double [ [ c-ptr integer ] [ float ] ] "infer-effect" set-word-prop
|
||||
\ alien-double t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-double [ [ float c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ alien-c-string [ [ c-ptr integer ] [ string ] ] "infer-effect" set-word-prop
|
||||
\ alien-c-string t "flushable" set-word-prop
|
||||
|
||||
\ set-alien-c-string [ [ string c-ptr integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ throw [ [ object ] [ ] ] "infer-effect" set-word-prop
|
||||
\ string>memory [ [ string integer ] [ ] ] "infer-effect" set-word-prop
|
||||
\ memory>string [ [ integer integer ] [ string ] ] "infer-effect" set-word-prop
|
||||
\ alien-address [ [ alien ] [ integer ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ slot [ [ object fixnum ] [ object ] ] "infer-effect" set-word-prop
|
||||
\ slot t "flushable" set-word-prop
|
||||
|
||||
\ set-slot [ [ object object fixnum ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ integer-slot [ [ object fixnum ] [ integer ] ] "infer-effect" set-word-prop
|
||||
\ integer-slot t "flushable" set-word-prop
|
||||
|
||||
\ set-integer-slot [ [ integer object fixnum ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ char-slot [ [ object fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ char-slot t "flushable" set-word-prop
|
||||
|
||||
\ set-char-slot [ [ integer object fixnum ] [ ] ] "infer-effect" set-word-prop
|
||||
\ resize-array [ [ integer array ] [ array ] ] "infer-effect" set-word-prop
|
||||
\ resize-string [ [ integer string ] [ string ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ <hashtable> [ [ number ] [ hashtable ] ] "infer-effect" set-word-prop
|
||||
\ <hashtable> t "flushable" set-word-prop
|
||||
|
||||
\ <array> [ [ number ] [ array ] ] "infer-effect" set-word-prop
|
||||
\ <array> t "flushable" set-word-prop
|
||||
|
||||
\ <tuple> [ [ number ] [ tuple ] ] "infer-effect" set-word-prop
|
||||
\ <tuple> t "flushable" set-word-prop
|
||||
|
||||
\ begin-scan [ [ ] [ ] ] "infer-effect" set-word-prop
|
||||
\ next-object [ [ ] [ object ] ] "infer-effect" set-word-prop
|
||||
\ end-scan [ [ ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ size [ [ object ] [ fixnum ] ] "infer-effect" set-word-prop
|
||||
\ size t "flushable" set-word-prop
|
||||
|
||||
\ die [ [ ] [ ] ] "infer-effect" set-word-prop
|
||||
\ fopen [ [ string string ] [ alien ] ] "infer-effect" set-word-prop
|
||||
\ fgetc [ [ alien ] [ object ] ] "infer-effect" set-word-prop
|
||||
\ fwrite [ [ string alien ] [ ] ] "infer-effect" set-word-prop
|
||||
\ fflush [ [ alien ] [ ] ] "infer-effect" set-word-prop
|
||||
\ fclose [ [ alien ] [ ] ] "infer-effect" set-word-prop
|
||||
\ expired? [ [ object ] [ boolean ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ <wrapper> [ [ object ] [ wrapper ] ] "infer-effect" set-word-prop
|
||||
\ <wrapper> t "flushable" set-word-prop
|
||||
\ <wrapper> t "foldable" set-word-prop
|
||||
|
|
|
|||
|
|
@ -25,13 +25,13 @@ USING: generic kernel-internals vectors ;
|
|||
UNION: boolean POSTPONE: f POSTPONE: t ;
|
||||
COMPLEMENT: general-t f
|
||||
|
||||
GENERIC: hashcode ( obj -- n )
|
||||
GENERIC: hashcode ( obj -- n ) flushable
|
||||
M: object hashcode drop 0 ;
|
||||
|
||||
GENERIC: = ( obj obj -- ? )
|
||||
GENERIC: = ( obj obj -- ? ) flushable
|
||||
M: object = eq? ;
|
||||
|
||||
GENERIC: clone ( obj -- obj )
|
||||
GENERIC: clone ( obj -- obj ) flushable
|
||||
M: object clone ;
|
||||
|
||||
: set-boot ( quot -- )
|
||||
|
|
|
|||
|
|
@ -15,16 +15,17 @@ UNION: integer fixnum bignum ;
|
|||
: gcd ( x y -- a d )
|
||||
#! Compute the greatest common divisor d and multiplier a
|
||||
#! such that a*x=d mod y.
|
||||
swap 0 1 2swap (gcd) abs ;
|
||||
swap 0 1 2swap (gcd) abs ; foldable
|
||||
|
||||
: mod-inv ( x n -- y )
|
||||
#! Compute the multiplicative inverse of x mod n.
|
||||
gcd 1 = [ "Non-trivial divisor found" throw ] unless ;
|
||||
gcd 1 = [ "Non-trivial divisor found" throw ] unless ; foldable
|
||||
|
||||
: bitroll ( n s w -- n )
|
||||
#! Roll n by s bits to the right, wrapping around after
|
||||
#! w bits.
|
||||
[ mod shift ] 3keep over 0 >= [ - ] [ + ] ifte shift bitor ;
|
||||
foldable
|
||||
|
||||
IN: math-internals
|
||||
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ GENERIC: ceiling ( n -- n ) foldable
|
|||
|
||||
: sgn ( n -- -1/0/1 )
|
||||
#! Push the sign of a real number.
|
||||
dup 0 = [ drop 0 ] [ 1 < -1 1 ? ] ifte ; inline
|
||||
dup 0 = [ drop 0 ] [ 1 < -1 1 ? ] ifte ; foldable
|
||||
|
||||
GENERIC: abs ( z -- |z| )
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ USING: errors kernel math math-internals ;
|
|||
drop fsqrt 0 swap rect>
|
||||
] [
|
||||
swap fsqrt swap 2 / polar>
|
||||
] ifte ;
|
||||
] ifte ; foldable
|
||||
|
||||
: norm ( vec -- n ) norm-sq sqrt ;
|
||||
|
||||
|
|
|
|||
|
|
@ -16,4 +16,5 @@ IN: math USING: kernel ;
|
|||
(random-int) 2dup swap mod (random-int-0)
|
||||
] ifte ; inline
|
||||
|
||||
: random-int ( min max -- n ) dupd swap - random-int-0 + ;
|
||||
: random-int ( min max -- n )
|
||||
dupd swap - random-int-0 + ; flushable
|
||||
|
|
|
|||
|
|
@ -13,10 +13,6 @@ USE: test
|
|||
[[ [ 1 2 ] [ 2 1 ] ]]
|
||||
] "assoc" set
|
||||
|
||||
[ t ] [ "assoc" get assoc? ] unit-test
|
||||
[ f ] [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] assoc? ] unit-test
|
||||
[ f ] [ "assoc" assoc? ] unit-test
|
||||
|
||||
[ f ] [ "monkey" f assoc ] unit-test
|
||||
[ f ] [ "donkey" "assoc" get assoc ] unit-test
|
||||
[ 1 ] [ "monkey" "assoc" get assoc ] unit-test
|
||||
|
|
|
|||
Loading…
Reference in New Issue