aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/base.clj1
-rw-r--r--src/lux/analyser/case.clj82
-rw-r--r--src/lux/analyser/env.clj24
-rw-r--r--src/lux/analyser/lambda.clj8
-rw-r--r--src/lux/analyser/lux.clj56
-rw-r--r--src/lux/analyser/module.clj97
-rw-r--r--src/lux/analyser/record.clj158
-rw-r--r--src/lux/base.clj130
-rw-r--r--src/lux/compiler.clj5
-rw-r--r--src/lux/compiler/cache.clj2
-rw-r--r--src/lux/compiler/case.clj23
-rw-r--r--src/lux/compiler/lux.clj21
-rw-r--r--src/lux/reader.clj10
-rw-r--r--src/lux/type.clj44
14 files changed, 370 insertions, 291 deletions
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 58c01e642..fe1e0d55b 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -21,7 +21,6 @@
"text"
"variant"
"tuple"
- "record"
"apply"
"case"
"lambda"
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 6992c11a3..34cbf8b48 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -14,7 +14,8 @@
[type :as &type])
(lux.analyser [base :as &&]
[env :as &env]
- [module :as &module])))
+ [module :as &module]
+ [record :as &&record])))
;; [Tags]
(deftags ""
@@ -25,7 +26,6 @@
"CharTotal"
"TextTotal"
"TupleTotal"
- "RecordTotal"
"VariantTotal"
)
@@ -37,7 +37,6 @@
"CharTestAC"
"TextTestAC"
"TupleTestAC"
- "RecordTestAC"
"VariantTestAC"
)
@@ -194,33 +193,25 @@
_
(fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*))))))
- (&/$RecordS ?slots)
- (|do [;; :let [_ (prn 'PRE (&type/show-type value-type))]
+ (&/$RecordS pairs)
+ (|do [?members (&&record/order-record pairs)
+ ;; :let [_ (prn 'PRE (&type/show-type value-type))]
value-type* (adjust-type value-type)
;; :let [_ (prn 'POST (&type/show-type value-type*))]
;; value-type* (resolve-type value-type)
]
(|case value-type*
- (&/$RecordT ?slot-types)
- (if (not (.equals ^Object (&/|length ?slot-types) (&/|length ?slots)))
- (fail (str "[Analyser Error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]"))
- (|do [[=tests =kont] (&/fold (fn [kont* slot]
- (|let [[sn sv] slot]
- (|case sn
- (&/$Meta _ (&/$TagS ?ident))
- (|do [=ident (&&/resolved-ident ?ident)
- :let [=tag (&/ident->text =ident)]]
- (if-let [=slot-type (&/|get =tag ?slot-types)]
- (|do [[=test [=tests =kont]] (analyse-pattern =slot-type sv kont*)]
- (return (&/T (&/|put =tag =test =tests) =kont)))
- (fail (str "[Pattern-matching Error] Record-type lacks slot: " =tag))))
-
- _
- (fail (str "[Pattern-matching Error] Record must use tags as slot-names: " (&/show-ast sn))))))
+ (&/$RecordT ?member-types)
+ (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
+ (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require record[" (&/|length ?member-types) "]. Given record[" (&/|length ?members) "]"))
+ (|do [[=tests =kont] (&/fold (fn [kont* vm]
+ (|let [[v m] vm]
+ (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)]
+ (return (&/T (&/|cons =test =tests) =kont)))))
(|do [=kont kont]
- (return (&/T (&/|table) =kont)))
- (&/|reverse ?slots))]
- (return (&/T (&/V $RecordTestAC =tests) =kont))))
+ (return (&/T (&/|list) =kont)))
+ (&/|reverse (&/zip2 ?member-types ?members)))]
+ (return (&/T (&/V $TupleTestAC =tests) =kont))))
_
(fail "[Pattern-matching Error] Record requires record-type.")))
@@ -320,34 +311,6 @@
(return (&/V $TupleTotal (&/T total? structs))))
(fail "[Pattern-matching Error] Inconsistent tuple-size."))
- [($DefaultTotal total?) ($RecordTestAC ?tests)]
- (|do [structs (&/map% (fn [t]
- (|let [[slot value] t]
- (|do [struct* (merge-total (&/V $DefaultTotal total?) (&/T value ?body))]
- (return (&/T slot struct*)))))
- (->> ?tests
- &/->seq
- (sort compare-kv)
- &/->list))]
- (return (&/V $RecordTotal (&/T total? structs))))
-
- [($RecordTotal total? ?values) ($RecordTestAC ?tests)]
- (if (.equals ^Object (&/|length ?values) (&/|length ?tests))
- (|do [structs (&/map2% (fn [left right]
- (|let [[lslot sub-struct] left
- [rslot value]right]
- (if (.equals ^Object lslot rslot)
- (|do [sub-struct* (merge-total sub-struct (&/T value ?body))]
- (return (&/T lslot sub-struct*)))
- (fail "[Pattern-matching Error] Record slots mismatch."))))
- ?values
- (->> ?tests
- &/->seq
- (sort compare-kv)
- &/->list))]
- (return (&/V $RecordTotal (&/T total? structs))))
- (fail "[Pattern-matching Error] Inconsistent record-size."))
-
[($DefaultTotal total?) ($VariantTestAC ?tag ?test)]
(|do [sub-struct (merge-total (&/V $DefaultTotal total?)
(&/T ?test ?body))]
@@ -361,6 +324,7 @@
))))
(defn ^:private check-totality [value-type struct]
+ ;; (prn 'check-totality (&type/show-type value-type) (&/adt->text struct))
(|case struct
($BoolTotal ?total ?values)
(return (or ?total
@@ -389,14 +353,6 @@
?structs ?members)]
(return (&/fold #(and %1 %2) true totals)))
- _
- (fail "[Pattern-maching Error] Tuple is not total."))))
-
- ($RecordTotal ?total ?structs)
- (if ?total
- (return true)
- (|do [value-type* (resolve-type value-type)]
- (|case value-type*
(&/$RecordT ?members)
(|do [totals (&/map2% (fn [sub-struct ?member]
(check-totality ?member sub-struct))
@@ -404,7 +360,7 @@
(return (&/fold #(and %1 %2) true totals)))
_
- (fail "[Pattern-maching Error] Record is not total."))))
+ (fail "[Pattern-maching Error] Tuple is not total."))))
($VariantTotal ?total ?structs)
(if ?total
@@ -422,6 +378,10 @@
($DefaultTotal ?total)
(return ?total)
+
+ ;; _
+ ;; (assert false (prn-str 'check-totality (&type/show-type value-type)
+ ;; (&/adt->text struct)))
))
;; [Exports]
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 614b38799..4e9dcd79f 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -15,28 +15,28 @@
;; [Exports]
(def next-local-idx
(fn [state]
- (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))))
+ (return* state (->> state (&/get$ &/$envs) &/|head (&/get$ &/$locals) (&/get$ &/$counter)))))
(defn with-local [name type body]
;; (prn 'with-local name)
(fn [state]
;; (prn 'with-local name)
- (let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS))
- =return (body (&/update$ &/$ENVS
+ (let [old-mappings (->> state (&/get$ &/$envs) &/|head (&/get$ &/$locals) (&/get$ &/$mappings))
+ =return (body (&/update$ &/$envs
(fn [stack]
- (let [bound-unit (&/V &&/$var (&/V &/$Local (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER))))]
- (&/|cons (&/update$ &/$LOCALS #(->> %
- (&/update$ &/$COUNTER inc)
- (&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m))))
+ (let [bound-unit (&/V &&/$var (&/V &/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter))))]
+ (&/|cons (&/update$ &/$locals #(->> %
+ (&/update$ &/$counter inc)
+ (&/update$ &/$mappings (fn [m] (&/|put name (&/T bound-unit type) m))))
(&/|head stack))
(&/|tail stack))))
state))]
(|case =return
(&/$Right ?state ?value)
- (return* (&/update$ &/$ENVS (fn [stack*]
- (&/|cons (&/update$ &/$LOCALS #(->> %
- (&/update$ &/$COUNTER dec)
- (&/set$ &/$MAPPINGS old-mappings))
+ (return* (&/update$ &/$envs (fn [stack*]
+ (&/|cons (&/update$ &/$locals #(->> %
+ (&/update$ &/$counter dec)
+ (&/set$ &/$mappings old-mappings))
(&/|head stack*))
(&/|tail stack*)))
?state)
@@ -47,4 +47,4 @@
(def captured-vars
(fn [state]
- (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS)))))
+ (return* state (->> state (&/get$ &/$envs) &/|head (&/get$ &/$closure) (&/get$ &/$mappings)))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index 91cf3443b..aeb5a4814 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -27,10 +27,10 @@
(defn close-over [scope name register frame]
(|let [[_ register-type] register
register* (&/T (&/V &&/$captured (&/T scope
- (->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER))
+ (->> frame (&/get$ &/$closure) (&/get$ &/$counter))
register))
register-type)]
- (&/T register* (&/update$ &/$CLOSURE #(->> %
- (&/update$ &/$COUNTER inc)
- (&/update$ &/$MAPPINGS (fn [mps] (&/|put name register* mps))))
+ (&/T register* (&/update$ &/$closure #(->> %
+ (&/update$ &/$counter inc)
+ (&/update$ &/$mappings (fn [mps] (&/|put name register* mps))))
frame))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index e55d5fec8..449ef59c1 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -18,7 +18,8 @@
[lambda :as &&lambda]
[case :as &&case]
[env :as &&env]
- [module :as &&module])))
+ [module :as &&module]
+ [record :as &&record])))
(defn ^:private analyse-1+ [analyse ?token]
(&type/with-var
@@ -124,7 +125,7 @@
;; (fn [$var]
;; (|do [exo-type** (&type/apply-type exo-type* $var)]
;; (analyse-variant analyse exo-type** ident ?values))))
-
+
;; _
;; (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*))))))
@@ -150,26 +151,14 @@
(return ?table)
_
- (fail (str "[Analyser Error] The type of a record must be a record type:\n"
- (&type/show-type exo-type*)
- "\n")))
+ (fail (str "[Analyser Error] The type of a record must be a record-type:\n" (&type/show-type exo-type*))))
_ (&/assert! (= (&/|length types) (&/|length ?elems))
(str "[Analyser Error] Record length mismatch. Expected: " (&/|length types) "; actual: " (&/|length ?elems)))
- =slots (&/map% (fn [kv]
- (|case kv
- [(&/$Meta _ (&/$TagS ?ident)) ?value]
- (|do [=ident (&&/resolved-ident ?ident)
- :let [?tag (&/ident->text =ident)]
- slot-type (if-let [slot-type (&/|get ?tag types)]
- (return slot-type)
- (fail (str "[Analyser Error] Record type does not have slot: " ?tag)))
- =value (&&/analyse-1 analyse slot-type ?value)]
- (return (&/T ?tag =value)))
-
- _
- (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
- ?elems)]
- (return (&/|list (&/T (&/V &&/$record =slots) (&/V &/$RecordT exo-type))))))
+ members (&&record/order-record ?elems)
+ =members (&/map2% (fn [elem-t elem]
+ (&&/analyse-1 analyse elem-t elem))
+ types members)]
+ (return (&/|list (&/T (&/V &&/$tuple =members) exo-type)))))
(defn ^:private analyse-global [analyse exo-type module name]
(|do [[[r-module r-name] $def] (&&module/find-def module name)
@@ -193,9 +182,9 @@
(defn ^:private analyse-local [analyse exo-type name]
(fn [state]
- (|let [stack (&/get$ &/$ENVS state)
- no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? name) not)
- (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? name) not))
+ (|let [stack (&/get$ &/$envs state)
+ no-binding? #(and (->> % (&/get$ &/$locals) (&/get$ &/$mappings) (&/|contains? name) not)
+ (->> % (&/get$ &/$closure) (&/get$ &/$mappings) (&/|contains? name) not))
[inner outer] (&/|split-with no-binding? stack)]
(|case outer
(&/$Nil)
@@ -204,8 +193,8 @@
state)
(&/$Cons ?genv (&/$Nil))
- (do ;; (prn 'analyse-symbol/_2 ?module name name (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
- (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))]
+ (do ;; (prn 'analyse-symbol/_2 ?module name name (->> ?genv (&/get$ &/$locals) (&/get$ &/$mappings) &/|keys &/->seq))
+ (if-let [global (->> ?genv (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))]
(do ;; (prn 'analyse-symbol/_2.1 ?module name name (aget global 0))
(|case global
[(&/$Global ?module* name*) _]
@@ -235,21 +224,21 @@
(&/$Cons top-outer _)
(do ;; (prn 'analyse-symbol/_3 ?module name)
- (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
- (&/|map #(&/get$ &/$NAME %) outer)
+ (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$name %2) %1)
+ (&/|map #(&/get$ &/$name %) outer)
(&/|reverse inner)))
[=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
(|let [[register new-inner] register+new-inner
[register* frame*] (&&lambda/close-over (&/|reverse in-scope) name register frame)]
(&/T register* (&/|cons frame* new-inner))))
- (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))
- (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get name)))
+ (&/T (or (->> top-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))
+ (->> top-outer (&/get$ &/$closure) (&/get$ &/$mappings) (&/|get name)))
(&/|list))
(&/|reverse inner) scopes)]
((|do [btype (&&/expr-type =local)
_ (&type/check exo-type btype)]
(return (&/|list =local)))
- (&/set$ &/$ENVS (&/|++ inner* outer) state))))
+ (&/set$ &/$envs (&/|++ inner* outer) state))))
))))
(defn analyse-symbol [analyse exo-type ident]
@@ -311,13 +300,14 @@
macro-expansion #(-> macro (.apply ?args) (.apply %))
;; :let [_ (prn 'MACRO-EXPAND|POST (&/ident->text real-name))]
;; :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
- ;; :let [_ (when (or (= "<>" r-name)
+ ;; :let [_ (when (or (= ":" (aget real-name 1))
+ ;; (= "type" (aget real-name 1))
;; ;; (= &&/$struct r-name)
;; )
- ;; (->> (&/|map &/show-ast macro-expansion*)
+ ;; (->> (&/|map &/show-ast macro-expansion)
;; (&/|interpose "\n")
;; (&/fold str "")
- ;; (prn (str r-module ";" r-name))))]
+ ;; (prn (&/ident->text real-name))))]
]
(&/flat-map% (partial analyse exo-type) macro-expansion))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 68554a019..6cf25b738 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -11,23 +11,23 @@
(:require [clojure.string :as string]
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return return* fail fail* |case]]
+ (lux [base :as & :refer [deftags |let |do return return* fail fail* |case]]
[type :as &type]
- [host :as &host])
- [lux.analyser.base :as &&]))
+ [host :as &host])))
;; [Utils]
-(def ^:private $DEFS 0)
-(def ^:private $IMPORTS 1)
-(def ^:private $ALIASES 2)
-(def ^:private $tags 3)
+(deftags ""
+ "module-aliases"
+ "defs"
+ "imports"
+ "tags")
(def ^:private +init+
- (&/R ;; "lux;defs"
+ (&/R ;; "lux;module-aliases"
+ (&/|table)
+ ;; "lux;defs"
(&/|table)
;; "lux;imports"
(&/|list)
- ;; "lux;module-aliases"
- (&/|table)
;; "lux;tags"
(&/|list)
))
@@ -37,24 +37,24 @@
"(-> Text (Lux (,)))"
(|do [current-module &/get-module-name]
(fn [state]
- (return* (&/update$ &/$MODULES
+ (return* (&/update$ &/$modules
(fn [ms]
(&/|update current-module
- (fn [m] (&/update$ $IMPORTS (partial &/|cons module) m))
+ (fn [m] (&/update$ $imports (partial &/|cons module) m))
ms))
state)
nil))))
(defn define [module name def-data type]
(fn [state]
- (|case (&/get$ &/$ENVS state)
+ (|case (&/get$ &/$envs state)
(&/$Cons ?env (&/$Nil))
(return* (->> state
- (&/update$ &/$MODULES
+ (&/update$ &/$modules
(fn [ms]
(&/|update module
(fn [m]
- (&/update$ $DEFS
+ (&/update$ $defs
#(&/|put name (&/T false def-data) %)
m))
ms))))
@@ -66,8 +66,8 @@
(defn def-type [module name]
"(-> Text Text (Lux Type))"
(fn [state]
- (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
- (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))]
+ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
+ (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
(|case $def
[_ (&/$TypeD _)]
(return* state &type/Type)
@@ -87,14 +87,14 @@
(defn def-alias [a-module a-name r-module r-name type]
;; (prn 'def-alias [a-module a-name] [r-module r-name] (&type/show-type type))
(fn [state]
- (|case (&/get$ &/$ENVS state)
+ (|case (&/get$ &/$envs state)
(&/$Cons ?env (&/$Nil))
(return* (->> state
- (&/update$ &/$MODULES
+ (&/update$ &/$modules
(fn [ms]
(&/|update a-module
(fn [m]
- (&/update$ $DEFS
+ (&/update$ $defs
#(&/|put a-name (&/T false (&/V &/$AliasD (&/T r-module r-name))) %)
m))
ms))))
@@ -107,15 +107,15 @@
"(-> Text (Lux Bool))"
(fn [state]
(return* state
- (->> state (&/get$ &/$MODULES) (&/|contains? name)))))
+ (->> state (&/get$ &/$modules) (&/|contains? name)))))
(defn alias [module alias reference]
(fn [state]
(return* (->> state
- (&/update$ &/$MODULES
+ (&/update$ &/$modules
(fn [ms]
(&/|update module
- #(&/update$ $ALIASES
+ #(&/update$ $module-aliases
(fn [aliases]
(&/|put alias reference aliases))
%)
@@ -125,7 +125,7 @@
(defn dealias [name]
(|do [current-module &/get-module-name]
(fn [state]
- (if-let [real-name (->> state (&/get$ &/$MODULES) (&/|get current-module) (&/get$ $ALIASES) (&/|get name))]
+ (if-let [real-name (->> state (&/get$ &/$modules) (&/|get current-module) (&/get$ $module-aliases) (&/|get name))]
(return* state real-name)
(fail* (str "Unknown alias: " name))))))
@@ -133,9 +133,9 @@
(|do [current-module &/get-module-name]
(fn [state]
;; (prn 'find-def/_0 module name 'current-module current-module)
- (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
(do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module)))
- (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))]
+ (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
(|let [[exported? $$def] $def]
(do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module))
(if (or exported? (.equals ^Object current-module module))
@@ -158,7 +158,7 @@
(defn declare-macro [module name]
(fn [state]
- (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))]
+ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs))]
(if-let [$def (&/|get name $module)]
(|case $def
[exported? (&/$ValueD ?type _)]
@@ -168,11 +168,11 @@
(.getField "_datum")
(.get nil))]]
(fn [state*]
- (return* (&/update$ &/$MODULES
+ (return* (&/update$ &/$modules
(fn [$modules]
(&/|update module
(fn [m]
- (&/update$ $DEFS
+ (&/update$ $defs
#(&/|put name (&/T exported? (&/V &/$MacroD macro)) %)
m))
$modules))
@@ -190,18 +190,18 @@
(defn export [module name]
(fn [state]
- (|case (&/get$ &/$ENVS state)
+ (|case (&/get$ &/$envs state)
(&/$Cons ?env (&/$Nil))
- (if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS) (&/|get name))]
+ (if-let [$def (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs) (&/|get name))]
(|case $def
[true _]
(fail* (str "[Analyser Error] Definition has already been exported: " module ";" name))
[false ?data]
(return* (->> state
- (&/update$ &/$MODULES (fn [ms]
+ (&/update$ &/$modules (fn [ms]
(&/|update module (fn [m]
- (&/update$ $DEFS
+ (&/update$ $defs
#(&/|put name (&/T true ?data) %)
m))
ms))))
@@ -230,30 +230,30 @@
_
(&/T ?exported? k "V")))))
- (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS)))))))
+ (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs)))))))
(def imports
(|do [module &/get-module-name]
(fn [state]
- (return* state (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $IMPORTS))))))
+ (return* state (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $imports))))))
(defn create-module [name]
"(-> Text (Lux (,)))"
(fn [state]
- (return* (&/update$ &/$MODULES #(&/|put name +init+ %) state) nil)))
+ (return* (&/update$ &/$modules #(&/|put name +init+ %) state) nil)))
(defn enter-module [name]
"(-> Text (Lux (,)))"
(fn [state]
(return* (->> state
- (&/update$ &/$MODULES #(&/|put name +init+ %))
- (&/set$ &/$ENVS (&/|list (&/env name))))
+ (&/update$ &/$modules #(&/|put name +init+ %))
+ (&/set$ &/$envs (&/|list (&/env name))))
nil)))
(defn tags-by-module [module]
"(-> Text (Lux (List (, Text (, Int (List Text))))))"
(fn [state]
- (if-let [=module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
(return* state (&/get$ $tags =module))
(fail* (str "[Lux Error] Unknown module: " module)))
))
@@ -261,9 +261,9 @@
(defn declare-tags [module tag-names]
"(-> Text (List Text) (Lux (,)))"
(fn [state]
- (if-let [=module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
(let [tags (&/|map (fn [tag-name] (&/T module tag-name)) tag-names)]
- (return* (&/update$ &/$MODULES
+ (return* (&/update$ &/$modules
(fn [=modules]
(&/|update module
#(&/set$ $tags (&/fold (fn [table idx+tag-name]
@@ -280,8 +280,17 @@
(defn tag-index [module tag-name]
"(-> Text Text (Lux Int))"
(fn [state]
- (if-let [=module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
(if-let [^objects idx+tags (&/|get tag-name (&/get$ $tags =module))]
(return* state (aget idx+tags 0))
- (fail* (str "[Lux Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
- (fail* (str "[Lux Error] Unknown module: " module)))))
+ (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
+ (fail* (str "[Module Error] Unknown module: " module)))))
+
+(defn tag-group [module tag-name]
+ "(-> Text Text (Lux (List Ident)))"
+ (fn [state]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
+ (if-let [^objects idx+tags (&/|get tag-name (&/get$ $tags =module))]
+ (return* state (aget idx+tags 1))
+ (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
+ (fail* (str "[Module Error] Unknown module: " module)))))
diff --git a/src/lux/analyser/record.clj b/src/lux/analyser/record.clj
new file mode 100644
index 000000000..2b4b7e095
--- /dev/null
+++ b/src/lux/analyser/record.clj
@@ -0,0 +1,158 @@
+;; Copyright (c) Eduardo Julian. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns lux.analyser.record
+ (:require clojure.core.match
+ clojure.core.match.array
+ (lux [base :as & :refer [deftags |let |do return fail |case]])
+ (lux.analyser [base :as &&]
+ [module :as &&module])))
+
+;; [Tags]
+(deftags ""
+ "bool"
+ "int"
+ "real"
+ "char"
+ "text"
+ "variant"
+ "tuple"
+ "apply"
+ "case"
+ "lambda"
+ "ann"
+ "def"
+ "declare-macro"
+ "var"
+ "captured"
+
+ "jvm-getstatic"
+ "jvm-getfield"
+ "jvm-putstatic"
+ "jvm-putfield"
+ "jvm-invokestatic"
+ "jvm-instanceof"
+ "jvm-invokevirtual"
+ "jvm-invokeinterface"
+ "jvm-invokespecial"
+ "jvm-null?"
+ "jvm-null"
+ "jvm-new"
+ "jvm-new-array"
+ "jvm-aastore"
+ "jvm-aaload"
+ "jvm-class"
+ "jvm-interface"
+ "jvm-try"
+ "jvm-throw"
+ "jvm-monitorenter"
+ "jvm-monitorexit"
+ "jvm-program"
+
+ "jvm-iadd"
+ "jvm-isub"
+ "jvm-imul"
+ "jvm-idiv"
+ "jvm-irem"
+ "jvm-ieq"
+ "jvm-ilt"
+ "jvm-igt"
+
+ "jvm-ceq"
+ "jvm-clt"
+ "jvm-cgt"
+
+ "jvm-ladd"
+ "jvm-lsub"
+ "jvm-lmul"
+ "jvm-ldiv"
+ "jvm-lrem"
+ "jvm-leq"
+ "jvm-llt"
+ "jvm-lgt"
+
+ "jvm-fadd"
+ "jvm-fsub"
+ "jvm-fmul"
+ "jvm-fdiv"
+ "jvm-frem"
+ "jvm-feq"
+ "jvm-flt"
+ "jvm-fgt"
+
+ "jvm-dadd"
+ "jvm-dsub"
+ "jvm-dmul"
+ "jvm-ddiv"
+ "jvm-drem"
+ "jvm-deq"
+ "jvm-dlt"
+ "jvm-dgt"
+
+ "jvm-d2f"
+ "jvm-d2i"
+ "jvm-d2l"
+
+ "jvm-f2d"
+ "jvm-f2i"
+ "jvm-f2l"
+
+ "jvm-i2b"
+ "jvm-i2c"
+ "jvm-i2d"
+ "jvm-i2f"
+ "jvm-i2l"
+ "jvm-i2s"
+
+ "jvm-l2d"
+ "jvm-l2f"
+ "jvm-l2i"
+
+ "jvm-iand"
+ "jvm-ior"
+ "jvm-ixor"
+ "jvm-ishl"
+ "jvm-ishr"
+ "jvm-iushr"
+
+ "jvm-land"
+ "jvm-lor"
+ "jvm-lxor"
+ "jvm-lshl"
+ "jvm-lshr"
+ "jvm-lushr"
+
+ )
+
+;; [Exports]
+(defn order-record [pairs]
+ "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))"
+ (|do [tag-group (|case pairs
+ (&/$Nil)
+ (return (&/|list))
+
+ (&/$Cons [(&/$Meta _ (&/$TagS tag1)) _] _)
+ (|do [[module name] (&&/resolved-ident tag1)]
+ (&&module/tag-group module name))
+
+ _
+ (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))
+ =pairs (&/map% (fn [kv]
+ (|case kv
+ [(&/$Meta _ (&/$TagS k)) v]
+ (|do [=k (&&/resolved-ident k)]
+ (return (&/T (&/ident->text =k) v)))
+
+ _
+ (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
+ pairs)]
+ (&/map% (fn [tag]
+ (if-let [member (&/|get tag =pairs)]
+ (return member)
+ (fail (str "[Analyser Error] Unknown tag: " tag))))
+ (&/|map &/ident->text tag-group))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index a700a30c8..b8b7118f4 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -63,30 +63,34 @@
;; [Fields]
;; Binding
-(def $COUNTER 0)
-(def $MAPPINGS 1)
+(deftags ""
+ "counter"
+ "mappings")
;; Env
-(def $CLOSURE 0)
-(def $INNER-CLOSURES 1)
-(def $LOCALS 2)
-(def $NAME 3)
+(deftags ""
+ "name"
+ "inner-closures"
+ "locals"
+ "closure")
;; Host
-(def $CLASSES 0)
-(def $LOADER 1)
-(def $WRITER 2)
+(deftags ""
+ "writer"
+ "loader"
+ "classes")
;; Compiler
-(def $cursor 0)
-(def $ENVS 1)
-(def $EVAL? 2)
-(def $EXPECTED 3)
-(def $HOST 4)
-(def $MODULES 5)
-(def $SEED 6)
-(def $SOURCE 7)
-(def $TYPES 8)
+(deftags ""
+ "source"
+ "cursor"
+ "modules"
+ "envs"
+ "types"
+ "expected"
+ "seed"
+ "eval?"
+ "host")
;; Vars
(deftags "lux;"
@@ -533,11 +537,11 @@
(def loader
(fn [state]
- (return* state (->> state (get$ $HOST) (get$ $LOADER)))))
+ (return* state (->> state (get$ $host) (get$ $loader)))))
(def classes
(fn [state]
- (return* state (->> state (get$ $HOST) (get$ $CLASSES)))))
+ (return* state (->> state (get$ $host) (get$ $classes)))))
(def +init-bindings+
(R ;; "lux;counter"
@@ -546,14 +550,14 @@
(|table)))
(defn env [name]
- (R ;; "lux;closure"
- +init-bindings+
+ (R ;; "lux;name"
+ name
;; "lux;inner-closures"
0
;; "lux;locals"
+init-bindings+
- ;; "lux;name"
- name
+ ;; "lux;closure"
+ +init-bindings+
))
(let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String
@@ -576,32 +580,32 @@
(defn host [_]
(let [store (atom {})]
- (R ;; "lux;classes"
- store
+ (R ;; "lux;writer"
+ (V $None nil)
;; "lux;loader"
(memory-class-loader store)
- ;; "lux;writer"
- (V $None nil))))
+ ;; "lux;classes"
+ store)))
(defn init-state [_]
- (R ;; "lux;cursor"
+ (R ;; "lux;source"
+ (V $None nil)
+ ;; "lux;cursor"
(T "" -1 -1)
+ ;; "lux;modules"
+ (|table)
;; "lux;envs"
(|list)
- ;; "lux;eval?"
- false
+ ;; "lux;types"
+ +init-bindings+
;; "lux;expected"
(V $VariantT (|list))
- ;; "lux;host"
- (host nil)
- ;; "lux;modules"
- (|table)
;; "lux;seed"
0
- ;; "lux;source"
- (V $None nil)
- ;; "lux;types"
- +init-bindings+
+ ;; "lux;eval?"
+ false
+ ;; "lux;host"
+ (host nil)
))
(defn save-module [body]
@@ -609,8 +613,8 @@
(|case (body state)
($Right state* output)
(return* (->> state*
- (set$ $ENVS (get$ $ENVS state))
- (set$ $SOURCE (get$ $SOURCE state)))
+ (set$ $envs (get$ $envs state))
+ (set$ $source (get$ $source state)))
output)
($Left msg)
@@ -618,20 +622,20 @@
(defn with-eval [body]
(fn [state]
- (|case (body (set$ $EVAL? true state))
+ (|case (body (set$ $eval? true state))
($Right state* output)
- (return* (set$ $EVAL? (get$ $EVAL? state) state*) output)
+ (return* (set$ $eval? (get$ $eval? state) state*) output)
($Left msg)
(fail* msg))))
(def get-eval
(fn [state]
- (return* state (get$ $EVAL? state))))
+ (return* state (get$ $eval? state))))
(def get-writer
(fn [state]
- (let [writer* (->> state (get$ $HOST) (get$ $WRITER))]
+ (let [writer* (->> state (get$ $host) (get$ $writer))]
(|case writer*
($Some datum)
(return* state datum)
@@ -641,15 +645,15 @@
(def get-top-local-env
(fn [state]
- (try (let [top (|head (get$ $ENVS state))]
+ (try (let [top (|head (get$ $envs state))]
(return* state top))
(catch Throwable _
(fail* "No local environment.")))))
(def gen-id
(fn [state]
- (let [seed (get$ $SEED state)]
- (return* (set$ $SEED (inc seed) state) seed))))
+ (let [seed (get$ $seed state)]
+ (return* (set$ $seed (inc seed) state) seed))))
(defn ->seq [xs]
(|case xs
@@ -671,19 +675,19 @@
(def get-module-name
(fn [state]
- (|case (|reverse (get$ $ENVS state))
+ (|case (|reverse (get$ $envs state))
($Nil)
(fail* "[Analyser Error] Can't get the module-name without a module.")
($Cons ?global _)
- (return* state (get$ $NAME ?global)))))
+ (return* state (get$ $name ?global)))))
(defn with-scope [name body]
(fn [state]
- (let [output (body (update$ $ENVS #(|cons (env name) %) state))]
+ (let [output (body (update$ $envs #(|cons (env name) %) state))]
(|case output
($Right state* datum)
- (return* (update$ $ENVS |tail state*) datum)
+ (return* (update$ $envs |tail state*) datum)
_
output))))
@@ -693,23 +697,23 @@
(defn with-closure [body]
(|do [closure-name (|do [top get-top-local-env]
- (return (->> top (get$ $INNER-CLOSURES) str)))]
+ (return (->> top (get$ $inner-closures) str)))]
(fn [state]
(let [body* (with-scope closure-name body)]
- (run-state body* (update$ $ENVS #(|cons (update$ $INNER-CLOSURES inc (|head %))
+ (run-state body* (update$ $envs #(|cons (update$ $inner-closures inc (|head %))
(|tail %))
state))))))
(def get-scope-name
(fn [state]
- (return* state (->> state (get$ $ENVS) (|map #(get$ $NAME %)) |reverse))))
+ (return* state (->> state (get$ $envs) (|map #(get$ $name %)) |reverse))))
(defn with-writer [writer body]
(fn [state]
- (let [output (body (update$ $HOST #(set$ $WRITER (V $Some writer) %) state))]
+ (let [output (body (update$ $host #(set$ $writer (V $Some writer) %) state))]
(|case output
($Right ?state ?value)
- (return* (update$ $HOST #(set$ $WRITER (->> state (get$ $HOST) (get$ $WRITER)) %) ?state)
+ (return* (update$ $host #(set$ $writer (->> state (get$ $host) (get$ $writer)) %) ?state)
?value)
_
@@ -718,10 +722,10 @@
(defn with-expected-type [type body]
"(All [a] (-> Type (Lux a)))"
(fn [state]
- (let [output (body (set$ $EXPECTED type state))]
+ (let [output (body (set$ $expected type state))]
(|case output
($Right ?state ?value)
- (return* (set$ $EXPECTED (get$ $EXPECTED state) ?state)
+ (return* (set$ $expected (get$ $expected state) ?state)
?value)
_
@@ -852,7 +856,7 @@
(def modules
"(Lux (List Text))"
(fn [state]
- (return* state (|keys (get$ $MODULES state)))))
+ (return* state (|keys (get$ $modules state)))))
(defn when% [test body]
"(-> Bool (Lux (,)) (Lux (,)))"
@@ -884,3 +888,9 @@
["" name] (|do [module get-module-name]
(return (T module name)))
_ (return ident)))
+
+(defn ident= [x y]
+ (|let [[xmodule xname] x
+ [ymodule yname] y]
+ (and (= xmodule ymodule)
+ (= xname yname))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 7622e3002..1814a97c0 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -58,9 +58,6 @@
(&a/$tuple ?elems)
(&&lux/compile-tuple compile-expression ?type ?elems)
- (&a/$record ?elems)
- (&&lux/compile-record compile-expression ?type ?elems)
-
(&a/$var (&/$Local ?idx))
(&&lux/compile-local compile-expression ?type ?idx)
@@ -426,7 +423,7 @@
(fn [state]
(|case ((&/with-writer =class
(&/exhaust% compiler-step))
- (&/set$ &/$SOURCE (&reader/from file-name file-content) state))
+ (&/set$ &/$source (&reader/from file-name file-content) state))
(&/$Right ?state _)
(&/run-state (|do [defs &a-module/defs
imports &a-module/imports
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index 742ac69d8..85488553c 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -58,7 +58,7 @@
(defn clean [state]
"(-> Compiler (,))"
- (let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set)
+ (let [needed-modules (->> state (&/get$ &/$modules) &/|keys &/->seq set)
outdated? #(-> ^File % .getName (string/replace &host/module-separator "/") (->> (contains? needed-modules)) not)
outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))
program-file (new File &&/output-package)]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index b108d463c..4d8ac2190 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -102,29 +102,6 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- (&a-case/$RecordTestAC ?slots)
- (doto writer
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
- (-> (doto (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx))
- (.visitInsn Opcodes/AALOAD)
- (compile-match test $next $sub-else)
- (.visitLabel $sub-else)
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $else)
- (.visitLabel $next))
- (->> (|let [[idx [_ test]] idx+member
- $next (new Label)
- $sub-else (new Label)])
- (doseq [idx+member (->> ?slots
- &/->seq
- (sort compare-kv)
- &/->list
- &/enumerate
- &/->seq)])))
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $target))
-
(&a-case/$VariantTestAC ?tag ?test)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 9baefa21c..e2b9f0e89 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -72,27 +72,6 @@
(&/|range num-elems) ?elems)]
(return nil)))
-(defn compile-record [compile *type* ?elems]
- (|do [^MethodVisitor *writer* &/get-writer
- :let [elems* (->> ?elems
- &/->seq
- (sort #(compare (&/|first %1) (&/|first %2)))
- &/->list)
- num-elems (&/|length elems*)
- _ (doto *writer*
- (.visitLdcInsn (int num-elems))
- (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))]
- _ (&/map2% (fn [idx kv]
- (|let [[k v] kv]
- (|do [:let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx)))]
- ret (compile v)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret))))
- (&/|range num-elems) elems*)]
- (return nil)))
-
(defn compile-variant [compile *type* ?tag ?value]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 6aa8cca6d..e0195658f 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -21,7 +21,7 @@
;; [Utils]
(defn ^:private with-line [body]
(fn [state]
- (|case (&/get$ &/$SOURCE state)
+ (|case (&/get$ &/$source state)
(&/$Nil)
(fail* "[Reader Error] EOF")
@@ -32,19 +32,19 @@
(fail* msg)
($Done output)
- (return* (&/set$ &/$SOURCE more state)
+ (return* (&/set$ &/$source more state)
output)
($Yes output line*)
- (return* (&/set$ &/$SOURCE (&/|cons line* more) state)
+ (return* (&/set$ &/$source (&/|cons line* more) state)
output))
)))
(defn ^:private with-lines [body]
(fn [state]
- (|case (body (&/get$ &/$SOURCE state))
+ (|case (body (&/get$ &/$source state))
(&/$Right reader* match)
- (return* (&/set$ &/$SOURCE reader* state)
+ (return* (&/set$ &/$source reader* state)
match)
(&/$Left msg)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 94b0fbc5e..92c986985 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -209,12 +209,12 @@
(Tuple$ (&/|list (Bound$ "s")
(Bound$ "a"))))))))
-(def Reader
+(def Source
(App$ List
(App$ (App$ Meta Cursor)
Text)))
-(def HostState
+(def Host
(Record$
(&/|list
;; "lux;writer"
@@ -274,7 +274,9 @@
(Record$
(&/|list
;; "lux;source"
- Reader
+ Source
+ ;; "lux;cursor"
+ Cursor
;; "lux;modules"
(App$ List (Tuple$ (&/|list Text
(App$ $Module (App$ (Bound$ "lux;Compiler") (Bound$ ""))))))
@@ -284,16 +286,14 @@
(Tuple$ (&/|list LuxVar Type))))
;; "lux;types"
(App$ (App$ Bindings Int) Type)
- ;; "lux;host"
- HostState
+ ;; "lux;expected"
+ Type
;; "lux;seed"
Int
;; "lux;eval?"
Bool
- ;; "lux;expected"
- Type
- ;; "lux;cursor"
- Cursor
+ ;; "lux;host"
+ Host
)))
$Void))
@@ -304,7 +304,7 @@
(defn bound? [id]
(fn [state]
- (if-let [type (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
+ (if-let [type (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
(|case type
(&/$Some type*)
(return* state true)
@@ -315,7 +315,7 @@
(defn deref [id]
(fn [state]
- (if-let [type* (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
+ (if-let [type* (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
(|case type*
(&/$Some type)
(return* state type)
@@ -326,26 +326,26 @@
(defn set-var [id type]
(fn [state]
- (if-let [tvar (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
+ (if-let [tvar (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
(|case tvar
(&/$Some bound)
(fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound)))
(&/$None)
- (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V &/$Some type) %)
+ (return* (&/update$ &/$types (fn [ts] (&/update$ &/$mappings #(&/|put id (&/V &/$Some type) %)
ts))
state)
nil))
- (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) &/|length))))))
+ (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$types) (&/get$ &/$mappings) &/|length))))))
;; [Exports]
;; Type vars
(def ^:private create-var
(fn [state]
- (let [id (->> state (&/get$ &/$TYPES) (&/get$ &/$COUNTER))]
- (return* (&/update$ &/$TYPES #(->> %
- (&/update$ &/$COUNTER inc)
- (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V &/$None nil) ms))))
+ (let [id (->> state (&/get$ &/$types) (&/get$ &/$counter))]
+ (return* (&/update$ &/$types #(->> %
+ (&/update$ &/$counter inc)
+ (&/update$ &/$mappings (fn [ms] (&/|put id (&/V &/$None nil) ms))))
state)
id))))
@@ -380,11 +380,11 @@
(|do [?type** (clean* id ?type*)]
(return (&/T ?id (&/V &/$Some ?type**)))))
))))
- (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
+ (->> state (&/get$ &/$types) (&/get$ &/$mappings)))]
(fn [state]
- (return* (&/update$ &/$TYPES #(->> %
- (&/update$ &/$COUNTER dec)
- (&/set$ &/$MAPPINGS (&/|remove id mappings*)))
+ (return* (&/update$ &/$types #(->> %
+ (&/update$ &/$counter dec)
+ (&/set$ &/$mappings (&/|remove id mappings*)))
state)
nil)))
state))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 05:32:47 +0000