Merge pull request #58 from LuxLang/hierarchy_normalization

Hierarchy normalization

1 files changed, 69 insertions, 0 deletions

diff --git a/stdlib/source/library/lux/data/product.lux b/stdlib/source/library/lux/data/product.lux
new file mode 100644
index 000000000..6cf05ac83
--- /dev/null
+++ b/stdlib/source/library/lux/data/product.lux
@@ -0,0 +1,69 @@
+(.module:
+  {#.doc "Functionality for working with tuples (particularly 2-tuples)."}
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]]]])
+
+(template [<name> <type> <output>]
+  [(def: #export (<name> xy)
+     (All [a b] (-> (& a b) <type>))
+     (let [[x y] xy]
+       <output>))]
+
+  [left  a x]
+  [right b y]
+  )
+
+(def: #export (curry f)
+  (All [a b c]
+    (-> (-> (& a b) c)
+        (-> a b c)))
+  (function (_ x y)
+    (f [x y])))
+
+(def: #export (uncurry f)
+  (All [a b c]
+    (-> (-> a b c)
+        (-> (& a b) c)))
+  (function (_ xy)
+    (let [[x y] xy]
+      (f x y))))
+
+(def: #export (swap xy)
+  (All [a b] (-> (& a b) (& b a)))
+  (let [[x y] xy]
+    [y x]))
+
+(def: #export (apply f g)
+  (All [a b c d]
+    (-> (-> a c) (-> b d)
+        (-> (& a b) (& c d))))
+  (function (_ [x y])
+    [(f x) (g y)]))
+
+(def: #export (fork f g)
+  (All [a l r]
+    (-> (-> a l) (-> a r)
+        (-> a (& l r))))
+  (function (_ x)
+    [(f x) (g x)]))
+
+(implementation: #export (equivalence left right)
+  (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence [l r])))
+
+  (def: (= [rl rr] [sl sr])
+    (and (\ left = rl sl)
+         (\ right = rr sr))))
+
+(def: #export (hash left right)
+  (All [l r] (-> (Hash l) (Hash r) (Hash (& l r))))
+  (implementation
+   (def: &equivalence
+     (..equivalence (\ left &equivalence)
+                    (\ right &equivalence)))
+   (def: (hash [leftV rightV])
+     ("lux i64 +"
+      (\ left hash leftV)
+      (\ right hash rightV)))))