From 2a662bb1f9c32c76037b0a478c7d206bf73babfb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 15 Feb 2015 20:04:22 -0400 Subject: Corrections to the super-refactoring: part 1 --- src/lux/analyser.clj | 2 +- src/lux/host.clj | 5 ++--- src/lux/macro.clj | 49 +++++++++++++++++++++++++------------------------ src/lux/type.clj | 26 +++++++++++++------------- src/lux/util.clj | 11 +++++++---- 5 files changed, 48 insertions(+), 45 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index de75b9f26..0b9839968 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -194,7 +194,7 @@ (exec [macro? (macro? ?module ?name)] (if macro? (let [macro-class (&host/location (list ?name ?module)) - [macro-expansion state*] (¯o/expand loader macro-class)] + [macro-expansion state*] (¯o/expand loader macro-class ?args)] (mapcat-m analyse-ast macro-expansion)) (exec [=args (mapcat-m analyse-ast ?args) :let [[needs-num =return-type] (match =fn-type diff --git a/src/lux/host.clj b/src/lux/host.clj index 8f9337157..2b9b1c725 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -4,7 +4,6 @@ [clojure.core.match :refer [match]] (lux [util :as &util :refer [exec return* return fail fail* repeat-m try-all-m map-m mapcat-m reduce-m - within normalize-ident]] [parser :as &parser] [type :as &type]))) @@ -74,7 +73,7 @@ (= field (.getName =field)) (= (java.lang.reflect.Modifier/isStatic (.getModifiers =field))))] (.getType =field)))] - (exec [=type (&type/class->type type*)] + (exec [=type (class->type type*)] (return =type)) (fail (str "[Analyser Error] Field does not exist: " target field)))) @@ -89,7 +88,7 @@ (= method-name (.getName =method)) (= (java.lang.reflect.Modifier/isStatic (.getModifiers =method))))] =method))] - (exec [=method (&type/method->type method)] + (exec [=method (method->type method)] (return =method)) (fail (str "[Analyser Error] Method does not exist: " target method-name)))) diff --git a/src/lux/macro.clj b/src/lux/macro.clj index 52001b24f..511ffb7a7 100644 --- a/src/lux/macro.clj +++ b/src/lux/macro.clj @@ -1,5 +1,6 @@ (ns lux.macro - (:require [lux.parser :as &parser])) + (:require [clojure.core.match :refer [match]] + [lux.parser :as &parser])) ;; [Utils] (defn ^:private ->lux+ [->lux loader xs] @@ -17,27 +18,27 @@ (-> .-tag (set! tag)) (-> .-_1 (set! value)))) -(defn ^:private ->lux-one [->lux loader tag values] +(defn ^:private ->lux-many [->lux loader tag values] (doto (.newInstance (.loadClass loader "lux.Variant1")) (-> .-tag (set! tag)) (-> .-_1 (set! (->lux+ ->lux loader values))))) (defn ^:private ->lux [loader x] (match x - [::&parser/Bool ?bool] - (->lux-one loader "Bool" ?bool) - [::&parser/Int ?int] - (->lux-one loader "Int" ?bool) - [::&parser/Real ?real] - (->lux-one loader "Real" ?bool) - [::&parser/Char ?elem] - (->lux-one loader "Char" ?bool) - [::&parser/Text ?text] - (->lux-one loader "Text" ?bool) - [::&parser/Tag ?tag] - (->lux-one loader "Tag" ?bool) - [::&parser/Ident ?ident] - (->lux-one loader "Ident" ?bool) + [::&parser/Bool ?value] + (->lux-one loader "Bool" ?value) + [::&parser/Int ?value] + (->lux-one loader "Int" ?value) + [::&parser/Real ?value] + (->lux-one loader "Real" ?value) + [::&parser/Char ?value] + (->lux-one loader "Char" ?value) + [::&parser/Text ?value] + (->lux-one loader "Text" ?value) + [::&parser/Tag ?value] + (->lux-one loader "Tag" ?value) + [::&parser/Ident ?value] + (->lux-one loader "Ident" ?value) [::&parser/Tuple ?elems] (->lux-many ->lux loader "Tuple" ?elems) [::&parser/Form ?elems] @@ -64,12 +65,12 @@ "Form" [::&parser/Form (->clojure+ ->clojure (.-_1 x))])) ;; [Resources] -(defn expand [loader macro-class] - (let [expansion (-> (.loadClass loader macro-class) - .getDeclaredConstructors - first - (.newInstance (to-array [(int 0) nil])) - (.apply (->lux+* ->lux loader ?args)) - (.apply nil))] - [(->> expansion .-_1 (->clojure+* ->clojure)) +(defn expand [loader macro-class tokens] + (let [output (-> (.loadClass loader macro-class) + .getDeclaredConstructors + first + (.newInstance (to-array [(int 0) nil])) + (.apply (->lux+ ->lux loader tokens)) + (.apply nil))] + [(->> output .-_1 (->clojure+ ->clojure)) (.-_2 output)])) diff --git a/src/lux/type.clj b/src/lux/type.clj index 0c1b34070..10d1171f4 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -131,7 +131,7 @@ success :else - (fail (str "Can't solve types: " (pr-str expected actual)))) + (fail (str "not (" given " <= " needed ")"))) [[::Tuple n!elems] [::Tuple g!elems]] (exec [_ (assert! (= (count n!elems) (count g!elems)) @@ -171,18 +171,18 @@ (return y) [[::Variant x!cases] [::Variant y!cases]] - (and (reduce && true - (for [[xslot xtype] (keys x!cases)] - (if-let [ytype (get y!cases xslot)] - (= xtype ytype) - true))) - (reduce && true - (for [[yslot ytype] (keys y!cases)] - (if-let [xtype (get x!cases yslot)] - (= xtype ytype) - true)))) - (return [::Variant (clojure.core/merge x!cases y!cases)]) - (fail (str "Incompatible variants: " (pr-str x) " and " (pr-str y))) + (if (and (reduce && true + (for [[xslot xtype] (keys x!cases)] + (if-let [ytype (get y!cases xslot)] + (= xtype ytype) + true))) + (reduce && true + (for [[yslot ytype] (keys y!cases)] + (if-let [xtype (get x!cases yslot)] + (= xtype ytype) + true)))) + (return [::Variant (clojure.core/merge x!cases y!cases)]) + (fail (str "Incompatible variants: " (pr-str x) " and " (pr-str y)))) [[::Record x!fields] [::Record y!fields]] (if (and (= (keys x!fields) (keys y!fields)) diff --git a/src/lux/util.clj b/src/lux/util.clj index 207a07203..00c0fa6f0 100644 --- a/src/lux/util.clj +++ b/src/lux/util.clj @@ -145,10 +145,13 @@ (return* state state))) (defn sequence-m [m-values] - (if (empty? m-values) - (return nil) - (exec [head (first m-values)] - (sequence-m (rest monads))))) + (match m-values + ([head & tail] :seq) + (exec [_ head] + (sequence-m tail)) + + _ + (return nil))) (defn ^:private normalize-char [char] (case char -- cgit v1.2.3