- Added type-safe modular arithmetic.

2 files changed, 177 insertions, 4 deletions

diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 1c56f1cb9..80d672d67 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -12,6 +12,7 @@
        (time [instant]
              [duration]
              [date])
+       (math [modular])
        [macro]
        (macro [code]
               ["s" syntax #+ syntax: Syntax])
@@ -26,14 +27,14 @@
     (wrap (list (` (let [(~ g!compose) (:: (~! text.Monoid<Text>) (~' compose))]
                      ($_ (~ g!compose) (~+ fragments))))))))
 
-## [Formatters]
-(type: #export (Formatter a)
+## [Formats]
+(type: #export (Format a)
   {#.doc "A way to produce readable text from values."}
   (-> a Text))
 
 (do-template [<name> <type> <formatter>]
   [(def: #export <name>
-     (Formatter <type>)
+     (Format <type>)
      <formatter>)]
 
   [%b        Bool              (:: bool.Codec<Text,Bool> encode)]
@@ -55,8 +56,13 @@
   [%date     date.Date         (:: date.Codec<Text,Date> encode)]
   )
 
+(def: #export (%mod modular)
+  (All [m] (Format (modular.Mod m)))
+  (let [[_ modulus] (modular.un-mod modular)]
+    (:: (modular.Codec<Text,Mod> modulus) encode modular)))
+
 (def: #export (%list formatter)
-  (All [a] (-> (Formatter a) (Formatter (List a))))
+  (All [a] (-> (Format a) (Format (List a))))
   (function [values]
     (case values
       #.Nil
diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux
new file mode 100644
index 000000000..7618a3a55
--- /dev/null
+++ b/stdlib/source/lux/math/modular.lux
@@ -0,0 +1,167 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:]
+                ["p" parser]
+                [codec #+ Codec]
+                [monad #+ do])
+       (data ["e" error #+ Error]
+             [number "int/" Codec<Text,Int>]
+             [text "text/" Monoid<Text>]
+             (text ["l" lexer #+ Lexer]))
+       (type abstract)
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [math]))
+
+(exception: #export Zero-Cannot-Be-A-Modulus)
+(exception: #export Cannot-Equalize-Numbers)
+(exception: #export Incorrect-Modulus)
+
+(abstract: #export (Modulus m)
+  {#.doc "A number used as a modulus in modular arithmetic.
+          It cannot be 0."}
+  
+  Int
+
+  (def: #export (from-int value)
+    (Ex [m] (-> Int (Error (Modulus m))))
+    (if (i/= 0 value)
+      (#e.Error (Zero-Cannot-Be-A-Modulus ""))
+      (#e.Success (@abstraction value))))
+
+  (def: #export (to-int modulus)
+    (All [m] (-> (Modulus m) Int))
+    (|> modulus @representation))
+  )
+
+(def: #export (congruent? modulus reference sample)
+  (All [m] (-> (Modulus m) Int Int Bool))
+  (|> sample
+      (i/- reference)
+      (i/% (to-int modulus))
+      (i/= 0)))
+
+(syntax: #export (modulus [modulus s.int])
+  (case (from-int modulus)
+    (#e.Success _)
+    (wrap (list (` (e.assume (..from-int (~ (code.int modulus)))))))
+    
+    (#e.Error error)
+    (p.fail error)))
+
+(def: (i/mod (^|> modulus [to-int])
+             value)
+  (All [m] (-> (Modulus m) Int Int))
+  (let [raw (i/% modulus value)]
+    (if (i/< 0 raw)
+      (let [shift (if (i/< 0 modulus) i/- i/+)]
+        (|> raw (shift modulus)))
+      raw)))
+
+(def: intL
+  (Lexer Int)
+  (p.codec number.Codec<Text,Int>
+           (p.either (l.seq (l.one-of "-") (l.many l.decimal))
+                     (l.many l.decimal))))
+
+(abstract: #export (Mod m)
+  {#.doc "A number under a modulus."}
+  
+  {#remainder Int
+   #modulus (Modulus m)}
+
+  (def: #export (mod modulus)
+    (All [m] (-> (Modulus m) (-> Int (Mod m))))
+    (function [value]
+      (@abstraction {#remainder (i/mod modulus value)
+                     #modulus modulus})))
+
+  (def: #export (un-mod modular)
+    (All [m] (-> (Mod m) [Int (Modulus m)]))
+    (@representation modular))
+
+  (def: separator Text " mod ")
+
+  (struct: #export (Codec<Text,Mod> modulus)
+    (All [m] (-> (Modulus m) (Codec Text (Mod m))))
+
+    (def: (encode modular)
+      (let [[remainder modulus] (@representation modular)]
+        ($_ text/compose
+            (int/encode remainder)
+            separator
+            (int/encode (to-int modulus)))))
+
+    (def: (decode text)
+      (<| (l.run text)
+          (do p.Monad<Parser>
+            [[remainder _ _modulus] ($_ p.seq intL (l.this separator) intL)
+             _ (p.assert (Incorrect-Modulus
+                          ($_ text/compose
+                              "Expected modulus: " (int/encode (to-int modulus)) "\n"
+                              "  Actual modulus: " (int/encode _modulus) "\n"))
+                         (i/= (to-int modulus) _modulus))]
+            (wrap (mod modulus remainder))))))
+
+  (def: #export (equalize reference sample)
+    (All [r s] (-> (Mod r) (Mod s) (Error (Mod r))))
+    (let [[reference reference-modulus] (@representation reference)
+          [sample sample-modulus] (@representation sample)]
+      (if (i/= (to-int reference-modulus)
+               (to-int sample-modulus))
+        (#e.Success (@abstraction {#remainder sample
+                                   #modulus reference-modulus}))
+        (#e.Error (Cannot-Equalize-Numbers
+                   ($_ text/compose
+                       "Reference modulus: " (int/encode (to-int reference-modulus)) "\n"
+                       "   Sample modulus: " (int/encode (to-int sample-modulus)) "\n"))))))
+
+  (do-template [<name> <op>]
+    [(def: #export (<name> reference sample)
+       (All [m] (-> (Mod m) (Mod m) Bool))
+       (let [[reference _] (@representation reference)
+             [sample _] (@representation sample)]
+         (<op> reference sample)))]
+
+    [m/= i/=]
+    [m/< i/<]
+    [m/<= i/<=]
+    [m/> i/>]
+    [m/>= i/>=]
+    )
+
+  (do-template [<name> <op>]
+    [(def: #export (<name> param subject)
+       (All [m] (-> (Mod m) (Mod m) (Mod m)))
+       (let [[param modulus] (@representation param)
+             [subject _] (@representation subject)]
+         (@abstraction {#remainder (|> subject
+                                       (<op> param)
+                                       (i/mod modulus))
+                        #modulus modulus})))]
+
+    [m/+ i/+]
+    [m/- i/-]
+    [m/* i/*])
+  
+  (def: (i/gcd+ a b)
+    (-> Int Int [Int Int Int])
+    (if (i/= 0 a)
+      [0 1 b]
+      (let [[ak bk gcd] (i/gcd+ (i/% a b) a)]
+        [(i/- (i/* ak
+                   (i// a b))
+              bk)
+         ak
+         gcd])))
+
+  (def: #export (inverse modular)
+    (All [m] (-> (Mod m) (Maybe (Mod m))))
+    (let [[value modulus] (@representation modular)
+          _modulus (to-int modulus)
+          [vk mk gcd] (i/gcd+ value _modulus)
+          co-prime? (i/= 1 gcd)]
+      (if co-prime?
+        (#.Some (mod modulus vk))
+        #.None)))
+  )