diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor index fceee5a75d..851aae4798 100644 --- a/basis/math/partial-dispatch/partial-dispatch.factor +++ b/basis/math/partial-dispatch/partial-dispatch.factor @@ -1,10 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel kernel.private math math.private -math.functions math.functions.private sequences parser -namespaces make assocs quotations arrays generic generic.math -hashtables effects compiler.units classes.algebra fry -combinators words ; +USING: accessors arrays assocs classes.algebra combinators +compiler.units fry generic generic.math hashtables kernel make +math math.private namespaces quotations sequences words ; IN: math.partial-dispatch PREDICATE: math-partial < word @@ -53,35 +51,21 @@ M: word integer-op-input-classes '[ [ fixnum>bignum ] dip _ execute ] ; : integer-fixnum-op-quot ( fix-word big-word -- quot ) - [ - [ over fixnum? ] % - [ '[ _ execute ] , ] [ bignum-fixnum-op-quot , ] bi* \ if , - ] [ ] make ; + bignum-fixnum-op-quot '[ over fixnum? [ _ execute ] _ if ] ; : fixnum-integer-op-quot ( fix-word big-word -- quot ) - [ - [ dup fixnum? ] % - [ '[ _ execute ] , ] [ fixnum-bignum-op-quot , ] bi* \ if , - ] [ ] make ; + fixnum-bignum-op-quot '[ dup fixnum? [ _ execute ] _ if ] ; : integer-bignum-op-quot ( big-word -- quot ) - [ - [ over fixnum? ] % - [ fixnum-bignum-op-quot , ] [ '[ _ execute ] , ] bi \ if , - ] [ ] make ; + [ fixnum-bignum-op-quot ] keep + '[ over fixnum? _ [ _ execute ] if ] ; : integer-integer-op-quot ( fix-word big-word -- quot ) - [ - [ 2dup both-fixnums? ] % - [ '[ _ execute ] , ] - [ - [ - [ dup fixnum? ] % - [ bignum-fixnum-op-quot , ] - [ integer-bignum-op-quot , ] bi \ if , - ] [ ] make , - ] bi* \ if , - ] [ ] make ; + [ bignum-fixnum-op-quot ] [ integer-bignum-op-quot ] bi + '[ + 2dup both-fixnums? + [ _ execute ] [ dup fixnum? _ _ if ] if + ] ; : integer-op-word ( triple -- word ) [ name>> ] map "-" join "math.partial-dispatch" create-word ;