##  Copyright (c) Eduardo Julian. All rights reserved.
##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
##  If a copy of the MPL was not distributed with this file,
##  You can obtain one at http://mozilla.org/MPL/2.0/.

(;module: {#;doc "Common mathematical constants and functions."}
  lux
  (lux (control monad)
       (data (struct [list "" Fold<List>])
             [number "Int/" Number<Int>]
             [product]
             text/format)
       host
       [compiler]
       (macro ["s" syntax #+ syntax: Syntax "s/" Functor<Syntax>]
              [ast])))

## [Values]
(do-template [<name> <value>]
  [(def: #export <name>
     Real
     (_lux_proc ["jvm" <value>] []))]

  [e  "getstatic:java.lang.Math:E"]
  [pi "getstatic:java.lang.Math:PI"]
  )

(def: #export tau
  {#;doc "The same as 2*PI."}
  Real
  6.28318530717958647692)

(do-template [<name> <method>]
  [(def: #export (<name> n)
     (-> Real Real)
     (_lux_proc ["jvm" <method>] [n]))]

  [cos   "invokestatic:java.lang.Math:cos:double"]
  [sin   "invokestatic:java.lang.Math:sin:double"]
  [tan   "invokestatic:java.lang.Math:tan:double"]

  [acos  "invokestatic:java.lang.Math:acos:double"]
  [asin  "invokestatic:java.lang.Math:asin:double"]
  [atan  "invokestatic:java.lang.Math:atan:double"]
  
  [cosh  "invokestatic:java.lang.Math:cosh:double"]
  [sinh  "invokestatic:java.lang.Math:sinh:double"]
  [tanh  "invokestatic:java.lang.Math:tanh:double"]

  [exp   "invokestatic:java.lang.Math:exp:double"]
  [log   "invokestatic:java.lang.Math:log:double"]
  
  [cbrt  "invokestatic:java.lang.Math:cbrt:double"]
  [sqrt  "invokestatic:java.lang.Math:sqrt:double"]

  [degrees "invokestatic:java.lang.Math:toDegrees:double"]
  [radians "invokestatic:java.lang.Math:toRadians:double"]
  )

(do-template [<name> <method>]
  [(def: #export (<name> n)
     (-> Real Real)
     (_lux_proc ["jvm" <method>] [n]))]

  [ceil  "invokestatic:java.lang.Math:ceil:double"]
  [floor "invokestatic:java.lang.Math:floor:double"]
  )

(def: #export (round n)
  (-> Real Real)
  (int-to-real (_lux_proc ["jvm" "invokestatic:java.lang.Math:round:double"] [n])))

(do-template [<name> <method>]
  [(def: #export (<name> param subject)
     (-> Real Real Real)
     (_lux_proc ["jvm" <method>] [subject param]))]

  [atan2 "invokestatic:java.lang.Math:atan2:double,double"]
  [pow   "invokestatic:java.lang.Math:pow:double,double"]
  )

(def: #export (gcd a b)
  {#;doc "Greatest Common Divisor."}
  (-> Nat Nat Nat)
  (case b
    +0 a
    _ (gcd b (n.% b a))))

(def: #export (lcm x y)
  {#;doc "Least Common Multiple."}
  (-> Nat Nat Nat)
  (case [x y]
    (^or [_ +0] [+0 _])
    +0

    _
    (|> x (n./ (gcd x y)) (n.* y))
    ))

## [Syntax]
(type: #rec Infix
  (#Const AST)
  (#Call (List AST))
  (#Infix Infix AST Infix))

(def: (infix^ _)
  (-> Unit (Syntax Infix))
  ($_ s;alt
      ($_ s;either
          (s/map ast;bool s;bool)
          (s/map ast;nat s;nat)
          (s/map ast;int s;int)
          (s/map ast;frac s;frac)
          (s/map ast;real s;real)
          (s/map ast;char s;char)
          (s/map ast;text s;text)
          (s/map ast;symbol s;symbol)
          (s/map ast;tag s;tag))
      (s;form (s;many s;any))
      (s;tuple (s;either (do s;Monad<Syntax>
                           [_ (s;tag! ["" "and"])
                            init-subject (infix^ [])
                            init-op s;any
                            init-param (infix^ [])
                            steps (s;some (s;seq s;any (infix^ [])))]
                           (wrap (product;right (fold (lambda [[op param] [subject [_subject _op _param]]]
                                                        [param [(#Infix _subject _op _param)
                                                                (` and)
                                                                (#Infix subject op param)]])
                                                      [init-param [init-subject init-op init-param]]
                                                      steps))))
                         (do s;Monad<Syntax>
                           [_ (wrap [])
                            init-subject (infix^ [])
                            init-op s;any
                            init-param (infix^ [])
                            steps (s;some (s;seq s;any (infix^ [])))]
                           (wrap (fold (lambda [[op param] [_subject _op _param]]
                                         [(#Infix _subject _op _param) op param])
                                       [init-subject init-op init-param]
                                       steps)))
                         ))
      ))

(def: (infix-to-prefix infix)
  (-> Infix AST)
  (case infix
    (#Const value)
    value
    
    (#Call parts)
    (ast;form parts)
    
    (#Infix left op right)
    (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left))))
    ))

(syntax: #export (infix [expr (infix^ [])])
  {#;doc (doc "Infix math syntax."
              (infix [x i.* 10])
              (infix [[x i.+ y] i.* [x i.- y]])
              (infix [[x n.< y] and [y n.< z]])
              (infix [#and x n.< y n.< z])
              (infix [(n.* +3 +9) gcd +450])

              "The rules for infix syntax are simple."
              "If you want your binary function to work well with it."
              "Then take the argument to the right (y) as your first argument,"
              "and take the argument to the left (x) as your second argument.")}
  (wrap (list (infix-to-prefix expr))))