aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/function/memo.lux62
-rw-r--r--stdlib/source/lux/data/text/format.lux39
-rw-r--r--stdlib/source/test/lux/control.lux11
-rw-r--r--stdlib/source/test/lux/control/function/memo.lux57
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))))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 09:36:29 +0000