From 1dd0787c5bb2470d31355125120c96052b041d90 Mon Sep 17 00:00:00 2001 From: Julien Coolen Date: Sun, 3 Nov 2024 17:00:16 +0100 Subject: [PATCH] functorial interface wip --- src/pari.ml | 154 ++++++++++++++++++++++++++++++++++++++++++++++++++- src/pari.mli | 120 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 272 insertions(+), 2 deletions(-) diff --git a/src/pari.ml b/src/pari.ml index 8ed5348..ba1b292 100644 --- a/src/pari.ml +++ b/src/pari.ml @@ -4,6 +4,9 @@ type 'kind ty = gen let t = gen +let register_gc v = + Gc.finalise_last (fun () -> pari_free Ctypes.(coerce gen (ptr void) v)) v + type group = Group type ring = Ring type field = Field @@ -19,8 +22,155 @@ type number_field = Number_field type 'a elliptic_curve = Elliptic_curve of 'a type 'a matrix = private Matrix of 'a -let register_gc v = - Gc.finalise_last (fun () -> pari_free Ctypes.(coerce gen (ptr void) v)) v +module F = struct + module type PARI_t = sig + type t + type k + + external of_gen : k ty -> t = "%identity" + external to_gen : t -> k ty = "%identity" + end + + module type Ring = sig + type t + + val add : t -> t -> t + val mul : t -> t -> t + end + + module Natural = struct + type t + end + + module type Multiplicative = sig + type t + + val mul : t -> t -> t + end + + module type Unital = sig + type t + + include Multiplicative with type t := t + + val one : t + val pow : t -> Natural.t -> t + end + + module type Division = sig + type t + + include Unital with type t := t + + val reciprocal : t -> t + val divide : t -> t -> t + end + + module type Domain = sig + type t + + include Ring with type t := t + + val divides : t -> t -> bool + end + + module type IntegralDomain = sig + type t + + include Domain with type t := t + + val divides : t -> t -> bool + end + + module type GCDDomain = sig + type t + + include IntegralDomain with type t := t + + val gcd : t -> t -> t + val lcm : t -> t -> t + end + + module type UFD = sig + type t + + include IntegralDomain with type t := t + + val factor : t -> (t * int) array + end + + module type PID = sig + type t + + include UFD with type t := t + + val egcd : t -> t -> t * t * t + end + + module type EuclideanDomain = sig + type t + + include PID with type t := t + + val ediv : t -> t -> t * t + val quot : t -> t -> t + val rem : t -> t -> t + val chinese : (t * t) array -> t * t + end + + module type Field = sig + type t + + include EuclideanDomain with type t := t + include Division with type t := t + end + + module type Poly = sig + include PARI_t + include Ring with type t := t + module BaseRing : Ring + + val create : BaseRing.t array -> t + end + + module Polynomial (R : sig + include PARI_t + include Ring with type t := t + end) : Poly with type k = R.k polynomial = struct + type t = gen + type k = R.k polynomial + + external of_gen : k ty -> t = "%identity" + external to_gen : t -> k ty = "%identity" + + module BaseRing = R + + let add = gadd + let mul = gmul + + let create (p : R.t array) : t = + let len = Array.length p in + let size = Signed.Long.of_int (Int.add len 2) in + let p' = cgetg size (Signed.Long.of_int 10 (* t_POL *)) in + let p'' = Ctypes.(coerce gen (ptr gen) p') in + (* TODO: support 32-bit arch *) + let typ = gentostr (type0 @@ R.to_gen p.(0)) in + let v = + if typ = "\"t_POL\"" then Signed.Long.(succ (gvar @@ R.to_gen p.(0))) + else Signed.Long.zero + in + Ctypes.(p' +@ 1 <-@ Signed.Long.(shift_left v Stdlib.(64 - 2 - 16))); + for i = 0 to len - 1 do + Ctypes.(p'' +@ (i + 2) <-@ R.to_gen p.(len - 1 - i)) + done; + let p = normalizepol_lg p' size in + register_gc @@ to_gen p; + p + end + + type ('t, 'coeff) poly = + (module Poly with type k = 'coeff polynomial and type t = 't) +end let gentostr = gentostr_raw let gentobytes x = gentostr x |> String.to_bytes diff --git a/src/pari.mli b/src/pari.mli index bfad899..16dbaeb 100644 --- a/src/pari.mli +++ b/src/pari.mli @@ -111,6 +111,126 @@ type 'a elliptic_curve = private Elliptic_curve of 'a val factor : 'a ty -> ('a ty * int) array +module F : sig + module type PARI_t = sig + type t + type k + + external of_gen : k ty -> t = "%identity" + external to_gen : t -> k ty = "%identity" + end + + module type Ring = sig + type t + + val add : t -> t -> t + val mul : t -> t -> t + end + + module Natural : sig + type t + end + + module type Multiplicative = sig + type t + + val mul : t -> t -> t + end + + module type Unital = sig + type t + + include Multiplicative with type t := t + + val one : t + val pow : t -> Natural.t -> t + end + + module type Division = sig + type t + + include Unital with type t := t + + val reciprocal : t -> t + val divide : t -> t -> t + end + + module type Domain = sig + type t + + include Ring with type t := t + + val divides : t -> t -> bool + end + + module type IntegralDomain = sig + type t + + include Domain with type t := t + + val divides : t -> t -> bool + end + + module type GCDDomain = sig + type t + + include IntegralDomain with type t := t + + val gcd : t -> t -> t + val lcm : t -> t -> t + end + + module type UFD = sig + type t + + include IntegralDomain with type t := t + + val factor : t -> (t * int) array + end + + module type PID = sig + type t + + include UFD with type t := t + + val egcd : t -> t -> t * t * t + end + + module type EuclideanDomain = sig + type t + + include PID with type t := t + + val ediv : t -> t -> t * t + val quot : t -> t -> t + val rem : t -> t -> t + val chinese : (t * t) array -> (t * t) + end + + module type Field = sig + type t + + include EuclideanDomain with type t := t + include Division with type t := t + end + + module type Poly = sig + include PARI_t + include Ring with type t := t + module BaseRing : Ring + + val create : BaseRing.t array -> t + end + + module Polynomial (R : sig + include PARI_t + include Ring with type t := t + end) : Poly with type k = R.k polynomial + + type ('t, 'coeff) poly = + (module Poly with type k = 'coeff polynomial and type t = 't) +end + module rec Complex : sig type t = complex ty