From 7f72a44157581d4f7f37d3627abb63749b9b9793 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 15 Sep 2019 22:03:01 -0400
Subject: Implemented function memoization.

---
 stdlib/source/test/lux/control.lux               | 11 ++++-
 stdlib/source/test/lux/control/function/memo.lux | 57 ++++++++++++++++++++++++
 2 files changed, 67 insertions(+), 1 deletion(-)
 create mode 100644 stdlib/source/test/lux/control/function/memo.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 12c906664..ace450eba 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- function)
    ["_" test (#+ Test)]]
   ["." / #_
    ["#." continuation]
@@ -24,6 +24,8 @@
     ["#/." cli]]
    [security
     ["#." policy]]
+   [function
+    ["#." memo]]
    ])
 
 (def: concurrency
@@ -49,6 +51,12 @@
       /policy.test
       ))
 
+(def: function
+  Test
+  ($_ _.and
+      /memo.test
+      ))
+
 (def: #export test
   Test
   ($_ _.and
@@ -66,4 +74,5 @@
       ..concurrency
       ..parser
       ..security
+      ..function
       ))
diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux
new file mode 100644
index 000000000..5b5c91271
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/memo.lux
@@ -0,0 +1,57 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract/monad (#+ do)]
+   ["%" data/text/format (#+ format)]
+   [control
+    ["." io (#+ IO)]
+    ["." state ("#@." monad)]]
+   [math
+    ["r" random]]
+   [data
+    [number
+     ["n" nat]]]
+   [time
+    ["." instant]
+    ["." duration (#+ Duration)]]]
+  {1
+   ["." /
+    ["/#" // #_
+     ["#" mixin]]]})
+
+(def: (fibonacci fibonacci input)
+  (/.Memo Nat Nat)
+  (case input
+    0 (state@wrap 0)
+    1 (state@wrap 1)
+    _ (do state.monad
+        [output-1 (fibonacci (n.- 1 input))
+         output-2 (fibonacci (n.- 2 input))]
+        (wrap (n.+ output-1 output-2)))))
+
+(def: (time function input)
+  (All [i o] (-> (-> i o) i (IO [Duration o])))
+  (do io.monad
+    [before instant.now
+     #let [output (function input)]
+     after instant.now]
+    (wrap [(instant.span before after)
+           output])))
+
+(def: #export test
+  Test
+  (<| (_.context (%.name (name-of /.memoization)))
+      (let [fast (/.closed n.hash fibonacci)
+            slow (/.none n.hash ..fibonacci)]
+        (do r.monad
+          [input (wrap 30)
+           #let [prefix (format (%.name (name-of /.memoization)) " => " (%.nat input) " => ")]]
+          (_.test "Memoization makes certain computations faster."
+                  (io.run
+                   (do io.monad
+                     [[fast-time fast-output] (..time fast input)
+                      [slow-time slow-output] (..time slow input)
+                      #let [_ (log! (format prefix "    memoized = " (%.duration fast-time)))
+                            _ (log! (format prefix "non-memoized = " (%.duration slow-time)))]]
+                     (wrap (and (n.= fast-output slow-output)
+                                (:: duration.order < slow-time fast-time))))))))))
-- 
cgit v1.2.3