Improves type tuning

erp12 · Dec 2, 2023 · 95daf3b · 95daf3b
1 parent 7e4f6b6
commit 95daf3b
Show file tree

Hide file tree

Showing 4 changed files with 51 additions and 13 deletions.
diff --git a/src/erp12/cbgp_lite/lang/lib.clj b/src/erp12/cbgp_lite/lang/lib.clj
@@ -917,10 +917,27 @@
 (def macros
   #{'if 'do2 'do3})
 
-(defn lib-for-types
-  [types]
+;; (defn lib-for-types
+;;   [types]
+;;   (->> type-env
+;;        (filter (fn [[_ typ]]
+;;                  (core/or (= (:type typ) :scheme)
+;;                           (some #(schema/occurs? % typ) types))))
+;;        (into {})))
+
+(defn lib-for-type-ctors
+  [type-ctors]
   (->> type-env
        (filter (fn [[_ typ]]
-                 (core/or (= (:type typ) :scheme)
-                          (some #(schema/occurs? % typ) types))))
+                 (set/subset? (->> (schema/schema-terms typ)
+                                   (remove #{:cat :s-var :scheme}))
+                              type-ctors)))
        (into {})))
+
+
+(comment
+
+  (type-env 'not)
+
+  (set/difference (set (keys (lib-for-type-ctors #{:=> 'boolean?})))
+                  (set (keys (lib-for-type-ctors #{:=>})))))
diff --git a/src/erp12/cbgp_lite/lang/schema.clj b/src/erp12/cbgp_lite/lang/schema.clj
@@ -2,6 +2,15 @@
   (:require [erp12.schema-inference.impl.util :as su]
             [clojure.walk :as w]))
 
+(defn schema-terms
+  [form]
+  (->> form
+       (tree-seq coll? identity)
+       (map :type)
+       (distinct)
+       (filter some?)
+       (into #{})))
+
 (defn occurs?
   [term form]
   (let [t (transient #{})]

diff --git a/src/erp12/cbgp_lite/task.clj b/src/erp12/cbgp_lite/task.clj
@@ -1,22 +1,26 @@
 (ns erp12.cbgp-lite.task
   (:require [clojure.set :as set]
             [erp12.cbgp-lite.lang.lib :as lib]
-            [erp12.cbgp-lite.search.plushy :as pl]
+            [erp12.cbgp-lite.lang.schema :as schema]
+            [erp12.cbgp-lite.search.pluhsy :as pl]
             [erp12.cbgp-lite.utils :as u]))
 
 (defn arg-symbols
   [{:keys [input->type]}]
   (vec (sort (keys input->type))))
 
-(defn task-types
-  [{:keys [input->type ret-type other-types] :or {other-types #{}}}]
-  (set/union (set (vals input->type))
-             #{ret-type}
-             (set other-types)))
+(defn task-type-ctors
+  [{:keys [input->type ret-type other-type-ctors] :or {other-type-ctors #{}}}]
+  (->> (schema/schema-terms {:type :=>
+                             :input {:type :cat
+                                     :children (vec (vals (input->type)))}
+                             :output ret-type})
+       (set/union (set other-type-ctors))
+       (remove #{:cat :s-var :scheme})))
 
 (defn vars-for-types
   [types]
-  (set (keys (lib/lib-for-types types))))
+  (set (keys (lib/lib-for-type-ctors types))))
 
 (defn type-environment
   [{:keys [input->type vars]}]
@@ -68,7 +72,7 @@
         ;; Create a sequence of program argument symbols
        :arg-symbols arg-symbols
         ;; Find all types related to the task
-       :types task-types
+       :types task-type-ctors
         ;; Find the set of all variables that leverage to task's types.
         ;; Includes generic functions.
        :vars (fn [{:keys [types]}] (vars-for-types types))

diff --git a/test/erp12/cbgp_lite/lang/lib_test.clj b/test/erp12/cbgp_lite/lang/lib_test.clj
@@ -129,4 +129,12 @@
 
 (deftest all-dealiases-in-type-env-test
   (is (empty? (set/difference (set (keys l/dealiases))
-                              (set (keys l/type-env))))))
+                              (set (keys l/type-env))))))
+
+(deftest lib-for-type-ctors-test
+  (is (empty? (keys (l/lib-for-type-ctors #{'boolean?}))))
+  (is (= #{'comp2-fn1 'comp2-fn2 'comp3-fn1 'comp3-fn2 'partial1-fn2 'partial1-fn3 'partial2-fn3 `l/max' `l/min'}
+         (set (keys (l/lib-for-type-ctors #{:=>})))))
+  (is (= #{'= `l/and 'not= `l/>' `l/or 'if `l/>=' `l/<=' 'not `l/<'}
+         (set/difference (set (keys (l/lib-for-type-ctors #{:=> 'boolean?})))
+                         (set (keys (l/lib-for-type-ctors #{:=>})))))))