From 901bcccc1c6d70e5beeaf96cd0dc32ed40291d21 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 23:25:13 -0600 Subject: [PATCH] Fix remaining text failures --- basis/compiler/compiler.factor | 5 +---- basis/compiler/tests/optimizer.factor | 22 ++++++++++--------- basis/compiler/tests/simple.factor | 4 ++-- .../tree/cleanup/cleanup-tests.factor | 2 +- .../tree/recursive/recursive-tests.factor | 2 +- basis/tools/profiler/profiler-tests.factor | 2 +- 6 files changed, 18 insertions(+), 19 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index d707dff983..f2f4e7aa9e 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -49,7 +49,7 @@ SYMBOL: +failed+ H{ } clone generic-dependencies set f swap compiler-error ; -: fail ( word error -- * ) +: fail ( word error -- ) [ swap compiler-error ] [ drop @@ -112,9 +112,6 @@ t compile-dependencies? set-global : decompile ( word -- ) f 2array 1array modify-code-heap ; -: compile-call ( quot -- ) - [ dup infer define-temp ] with-compilation-unit execute ; - : optimized-recompile-hook ( words -- alist ) [ compile-queue set diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 708d17f3d3..cfeb5d01ac 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -55,7 +55,7 @@ TUPLE: pred-test ; ! regression -: literal-not-branch 0 not [ ] [ ] if ; +: literal-not-branch ( -- ) 0 not [ ] [ ] if ; [ ] [ literal-not-branch ] unit-test @@ -108,12 +108,12 @@ GENERIC: void-generic ( obj -- * ) [ 10 ] [ branch-fold-regression-1 ] unit-test ! another regression -: constant-branch-fold-0 "hey" ; foldable +: constant-branch-fold-0 ( -- value ) "hey" ; foldable : constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline [ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test ! another regression -: foo f ; +: foo ( -- value ) f ; : bar ( -- ? ) foo 4 4 = and ; [ f ] [ bar ] unit-test @@ -134,15 +134,15 @@ M: slice foozul ; ] unit-test ! regression -: constant-fold-2 f ; foldable -: constant-fold-3 4 ; foldable +: constant-fold-2 ( -- value ) f ; foldable +: constant-fold-3 ( -- value ) 4 ; foldable [ f t ] [ [ constant-fold-2 constant-fold-3 4 = ] compile-call ] unit-test -: constant-fold-4 f ; foldable -: constant-fold-5 f ; foldable +: constant-fold-4 ( -- value ) f ; foldable +: constant-fold-5 ( -- value ) f ; foldable [ f ] [ [ constant-fold-4 constant-fold-5 or ] compile-call @@ -247,7 +247,7 @@ USE: binary-search.private [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test -: lift-loop-tail-test-1 ( a quot -- ) +: lift-loop-tail-test-1 ( a quot: ( -- ) -- ) over even? [ [ [ 3 - ] dip call ] keep lift-loop-tail-test-1 ] [ @@ -256,11 +256,13 @@ USE: binary-search.private ] [ [ [ 2 - ] dip call ] keep lift-loop-tail-test-1 ] if - ] if ; inline + ] if ; inline recursive -: lift-loop-tail-test-2 +: lift-loop-tail-test-2 ( -- a b c ) 10 [ ] lift-loop-tail-test-1 1 2 3 ; +\ lift-loop-tail-test-2 must-infer + [ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test ! Forgot a recursive inline check diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index 0fde270eac..d53b864b06 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -18,13 +18,13 @@ IN: compiler.tests [ "hey" ] [ [ "hey" ] compile-call ] unit-test ! Calls -: no-op ; +: no-op ( -- ) ; [ ] [ [ no-op ] compile-call ] unit-test [ 3 ] [ [ no-op 3 ] compile-call ] unit-test [ 3 ] [ [ 3 no-op ] compile-call ] unit-test -: bar 4 ; +: bar ( -- value ) 4 ; [ 4 ] [ [ bar no-op ] compile-call ] unit-test [ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 751a335a13..54f8aaf20e 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -474,7 +474,7 @@ cell-bits 32 = [ ] unit-test ! A reduction -: buffalo-sauce f ; +: buffalo-sauce ( -- value ) f ; : steak ( -- ) buffalo-sauce [ steak ] when ; inline recursive diff --git a/basis/compiler/tree/recursive/recursive-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor index b1f9406092..d548d58bc6 100644 --- a/basis/compiler/tree/recursive/recursive-tests.factor +++ b/basis/compiler/tree/recursive/recursive-tests.factor @@ -87,7 +87,7 @@ compiler.tree.combinators ; ] contains-node? ] unit-test -: blah f ; +: blah ( -- value ) f ; DEFER: a diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index 197ace74d8..5bf62ef156 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -1,6 +1,6 @@ IN: tools.profiler.tests USING: accessors tools.profiler tools.test kernel memory math -threads alien tools.profiler.private sequences compiler.units +threads alien tools.profiler.private sequences compiler words ; [ t ] [