diff --git a/src/erp12/cbgp_lite/lang/lib.clj b/src/erp12/cbgp_lite/lang/lib.clj index 7f63553..0ae5591 100644 --- 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 #{:=>}))))) \ No newline at end of file diff --git a/src/erp12/cbgp_lite/lang/schema.clj b/src/erp12/cbgp_lite/lang/schema.clj index 5310ae5..9f9d5c0 100644 --- 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 index c930e4a..c2af306 100644 --- 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 index 5b4beb5..cfb40a8 100644 --- 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)))))) \ No newline at end of file + (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 #{:=>}))))))) \ No newline at end of file