summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorCarlo Zancanaro <carlo@zancanaro.id.au>2021-06-25 21:18:59 +1000
committerCarlo Zancanaro <carlo@zancanaro.id.au>2021-06-25 21:18:59 +1000
commitd082d635b0f311cc2213eadc446412ef5ca11d17 (patch)
tree24282eb924294ea4c57a5646d3be360b847aecda /src
parent947384ba7e71848008d872169e30912c5cd769db (diff)
Add some more thingsHEADmaster
Diffstat (limited to 'src')
-rw-r--r--src/jester/operators/lambdas.clj78
-rw-r--r--src/jester/operators/match.clj52
-rw-r--r--src/jester/operators/numbers.clj18
3 files changed, 148 insertions, 0 deletions
diff --git a/src/jester/operators/lambdas.clj b/src/jester/operators/lambdas.clj
new file mode 100644
index 0000000..2243809
--- /dev/null
+++ b/src/jester/operators/lambdas.clj
@@ -0,0 +1,78 @@
+(ns jester.operators.lambdas
+ (:require [jester.types :refer [type-variable]])
+ (:require [jester.expansion :refer [with-type
+ expand-use
+ define-simple-operator
+ define-syntax
+ with-temporary-parameter-type
+ *operators*
+ *syntax*
+ operator-type]]))
+
+(defn ^:private expand-fn [args body]
+ (let [args-vars (mapv #(do % (type-variable)) args)
+ body-var (type-variable)]
+ (letfn [(binding-params [args vars f]
+ (if (empty? args)
+ (f)
+ (with-temporary-parameter-type [(first args) (first vars)]
+ (binding-params (rest args) (rest vars) f))))]
+ (with-type `(fn [~@args]
+ ~(binding-params args args-vars #(expand-use body body-var)))
+ `(-> ~args-vars ~body-var)))))
+
+(define-syntax fn [[& args] body]
+ (expand-fn args body))
+
+(define-syntax fn* [[& args] body]
+ (expand-fn args body))
+
+(define-syntax var [name]
+ (when-not (symbol? name)
+ (throw (ex-info (str "Var name must be a symbol, not " (pr-str name))
+ {:invalid-name name})))
+ (if (contains? *operators* name)
+ (if-let [operator (get *operators* name)]
+ (with-type (:name operator)
+ (operator-type operator)))))
+
+(defmacro call [f & args]
+ (cons f args))
+
+(define-simple-operator call
+ (∀ [args return] (-> [(-> args return) & args] return)))
+
+(define-simple-operator apply
+ (∀ [args return] (-> [(-> args return) args] return)))
+
+(define-simple-operator apply1 clojure.core/apply
+ (∀ [arg1 args return] (-> [(-> [arg1 & args] return) arg1 args] return)))
+
+(define-simple-operator apply2 clojure.core/apply
+ (∀ [arg1 arg2 args return] (-> [(-> [arg1 arg2 & args] return) arg1 arg2 args] return)))
+
+(define-simple-operator apply3 clojure.core/apply
+ (∀ [arg1 arg2 arg3 args return] (-> [(-> [arg1 arg2 arg3 & args] return) arg1 arg2 arg3 args] return)))
+
+(define-simple-operator map
+ (∀ [a b] (-> [(-> [a] b) (list a)] (list b))))
+
+(define-simple-operator filter
+ (∀ [a] (-> [(-> [a] boolean) (list a)] (list a))))
+
+(define-simple-operator remove
+ (∀ [a] (-> [(-> [a] boolean) (list a)] (list a))))
+
+(define-simple-operator reduce
+ (∀ [item result] (-> [(-> [result item] result) result (list item)] result)))
+
+(defn zip [as bs]
+ (map vector as bs))
+
+(define-simple-operator zip
+ (∀ [a b] (-> [(list a) (list b)] (list [a b]))))
+
+(define-simple-operator zip1 jester.operators.lambdas/zip
+ (∀ [x1 y1] (-> [[x1] [y1]] [[x1 y1]])))
+(define-simple-operator zip2 jester.operators.lambdas/zip
+ (∀ [x1 x2 y1 y2] (-> [[x1 x2] [y1 y2]] [[x1 y1] [x2 y2]])))
diff --git a/src/jester/operators/match.clj b/src/jester/operators/match.clj
new file mode 100644
index 0000000..b1eeb87
--- /dev/null
+++ b/src/jester/operators/match.clj
@@ -0,0 +1,52 @@
+(ns jester.operators.match
+ (:require [jester.types :refer [type-variable
+ union-types]])
+ (:require [jester.comparisons :refer [string= number= boolean=]])
+ (:require [jester.expansion :refer [with-type
+ expand-use
+ define-simple-operator
+ define-syntax
+ with-temporary-parameter-type
+ *operators*
+ *syntax*
+ operator-type]]))
+
+(defn ^:private transpose [xs]
+ (apply mapv vector xs))
+
+(defn compile-clause [form arg]
+ (cond
+ (map? form) (reduce-kv (fn [[[_ & codes] types] k v]
+ (let [[code type] (compile-clause v `(get ~arg ~k))]
+ [`(and ~@codes ~code)
+ (assoc types k type)]))
+ [`(and) {}] form)
+ (vector? form) (reduce-kv (fn [[[_ & codes] types] k v]
+ (let [[code type] (compile-clause v `(get ~arg ~k))]
+ [`(and ~@codes ~code)
+ (conj types type)]))
+ [`(and) []] form)
+ ;; (transpose (map-indexed #(compile-clause %2 `(get ~arg ~%1)) form))
+ (symbol? form) [true 'none]
+ (number? form) [`(number= ~form ~arg) `(enum ~form)]
+ (string? form) [`(string= ~form ~arg)`(enum ~form)]
+ (boolean? form) [`(boolean= ~form ~arg) `(enum ~form)]
+ :else (throw (ex-info "Pattern type not supported yet"
+ {:form form}))))
+
+(defn combine-pattern-types [types]
+ (reduce union-types 'none types))
+
+(define-syntax match [expression & match-clauses]
+ (let [match-value (gensym "match-value")
+ paired-clauses (partition 2 match-clauses)
+ return-type (type-variable)
+ [patterns types] (transpose (mapv (comp #(compile-clause % match-value) first) paired-clauses))
+ type (combine-pattern-types types)
+ bodies (with-temporary-parameter-type [match-value type]
+ (mapv (comp #(expand-use % return-type) second) paired-clauses))]
+ (with-type `(let [~match-value ~(expand-use expression type)]
+ (cond ~@(mapcat (fn [pattern body]
+ [pattern body])
+ patterns bodies)))
+ return-type)))
diff --git a/src/jester/operators/numbers.clj b/src/jester/operators/numbers.clj
new file mode 100644
index 0000000..828d4bb
--- /dev/null
+++ b/src/jester/operators/numbers.clj
@@ -0,0 +1,18 @@
+(ns jester.operators.numbers
+ (:require [jester.types :refer [type-variable]])
+ (:require [jester.expansion :refer [with-type
+ expand-use
+ define-simple-operator
+ define-syntax
+ with-temporary-parameter-type
+ *operators*
+ *syntax*
+ operator-type]]))
+
+(define-simple-operator + (-> [& (list number)] number))
+(define-simple-operator - (-> [number & (list number)] number))
+(define-simple-operator * (-> [& (list number)] number))
+(define-simple-operator / (-> [number & (list number)] number))
+
+(define-simple-operator mod (-> [number number] number))
+(define-simple-operator rem (-> [number number] number))