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