CommonTools.ml

(* Copyright INRIA and Microsoft Corporation, 2008-2013. *)
(* DDMF is distributed under CeCILL-B license. *)

INCLUDE "preamble.ml"

exception UndefinedExpression

(* TODO: Does this have to go to DynaMoW? *)
(* Or do we have to restyle our code from Maple style to terminating *)
(* recursion? *)
(* Yes, probably so, therefore let me keep the name of this module long *)
(* on purpose. *)

(* Integer interval, from n to m included. *)
let interval n m =
  let rec loop l m = if n > m then l else loop (m :: l) (pred m) in
  loop [] m

(* Integer range, from 1 to m included. *)
let range = interval 1

let symb_of_symb_list l =
  <:unit< __DynaMoW_table := table() >> ;
  let rec aux i = function
  | [] -> 0
  | h :: q ->
      <:unit< __DynaMoW_table[$(int:i)] := $(h) >> ;
      (aux (i + 1) q) + 1 in
  let n = aux 1 l in
  let res =
    << [seq(__DynaMoW_table[__DynaMoW_i], __DynaMoW_i = 1 .. $(int:n))] >> in
  <:unit< unassign(__DynaMoW_table) :  unassign(__DynaMoW_i) >> ;
  res

let symb_of_name_list (l : name maple list) : any maple =
  symb_of_symb_list (Obj.magic l)

let symb_list_of_symb l =
  if <:bool< type($(l), list) >> then
    List.map
     (fun i -> << $(l)[$(int:i)] >>)
     (range <:int< nops($(l)) >>)
  else
(* FIXME: use DynaMoW-specific exception to signal error (as soon as the *)
(*        error handling in DynaMoW is cleaned-up). *)
    failwith (Maple.serialization_of_t l ^ " is not a list")

let rec prefix_of_list n =
  if n < 0 then invalid_arg "prefix_of_list" else
  function
  | [] -> if n > 0 then failwith "prefix_of_list" else []
  | h :: q -> h :: (prefix_of_list (n-1) q)


(* Parse a list of strings and return it as a Maple list. *)
(* Used by services where the user can specify values for parameters. *)
let parse_string_list strs =
  symb_of_symb_list (List.map (fun x -> << parse($(str: x)) >>) strs)


(* Make substitutions for parameters in symbolic expressions. *)
(* Input: expr is an arbitrary Maple expression, pars is a list *)
(* of names to be substituted, and the values vals are given as *)
(* a list of strings (to be parsed by Maple). *)
(* Intended use: in services which deal with parametrized objects. *)
let eval_expr expr pars vals =
  let parlist = symb_of_name_list pars
  and vallist = parse_string_list vals in
  let eqns = << zip(`=`, $(parlist), $(vallist)) >> in
  try
    << eval($(expr), $(eqns)) >>
  with _ ->
    let eqns = << [selectremove(a -> type(op(2, a), complex), $(eqns))] >> in
    let res = << foldl(limit, eval($(expr), $(eqns)[2]), op($(eqns)[1])) >> in
    if <:bool< $(res) = undefined >> then raise UndefinedExpression else res


(* Same as eval_expr, but without letting Maple evaluate the expression. *)
(* Returns the result as a string in LaTeX format. *)
let subs_expr expr pars vals =
  let ints = range (List.length pars) in
  let names = List.map (fun a -> "_DDMF_" ^ (string_of_int a) ^ "_") ints in
  let expr1 = eval_expr expr pars names in
  let regexps =
    List.map
      (fun a ->
        Str.regexp_string ("{\\rm \\_DDMF\\_" ^ (string_of_int a) ^ "\\_}"))
      ints
  in
  List.fold_left2
    (fun latex regexp value ->
      Str.global_replace regexp (Maple.evaluator_latex value) latex)
    <:latex< $(expr1) >>
    regexps
    vals


(* Determine appropriate names for sequences and summation variable. *)
(* We have to avoid conflicts with a (possibly parametrized) input.  *)
let unused_names_for_sequence expr =
  let sum_var_names = << [n, k, m, l, p, q, r, s, t, a, b, c, d, j] >> in
  let seq_var_names = << [u, v, w, c, a, b, d, f, g, h, p, q, r, s, t] >> in
  let sum_var : name maple =
    << remove(a -> has($(expr), a), $(sum_var_names))[1] >> in
  let seq_var : name maple =
    << remove(a -> has([$(expr), $(sum_var)], a), $(seq_var_names))[1] >> in
  seq_var, sum_var

Generated by GNU Enscript 1.6.5.90.