working on inference

diff --git a/library/cons.factor b/library/cons.factor
index 2d06641276f8239d22c60640f99fd909f91f69ea..32030f550847e083f4cce15eced80038d7807079 100644 (file)
--- a/library/cons.factor
+++ b/library/cons.factor
@@ -43,3 +43,9 @@ IN: lists USE: kernel USE: stack
 : unswons ( [ car | cdr ] -- cdr car )
     #! Push both the head and tail of a list.
     dup cdr swap car ; inline
+
+: 2car ( cons cons -- car car )
+    swap car swap car ;
+
+: 2cdr ( cons cons -- car car )
+    swap cdr swap cdr ;

diff --git a/library/lists.factor b/library/lists.factor
index 2e3971e5208440954dc0a50834f58a46794de66c..fbd172069b5db0fe93329bcc32f5bdccdc32ce3e 100644 (file)
--- a/library/lists.factor
+++ b/library/lists.factor
@@ -205,14 +205,15 @@ DEFER: tree-contains?
 : count ( n -- [ 0 ... n-1 ] )
     [ ] (count) ;
 
-: car= swap car swap car = ;
-: cdr= swap cdr swap cdr = ;
-
 : cons= ( obj cons -- ? )
     2dup eq? [
         2drop t
     ] [
-        over cons? [ 2dup car= >r cdr= r> and ] [ 2drop f ] ifte
+        over cons? [
+            2dup 2car = >r 2cdr = r> and
+        ] [
+            2drop f
+        ] ifte
     ] ifte ;
 
 : (cons-hashcode) ( cons count -- hash )

diff --git a/library/test/inference.factor b/library/test/inference.factor
index bed403414e14e5283722fad84c50cb962a1f7d89..a2a7db205542b5b945cbbfef8f462945b4018e71 100644 (file)
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -1,6 +1,7 @@
 IN: scratchpad
 USE: test
 USE: inference
+USE: math
 USE: stack
 USE: combinators
 USE: vectors
@@ -33,3 +34,10 @@ USE: vectors
         ] ifte
     ] infer
 ] unit-test
+
+[ [ 1 | 1 ] ] [ [ dup [ ] when ] infer ] unit-test
+[ [ 1 | 1 ] ] [ [ dup [ dup fixnum* ] when ] infer ] unit-test
+[ [ 2 | 1 ] ] [ [ [ dup fixnum* ] when ] infer ] unit-test
+
+[ [ 1 | 0 ] ] [ [ [ drop ] when* ] infer ] unit-test
+[ [ 1 | 1 ] ] [ [ [ { { [ ] } } ] unless* ] infer ] unit-test

diff --git a/library/tools/inference.factor b/library/tools/inference.factor
index d8c2a03ec374e24d646d84704ed1017ef22508aa..0af50d9c0018b4f2e891334dc602f39b0b6493fd 100644 (file)
--- a/library/tools/inference.factor
+++ b/library/tools/inference.factor
@@ -104,7 +104,7 @@ DEFER: (infer)
         drop dup compound? [
             word-parameter (infer)
         ] [
-            drop no-effect
+            no-effect
         ] ifte
     ] ifte ;
 
@@ -124,22 +124,26 @@ DEFER: (infer)
     #! Stack effect of a quotation.
     [ init-inference (infer)  effect ] with-scope ;
 
-: infer-branch ( quot -- in-d datastack )
+: infer-branch ( quot -- [ in-d |  datastack ] )
     [
         copy-interpreter (infer)
-        d-in get  meta-d get
+        d-in get  meta-d get cons
     ] with-scope ;
 
-: unify ( in stack in stack -- )
-    swapd 2dup vector-length= [
-        drop meta-d set
-        2dup = [
-            drop d-in set
-        ] [
-            "Unbalanced ifte inputs" throw
-        ] ifte
+: difference ( [ in | stack ] -- diff )
+    uncons vector-length - ;
+
+: balanced? ( [ in | stack ] [ in | stack ] -- ? )
+    difference swap difference = ;
+
+: unify-stacks ( stack stack -- stack )
+    swap vector-length swap vector-length max gensym-vector ;
+
+: unify ( [ in | stack ] [ in | stack ] -- )
+    2dup balanced? [
+        2dup 2car max d-in set 2cdr unify-stacks meta-d set
     ] [
-        "Unbalanced ifte outputs" throw
+        "Unbalanced ifte branches" throw
     ] ifte ;
 
 : infer-ifte ( -- )
@@ -172,6 +176,10 @@ DEFER: (infer)
 \ rot t "meta-infer" set-word-property
 \ rot [ 3 | 3 ] "infer-effect" set-word-property
 
+\ fixnum+ [ 2 | 1 ] "infer-effect" set-word-property
+\ fixnum- [ 2 | 1 ] "infer-effect" set-word-property
+\ fixnum* [ 2 | 1 ] "infer-effect" set-word-property
+
 \ vector-nth [ 2 | 1 ] "infer-effect" set-word-property
 \ set-vector-nth [ 3 | 0 ] "infer-effect" set-word-property
 \ vector-length [ 1 | 1 ] "infer-effect" set-word-property

diff --git a/library/vocabularies.factor b/library/vocabularies.factor
index f04957e790b7e5076809ea4269f9b9c4ee303d10..81f431e888fea31ed5634ddb530806de2f29200a 100644 (file)
--- a/library/vocabularies.factor
+++ b/library/vocabularies.factor
@@ -63,6 +63,7 @@ USE: strings
         "errors"
         "files"
         "hashtables"
+        "inference"
         "inferior"
         "interpreter"
         "inspector"
@@ -84,7 +85,6 @@ USE: strings
         "syntax"
         "test"
         "threads"
-        "trace"
         "unparser"
         "vectors"
         "vocabularies"