[-*- Mode: lispcc -*-]



























[-----grammar
 (gz start (prog))
 (gz prog (module))
 (gz module (f :class id exports imports :cbeg f topdecl-star j j
             ::pr("module [[id]] [[exports]] where{\n[[imports]]\n"
                  "[[topdecl-star('',';\n','\n')]]}\n\n")))
 (gz exports (f export-star j
              ::pr("[[export-star('(',',',')')]]")) (:export-everything ::pr("")))
 (gz export (id))
 (gz imports (f import-star j
              ::pr("[[import-star('',';\n',';\n')]]")))
 (gz import(id ::pr( "import [[id]]")))
 (gz type-class (f :type-class context-opt type f type-class-decl-star j j
                 ::pr("class [[context-opt]][[type]] where{\n"
                      "[[type-class-decl-star('',';\n','\n')]]}")))
 (gz topdecl (decl) (data)(type-synonym)(newtype)(instance)(type-class))
 (gz type-class-decl (type-signature)(decl))
 (gz type-signature (f :tysig name ret-type-and-params j
                     ::pr("[[name]]::[[ret-type-and-params]]")))
 (gz instance (f :instance context-opt (type ::is id) simpletype-plus decls j
               ::pr ("instance [[context-opt]][[type]] [[simpletype-plus('(',')(',')')]] where [[decls]]")))
 (gz newtype (f :newtype simpletype type deriving-opt j
              ::pr("newtype [[simpletype]] = [[type]][[deriving-opt]]")))
 (gz deriving (:deriving f id-non-plus j
               ::pr(" deriving [[id-non-plus('(',',',')')]]")))
 (gz id-non (id))
 (gz type-synonym (f :type-synonym simpletype type j
                   ::pr("type [[simpletype]] = [[type]]")))
 (gz data (f :data simpletype constrs deriving-opt j ::pr("data [[simpletype]] = [[constrs]][[deriving-opt]]")))
 (gz simpletype (type))
 (gz constrs(f constr-star j ::pr("[[constr-star('',' | ','')]]"))

  )
 (gz field-type-and-param (f param type j
                           ::pr("[[param]]::[[type]]")))
 (gz type-and-param ( f param type j ::pr("[[type]]")))
 (gz constr(positional-constructor) (field-label-constructor) )
 (gz field-label-constructor(f type-ctor :field f field-type-and-param-star j j
                             ::pr("[[type-ctor]][[field-type-and-param-star('{',',','}')]]")))

 (gz decls ( :x f decl-star j ::pr("{[[decl-star('\n',';\n','\n')]]}\n")))
 (gz context (:context f a-context-plus j ::pr
              ("[[a-context-plus('(',',',')')]]=>")))
 (gz a-context (f (type ::is id)(name ::is id) j ::pr("[[type]] [[name]]")))
 (gz ret-type-and-params
  (context-opt type f type-and-param-star j
   ::pr("[[context-opt]][[type-and-param-star('','\x2d>','')]]"
        (::c "if(my_type_and_param_star->v.size()>0)out('\x2d>');")
        "[[type]]")))

 (gz decl (f :fun name ret-type-and-params  expr j
           ::pr("[[name]]::[[ret-type-and-params]];\n"
                "[[name]]"
                (::c "for(list<tree_type*>::const_iterator pos = my_ret_type_and_params->my_type_and_param_star->v.begin();pos!= my_ret_type_and_params->my_type_and_param_star->v.end();++pos){"
                 "const tr_type_and_param* t=dynamic_cast<const tr_type_and_param*>(*pos);"
                 "assert(t);"
                 "out(' ');"
                 "t->my_param->print();" "}")
                " = [[expr]]"))
  (f :fun name :no-sig ret-type-and-params  expr j
   ::pr("[[name]]"
        (::c "for(list<tree_type*>::const_iterator pos = my_ret_type_and_params->my_type_and_param_star->v.begin();pos!= my_ret_type_and_params->my_type_and_param_star->v.end();++pos){"
         "const tr_type_and_param* t=dynamic_cast<const tr_type_and_param*>(*pos);"
         "assert(t);"
         "out(' ');"
         "t->my_param->print();" "}")
        " = [[expr]]")))
 (gz name (id))
 (gz positional-constructor
  (f   type-ctor typepls-opt j
   ::pr("[[type-ctor]][[typepls-opt]]"))
  (f :tuple type-plus j
   ::pr("[[type-plus('(',',',')')]]"))
  )
 (gz pattern (f  pattern-ctor pattern-star j
              ::pr ("([[pattern-ctor]][[pattern-star('',' ','')]])"))
  (f pattern-ctor :fpat f fpat-star j j
   ::pr ("[[pattern-ctor]][[fpat-star('{',',','}')]]")
   )
  (f :ptuple pattern-plus j [pattern-plus cuz :nil exists for empty lists]
   ::pr("[[pattern-plus('(',',',')')]]"))
  (f :plist pattern-plus j [pattern-plus cuz :nil exists for empty lists]
   ::pr("[[pattern-plus('\x5b',',','\x5d')]]"))
  (f :pchar astring j ::pr("\x27[[astring]]\x27"))
  (f :as id pattern j ::pr("[[id]]@[[pattern]]"))
  )
 (gz pattern-ctor (id) (:cons ::pr ("(:)")) (:nil ::pr ("[]")))

 (gz fpat (f (variable ::is id) pattern j
           ::pr("[[variable]] = [[pattern]]")))

 (gz type
  (f :fn ret-type-and-params j ::pr ("([[ret-type-and-params]])")) (:unit ::pr("()"))
  (positional-constructor))
 (gz typepls (paren-type-plus))
 (gz paren-type (type ::pr( "([[type]])"))
  (f :strict type j ::pr("!([[type]])"))
  (f :generic id j ::pr (" [[id]] ")))
 (gz type-ctor(id)(:list ::pr ("[]")))
 (gz param (id))
 (gz qastring  (astring ::pr("\x22[[astring]]\x22")))

 (gz expr (id) (:mcons ::pr ("(:)")) [(:nil ::pr ("[]"))]
  (f :dotdot (a ::is expr) (b ::is expr)j
   ::pr("\x5b[[a]]..[[b]]\x5d"))
  (f :dotdot-forever expr j
   ::pr("\x5b[[expr]]..\x5d"))
  (qastring)
  (f :char astring j ::pr("\x27[[astring]]\x27"))
  (f :ty type expr j ::pr("([[expr]]::[[type]])"))
  (f (fun-name ::is expr) expr-star j
   ::pr ("([[fun-name]][[expr-star(' ',' ','')]])"))
  [(f :construct ctor expr-star j
    ::pr ("([[ctor]] [[expr-star('',' ','')]])"))]
  (f :do f stmt-star j j ::pr("(do{\n[[stmt-star('  ','\n  ','\n')]]})"))
  (f :case expr f alt-star j j
   ::pr("(case [[expr]] of {\n[[alt-star('  ',';\n  ','\n')]]})"))
  (f :let decls expr j
   ::pr("(let [[decls]] in [[expr]])"))
  (f :letpost expr decls j
   ::pr("(let [[decls]] in [[expr]])"))
  (f :cfd (type ::is id) assignments-star j
   ::pr("[[type]][[assignments-star('{',',','}')]]"))
  [(f :compose (a ::is expr) (b ::is expr) j ::pr("((.)[[a]] [[b]])"))]
  (:compose ::pr ("(.)"))
  (f :mlist expr-star j ::pr("[[expr-star('\x5b',',','\x5d')]]"))
  (f :mtuple expr-star j ::pr("[[expr-star('(',',',')')]]"))
  (:nothing  ::pr ("()"))

  )
 (gz assignments (f id expr j ::pr("[[id]] = [[expr]]")))
 (gz stmt (expr ::pr("[[expr]];"))
  (f ":=" id expr j ::pr("[[id]]<-[[expr]];")))
 (gz alt (f where-opt pattern expr j
          ::pr("[[pattern]]\x2d>[[expr]][[where-opt]]")))

 (gz where (:where decls ::pr ("where[[decls]]")))
 ]


(:class Main :export-everything (  [Exception] [Char Monad]List  Ratio)
 :cbeg(
       (:newtype(Power-of-pi)(Power-of-pi(Int)):deriving(Show Eq))
       
       [(:data(Pure-rational)((Real-pure(Rational)) (Imaginary-pure(Rational))):deriving(Show))]
       (:data(Pure-rational)((Pure-rational(Rational)(Imaginess))):deriving(Show))
       (:data(Imaginess)((Real)(Imaginary)):deriving(Show))
       (:fun get-number-of-pure(Rational)((x(Pure-rational)))
        (:case x(((Pure-rational(a)(_))a))))
       (:data(Poly-term) ((Zero-poly-term)
                          (Poly-term(Pure-rational)(Power-of-pi) )):deriving(Show))
       (:type-synonym(B)(:list(Poly-term)))
       (:fun zero-B(B)()
        (:mlist Zero-poly-term))
       (:fun one-B(B)()
        (:mlist (Poly-term (Pure-rational 1 Real)(Power-of-pi 0) )))
       (:type-synonym(B-list)(:list(B)))
       (:fun long-all-bs(B-list)()
        (:mcons zero-B
         (:mcons zero-B
          (:mcons one-B
           (zipWith4 adder long-all-bs
            (tail long-all-bs)
            (drop 2 long-all-bs)
            
            (enumFrom 0))))))
       (:fun make-Real-pure(Pure-rational)((r(Rational)))
        (Pure-rational r Real))
       (:fun simpleadder(B)((bn-2(B))(bn-1(B))(bn(B))(n(Int)))
        (:mlist (Poly-term (make-Real-pure (% (toInteger n) 1))(Power-of-pi 0) )))
       (:fun adder(B)((bn-2(B))(bn-1(B))(bn(B))(n(Int)))
        (:letpost
         (scalar-mult W-mult-B throwpi)
         :x(
            (:fun numerat(B)()(subtract-b special bn-2))
            (:fun special(B)()
             (scalar-mult (Pi-mult-B 1)
              (scalar-mult (I-mult-B)
               (scalar-mult (Rational-mult-B (% (toInteger(+ 1 (* 2 n)))
                                              1))
                bn))))
            (:fun scals-denon(B)()
             (scalar-mult (Rational-mult-B(% 1 (toInteger(* 4(+ 1 n)))))
              numerat))
            (:fun throwpi(B)()
             (scalar-mult(Pi-mult-B (negate 2)) scals-denon))
            
            ))
        [])
       
       

       (:data(Scalar-to-mult-B)((I-mult-B)(Pi-mult-B(Int))
                                (W-mult-B)
                                (Rational-mult-B(Rational))):deriving(Show))
       (:fun scalar-mult(B)((s(Scalar-to-mult-B))(b(B)))
        (:case s
         (((I-mult-B)(map i-mult-poly-term b))
          ((Pi-mult-B(pow))(map (add-pi-pow pow) b))
          ((Rational-mult-B(x))(map (rational-mult-poly-term x)b))
          ((W-mult-B)(:mcons Zero-poly-term b))
          )))
       (:fun rational-mult-poly-term(Poly-term)((x(Rational))(p(Poly-term)))
        (manip-poly-term(rational-mult-pure-rational x)p))
       (:fun rational-mult-pure-rational(Pure-rational)
        ((s(Rational))(x(Pure-rational)))
        (:case x(((Pure-rational(a)(i))(Pure-rational(* s a)i))))
        [(:case x(((Real-pure(a))(Real-pure(* s a)))
                  ((Imaginary-pure(a))(Imaginary-pure(* s a)))))])
       
       (:fun negate-pure-rational(Pure-rational)
        ((x(Pure-rational)))(rational-mult-pure-rational (%(negate 1)1)x))
       (:fun manip-poly-term(Poly-term)
        ((f(:fn(Pure-rational)((x(Pure-rational)))))(p(Poly-term)))
        (:case p
         (((Poly-term(frac)(pow))(Poly-term (f frac) pow))
          ((_) p) ["note: this only works form multiplies \f"])))
       (:fun add-pi-pow(Poly-term)((n(Int))(p(Poly-term)))
        (:case p
         (((Poly-term(frac)(Power-of-pi(pow)))
           (Poly-term frac (Power-of-pi(+ pow n))))
          ((Zero-poly-term)p))))
       
       (:fun i-mult-poly-term(Poly-term)((p(Poly-term)))
        (manip-poly-term i-mult p)
        [(:case p
          (((Poly-term(frac)(pow))(Poly-term(i-mult frac)(pow)))))])
       (:fun i-mult(Pure-rational)((x(Pure-rational)))
        (:case x(((Pure-rational(a)(Real))(Pure-rational a Imaginary))
                 ((Pure-rational(a)(Imaginary))(Pure-rational (negate a)Real))))
        [(:case x(((Real-pure(a))(Imaginary-pure(a)))
                  ((Imaginary-pure(a))(Real-pure(negate a)))))])
       
       
       (:fun add-b(B)((x(B))(y(B)))
        (subtract-b x (negate-Bs y)))
       (:fun subtract-b(B)((x(B))(y(B)))
        (zipWith-lengthen subtract-poly-term x y))
       (:fun zipWith-lengthen(B)
        ((f(:fn(Poly-term)((x(Poly-term))(y(Poly-term)))))
         (x(B))(y(B)))
        (:case (:mtuple x y)
         (((:ptuple(:cons(x1)(xr))(:cons(y1)(yr)))
           (:mcons (f x1 y1)(zipWith-lengthen f xr yr)))
          ((:ptuple(:nil)(:cons(y1)(yr)))
           (:mcons (f Zero-poly-term y1)(zipWith-lengthen f (:mlist)yr)))
          ((:ptuple(:cons(x1)(xr))(:nil))
           (:mcons (f x1 Zero-poly-term)(zipWith-lengthen f xr(:mlist))))
          ((:ptuple(:nil)(:nil))(:mlist)))))
       
       [(:fun conv-zero-poly(Poly-term)((x(Poly-term)))
         (:case x(((Zero-poly-term)(Poly-term(Real-pure 0)(Power-of-pi 0)))
                  ((_)x))))]
       (:fun subtract-poly-term(Poly-term)((x(Poly-term))(y(Poly-term)))
        (:case (:mtuple x y)
         (((:ptuple (Poly-term(frac1)(pow1))(Poly-term(frac2)(pow2)))
           (:case(== pow1 pow2)
            (((True)(Poly-term(subtract-pure-rational frac1 frac2)pow1))
             ((_)
              (error (concat (:mlist "tried to subtract-poly-term "
                              (show x)" and "(show y))))))))
          ((:ptuple(_)(Zero-poly-term))x)
          ((:ptuple(Zero-poly-term)(_))
           (negate-poly-term y))
          )))
       (:fun negate-poly-term(Poly-term)((y(Poly-term)))
        (rational-mult-poly-term (% (negate 1)1)y))
       (:fun negate-Bs(B)((y(B)))
        (map negate-poly-term y))
       
       (:fun subtract-pure-rational(Pure-rational)((x(Pure-rational))(y(Pure-rational)))
        (:case (:mtuple x y)
         (((:ptuple(Pure-rational(a)(Real))(Pure-rational(b)(Real)))
           (Pure-rational (- a b)(Real)))
          ((:ptuple(Pure-rational(a)(Imaginary))(Pure-rational(b)(Imaginary)))
           (Pure-rational (- a b)(Imaginary)))))
        [(:case (:mtuple x y)
          (((:ptuple(Real-pure(a))(Real-pure(b)))(Real-pure (- a b)))
           ((:ptuple(Imaginary-pure(a))(Imaginary-pure(b)))(Imaginary-pure (- a b)))))])
       (:fun add-pure-rational(Pure-rational)((x(Pure-rational))(y(Pure-rational)))
        (subtract-pure-rational x (negate-pure-rational y)))
       [(:fun zip-4-func(B-list)((f(:fn(B)((a(B))(b(B))(c(B))(d(Int)))))
                                 (x(B-list))(y(B-list))(z(B-list))
                                 (n(:list(Int))))
         (:case (:mtuple x y z n)
          (((:ptuple(:cons(x1)(xr))
             (:cons(y1)(yr))
             (:cons(z1)(zr))
             (:cons(n1)(nr)))(:mcons (f x1 y1 z1 n1)(zip-4-func f xr yr zr nr))))))]
       ["necessary"]
       (:fun all-bs(B-list)()
        (drop 2 long-all-bs))
       (:fun all-cs(B-list)()
        (map c-calc (enumFrom 0)))
       (:fun pretty-b-matlab(String) ((b(:tuple(Poly-term)(W-power))))
        (:case b([((:ptuple(Zero-poly-term)(_))"0")]
                 ((:ptuple (Poly-term(rat)(Power-of-pi(x)))(W-power(w)))
                  (concat (:mlist (pretty-rat-matlab rat x) "*omega^" (show w)))))))
       (:fun pretty-b(String) ((b(:tuple(Poly-term)(W-power))))
        (:case b(((:ptuple(Zero-poly-term)(_))"0")
                 ((:ptuple (Poly-term(rat)(Power-of-pi(x)))(W-power(w)))
                  (concat (:mlist (pretty-rat rat x) "\\omega^" (show w)))))))

       (:fun pretty-c-phi(String)((b(:tuple(Poly-term)(Phi-power))))
        (:case b(((:ptuple(Zero-poly-term)(_))"0")
                 ((:ptuple (Poly-term(rat)(Power-of-pi(x)))(Phi-power(w)))
                  (concat (:mlist (pretty-rat rat x) "\\Psi^{(" (show w)")}(p)"))))))
       (:fun pretty-c-phi-matlab(String)((b(:tuple(Poly-term)(Phi-power))))
        (:case b(((:ptuple(Zero-poly-term)(_))"0")
                 ((:ptuple (Poly-term(rat)(Power-of-pi(x)))(Phi-power(w)))
                  (concat (:mlist (pretty-rat-matlab rat x) "*sym('P" (show w) "')"))))))
       (:fun pretty-big-C(String)((b(BC-term)))
        (:case b(((BC-term(rat)(Power-of-pi(x))(_)(Phi-power(w)))
                  (concat (:mlist (pretty-rat rat x) "\\Psi^{(" (show w)")}(p)"))
                  ))))
                  
       (:fun pretty-rat(String)((x(Pure-rational))(pi(Int)))
        (:case x
         (((Pure-rational(x)(i))
           (concat
            (:mlist "\\frac{"
             (show (numerator x))
             "}{"
             (show (denominator x))
             (maybe-pi-denom pi)
             "}"
             (maybe-pi-numerator pi)
             (maybe-imag i)))))))
       (:fun pretty-rat-matlab(String)((x(Pure-rational))(pi(Int)))
        (:case x
         (((Pure-rational(x)(i))
           (concat
            (:mlist "sym('"
             (show (numerator x))
             "')/sym('"
             (show (denominator x))
             "')*sym('pi')^("
             (show pi)
             ")*(1"
             (maybe-imag i)
             ")"))))))
       (:fun fold-plus(String)((a(String))(b(String)))
        (concat (:mlist a " + " b)))
       (:fun maybe-imag(String)((i(Imaginess)))
        (:case i(((Real)"")
                 ((Imaginary)"i"))))
       (:fun maybe-pi-numerator(String)((pi(Int)))
        (:case (compare pi 0)
         ((( EQ)"")
          ((GT)(concat (:mlist " \\pi^{"(show pi)"}")))
          ((_)""))))
       (:fun maybe-pi-denom(String)((pi(Int)))
        (:case (compare pi 0)
         ((( EQ)"")
          ((LT)(concat (:mlist " \\pi^{"(show (negate pi))"}")))
          ((_)""))))
       (:fun not-Zero-poly(Bool)((x (:tuple(Poly-term)(a))))
        (:case (fst x)(((Zero-poly-term)False)
                       ((_)True))))

       (:fun show-a-B-matlab(String)((n(Int)))
        (concat
         (:mlist
          ["b_{"
           (show n)
           "} &=& "]
          (foldr1 fold-plus
           (map pretty-b-matlab (reverse(filter not-Zero-poly(annotate-power W-power
                                                              (!! all-bs n))))))
          "\n")
         ))
       
       (:fun show-a-B(String)((n(Int)))
        (concat
         (:mlist
          "b_{"
          (show n)
          "} &=& "
          (foldr1 fold-plus
           (map pretty-b (reverse(filter not-Zero-poly(annotate-power W-power
                                                       (!! all-bs n))))))
          "\\\\\n")
         ))

       (:fun show-a-C-matlab(String)((n(Int)))
        (concat
         (:mlist
          ["c_{"
           (show n)
           "} &=& "]
          (foldr1 fold-plus
           (map pretty-c-phi-matlab (reverse(filter not-Zero-poly(annotate-power Phi-power
                                                                  (!! all-cs n))))))
          "\n")
         ))
       (:fun show-a-C(String)((n(Int)))
        (concat
         (:mlist
          "c_{"
          (show n)
          "} &=& "
          (foldr1 fold-plus
           (map pretty-c-phi (reverse(filter not-Zero-poly(annotate-power Phi-power
                                                           (!! all-cs n))))))
          "\\\\\n")
         ))
       (:fun show-a-big-C(String)((n(Int)))
        (concat
         (:mlist
          "C_{"
          (show n)
          "} &=& "
          (foldr1 fold-plus
           (map pretty-big-C (reverse(terms-of-C 60 60 n))))
          "\\\\\n")
         ))
       
       
       
       (:fun c-calc(B)((n(Int)))
        (extract-id
         (:do
          (
           (:= x (Id(foldl1 add-b (map (inner-sum n) (enumFromTo 0 (floor (% (toInteger n) 2)))))))
           (:= x (Id (scalar-mult (Rational-mult-B (% (!! fact n) (^ 2 n)))x)))
           (return x)
           ))))
       (:fun raw-polynomial-bc(:list(BC-term))((m(Int)))
        (filter not-zero-BC (concat(take m (zipWith mult-B-and-C all-bs all-cs)))))
       (:fun is-W-pow(Bool)((pow(Int))(bc(BC-term)))
        (:case bc(((BC-term(_) (_) (W-power(w)) (_))(== pow w)))))
       (:fun is-pi-pow(Bool)((pow(Int))(bc(BC-term)))
        (:case bc(((BC-term(_) (Power-of-pi(w)) (_) (_))(== pow w)))))
       (:fun raw-C(:list(BC-term))((n(Int))(terms(:list(BC-term))))
        (filter (is-W-pow n)terms))
       (:fun sum-pow-pi(BC-term)((terms(:list(BC-term)))(which-pi(Int)))
        (foldl sum-identical-BC-terms Zero-BC-term
         (filter (is-pi-pow which-pi )terms)))
       (:fun sum-identical-BC-terms(BC-term)((a(BC-term))(b(BC-term)))
        (:case (:mtuple a b)
         (((:ptuple(Zero-BC-term)(_)) b)
          ((:ptuple(BC-term(rat1)(xx)(yy)(zz))
            (BC-term(rat2)(xx2)(yy2)(zz2)))
           (:case(==(:mtuple xx yy zz)(:mtuple xx2 yy2 zz2))
            (((True)
              (BC-term (add-pure-rational rat1 rat2)xx yy zz))))))))
       (:fun collected-C(:list (BC-term))((n(Int))(terms(:list(BC-term))))
        (map (sum-pow-pi (raw-C n terms))(enumFromThen 0 (negate 1))))
       (:fun fact(:list(Integer))()
        (:let :x(
                 (:fun fact1(:list(Integer))((v(Integer))(n(Integer)))
                  (:mcons v (fact1(* v n)(+ 1 n))))
                 )
         (fact1 1 1)))
       (:fun compose-pow(B)((n(Int))(f(:fn(B)((b(B)))))(b(B)))
        (!! (iterate f b)n))
       (:newtype(Id(a))(Id(a)):deriving(Show))
       (:fun extract-id(a)((x(Id(a))))
        (:case x(((Id(y))y))))
       (:instance Monad(Id )
        :x(
           (:fun return :no-sig(Int)((v(Int)))
            (Id v))
           (:fun >>= :no-sig(Int)((m(Int))(f(Int)))
            (f (extract-id m)))
           ))
       (:fun i (:fn(:fn(Id(b))((_(a))))((f(:fn(b)((_(a)))))))()
        (:compose Id ))
       (:fun inner-sum(B)((n(Int)) (j(Int)))
        (:let
         :x(
            (:fun the-pow(Int)()(* 1 j))
            (:fun n-minus-2j(Int)()(- n  (* 2 j)))
            
            )
         
         (extract-id
          (:do
           (
            (:= x (Id(phi-pow n-minus-2j)))
            (:= x (Id(compose-pow the-pow (scalar-mult I-mult-B) x)))
            (:= x (Id  (scalar-mult (Pi-mult-B the-pow)  x)))
            
            (:= x (Id(scalar-mult(Rational-mult-B (% (^ 2 the-pow) 1))x)))
            (:= x (Id(scalar-mult(Rational-mult-B (% 1 (!! fact  (* 1 j))))x)))
            (:= x (Id(scalar-mult(Rational-mult-B (% 1 (!! fact n-minus-2j)))x)))
            (return x))))))
       (:data(BC-term)((Zero-BC-term)
                       (BC-term(Pure-rational)(Power-of-pi)(W-power)(Phi-power))):deriving(Show))
       (:type-synonym(BC)(:list(BC-term)))
       (:newtype(W-power)(W-power(Int)):deriving(Show Eq))
       (:newtype(Phi-power)(Phi-power(Int)):deriving(Show Eq))
       (:fun annotate-power(:list(:tuple(a)(b)))
        ((f(:fn(b)((i(Int)))))(l(:list(a))))
        (zip l (map f (enumFrom 0))))
       (:fun mult-B-and-C(BC)((b(B))(c(B)))
        (:do
         (
          (:= y (annotate-power Phi-power c))
          (:= x (annotate-power W-power b))
          (return (mult-W-Phi x y))
          )))
       
       (:fun not-zero-BC(Bool)((x(BC-term)))
        (:case x(((Zero-BC-term)False)
                 ((BC-term(rat)(_)(_)(_)) (not(is-rational-zero rat))))))
       (:fun is-rational-zero(Bool)((x(Pure-rational)))
        (== 0 (get-number-of-pure x))
        [(:case x(((Real-pure(x))(== x 0))
                  ((Imaginary-pure(x))(== x 0))))])
       (:fun mult-W-Phi(BC-term)((w(:tuple(Poly-term)(W-power)))
                                 (phi(:tuple(Poly-term)(Phi-power))))
        (:case (:mtuple (fst w)(fst phi))
         (((:ptuple(Zero-poly-term)(_))Zero-BC-term)
          ((:ptuple(_)(Zero-poly-term))Zero-BC-term)
          ((:ptuple(Poly-term(rat1)(Power-of-pi (pow1)))
            (Poly-term(rat2)(Power-of-pi (pow2))))
           (BC-term(mult-pure-rational rat1 rat2)(Power-of-pi (+ pow1 pow2))
            (snd w)(snd phi))))))
       (:fun mult-pure-rational(Pure-rational)((x(Pure-rational))(y(Pure-rational)))
        (:let
         :x(
            (:fun real-y(Rational)()
             (get-number-of-pure y)
             [(:case y(((Real-pure(x))x)
                       ((Imaginary-pure(x))x)))])
            (:fun almost(Pure-rational)()
             (rational-mult-pure-rational real-y x))
            )
         (:case y(((Pure-rational(_)(Real))almost)
                  ((Pure-rational(_)(Imaginary))(i-mult almost))))
         ))
       (:fun phi-pow(B)((j(Int)))
        (:case (compare j 0)
         (((EQ)one-B)
          ((GT)(:mcons Zero-poly-term (phi-pow (- j 1)))))))
       (:fun terms-of-C(:list(BC-term))((cut0(Int))(cut(Int))(n(Int)))
        (filter not-zero-BC (take cut (collected-C n (raw-polynomial-bc cut0)))))
       (:fun main(IO :unit)()
        (:do
         (
          (putStrLn "syms omega")
          (putStr "b=")
          (beg-eqnarray)
          (putStr(concatMap show-a-B-matlab (enumFromTo 0 200)))
          (end-eqnarray)
          (putStr "c=")
          (beg-eqnarray)
          (putStr(concatMap show-a-C-matlab (enumFromTo 0 200)))
          
          (end-eqnarray)
          [(beg-eqnarray)
           (putStr(concatMap show-a-big-C (enumFromTo 0 5)))
           (end-eqnarray)]
          )))
       (:fun beg-eqnarray(IO :unit)()
        [(putStrLn"\\begin{eqnarray*}")]
        (putStr "[")
        )
       (:fun end-eqnarray(IO :unit)()
        [(putStrLn"\\end{eqnarray*}\n")]
        (putStrLn "];"))
       
       (:fun show-list :context((Show a))(String)((l(:list(a))))
        (:let :x(
                 (:fun a-show :no-sig(String)((elem(a)))
                  (++ (show elem) "\n")))
         (foldr ++ "" (map a-show l))))
       )
 )