core: get rid of some unnecessary wrappers.

db4
John Benediktsson 2014-11-02 20:16:22 -08:00
parent a458c4e5d9
commit f3a8546b23
8 changed files with 14 additions and 15 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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

View File

@ -17,7 +17,7 @@ SYMBOL: +running+
SYMBOL: +done+
: <vocab> ( name -- vocab )
\ vocab new
vocab new
swap >>name
H{ } clone >>words ;

View File

@ -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