use ERROR: in several places instead of throwing strings
parent
e5b9fabc65
commit
dc79446250
|
@ -202,9 +202,11 @@ M: anonymous-complement (classes-intersect?)
|
||||||
: class= ( first second -- ? )
|
: class= ( first second -- ? )
|
||||||
[ class<= ] [ swap class<= ] 2bi and ;
|
[ class<= ] [ swap class<= ] 2bi and ;
|
||||||
|
|
||||||
|
ERROR: topological-sort-failed ;
|
||||||
|
|
||||||
: largest-class ( seq -- n elt )
|
: largest-class ( seq -- n elt )
|
||||||
dup [ [ class< ] with any? not ] curry find-last
|
dup [ [ class< ] with any? not ] curry find-last
|
||||||
[ "Topological sort failed" throw ] unless* ;
|
[ topological-sort-failed ] unless* ;
|
||||||
|
|
||||||
: sort-classes ( seq -- newseq )
|
: sort-classes ( seq -- newseq )
|
||||||
[ name>> ] sort-with >vector
|
[ name>> ] sort-with >vector
|
||||||
|
|
|
@ -24,9 +24,11 @@ ERROR: bad-effect ;
|
||||||
: parse-effect-tokens ( end -- tokens )
|
: parse-effect-tokens ( end -- tokens )
|
||||||
[ parse-effect-token dup ] curry [ ] produce nip ;
|
[ parse-effect-token dup ] curry [ ] produce nip ;
|
||||||
|
|
||||||
|
ERROR: stack-effect-omits-dashes effect ;
|
||||||
|
|
||||||
: parse-effect ( end -- effect )
|
: parse-effect ( end -- effect )
|
||||||
parse-effect-tokens { "--" } split1 dup
|
parse-effect-tokens { "--" } split1 dup
|
||||||
[ <effect> ] [ "Stack effect declaration must contain --" throw ] if ;
|
[ <effect> ] [ drop stack-effect-omits-dashes ] if ;
|
||||||
|
|
||||||
: complete-effect ( -- effect )
|
: complete-effect ( -- effect )
|
||||||
"(" expect ")" parse-effect ;
|
"(" expect ")" parse-effect ;
|
||||||
|
|
|
@ -208,9 +208,11 @@ SYMBOL: predicate-engines
|
||||||
: keep-going? ( assoc -- ? )
|
: keep-going? ( assoc -- ? )
|
||||||
assumed get swap second first class<= ;
|
assumed get swap second first class<= ;
|
||||||
|
|
||||||
|
ERROR: unreachable ;
|
||||||
|
|
||||||
: prune-redundant-predicates ( assoc -- default assoc' )
|
: prune-redundant-predicates ( assoc -- default assoc' )
|
||||||
{
|
{
|
||||||
{ [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] }
|
{ [ dup empty? ] [ drop [ unreachable ] { } ] }
|
||||||
{ [ dup length 1 = ] [ first second { } ] }
|
{ [ dup length 1 = ] [ first second { } ] }
|
||||||
{ [ dup keep-going? ] [ rest-slice prune-redundant-predicates ] }
|
{ [ dup keep-going? ] [ rest-slice prune-redundant-predicates ] }
|
||||||
[ [ first second ] [ rest-slice ] bi ]
|
[ [ first second ] [ rest-slice ] bi ]
|
||||||
|
|
|
@ -48,9 +48,11 @@ GENERIC: (log2) ( x -- n ) foldable
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
ERROR: log2-expects-positive x ;
|
||||||
|
|
||||||
: log2 ( x -- n )
|
: log2 ( x -- n )
|
||||||
dup 0 <= [
|
dup 0 <= [
|
||||||
"log2 expects positive inputs" throw
|
log2-expects-positive
|
||||||
] [
|
] [
|
||||||
(log2)
|
(log2)
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
|
@ -281,9 +281,11 @@ INSTANCE: repetition immutable-sequence
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
ERROR: integer-length-expected obj ;
|
||||||
|
|
||||||
: check-length ( n -- n )
|
: check-length ( n -- n )
|
||||||
#! Ricing.
|
#! Ricing.
|
||||||
dup integer? [ "length not an integer" throw ] unless ; inline
|
dup integer? [ integer-length-expected ] unless ; inline
|
||||||
|
|
||||||
: ((copy)) ( dst i src j n -- dst i src j n )
|
: ((copy)) ( dst i src j n -- dst i src j n )
|
||||||
dup -roll [
|
dup -roll [
|
||||||
|
|
Loading…
Reference in New Issue