Qi.myr

   1 use std
   2
   3 use t
   4
   5 use "traits"
   6 use "Q"
   7 use "Z"
   8
   9 pkg yakmo =
  10         type Qi = struct
  11                 re : Q#
  12                 im : Q#
  13         ;;
  14         impl disposable Qi#
  15         impl division_struct Qi#
  16         impl field_struct Qi#
  17         impl group_struct Qi#
  18         impl module_struct Qi# -> Q#
  19         impl real_struct Qi#
  20         impl ring_struct Qi#
  21         impl std.equatable Qi#
  22         impl t.dupable Qi#
  23
  24         const Qifrom : (re : Q#, im : Q# -> Qi#)
  25         const QifromS : (rep : byte[:], req : byte[:], imp : byte[:], imq : byte[:] -> std.result(Qi#, byte[:]))
  26         const getI : (-> Qi#)
  27 ;;
  28
  29 const __init__ = {
  30         var q : Qi#
  31         q = q
  32         std.fmtinstall(std.typeof(q), qifmt)
  33 }
  34
  35 const qifmt = {sb, ap, opts
  36         var q : Qi# = std.vanext(ap)
  37         var re : Q# = q.re
  38         var im : Q# = q.im
  39         var rez : bool = std.bigeqi(re.p, 0)
  40         var imz : bool = std.bigeqi(im.p, 0)
  41
  42         if rez && imz
  43                 std.sbputs(sb, "0")
  44         else
  45                 if !rez
  46                         std.sbfmt(sb, "{}", re.p)
  47                         if !std.bigeqi(re.q, 1)
  48                                 std.sbputs(sb, "/")
  49                                 std.sbfmt(sb, "{}", re.q)
  50                         ;;
  51                 ;;
  52
  53                 if !rez && !imz
  54                         std.sbputs(sb, " + ")
  55                 ;;
  56
  57                 if !imz
  58                         if !std.bigeqi(im.p, 1)
  59                                 std.sbfmt(sb, "{}", im.p)
  60                         ;;
  61                         std.sbputs(sb, "i")
  62                         if !std.bigeqi(im.q, 1)
  63                                 std.sbputs(sb, "/")
  64                                 std.sbfmt(sb, "{}", im.q)
  65                         ;;
  66                 ;;
  67         ;;
  68 }
  69
  70 /*
  71    TODO: Every invocation of this should be replaced with "std.free".
  72    Typechecking issues that Ori will fix soon.
  73  */
  74 const freewrap = { a : Qi#
  75         std.bytefree((a : byte#), sizeof(Qi))
  76 }
  77
  78 impl disposable Qi# =
  79         __dispose__ = {q : Qi#
  80                 __dispose__(q.re)
  81                 __dispose__(q.im)
  82                 /* std.free(q) */
  83                 freewrap(q)
  84         }
  85 ;;
  86
  87 impl group_struct Qi# =
  88         gid = {
  89                 var qa : Q# = gid()
  90                 var qb : Q# = gid()
  91                 var ret : Qi = [ .re = qa, .im = qb ]
  92                 -> (std.mk(ret) : Qi#) // TODO: Cast should be unnecessary
  93         }
  94
  95         eq_gid = {r
  96                 -> eq_gid(r.re) && eq_gid(r.im)
  97         }
  98
  99         gadd_ip = {q1 : Qi#, q2 : Qi#
 100                 gadd_ip(q1.re, q2.re)
 101                 gadd_ip(q1.im, q2.im)
 102         }
 103
 104         gadd = {q1 : Qi#, q2 : Qi#
 105                 var qq = t.dup(q1)
 106                 gadd_ip(qq, q2)
 107                 -> qq
 108         }
 109
 110         gneg_ip = {q : Qi#
 111                 gneg_ip(q.re)
 112                 gneg_ip(q.im)
 113         }
 114
 115         gneg = {q : Qi#
 116                 var qq = t.dup(q)
 117                 gneg_ip(qq)
 118                 -> qq
 119         }
 120 ;;
 121
 122 impl division_struct Qi# =
 123         div_maybe = {a, b
 124                 match finv(b)
 125                 | `std.Some bi: -> `std.Some rmul(a, bi)
 126                 | `std.None: -> `std.None
 127                 ;;
 128         }
 129 ;;
 130
 131 impl field_struct Qi# =
 132         finv = {q
 133                 /* TODO: auto should work here. */
 134                 var a2 : Q# = /* auto */ rmul(q.re, q.re)
 135                 var b2 : Q# = /* auto */ rmul(q.im, q.im)
 136                 var m : Q# =  /* auto */ gadd(a2, b2)
 137                 var ret : std.option(Qi#) = `std.None
 138
 139                 match finv(m)
 140                 | `std.None:
 141                 | `std.Some mi:
 142                         var ap : Q# = rmul(q.re, mi)
 143                         var bp : Q# = rmul(q.im, mi)
 144                         gneg_ip(bp)
 145                         var r : Qi = [ .re = ap, .im = bp ]
 146                         ret = `std.Some (std.mk(r) : Qi#) // TODO: Cast shouldn't be necessary
 147                         __dispose__(mi)
 148                 ;;
 149
 150                 __dispose__(a2)
 151                 __dispose__(b2)
 152                 __dispose__(m)
 153
 154                 -> ret
 155         }
 156 ;;
 157
 158 impl module_struct Qi# -> Q# =
 159         phi_ip = {r : Q#, q : Qi#
 160                 /* r · (a, b) := (r·a, r·b) */
 161                 rmul_ip(r, q.re)
 162                 rmul_ip(r, q.im)
 163         }
 164
 165         phi = {r : Q#, q : Qi#
 166                 var qq = t.dup(q)
 167                 phi_ip(r, qq)
 168                 -> qq
 169         }
 170 ;;
 171
 172 impl real_struct Qi# =
 173         compconj_ip = {q
 174                 compconj_ip(q.re)
 175                 gneg_ip(q.im)
 176         }
 177         compconj = {q
 178                 var qq = t.dup(q)
 179                 compconj_ip(qq)
 180                 -> qq
 181         }
 182 ;;
 183
 184 impl ring_struct Qi# =
 185         rid = {
 186                 /* (1, 0) \cong 1 + 0i */
 187                 var qa : Q# = rid()
 188                 var qb : Q# = gid()
 189                 var ret : Qi = [ .re = qa, .im = qb ]
 190                 -> (std.mk(ret) : Qi#) // TODO: Cast should be unnecessary
 191         }
 192
 193         rmul_ip = {q1 : Qi#, q2 : Qi#
 194                 /* (a, b) · (a', b') := (a·a' - b·b', a·b' + a'·b) */
 195
 196                 /* Beats me why the auto stuff doesn't work here */
 197                 var aap : Q# = /* auto */ rmul(q1.re, q2.re)
 198                 var bbp : Q# = /* auto */ rmul(q1.im, q2.im)
 199                 var mbbp : Q# = /* auto */ gneg(bbp)
 200                 var abp : Q# = /* auto */ rmul(q1.re, q2.im)
 201                 var apb : Q# = /* auto */ rmul(q2.re, q1.im)
 202                 var oldre : Q# = /* auto */ q1.re
 203                 var oldim : Q# = /* auto */ q1.im
 204                 q1.re = gadd(aap, mbbp)
 205                 q1.im = gadd(abp, apb)
 206                 __dispose__(aap)
 207                 __dispose__(bbp)
 208                 __dispose__(mbbp)
 209                 __dispose__(abp)
 210                 __dispose__(apb)
 211                 __dispose__(oldre)
 212                 __dispose__(oldim)
 213         }
 214
 215         rmul = {q1 : Qi#, q2 : Qi#
 216                 var qq : Qi# = t.dup(q1)
 217                 rmul_ip(qq, q2)
 218                 -> qq
 219         }
 220 ;;
 221
 222 impl std.equatable Qi# =
 223         eq = {a : Qi#, b : Qi#
 224                 -> std.eq(a.re, b.re) && std.eq(a.im, b.im)
 225         }
 226 ;;
 227
 228 impl t.dupable Qi# =
 229         dup = {q : Qi#
 230                 var rep : Q# = t.dup(q.re)
 231                 var imp : Q# = t.dup(q.im)
 232                 var ret : Qi = [ .re = rep, .im = imp ]
 233                 -> (std.mk(ret) : Qi#) // TODO: Cast shouldn't be necessary
 234         }
 235 ;;
 236
 237 const Qifrom = {re, im
 238         var rep : Q# = t.dup(re)
 239         var imp : Q# = t.dup(im)
 240         var q : Qi = [ .re = rep, .im = imp ]
 241         -> (std.mk(q) : Qi#) // TODO: Cast should be unnecessary */
 242 }
 243
 244 const QifromS = {rep, req, imp, imq
 245         match QfromS(rep, req)
 246         | `std.Err e:
 247                 auto (e : t.doomed_str)
 248                 -> `std.Err std.fmt("Bad real part: {}", e)
 249         | `std.Ok re:
 250                 match QfromS(imp, imq)
 251                 | `std.Err e:
 252                         auto (e : t.doomed_str)
 253                         -> `std.Err std.fmt("Bad imaginary part: {}", e)
 254                 | `std.Ok im:
 255                         var qbase : Qi = [ .re = re, .im = im ]
 256                         -> `std.Ok std.mk(qbase)
 257                 ;;
 258         ;;
 259 }
 260
 261 const getI = {
 262         var i : Qi = [ .re = gid(), .im = rid() ]
 263         -> (std.mk(i) : Qi#) // TODO: Cast should be unnecessary */
 264 }