core: get rid of some unnecessary wrappers.
parent
a458c4e5d9
commit
f3a8546b23
|
@ -568,7 +568,7 @@ M: quotation '
|
||||||
fixup-header
|
fixup-header
|
||||||
"Image length: " write image get length .
|
"Image length: " write image get length .
|
||||||
"Object cache size: " write objects get assoc-size .
|
"Object cache size: " write objects get assoc-size .
|
||||||
\ last-word-symbol global delete-at
|
\ last-word global delete-at
|
||||||
image get ;
|
image get ;
|
||||||
|
|
||||||
! Image output
|
! Image output
|
||||||
|
|
|
@ -14,7 +14,7 @@ SYMBOL: new-definitions
|
||||||
TUPLE: redefine-error def ;
|
TUPLE: redefine-error def ;
|
||||||
|
|
||||||
: throw-redefine-error ( definition -- )
|
: throw-redefine-error ( definition -- )
|
||||||
\ redefine-error boa throw-continue ;
|
redefine-error boa throw-continue ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
|
|
@ -124,7 +124,7 @@ TUPLE: tuple-dispatch-engine echelons ;
|
||||||
: <tuple-dispatch-engine> ( methods -- engine )
|
: <tuple-dispatch-engine> ( methods -- engine )
|
||||||
convert-tuple-inheritance echelon-sort
|
convert-tuple-inheritance echelon-sort
|
||||||
[ dupd <echelon-dispatch-engine> ] assoc-map
|
[ dupd <echelon-dispatch-engine> ] assoc-map
|
||||||
\ tuple-dispatch-engine boa ;
|
tuple-dispatch-engine boa ;
|
||||||
|
|
||||||
: convert-tuple-methods ( assoc -- assoc' )
|
: convert-tuple-methods ( assoc -- assoc' )
|
||||||
tuple bootstrap-word
|
tuple bootstrap-word
|
||||||
|
|
|
@ -108,7 +108,7 @@ ERROR: non-negative-integer-expected n ;
|
||||||
|
|
||||||
: iota ( n -- iota )
|
: iota ( n -- iota )
|
||||||
dup 0 < [ non-negative-integer-expected ] when
|
dup 0 < [ non-negative-integer-expected ] when
|
||||||
\ iota-tuple boa ; inline
|
iota-tuple boa ; inline
|
||||||
|
|
||||||
M: iota-tuple length n>> ; inline
|
M: iota-tuple length n>> ; inline
|
||||||
M: iota-tuple nth-unsafe drop ; inline
|
M: iota-tuple nth-unsafe drop ; inline
|
||||||
|
|
|
@ -27,7 +27,7 @@ main ;
|
||||||
new-definitions get >>definitions drop ;
|
new-definitions get >>definitions drop ;
|
||||||
|
|
||||||
: <source-file> ( path -- source-file )
|
: <source-file> ( path -- source-file )
|
||||||
\ source-file-tuple new
|
source-file-tuple new
|
||||||
swap >>path
|
swap >>path
|
||||||
<definitions> >>definitions ;
|
<definitions> >>definitions ;
|
||||||
|
|
||||||
|
@ -62,7 +62,7 @@ SYMBOL: file
|
||||||
|
|
||||||
: wrap-source-file-error ( error -- * )
|
: wrap-source-file-error ( error -- * )
|
||||||
file get rollback-source-file
|
file get rollback-source-file
|
||||||
\ source-file-error new
|
source-file-error new
|
||||||
f >>line#
|
f >>line#
|
||||||
file get path>> >>file
|
file get path>> >>file
|
||||||
swap >>error rethrow ;
|
swap >>error rethrow ;
|
||||||
|
|
|
@ -19,7 +19,7 @@ ERROR: no-word-error name ;
|
||||||
suffix ;
|
suffix ;
|
||||||
|
|
||||||
: <no-word-error> ( name possibilities -- error restarts )
|
: <no-word-error> ( name possibilities -- error restarts )
|
||||||
[ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ;
|
[ drop no-word-error boa ] [ word-restarts-with-defer ] 2bi ;
|
||||||
|
|
||||||
TUPLE: manifest
|
TUPLE: manifest
|
||||||
current-vocab
|
current-vocab
|
||||||
|
@ -89,7 +89,7 @@ PRIVATE>
|
||||||
TUPLE: no-current-vocab-error ;
|
TUPLE: no-current-vocab-error ;
|
||||||
|
|
||||||
: no-current-vocab ( -- vocab )
|
: no-current-vocab ( -- vocab )
|
||||||
\ no-current-vocab-error boa
|
no-current-vocab-error boa
|
||||||
{ { "Define words in scratchpad vocabulary" "scratchpad" } }
|
{ { "Define words in scratchpad vocabulary" "scratchpad" } }
|
||||||
throw-restarts dup set-current-vocab ;
|
throw-restarts dup set-current-vocab ;
|
||||||
|
|
||||||
|
@ -169,7 +169,7 @@ TUPLE: rename word vocab words ;
|
||||||
TUPLE: ambiguous-use-error words ;
|
TUPLE: ambiguous-use-error words ;
|
||||||
|
|
||||||
: <ambiguous-use-error> ( words -- error restarts )
|
: <ambiguous-use-error> ( words -- error restarts )
|
||||||
[ \ ambiguous-use-error boa ] [ word-restarts ] bi ;
|
[ ambiguous-use-error boa ] [ word-restarts ] bi ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
|
|
@ -17,7 +17,7 @@ SYMBOL: +running+
|
||||||
SYMBOL: +done+
|
SYMBOL: +done+
|
||||||
|
|
||||||
: <vocab> ( name -- vocab )
|
: <vocab> ( name -- vocab )
|
||||||
\ vocab new
|
vocab new
|
||||||
swap >>name
|
swap >>name
|
||||||
H{ } clone >>words ;
|
H{ } clone >>words ;
|
||||||
|
|
||||||
|
|
|
@ -16,11 +16,9 @@ BUILTIN: word
|
||||||
! also looking for classes
|
! also looking for classes
|
||||||
: word ( -- * ) "dummy word" throw ;
|
: word ( -- * ) "dummy word" throw ;
|
||||||
|
|
||||||
SYMBOL: last-word-symbol
|
: last-word ( -- word ) \ last-word get-global ;
|
||||||
|
|
||||||
: last-word ( -- word ) \ last-word-symbol get-global ;
|
: set-last-word ( word -- ) \ last-word set-global ;
|
||||||
|
|
||||||
: set-last-word ( word -- ) \ last-word-symbol set-global ;
|
|
||||||
|
|
||||||
M: word execute (execute) ;
|
M: word execute (execute) ;
|
||||||
|
|
||||||
|
@ -52,7 +50,8 @@ M: word definition def>> ;
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
TUPLE: undefined-word word ;
|
TUPLE: undefined-word word ;
|
||||||
: undefined ( -- * ) callstack caller \ undefined-word boa throw ;
|
|
||||||
|
: undefined ( -- * ) callstack caller undefined-word boa throw ;
|
||||||
|
|
||||||
: undefined-def ( -- quot )
|
: undefined-def ( -- quot )
|
||||||
#! 'f' inhibits tail call optimization in non-optimizing
|
#! 'f' inhibits tail call optimization in non-optimizing
|
||||||
|
|
Loading…
Reference in New Issue