Implemented function memoization.

4 files changed, 147 insertions, 22 deletions

diff --git a/stdlib/source/lux/control/function/memo.lux b/stdlib/source/lux/control/function/memo.lux
new file mode 100644
index 000000000..975d03148
--- /dev/null
+++ b/stdlib/source/lux/control/function/memo.lux
@@ -0,0 +1,62 @@
+## Inspired by;
+## "The Different Aspects of Monads and Mixins" by Bruno C. d. S. Oliveira
+
+(.module:
+  [lux #*
+   [abstract
+    [hash (#+ Hash)]
+    [monad (#+ do)]]
+   [control
+    ["." state (#+ State)]]
+   [data
+    ["." product]
+    [collection
+     ["." dictionary (#+ Dictionary)]]]]
+  ["." // #_
+   ["#" mixin (#+ Mixin Recursive)]])
+
+(def: #export memoization
+  (All [i o]
+    (Mixin (-> i (State (Dictionary i o) o))))
+  (function (_ delegate recur)
+    (function (_ input)
+      (do state.monad
+        [memory state.get]
+        (case (dictionary.get input memory)
+          (#.Some output)
+          (wrap output)
+
+          #.None
+          (do @
+            [output (delegate input)
+             _ (state.update (dictionary.put input output))]
+            (wrap output)))))))
+
+(type: #export (Memo i o)
+  (Recursive i (State (Dictionary i o) o)))
+
+(def: #export (open memo)
+  {#.doc (doc "Memoization where the memoized results can be re-used accross invocations.")}
+  (All [i o]
+    (-> (Memo i o) (-> [(Dictionary i o) i] [(Dictionary i o) o])))
+  (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo)))]
+    (function (_ [memory input])
+      (|> input memo (state.run memory)))))
+
+(def: #export (closed hash memo)
+  {#.doc (doc "Memoization confined to a single invocation to the function (not counting any subsequent recursive invocations)."
+              "Memoized results will be re-used during recursive invocations, but cannot be accessed after the main invocation has ended.")}
+  (All [i o]
+    (-> (Hash i) (Memo i o) (-> i o)))
+  (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo)))
+        empty (dictionary.new hash)]
+    (|>> memo (state.run empty) product.right)))
+
+(def: #export (none hash memo)
+  {#.doc (doc "No memoization at all."
+              "This is useful as a test control when measuring the effect of using memoization.")}
+  (All [i o]
+    (-> (Hash i) (Memo i o) (-> i o)))
+  (let [memo (//.mixin (//.from-recursive memo))
+        empty (dictionary.new hash)]
+    (|>> memo (state.run empty) product.right)))
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index a6dd67617..99dbc2a73 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -45,29 +45,26 @@
      (Format <type>)
      <formatter>)]
 
-  [bit     Bit             (:: bit.codec encode)]
-  [nat     Nat             (:: nat.decimal encode)]
-  [int     Int             (:: int.decimal encode)]
-  [rev     Rev             (:: rev.decimal encode)]
-  [frac    Frac            (:: frac.decimal encode)]
-  [ratio   ratio.Ratio     (:: ratio.codec encode)]
-  [text    Text            text.encode]
-  [name    Name            (:: name.codec encode)]
-  [code    Code            code.to-text]
-  [type    Type            type.to-text]
-  [bin     Nat             (:: nat.binary encode)]
-  [oct     Nat             (:: nat.octal encode)]
-  [hex     Nat             (:: nat.hex encode)]
-  [xml     xml.XML         (:: xml.codec encode)]
-  [json    json.JSON       (:: json.codec encode)]
-  [instant instant.Instant instant.to-text]
-  [date    date.Date       (:: date.codec encode)]
+  [bit      Bit               (:: bit.codec encode)]
+  [nat      Nat               (:: nat.decimal encode)]
+  [int      Int               (:: int.decimal encode)]
+  [rev      Rev               (:: rev.decimal encode)]
+  [frac     Frac              (:: frac.decimal encode)]
+  [ratio    ratio.Ratio       (:: ratio.codec encode)]
+  [text     Text              text.encode]
+  [name     Name              (:: name.codec encode)]
+  [code     Code              code.to-text]
+  [type     Type              type.to-text]
+  [bin      Nat               (:: nat.binary encode)]
+  [oct      Nat               (:: nat.octal encode)]
+  [hex      Nat               (:: nat.hex encode)]
+  [xml      xml.XML           (:: xml.codec encode)]
+  [json     json.JSON         (:: json.codec encode)]
+  [instant  instant.Instant   instant.to-text]
+  [duration duration.Duration duration.encode]
+  [date     date.Date         (:: date.codec encode)]
   )
 
-(def: #export duration
-  (Format duration.Duration)
-  duration.encode)
-
 (def: #export (cursor [file line column])
   (Format Cursor)
   (|> (.list (..text file) (..nat line) (..nat column))
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))))))))))