Fix some code duplication

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 3850f31aa4797952b3c1cb5b25f9e710a4c2570b..d990f610a0241de66453aa6da7322ce7aa29a7df 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,8 +1,9 @@
 - workspace window takes too long to come up
+- bogus compile error
+- live search: timer delay would be nice
 
 + 0.87:
 
-- live search: timer delay would be nice
 - menu should stay up if mouse button released
 - roundoff is still not quite right with tracks
 - grid displays quickly now, but constructing large amounts of gadgets

diff --git a/contrib/benchmarks/hashtables.factor b/contrib/benchmarks/hashtables.factor
index 538efae30cd7b59e7d9aab01c289a23662f90d13..44e0a615ca75f8dff3872490556469ed7037d9a9 100644 (file)
--- a/contrib/benchmarks/hashtables.factor
+++ b/contrib/benchmarks/hashtables.factor
@@ -14,7 +14,6 @@ sequences strings test ;
         drop
         [
             [
-                ( hash elt -- )
                 hash-bench-step
             ] each-with
         ] 2keep

diff --git a/library/compiler/alien/alien-indirect.factor b/library/compiler/alien/alien-indirect.factor
index 72590c50439ac2dd9917a86bf4c2315d8c2b210b..83b6ece28f1928bd189ccabb407dc88829f79a96 100644 (file)
--- a/library/compiler/alien/alien-indirect.factor
+++ b/library/compiler/alien/alien-indirect.factor
@@ -7,6 +7,10 @@ kernel namespaces sequences strings words parser prettyprint ;
 TUPLE: alien-indirect return parameters abi ;
 C: alien-indirect make-node ;
 
+M: alien-indirect alien-invoke-parameters alien-indirect-parameters ;
+M: alien-indirect alien-invoke-return alien-indirect-return ;
+M: alien-indirect alien-invoke-abi alien-indirect-abi ;
+
 TUPLE: alien-indirect-error ;
 
 : alien-indirect ( funcptr args... return parameters abi -- )
@@ -18,6 +22,10 @@ M: alien-indirect-error summary
 \ alien-indirect [ string object string ] [ ] <effect>
 "inferred-effect" set-word-prop
 
+: alien-indirect-stack ( node -- )
+    1 over consume-values
+    alien-invoke-stack ;
+
 \ alien-indirect [
     empty-node <alien-indirect>
     pop-literal nip over set-alien-indirect-abi
@@ -25,22 +33,16 @@ M: alien-indirect-error summary
     pop-literal nip over set-alien-indirect-return
     dup alien-indirect-parameters
     make-prep-quot 1 make-dip infer-quot
-    node,
+    dup node,
+    alien-indirect-stack
 ] "infer" set-word-prop
 
-: generate-indirect-cleanup ( node -- )
-    dup alien-indirect-abi "stdcall" = [
-        drop
-    ] [
-        alien-indirect-parameters stack-space %cleanup
-    ] if ;
-
 M: alien-indirect generate-node
     end-basic-block
     %prepare-alien-indirect
     dup alien-indirect-parameters objects>registers
     %alien-indirect
-    dup generate-indirect-cleanup
+    dup generate-invoke-cleanup
     alien-indirect-return box-return
     iterate-next ;
 

diff --git a/library/compiler/alien/alien-invoke.factor b/library/compiler/alien/alien-invoke.factor
index 26bd931677cc7c00d529f84f9da937c377909474..2f6de781e1c884c53bb82992453a36309d69bc3a 100644 (file)
--- a/library/compiler/alien/alien-invoke.factor
+++ b/library/compiler/alien/alien-invoke.factor
@@ -6,6 +6,12 @@ inference io kernel kernel-internals math namespaces parser
 prettyprint sequences strings words ;
 
 TUPLE: alien-invoke library function return parameters ;
+
+GENERIC: alien-invoke-abi
+
+M: alien-invoke alien-invoke-abi
+    alien-invoke-library library-abi ;
+
 C: alien-invoke make-node ;
 
 : alien-invoke-stack ( node -- )
@@ -59,7 +65,7 @@ M: alien-invoke-error summary
     [ ] [ f swap c-type c-type-box ] if-void ;
 
 : generate-invoke-cleanup ( node -- )
-    dup alien-invoke-library library-abi "stdcall" = [
+    dup alien-invoke-abi [
         drop
     ] [
         alien-invoke-parameters stack-space %cleanup

diff --git a/library/compiler/inference/words.factor b/library/compiler/inference/words.factor
index 4cf0a69fe31ace73ef220d76664c78108a230768..d75b9dadeffab5227b30ec097c18becb52d50ed2 100644 (file)
--- a/library/compiler/inference/words.factor
+++ b/library/compiler/inference/words.factor
@@ -118,9 +118,13 @@ TUPLE: effect-error word effect ;
     "inferred-effect" set-word-prop ;
 
 : finish-word ( word -- effect vars )
-    current-effect 2dup check-effect
-    inferred-vars get
-    [ save-inferred-data ] 2keep ;
+    current-effect inferred-vars get
+    pick custom-infer? [
+        rot drop
+    ] [
+        >r 2dup check-effect r>
+        [ save-inferred-data ] 2keep
+    ] if ;
 
 M: compound infer-word
     [ dup infer-compound [ finish-word ] bind ]

diff --git a/library/compiler/test/alien.factor b/library/compiler/test/alien.factor
index c7d417e107bef498a18da2249d1b3b744a2e37fe..955e6b242cd77fe06b03e3f7073b872e6e61565e 100644 (file)
--- a/library/compiler/test/alien.factor
+++ b/library/compiler/test/alien.factor
@@ -1,6 +1,8 @@
 IN: temporary
 USING: alien compiler kernel namespaces namespaces test
-sequences ;
+sequences inference errors ;
+
+[ t ] [ [ [ alien-indirect ] infer ] catch inference-error? ] unit-test
 
 FUNCTION: void ffi_test_0 ;
 [ ] [ ffi_test_0 ] unit-test