cleanup quicksort, thread safety fix

TODO.FACTOR.txt

@@ -1,6 +1,5 @@
 + inference/interpreter:
 
-- word links in stepper
 - : bin 5 [ 5 bin bin 5 ] [ 2drop ] ifte ;
 - combinator inference
 - generic/2generic inference
@@ -31,6 +30,7 @@
 
 + listener/plugin:
 
+- gracefully handle non-working cfactor
 - accept multi-line input in listener
 - don't show listener on certain commands
 - NPE in ErrorHighlight
@@ -63,10 +63,8 @@
 - jedit ==> jedit-word, jedit takes a file name
 - command line parsing cleanup
 - nicer way to combine two paths
-- :get &get
+- catchstack lists
-- namestack, catchstack lists
 - OOP
-- room. prints code heap size
 - refactor sort
 - ditch object paths
 - browser responder for word links in HTTPd; inspect responder for

doc/new-guide.tex

@@ -899,17 +899,18 @@ Test if a value is a proper list.\\
 
 \section{The interpreter}
 
+\chapkeywords{acons >r r>}
 \index{\texttt{acons}}
 \index{\texttt{>r}}
 \index{\texttt{r>}}
 
 So far, we have seen what we called ``the stack'' store intermediate values between computations. In fact Factor maintains a number of other stacks, and the formal name for the stack we've been dealing with so far is the \emph{data stack}.
 
-Another fundamental stack is the \emph{call stack}. It is used to save interpreter state for nested calls.
+Another fundamental stack is the \emph{return stack}. It is used to save interpreter state for nested calls.
 
-You have probably noticed that code quotations are just lists. At a low level, each colon definition is also just a quotation. The interpreter consists of a loop that iterates a quotation, pushing each literal, and executing each word. If the word is a colon definition, the interpreter saves its state on the call stack, executes the definition of that word, then restores the execution state from the call stack and continues.
+You have probably noticed that code quotations are just lists. At a low level, each colon definition is also just a quotation. The interpreter consists of a loop that iterates a quotation, pushing each literal, and executing each word. If the word is a colon definition, the interpreter saves its state on the return stack, executes the definition of that word, then restores the execution state from the return stack and continues.
 
-The call stack also serves a dual purpose as a temporary storage area. Sometimes, juggling values on the data stack becomes ackward, and in that case \texttt{>r} and \texttt{r>} can be used to move a value from the data stack to the call stack, and vice versa, respectively.
+The return stack also serves a dual purpose as a temporary storage area. Sometimes, juggling values on the data stack becomes ackward, and in that case \texttt{>r} and \texttt{r>} can be used to move a value from the data stack to the return stack, and vice versa, respectively.
 
 A simple example can be found in the definition of the \texttt{acons} word:
 
@@ -929,9 +930,28 @@ Note that usages of \texttt{>r} and \texttt{r>} must be balanced within a single
 : the-ugly r> ;
 \end{verbatim}
 
-Basically, the rule is you must leave the call stack in the same state as you found it so that when the current quotation finishes executing, the interpreter can continue executing without seeing your data on the call stack.
+Basically, the rule is you must leave the return stack in the same state as you found it so that when the current quotation finishes executing, the interpreter can return to the calling word.
+
+One exception is that when \texttt{ifte} occurs as the last word in a definition, values may be pushed on the return stack before the condition value is computed, as long as both branches of the \texttt{ifte} pop the values off the return stack before returning.
+
+Lets review the words we saw in this chapter:
+
+\wordtable{
+\tabvocab{lists}
+\texttt{acons}&
+\texttt{( value key alist -{}- alist )}&
+Add a key/value pair to the association list.\\
+\tabvocab{stack}
+\texttt{>r}&
+\texttt{( obj -{}- r:obj )}&
+Move value to return stack..\\
+\texttt{r>}&
+\texttt{( r:obj -{}- obj )}&
+Move value from return stack..\\
+}
+
+\section{Word definitions}
 
-One exception is that when \texttt{ifte} occurs as the last word in a definition, values may be pushed on the call stack before the condition value is computed, as long as both branches of the \texttt{ifte} pop the values off the callstack before returning.
 
 \section{Recursive combinators}
 
@@ -1232,6 +1252,16 @@ BIN: 11111 -2 shift .b
 
 The attentive reader will notice that shifting to the left is equivalent to multiplying by a power of two, and shifting to the right is equivalent to performing a truncating division by a power of two.
 
+\chapter{Working with state}
+
+\section{Building lists and strings}
+
+\chapkeywords{make-string make-list ,}
+\index{\texttt{make-string}}
+\index{\texttt{make-list}}
+\index{\texttt{make-,}}
+
+
 \input{new-guide.ind}
 
 \end{document}

factor/ExternalFactor.java

@@ -158,6 +158,15 @@ public class ExternalFactor extends DefaultVocabularyLookup
 		{
 			/* don't care about response */
 			sendEval("0 exit*");
+		}
+		catch(Exception e)
+		{
+			// We don't care...
+			Log.log(Log.DEBUG,this,e);
+		}
+		
+		try
+		{
 			in.close();
 			out.close();
 		}

factor/jedit/FactorPlugin.java

@@ -79,7 +79,7 @@ public class FactorPlugin extends EditPlugin
 	 * Returns the object representing a connection to an external Factor instance.
 	 * It will start the interpreter if it's not already running.
 	 */
-	public static ExternalFactor getExternalInstance()
+	public synchronized static ExternalFactor getExternalInstance()
 		throws IOException, UnsupportedEncodingException
 	{
 		if(external == null)

library/lists.factor

@@ -43,6 +43,8 @@ USE: vectors
     over [ >r uncons r> append cons ] [ nip ] ifte ;
 
 : contains? ( element list -- remainder )
+    #! Push remainder of list from first occurrence of element,
+    #! or f.
     dup [
         2dup car = [ nip ] [ cdr contains? ] ifte
     ] [
@@ -50,67 +52,54 @@ USE: vectors
     ] ifte ;
 
 : nth ( n list -- list[n] )
-    #! Push the nth element of a proper list.
+    #! nth element of a proper list.
     #! Supplying n <= 0 pushes the first element of the list.
     #! Supplying an argument beyond the end of the list raises
     #! an error.
     swap [ cdr ] times car ;
 
 : last* ( list -- last )
-    #! Pushes last cons of a list.
+    #! Last cons of a list.
     dup cdr cons? [ cdr last* ] when ;
 
 : last ( list -- last )
+    #! Last element of a list.
     last* car ;
 
+: tail ( list -- tail )
+    #! Return the cdr of the last cons cell, or f.
+    dup [ last* cdr ] when ;
+
 : list? ( list -- ? )
     #! Proper list test. A proper list is either f, or a cons
     #! cell whose cdr is a proper list.
-    dup [
+    dup cons? [ tail ] when not ;
-        dup cons? [ cdr list? ] [ drop f ] ifte
-    ] [
-        drop t
-    ] ifte ;
 
 : partition-add ( obj ? ret1 ret2 -- ret1 ret2 )
-    >r >r [ r> cons r> ] [ r> swap r> cons ] ifte ; inline
+    rot [ >r cons r> ] [ swapd cons ] ifte ; inline
 
-: partition-step ( ret1 ret2 ref combinator car -- ret1 ret2 )
+: partition-step ( list combinator -- cdr combinator car ? )
-    >r rot >r rot r> r> -rot >r >r dup >r swap call r> swap r> r>
+    over car over call >r >r unswons r> swap r> ; inline
-    partition-add ; inline
 
-: partition-iter ( ret1 ret2 ref combinator list -- ret1 ret2 )
+: (partition) ( list combinator ret1 ret2 -- ret1 ret2 )
-    dup [
+    >r >r  over [
-        3dup cdr >r >r >r
+        partition-step  r> r> partition-add  (partition)
-        car partition-step
-        r> r> r> partition-iter
     ] [
-        3drop
+        2drop  r> r>
     ] ifte ; inline
 
-: partition ( ref list combinator -- list1 list2 )
+: partition ( list ref combinator -- list1 list2 )
-    #! Compare each element in a proper list against a
-    #! reference element using a combinator. The combinator's
-    #! return value determines if the element is prepended to
-    #! the first or second list.
     #! The combinator must have stack effect:
     #! ( ref element -- ? )
-    swap >r >r >r [ ] [ ] r> r> r> partition-iter ;
+    cons [ ] [ ] (partition) ; inline
-    inline
 
 : sort ( list comparator -- sorted )
-    #! Sort the elements in a proper list using a comparator.
+    #! To sort in ascending order, comparator must have stack
-    #! The comparator must have stack effect:
+    #! effect ( x y -- x>y ).
-    #! ( x y -- ? )
-    #! To sort elements in descending order, return t if x < y.
-    #! To sort elements in ascending order, return t if x > y.
     over [
-        ! Partition
+        ( Partition ) [ >r uncons over r> partition ] keep
-        dup >r >r uncons dupd r> partition r>
+        ( Recurse ) [ sort swap ] keep sort
-        ! Recurse
+        ( Combine ) swapd cons append
-        tuck sort >r sort swap r>
-        ! Combine
-        cons append
     ] [
         drop
     ] ifte ; inline

library/math/arithmetic.factor

@@ -57,7 +57,7 @@ USE: stack
     #! by swapping them.
     2dup > [ swap ] when  >r dupd max r> min = ;
 
-: sq dup * ; inline recursive-infer
+: sq dup * ; inline
 
 : pred 1 - ; inline
 : succ 1 + ; inline

library/test/inference.factor

@@ -146,5 +146,17 @@ DEFER: foe
 [ [ 2 | 1 ] ] [ [ /i ] infer ] unit-test
 [ [ 2 | 1 ] ] [ [ /f ] infer ] unit-test
 [ [ 2 | 2 ] ] [ [ /mod ] infer ] unit-test
-
+[ [ 2 | 1 ] ] [ [ + ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ - ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ * ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ / ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ < ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ <= ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ > ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ >= ] infer ] unit-test
 [ [ 2 | 1 ] ] [ [ number= ] infer ] unit-test
+
+[ [ 2 | 1 ] ] [ [ = ] infer ] unit-test
+
+[ [ 1 | 0 ] ] [ [ >n ] infer ] unit-test
+[ [ 0 | 1 ] ] [ [ n> ] infer ] unit-test

library/test/lists/combinators.factor

@@ -19,6 +19,9 @@ USE: strings
 
 [ [ 43 "a" [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
 
+[ "fdsfs" num-sort ] unit-test-fails
+[ [ ] ] [ [ ] num-sort ] unit-test
+[ [ "2 + 2" ] ] [ [ "2 + 2" ] [ str-lexi> ] sort ] unit-test
 [ [ 1 2 3 4 5 6 7 ] ] [ [ 6 4 5 7 2 1 3 ] num-sort ] unit-test
 
 [ f ] [ [ { } { } "Hello" ] all=? ] unit-test

library/tools/inference.factor

@@ -43,7 +43,6 @@ USE: hashtables
 ! Word properties that affect inference:
 ! - infer-effect -- must be set. controls number of inputs
 ! expected, and number of outputs produced.
-! - meta-infer -- evaluate word in meta-interpreter if set.
 ! - infer - quotation with custom inference behavior; ifte uses
 ! this. Word is passed on the stack.
 ! - recursive-infer - if true, inferencer will always invoke
@@ -92,24 +91,16 @@ SYMBOL: entry-effect
 : consume/produce ( [ in | out ] -- )
     unswons dup ensure-d consume-d produce-d ;
 
-: standard-effect ( word [ in | out ] -- )
+: apply-effect ( word [ in | out ] -- )
     #! If a word does not have special inference behavior, we
     #! either execute the word in the meta interpreter (if it is
     #! side-effect-free and all parameters are literal), or
     #! simply apply its stack effect to the meta-interpreter.
-    over "meta-infer" word-property [
-        drop host-word
-    ] [
-        nip consume/produce
-    ] ifte ;
-
-: apply-effect ( word [ in | out ] -- )
-    #! Helper word for apply-word.
     dup car ensure-d
-    over "infer" word-property dup [
+    swap "infer" word-property dup [
-        nip nip call
+        nip call
     ] [
-        drop standard-effect
+        drop consume/produce
     ] ifte ;
 
 : no-effect ( word -- )
@@ -301,6 +292,10 @@ DEFER: (infer)
     #! Stack effect of a quotation.
     [ init-inference (infer)  effect ] with-scope ;
 
+: meta-infer ( word -- )
+    #! Mark a word as being partially evaluated.
+    dup unit [ car meta-word ] cons  "infer" set-word-property ;
+
 \ call [ pop-d (infer) ] "infer" set-word-property
 \ ifte [ infer-ifte ] "infer" set-word-property
 
@@ -313,11 +308,16 @@ DEFER: (infer)
 \ >r [ pop-d push-r ] "infer" set-word-property
 \ r> [ pop-r push-d ] "infer" set-word-property
 
-\ drop  t "meta-infer" set-word-property
+\ drop meta-infer
-\ dup  t "meta-infer" set-word-property
+\ dup meta-infer
-\ swap t "meta-infer" set-word-property
+\ swap meta-infer
-\ over t "meta-infer" set-word-property
+\ over meta-infer
-\ pick t "meta-infer" set-word-property
+\ pick meta-infer
-\ nip t "meta-infer" set-word-property
+\ nip meta-infer
-\ tuck t "meta-infer" set-word-property
+\ tuck meta-infer
-\ rot t "meta-infer" set-word-property
+\ rot meta-infer
+
+\ + [ 2 | 1 ] "infer-effect" set-word-property
+\ - [ 2 | 1 ] "infer-effect" set-word-property
+\ * [ 2 | 1 ] "infer-effect" set-word-property
+\ / [ 2 | 1 ] "infer-effect" set-word-property