wingo pushed a commit to branch master in repository guile. commit 16ed2aee88f017c8223aef38bbf9606bd817dc35 Author: Andy Wingo <wi...@pobox.com> Date: Mon Nov 27 15:03:23 2017 +0100
Enable lsh/immediate, rsh/immediate specialization * module/language/cps/specialize-numbers.scm (specialize-operations): Fix typo in match syntax preventing us from optimizing the immediate variants of lsh and rsh, and typo also in specialize-unop argument order. --- module/language/cps/specialize-numbers.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm index a0c4b15..7df5f2a 100644 --- a/module/language/cps/specialize-numbers.scm +++ b/module/language/cps/specialize-numbers.scm @@ -534,7 +534,7 @@ BITS indicating the significant bits needed for a variable. BITS may be (setk label ($kargs names vars ,body))))) (((or 'add/immediate 'sub/immediate 'mul/immediate) - (? u64-result?) (? u64-parameter? b) (? u64-operand? a)) + (? u64-result?) (? u64-parameter?) (? u64-operand? a)) (let ((op (match op ('add/immediate 'uadd/immediate) ('sub/immediate 'usub/immediate) @@ -546,7 +546,7 @@ BITS indicating the significant bits needed for a variable. BITS may be (setk label ($kargs names vars ,body))))) (((or 'add/immediate 'sub/immediate 'mul/immediate) - (? s64-result?) (? s64-parameter? b) (? s64-operand? a)) + (? s64-result?) (? s64-parameter?) (? s64-operand? a)) (let ((op (match op ('add/immediate 'sadd/immediate) ('sub/immediate 'ssub/immediate) @@ -582,24 +582,24 @@ BITS indicating the significant bits needed for a variable. BITS may be (setk label ($kargs names vars ,body))))) (((or 'lsh/immediate 'rsh/immediate) - (? u64-result?) (? u6-parameter? b) (u64-operand? a)) + (? u64-result?) (? u6-parameter?) (? u64-operand? a)) (let ((op (match op ('lsh/immediate 'ulsh/immediate) ('rsh/immediate 'ursh/immediate)))) (with-cps cps (let$ body (specialize-unop - k src op a param + k src op param a (unbox-u64 a) (box-u64 result))) (setk label ($kargs names vars ,body))))) (((or 'lsh/immediate 'rsh/immediate) - (? s64-result?) (? u6-parameter? b) (s64-operand? a)) + (? s64-result?) (? u6-parameter?) (? s64-operand? a)) (let ((op (match op ('lsh/immediate 'slsh/immediate) ('rsh/immediate 'srsh/immediate)))) (with-cps cps (let$ body (specialize-unop - k src op a param + k src op param a (unbox-s64 a) (box-s64 result))) (setk label ($kargs names vars ,body)))))