- reader syntax for arrays, byte arrays, displaced aliens\r
- sleep word\r
- docstrings appear twice\r
+- fix infer hang\r
+- fix sort out of bounds\r
\r
+ ui:\r
\r
: transfer-word ( word -- word )
#! This is a hack. See doc/bootstrap.txt.
- dup dup word-name swap word-vocabulary unit search
+ dup dup word-name swap word-vocabulary lookup
[ ] [ dup "Missing DEFER: " word-error ] ?ifte ;
: pooled-object ( object -- ptr ) objects get hash ;
} 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 ;
+ 3unseq >r lookup r> "stack-effect" set-word-prop ;
{
{ "drop" "kernel" " x -- " }
IN: sorting-internals
-USING: kernel math sequences ;
+USING: kernel math sequences vectors ;
TUPLE: sorter seq start end mid ;
[ >r 1 + rot <slice> r> set-sorter-seq ] keep
dup sorter-seq midpoint over set-sorter-mid
dup sorter-seq length 1 - over set-sorter-end
- 0 over set-sorter-start ;
+ 0 over set-sorter-start ; inline
-: s*/e* dup sorter-start swap sorter-end ;
-: s*/e dup sorter-start swap sorter-seq length 1 - ;
-: s/e* 0 swap sorter-end ;
-: sorter-exchange dup s*/e* rot sorter-seq exchange ;
+: s*/e* dup sorter-start swap sorter-end ; inline
+: s*/e dup sorter-start swap sorter-seq length 1 - ; inline
+: s/e* 0 swap sorter-end ; inline
+: sorter-exchange dup s*/e* rot sorter-seq exchange ; inline
: compare over sorter-seq nth swap sorter-mid rot call ; inline
-: >start> dup sorter-start 1 + swap set-sorter-start ;
-: <end< dup sorter-end 1 - swap set-sorter-end ;
+: >start> dup sorter-start 1 + swap set-sorter-start ; inline
+: <end< dup sorter-end 1 - swap set-sorter-end ; inline
: sort-up ( quot sorter -- quot sorter )
dup s*/e < [
2drop
] ifte 2drop ; inline
-: partition ( seq -1/1 -- seq )
- >r dup midpoint@ swap r> 1 <
+: partition ( -1/1 seq -- seq )
+ dup midpoint@ swap rot 1 <
[ head-slice ] [ tail-slice ] ifte ; inline
: (binsearch) ( elt quot seq -- i )
dup length 1 <= [
2nip slice-from
] [
- 3dup midpoint swap call dup 0 = [
- drop 2nip dup slice-from swap slice-to + 2 /i
+ 3dup >r >r >r midpoint swap call dup 0 = [
+ r> r> 3drop r> dup slice-from swap slice-to + 2 /i
] [
- partition (binsearch)
+ r> swap r> swap r> partition (binsearch)
] ifte
] ifte ; inline
global [
[
dup word? [
- dup word-name swap word-vocabulary vocab hash
+ dup word-name swap word-vocabulary lookup
] when
] map
] bind ;
swap words [ word-name over swap option ] each drop
</select> ;
-: find-word ( vocab string -- word )
- #! Given the name of a word, find it in the given vocab. Return the
- #! word object itself if successfull, otherwise return false.
- swap unit search ;
-
: word-source ( vocab word -- )
#! Write the source for the given word from the vocab as HTML.
- find-word [
+ swap lookup [
[ see ] with-simple-html-output
] when* ;
last-newline set
line-count inc
line-limit? [ " ..." write end-printing get call ] when
- terpri do-indent ;
+ "\n" write do-indent ;
TUPLE: text string style ;
: unparse-short ( object -- str ) [ pprint-short ] string-out ;
-: [.] ( sequence -- )
- #! Unparse each element on its own line.
- [ dup unparse-short swap write-object terpri ] each ;
+: unparse-short ( object -- )
+ dup unparse-short swap write-object terpri ;
+
+: [.] ( sequence -- ) [ unparse-short. ] each ;
: stack. reverse-slice [.] ;
IN: temporary
-USING: compiler inference math generic ;
+USING: compiler inference math generic parser ;
USE: test
[ 1 2 3 1 2 3 ] [ bar ] unit-test
[ [ [ ] [ object object object ] ] ] [ [ foo ] infer ] unit-test
+
+[ ] [
+ "IN: temporary : foo ; : bar foo ; : baz foo ; : foo ;" eval
+] unit-test
[ 3 ] [ { 1 2 3 4 } midpoint ] unit-test
+[ -1 ] [ 3 { } [ - ] binsearch ] unit-test
+[ 0 ] [ 3 { 3 } [ - ] binsearch ] unit-test
+[ 1 ] [ 2 { 1 2 3 } [ - ] binsearch ] unit-test
+[ 3 ] [ 4 { 1 2 3 4 5 6 } [ - ] binsearch ] unit-test
+[ 1 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
+[ 3 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
+[ 10 ] [ 10 20 >vector [ - ] binsearch ] unit-test
+
: seq-sorter 0 over length 1 - <sorter> ;
[ { 4 2 3 1 } ]
map-pairs [ 0 <= ] all? ;
[ t ] [
- 10 [
+ 100 [
drop
1000 [ drop 0 1000 random-int ] map [ - ] sort [ - ] sorted?
] all?
] unit-test
-
-[ -1 ] [ 3 { } [ - ] binsearch ] unit-test
-[ 0 ] [ 3 { 3 } [ - ] binsearch ] unit-test
-[ 1 ] [ 2 { 1 2 3 } [ - ] binsearch ] unit-test
-[ 3 ] [ 4 { 1 2 3 4 5 6 } [ - ] binsearch ] unit-test
-[ 1 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
-[ 3 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
-[ 10 ] [ 10 20 >vector [ - ] binsearch ] unit-test
: &s
#! Print stepper data stack.
- meta-d get reverse [.] ;
+ meta-d get stack. ;
: &r
#! Print stepper call stack, as well as the currently
#! executing quotation.
- meta-cf get . meta-executing get . meta-r get reverse [.] ;
+ meta-cf get unparse-short.
+ meta-executing get . meta-r get stack. ;
: &get ( var -- value )
#! Get stepper variable value.
global [ <namespace> crossref set ] bind
[ add-crossref ] each-word ;
+: lookup ( name vocab -- word ) vocab ?hash ;
+
: search ( name vocabs -- word )
- [ vocab ?hash ] map-with [ ] find nip ;
+ [ lookup ] map-with [ ] find nip ;
: <props> ( name vocab -- plist )
[ "vocabulary" set "name" set ] make-hash ;
#! Create a new word in a vocabulary. If the vocabulary
#! already contains the word, the existing instance is
#! returned.
- 2dup check-create 2dup vocab ?hash
+ 2dup check-create 2dup lookup
[ nip ] [ (create) dup reveal ] ?ifte ;
: constructor-word ( string vocab -- word )
: usages ( word -- deps )
#! List all usages of a word. This is a transitive closure,
#! so indirect usages are reported.
- crossref get dup [ closure word-sort ] [ 2drop { } ] ifte ;
+ crossref get dup [ closure ] [ 2drop { } ] ifte ;
: usage ( word -- list )
#! List all direct usages of a word.
- crossref get ?hash dup [ hash-keys ] when word-sort ;
+ crossref get ?hash dup [ hash-keys ] when ;
GENERIC: (uncrossref) ( word -- )
M: word (uncrossref) drop ;
: uncrossref ( word -- )
- dup (uncrossref) usages [ (uncrossref) ] each ;
+ dup (uncrossref) usages [ (uncrossref) ] each ;
! The word primitive combined with the word def specify what the
! word does when invoked.