From f331a9241eb62ccbe4f612c09e5d2ebe33780649 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 13 Aug 2005 03:54:29 +0000 Subject: [PATCH] fix node splitter bug, fix typos in identities --- library/alien/compiler.factor | 6 +- library/bootstrap/boot-stage2.factor | 16 ---- library/bootstrap/boot-stage3.factor | 1 - library/inference/call-optimizers.factor | 110 +++++++++++++++++++++-- library/inference/inline-methods.factor | 2 +- library/inference/known-words.factor | 6 +- library/inference/optimizer.factor | 8 +- library/inference/split-nodes.factor | 11 +-- library/test/compiler/optimizer.factor | 6 ++ 9 files changed, 127 insertions(+), 39 deletions(-) diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index 97277c4254..39032cedf8 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -159,8 +159,8 @@ M: compound (uncrossref) dup f "infer-effect" set-word-prop dup f "base-case" set-word-prop dup f "no-effect" set-word-prop - dup f "inline" set-word-prop - dup f "foldable" set-word-prop - dup f "flushable" set-word-prop + ! dup f "inline" set-word-prop + ! dup f "foldable" set-word-prop + ! dup f "flushable" set-word-prop decompile ] ifte ; diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index df106bac85..5d0f3e24cd 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -4,22 +4,6 @@ USING: alien assembler command-line compiler errors generic hashtables io kernel lists memory namespaces parser sequences unparser words ; -: restarts. ( menu -- ) - "Restarts:" print - dup length [ unparse print ". " write first print ] 2each - "> " write flush - ; - -: try-resource ( path -- ) - "Loading " write dup print - [ - run-resource - ] [ - [ - "Error loading resource. Restarts:" print - ] when* - ] catch ; - : pull-in ( ? list -- ) swap [ [ diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor index 7b3d2703b8..0bfe7cfea8 100644 --- a/library/bootstrap/boot-stage3.factor +++ b/library/bootstrap/boot-stage3.factor @@ -35,7 +35,6 @@ init-assembler compile? [ \ car compile \ * compile - \ length compile \ = compile \ unparse compile \ scan compile diff --git a/library/inference/call-optimizers.factor b/library/inference/call-optimizers.factor index dd32d8eff5..ba7ab5518b 100644 --- a/library/inference/call-optimizers.factor +++ b/library/inference/call-optimizers.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: inference -USING: errors hashtables kernel sequences vectors words ; +USING: errors hashtables kernel math math-internals sequences +vectors words ; ! A system for associating dataflow optimizers with words. @@ -57,9 +58,108 @@ M: #call optimize-node* ( node -- node/t ) { [ t ] [ drop t ] } } cond ; +! Arithmetic identities SYMBOL: @ -: values-match? ( spec values -- ? ) - #! spec is a sequence of literals, or the symbol @ which is - #! a wildcard. - [ dup literal? [ drop @ ] unless = ] 2map conjunction ; +: define-identities ( words identities -- ) + swap [ swap "identities" set-word-prop ] each-with ; + +: literals-match? ( values template -- ? ) + [ + over literal? [ >r literal-value r> ] [ nip @ ] ifte = + ] 2map conjunction ; + +: values-match? ( values template -- ? ) + [ @ = ] 2map [ ] subset [ eq? ] every? ; + +: apply-identity? ( values identity -- ? ) + first 2dup literals-match? >r values-match? r> and ; + +: apply-identities ( values identities -- node/f ) + dupd [ apply-identity? ] find-with nip dup + [ second swap dataflow-with ] [ 2drop f ] ifte ; + +[ + fixnum+ bignum+ float+ ] { + { { @ 0 } [ drop ] } + { { 0 @ } [ nip ] } +} define-identities + +[ - fixnum- bignum- float- ] { + { { @ 0 } [ drop ] } + { { @ @ } [ 2drop 0 ] } +} define-identities + +[ * fixnum* bignum* float* ] { + { { @ 1 } [ drop ] } + { { 1 @ } [ nip ] } + { { @ 0 } [ 2drop 0 ] } + { { 0 @ } [ 2drop 0 ] } + { { @ -1 } [ drop 0 swap - ] } + { { -1 @ } [ nip 0 swap - ] } +} define-identities + +[ / /i /f fixnum/i fixnum/f bignum/i bignum/f float/f ] { + { { @ 1 } [ drop ] } + { { @ -1 } [ drop 0 swap - ] } +} define-identities + +[ rem mod fixnum-mod bignum-mod ] { + { { @ 1 } [ 2drop 0 ] } +} define-identities + +! [ ^ ] { +! { { 1 @ } [ 2drop 1 ] } +! { { @ 1 } [ drop ] } +! { { @ 2 } [ drop dup * ] } +! { { @ -1 } [ drop 1 swap / ] } +! { { @ -2 } [ drop dup * 1 swap / ] } +! } define-identities + +[ bitand fixnum-bitand bignum-bitand ] { + { { @ -1 } [ drop ] } + { { -1 @ } [ nip ] } + { { @ @ } [ drop ] } + { { @ 0 } [ 2drop 0 ] } + { { 0 @ } [ 2drop 0 ] } +} define-identities + +[ bitor fixnum-bitor bignum-bitor ] { + { { @ 0 } [ drop ] } + { { 0 @ } [ nip ] } + { { @ @ } [ drop ] } + { { @ -1 } [ 2drop -1 ] } + { { -1 @ } [ 2drop -1 ] } +} define-identities + +[ bitxor fixnum-bitxor bignum-bitxor ] { + { { @ 0 } [ drop ] } + { { 0 @ } [ nip ] } + { { @ -1 } [ drop bitnot ] } + { { -1 @ } [ nip bitnot ] } + { { @ @ } [ 2drop 0 ] } +} define-identities + +[ shift fixnum-shift bignum-shift ] { + { { 0 @ } [ 2drop 0 ] } + { { @ 0 } [ drop ] } +} define-identities + +[ < fixnum< bignum< float< ] { + { { @ @ } [ 2drop f ] } +} define-identities + +[ <= fixnum<= bignum<= float<= ] { + { { @ @ } [ 2drop t ] } +} define-identities + +[ > fixnum> bignum> float>= ] { + { { @ @ } [ 2drop f ] } +} define-identities + +[ >= fixnum>= bignum>= float>= ] { + { { @ @ } [ 2drop t ] } +} define-identities + +[ eq? number= = ] { + { { @ @ } [ 2drop t ] } +} define-identities diff --git a/library/inference/inline-methods.factor b/library/inference/inline-methods.factor index e9f7c3807f..a190afbf41 100644 --- a/library/inference/inline-methods.factor +++ b/library/inference/inline-methods.factor @@ -57,7 +57,7 @@ M: 2generic dispatching-values drop node-in-d 2 swap tail* ; : inline-method ( node -- node ) dup method-dataflow [ >r node-param r> remember-node - ] 2keep subst-node ; + ] 2keep [ subst-node ] keep ; : related? ( actual testing -- ? ) #! If actual is a subset of testing or if the two classes diff --git a/library/inference/known-words.factor b/library/inference/known-words.factor index cea8d0cb30..3daf154752 100644 --- a/library/inference/known-words.factor +++ b/library/inference/known-words.factor @@ -1,6 +1,7 @@ IN: inference -USING: errors generic interpreter kernel kernel-internals lists -math math-internals parser sequences vectors words ; +USING: errors generic hashtables interpreter kernel +kernel-internals lists math math-internals parser sequences +vectors words ; ! Primitive combinators \ call [ @@ -55,6 +56,7 @@ math math-internals parser sequences vectors words ; \ inference-error t "terminator" set-word-prop \ throw t "terminator" set-word-prop \ = [ [ object object ] [ boolean ] ] "infer-effect" set-word-prop +\ hash-contained? [ [ object object ] [ boolean ] ] "infer-effect" set-word-prop \ gcd [ [ integer integer ] [ integer integer ] ] "infer-effect" set-word-prop \ car [ [ general-list ] [ object ] ] "infer-effect" set-word-prop \ cdr [ [ general-list ] [ object ] ] "infer-effect" set-word-prop diff --git a/library/inference/optimizer.factor b/library/inference/optimizer.factor index 681891dd99..8bedd83213 100644 --- a/library/inference/optimizer.factor +++ b/library/inference/optimizer.factor @@ -71,16 +71,12 @@ M: #ifte optimize-node* ( node -- node ) [ literal-value 0 1 ? static-branch ] [ 2drop t ] ifte ; ! #values/#return -: post-inline ( #return/#values #call/#merge -- node ) - [ >r node-in-d r> node-out-d unify-length ] keep - node-successor [ subst-values ] keep ; - : optimize-fold ( node -- node/t ) #! Optimize #return/#call or #values/#merge, resulting from #! method inlining or branch folding, respectively. - dup node-successor dup [ post-inline ] [ 2drop t ] ifte ; + node-successor [ node-successor ] [ t ] ifte* ; -M: #values optimize-node* ( node -- node ? ) +M: #values optimize-node* ( node -- node/t ) optimize-fold ; M: #return optimize-node* ( node -- node/t ) diff --git a/library/inference/split-nodes.factor b/library/inference/split-nodes.factor index 0c9f781e27..d9922f2fd7 100644 --- a/library/inference/split-nodes.factor +++ b/library/inference/split-nodes.factor @@ -37,16 +37,17 @@ M: #dispatch split-node* ( node -- ) M: #label split-node* ( node -- ) node-children first split-node ; -: post-inline ( #return #call -- node ) - [ >r node-in-d r> node-out-d ] keep - node-successor [ subst-values ] keep ; +: post-inline ( #return/#values #call/#merge -- ) + [ >r node-in-d r> node-out-d unify-length ] keep + node-successor subst-values ; : subst-node ( old new -- ) - [ last-node set-node-successor ] keep dup split-node ; + [ last-node 2dup swap post-inline set-node-successor ] keep + split-node ; : inline-literals ( node literals -- node ) #! Make #push -> #return -> successor over drop-inputs [ - >r [ literalize ] map dataflow subst-node + >r [ literalize ] map dataflow [ subst-node ] keep r> set-node-successor ] keep ; diff --git a/library/test/compiler/optimizer.factor b/library/test/compiler/optimizer.factor index 3d4092a8bf..a7b9fbbfca 100644 --- a/library/test/compiler/optimizer.factor +++ b/library/test/compiler/optimizer.factor @@ -159,3 +159,9 @@ TUPLE: pred-test ; ] ifte ; compiled [ << pred-test >> "pred-test" ] [ << pred-test >> pred-test-4 ] unit-test + +: inline-test + "nom" = ; compiled + +[ t ] [ "nom" inline-test ] unit-test +[ f ] [ 3 inline-test ] unit-test