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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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