include Backend open Printf open Expr open Func let comments l = List.map (fun x -> "% "^x) l let documentation f = comments (documentation f) let const = function | Int x -> string_of_int x | Float x -> string_of_float x | Math "pi" -> "pi" | Math x -> x let func = function | "exp" -> "exp" | "sqrt" -> "sqrt" | "log" -> "log" | "abs" -> "abs" | s -> s let never_paren = function | Cst _ | Var _ | Pow _ | App _ | Mul _ | Opp _ | Length _ | Get (Var _, _) -> true | _ -> false let never_paren_for_pow = function | Cst _ | Var _ | Pow _ | App _ | Get (Var _, _) -> true | _ -> false let paren x = sprintf "(%s)" x let pow u v = sprintf "%s^%s" u v let length x = sprintf "size(%s, 1)" x let sum x = sprintf "sum(%s)" x let rec expr = function (* Variable *) | Var v -> var (Variable.name v) (* Constant *) | Cst x -> const x (* Multiplication *) | Mul (u, v) when never_paren u && never_paren v -> (expr u) ^ " * " ^ (expr v) | Mul (u, (Mul _ as v)) when never_paren u -> (expr u) ^ " * " ^ (expr v) | Mul ((Mul _ as u), v) when never_paren v -> (expr u) ^ " * " ^ (expr v) | Mul ((Mul _ as u), v) -> (expr u) ^ " * " ^ (paren (expr v)) | Mul (u, (Mul _ as v)) -> (paren (expr u)) ^ " * " ^ (expr v) | Mul (u, (Div _ as v)) when never_paren u -> (expr u) ^ " * " ^ (expr v) | Mul ((Div _ as u), v) when never_paren v -> (expr u) ^ " * " ^ (expr v) | Mul ((Div _ as u), v) -> (expr u) ^ " * " ^ (paren (expr v)) | Mul (u, (Div _ as v)) -> (paren (expr u)) ^ " * " ^ (expr v) | Mul (u, v) when never_paren u -> (expr u) ^ " * " ^ (paren (expr v)) | Mul (u, v) when never_paren v -> (paren (expr u)) ^ " * " ^ (expr v) | Mul (u, v) -> (paren (expr u)) ^ " * " ^ (paren (expr v)) (* Division *) | Div (u, v) when never_paren u && never_paren v -> (expr u) ^ " / " ^ (expr v) | Div (u, v) when never_paren u -> (expr u) ^ " / " ^ (paren (expr v)) | Div (u, v) when never_paren v -> (paren (expr u)) ^ " / " ^ (expr v) | Div (u, v) -> (paren (expr u)) ^ " / " ^ (paren (expr v)) (* Addition *) | Add (u, v) when never_paren u && never_paren v -> (expr u) ^ " + " ^ (expr v) | Add (u, (Add _ as v)) when never_paren u -> (expr u) ^ " + " ^ (expr v) | Add ((Add _ as u), v) when never_paren v -> (expr u) ^ " + " ^ (expr v) | Add ((Add _ as u), v) -> (expr u) ^ " + " ^ (expr v) | Add (u, (Div _ as v)) when never_paren u -> (expr u) ^ " + " ^ (expr v) | Add ((Div _ as u), v) when never_paren v -> (expr u) ^ " + " ^ (expr v) | Add ((Div _ as u), v) -> (expr u) ^ " + " ^ (expr v) | Add (u, v) when never_paren u -> (expr u) ^ " + " ^ (paren (expr v)) | Add (u, (Add _ as v)) -> (paren (expr u)) ^ " + " ^ (expr v) | Add (u, v) when never_paren v -> (paren (expr u)) ^ " + " ^ (expr v) | Add (u, v) -> (paren (expr u)) ^ " + " ^ (paren (expr v)) (* Minus *) | Min (u, v) when never_paren u && never_paren v -> (expr u) ^ " - " ^ (expr v) | Min (u, (Min _ as v)) when never_paren u -> (expr u) ^ " - " ^ (expr v) | Min (u, (Min _ as v)) -> (paren (expr u)) ^ " - " ^ (expr v) | Min (u, (Add _ as v)) when never_paren u -> (expr u) ^ " - " ^ (expr v) | Min (u, (Add _ as v)) -> (paren (expr u)) ^ " - " ^ (expr v) | Min (u, v) when never_paren u -> (expr u) ^ " - " ^ (paren (expr v)) | Min ((Min _ as u), v) when never_paren v -> (expr u) ^ " - " ^ (expr v) | Min ((Min _ as u), v) -> (expr u) ^ " - " ^ (paren (expr v)) | Min ((Add _ as u), v) when never_paren v -> (expr u) ^ " - " ^ (expr v) | Min ((Add _ as u), v) -> (expr u) ^ " - " ^ (paren (expr v)) | Min (u, v) when never_paren v -> (paren (expr u)) ^ " - " ^ (expr v) | Min (u, v) -> (paren (expr u)) ^ " - " ^ (paren (expr v)) (* Power *) | Pow (u, v) when never_paren_for_pow u && never_paren_for_pow v -> pow (expr u) (expr v) | Pow (u, v) when never_paren_for_pow v -> pow (paren (expr u)) (expr v) | Pow (u, v) when never_paren_for_pow u -> pow (expr u) (paren (expr v)) | Pow (u, v) -> pow (paren (expr u)) (paren (expr v)) (* Opposite *) | Opp u when never_paren u -> "- " ^ (expr u) | Opp (Mul _ as u) -> "- " ^ (expr u) | Opp (Div _ as u) -> "- " ^ (expr u) | Opp u -> "- " ^ (paren (expr u)) (* Application *) | App ("transpose", [u]) when never_paren u -> (expr u) ^"'" | App ("transpose", [u]) -> (paren (expr u)) ^"'" | App (f, lu) -> (func f) ^ "(" ^ (String.concat ", " (List.map expr lu)) ^ ")" (* Vector length *) | Length u -> length (expr u) (* Vector sum *) | Sum (Var _ as u) -> sum (expr u) | Sum u -> sum (paren (expr u)) (* Vector index *) | Get (Var _ as u, i) -> (expr u) ^ "(" ^ (string_of_int (i+1)) ^ ")" (* Tuple *) | Tuple lu -> "{" ^ (String.concat ", " (List.map expr lu) ) ^ "}" (* Vector *) | Vector lu -> "[" ^ (String.concat ", " (List.map expr lu) ) ^ "]" let gettype (t, _, _) = t let def ?(doc=true) f = let args = List.map var f.args in String.concat "\n" ( (if doc then documentation f else [])@ [ sprintf "function %s(%s)" (var f.name) (String.concat ", " args); sprintf " %s" (expr f.expr); "end"; ] ) let try_def f = try def f with _ -> "Backend failure"