aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/math/simple.lux306
1 files changed, 0 insertions, 306 deletions
diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux
deleted file mode 100644
index 752f5a5b5..000000000
--- a/stdlib/source/lux/math/simple.lux
+++ /dev/null
@@ -1,306 +0,0 @@
-(;module: {#;doc "Polymorphic arithmetic operators that work with all primitive numeric types, without requiring any prefixes."}
- lux
- (lux (control monad
- ["p" parser])
- (data text/format
- [product]
- (coll [list]))
- [macro]
- (macro [code]
- ["s" syntax #+ syntax: Syntax])
- [type]
- (type [check])))
-
-(def: (find-type-var id env)
- (-> Nat Type-Context (Lux Type))
- (case (list;find (|>. product;left (n.= id))
- (get@ #;var-bindings env))
- (#;Some [_ (#;Some type)])
- (case type
- (#;Var id')
- (find-type-var id' env)
-
- _
- (:: macro;Monad<Lux> wrap type))
-
- (#;Some [_ #;None])
- (macro;fail (format "Unbound type-var " (%n id)))
-
- #;None
- (macro;fail (format "Unknown type-var " (%n id)))
- ))
-
-(def: (resolve-type var-name)
- (-> Ident (Lux Type))
- (do macro;Monad<Lux>
- [raw-type (macro;find-type var-name)
- compiler macro;get-compiler]
- (case raw-type
- (#;Var id)
- (find-type-var id (get@ #;type-context compiler))
-
- _
- (wrap raw-type))))
-
-(do-template [<name> <rec> <nat-op> <int-op> <real-op> <deg-op>]
- [(syntax: #export (<name> [args ($_ p;alt
- (p;seq (p;alt s;symbol s;any)
- (p;some s;any))
- s;end!)])
- ## {#;doc (doc (= (<name> +1 +2)
- ## (<nat-op> +1 +2))
- ## (= (<name> 1 2)
- ## (<int-op> 1 2))
- ## (= (<name> 1.0 2.0)
- ## (<real-op> 1.0 2.0))
- ## (= (<name> .1 .2)
- ## (<deg-op> .1 .2)))}
- (case args
- (+0 [(#;Left x) ys])
- (do @
- [=x (resolve-type x)
- op (cond (check;checks? Nat =x)
- (wrap (` <nat-op>))
-
- (check;checks? Int =x)
- (wrap (` <int-op>))
-
- (check;checks? Real =x)
- (wrap (` <real-op>))
-
- (check;checks? Deg =x)
- (wrap (` <deg-op>))
-
- (macro;fail (format "No operation for types: " (%type =x))))]
- (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys))))))
-
- (+0 [(#;Right x) ys])
- (do @
- [g!x (macro;gensym "g!x")]
- (wrap (list (` (let [(~ g!x) (~ x)]
- (<rec> (~ g!x) (~@ ys)))))))
-
- (+1 [])
- (do @
- [=e macro;expected-type
- op (cond (check;checks? (-> Nat Nat Nat) =e)
- (wrap (` <nat-op>))
-
- (check;checks? (-> Int Int Int) =e)
- (wrap (` <int-op>))
-
- (check;checks? (-> Real Real Real) =e)
- (wrap (` <real-op>))
-
- (check;checks? (-> Deg Deg Deg) =e)
- (wrap (` <deg-op>))
-
- (macro;fail (format "No operation for type: " (%type =e))))]
- (wrap (list op)))
- ))]
-
- [+ ;;+ n.+ i.+ r.+ d.+]
- [- ;;- n.- i.- r.- d.-]
- [* ;;* n.* i.* r.* d.*]
- [/ ;;/ n./ i./ r./ d./]
- [% ;;% n.% i.% r.% d.%]
- )
-
-(do-template [<name> <rec> <nat-op> <int-op> <real-op> <deg-op>]
- [(syntax: #export (<name> [args ($_ p;alt
- (p;seq (p;alt s;symbol s;any)
- (p;some s;any))
- s;end!)])
- ## {#;doc (doc (= (<name> +1 +2)
- ## (<nat-op> +1 +2))
- ## (= (<name> 1 2)
- ## (<int-op> 1 2))
- ## (= (<name> 1.0 2.0)
- ## (<real-op> 1.0 2.0))
- ## (= (<name> .1 .2)
- ## (<deg-op> .1 .2)))}
- (case args
- (+0 [(#;Left x) ys])
- (do @
- [=x (resolve-type x)
- op (cond (check;checks? Nat =x)
- (wrap (` <nat-op>))
-
- (check;checks? Int =x)
- (wrap (` <int-op>))
-
- (check;checks? Real =x)
- (wrap (` <real-op>))
-
- (check;checks? Deg =x)
- (wrap (` <deg-op>))
-
- (macro;fail (format "No operation for types: " (%type =x))))]
- (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys))))))
-
- (+0 [(#;Right x) ys])
- (do @
- [g!x (macro;gensym "g!x")]
- (wrap (list (` (let [(~ g!x) (~ x)]
- (<rec> (~ g!x) (~@ ys)))))))
-
- (+1 [])
- (do @
- [=e macro;expected-type
- op (cond (check;checks? (-> Nat Nat Bool) =e)
- (wrap (` <nat-op>))
-
- (check;checks? (-> Int Int Bool) =e)
- (wrap (` <int-op>))
-
- (check;checks? (-> Real Real Bool) =e)
- (wrap (` <real-op>))
-
- (check;checks? (-> Deg Deg Bool) =e)
- (wrap (` <deg-op>))
-
- (macro;fail (format "No operation for type: " (%type =e))))]
- (wrap (list op)))
- ))]
-
- [= ;;= n.= i.= r.= d.=]
- [< ;;< n.< i.< r.< d.<]
- [<= ;;<= n.<= i.<= r.<= d.<=]
- [> ;;> n.> i.> r.> d.>]
- [>= ;;>= n.>= i.>= r.>= d.>=]
- )
-
-(do-template [<name> <rec> <nat-op> <int-op>]
- [(syntax: #export (<name> [args ($_ p;alt
- (p;seq (p;alt s;symbol s;any)
- (p;some s;any))
- s;end!)])
- ## {#;doc (doc (= (<name> +1 +2)
- ## (<nat-op> +1 +2))
- ## (= (<name> 1 2)
- ## (<int-op> 1 2)))}
- (case args
- (+0 [(#;Left x) ys])
- (do @
- [=x (resolve-type x)
- op (cond (check;checks? Nat =x)
- (wrap (` <nat-op>))
-
- (check;checks? Int =x)
- (wrap (` <int-op>))
-
- (macro;fail (format "No operation for types: " (%type =x))))]
- (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys))))))
-
- (+0 [(#;Right x) ys])
- (do @
- [g!x (macro;gensym "g!x")]
- (wrap (list (` (let [(~ g!x) (~ x)]
- (<rec> (~ g!x) (~@ ys)))))))
-
- (+1 [])
- (do @
- [=e macro;expected-type
- op (cond (check;checks? (-> Nat Nat Nat) =e)
- (wrap (` <nat-op>))
-
- (check;checks? (-> Int Int Int) =e)
- (wrap (` <int-op>))
-
- (macro;fail (format "No operation for type: " (%type =e))))]
- (wrap (list op)))
- ))]
-
- [min ;;min n.min i.min]
- [max ;;max n.max i.max]
- )
-
-(do-template [<name> <rec> <nat-op> <int-op>]
- [(syntax: #export (<name> [args ($_ p;alt
- s;symbol
- s;any
- s;end!)])
- ## {#;doc (doc (= (<name> +1 +2)
- ## (<nat-op> +1 +2))
- ## (= (<name> 1 2)
- ## (<int-op> 1 2)))}
- (case args
- (+0 x)
- (do @
- [=x (resolve-type x)
- op (cond (check;checks? Nat =x)
- (wrap (` <nat-op>))
-
- (check;checks? Int =x)
- (wrap (` <int-op>))
-
- (macro;fail (format "No operation for type: " (%type =x))))]
- (wrap (list (` ((~ op) (~ (code;symbol x)))))))
-
- (+1 x)
- (do @
- [g!x (macro;gensym "g!x")]
- (wrap (list (` (let [(~ g!x) (~ x)]
- (<rec> (~ g!x)))))))
-
- (+2 [])
- (do @
- [=e macro;expected-type
- op (cond (check;checks? (-> Nat Nat) =e)
- (wrap (` <nat-op>))
-
- (check;checks? (-> Int Int) =e)
- (wrap (` <int-op>))
-
- (macro;fail (format "No operation for type: " (%type =e))))]
- (wrap (list op)))
- ))]
-
- [inc ;;inc n.inc i.inc]
- [dec ;;dec n.dec i.dec]
- )
-
-(do-template [<name> <rec> <nat-op> <int-op>]
- [(syntax: #export (<name> [args ($_ p;alt
- s;symbol
- s;any
- s;end!)])
- ## {#;doc (doc (= (<name> +1 +2)
- ## (<nat-op> +1 +2))
- ## (= (<name> 1 2)
- ## (<int-op> 1 2)))}
- (case args
- (+0 x)
- (do @
- [=x (resolve-type x)
- op (cond (check;checks? Nat =x)
- (wrap (` <nat-op>))
-
- (check;checks? Int =x)
- (wrap (` <int-op>))
-
- (macro;fail (format "No operation for type: " (%type =x))))]
- (wrap (list (` ((~ op) (~ (code;symbol x)))))))
-
- (+1 x)
- (do @
- [g!x (macro;gensym "g!x")]
- (wrap (list (` (let [(~ g!x) (~ x)]
- (<rec> (~ g!x)))))))
-
- (+2 [])
- (do @
- [=e macro;expected-type
- op (cond (check;checks? (-> Nat Bool) =e)
- (wrap (` <nat-op>))
-
- (check;checks? (-> Int Bool) =e)
- (wrap (` <int-op>))
-
- (macro;fail (format "No operation for type: " (%type =e))))]
- (wrap (list op)))
- ))]
-
- [even? ;;even? n.even? i.even?]
- [odd? ;;odd? n.odd? i.odd?]
- )
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 17:01:12 +0000