(* mParser *) type state = { buf: string; idx: int } type 'a reply = | Failed | Ok of 'a * state type 'a t = state -> 'a reply let parse_string p str = p { buf = str; idx = 0 } let return x s = Ok (x, s) let zero _ = Failed let bind p f s = match p s with | Failed -> Failed | Ok (r1, s1) -> f r1 s1 let (>>=) = bind let (<|>) p1 p2 s = match p1 s with | Failed -> p2 s | other -> other let choice ps = List.fold_left (<|>) zero ps (* many parses zero or more occurences of p *) let rec many p s = match p s with | Failed -> Ok ([], s) | Ok (r, s') -> begin match many p s' with | Failed -> Failed | Ok (rs, s'') -> Ok (r :: rs, s'') end let sep_by1 p sep = p >>= fun x -> many (sep >>= fun _ -> p >>= fun x -> return x) >>= fun xs -> return (x :: xs) let (<|>$) p x = p <|> return x let opt x p = p <|>$ x let regexp rx s = if Str.string_match rx s.buf s.idx then let matched = Str.matched_string s.buf in Ok (matched, { s with idx = s.idx + String.length matched }) else Failed let spaces = regexp (Str.regexp " *") let string str = regexp (Str.regexp str) let symbol str = string str >>= fun s -> spaces >>= fun _ -> return s let integer = regexp (Str.regexp "[1-9][0-9]*") >>= fun i -> return (int_of_string i) type assoc = | Assoc_none | Assoc_left | Assoc_right type 'a operator = | Infix of ('a -> 'a -> 'a) t * assoc | Prefix of ('a -> 'a) t | Postfix of ('a -> 'a) t let expression operators term = let make_parser term ops = let split_op (rassoc, lassoc, nassoc, prefix, postfix) op = match op with | Infix (p, assoc) -> ( match assoc with | Assoc_none -> (rassoc, lassoc, p :: nassoc, prefix, postfix) | Assoc_left -> (rassoc, p :: lassoc, nassoc, prefix, postfix) | Assoc_right -> (p :: rassoc, lassoc, nassoc, prefix, postfix) ) | Prefix p -> (rassoc, lassoc, nassoc, p :: prefix, postfix) | Postfix p -> (rassoc, lassoc, nassoc, prefix, p :: postfix) in let (rassoc, lassoc, nassoc, prefix, postfix) = List.fold_left split_op ([], [], [], [], []) ops in let rassoc_op = choice rassoc and lassoc_op = choice lassoc and nassoc_op = choice nassoc and prefix_op = choice prefix and postfix_op = choice postfix in let prefix_p = opt (fun x -> x) prefix_op and postfix_p = opt (fun x -> x) postfix_op in let term_p = prefix_p >>= fun pre -> term >>= fun x -> postfix_p >>= fun post -> return (post (pre x)) in let rec rassoc_p x = rassoc_op >>= fun f -> (term_p >>= (fun z -> rassoc_p' z)) >>= fun y -> return (f x y) and rassoc_p' x = opt x (rassoc_p x) in let rec lassoc_p x = lassoc_op >>= fun f -> term_p >>= fun y -> lassoc_p' (f x y) and lassoc_p' x = opt x (lassoc_p x) in let nassoc_p x = nassoc_op >>= fun f -> term_p >>= fun y -> return (f x y) in term_p >>= fun x -> (rassoc_p x <|> lassoc_p x <|> nassoc_p x <|>$ x) in List.fold_left make_parser term operators (* ------------------------------------ mParser ------------------------------------ *) type expr = | Var | Add of expr * expr | Mul of expr * expr | Const of int | Deriv of expr let add x y = Add (x, y) let mul x y = Mul (x, y) let operators = [ [ Infix (symbol "*" >>= (fun _ -> return mul), Assoc_left) ] ; [ Infix (symbol "+" >>= (fun _ -> return add), Assoc_left) ] ] let deriv p = string "d{" >>= fun _ -> p >>= fun x -> string "}" >>= fun _ -> return (Deriv x) let const s = (integer >>= fun x -> return (Const x)) s let var s = (string "x" >>= fun _ -> return Var) s let rec term s = ((deriv expr <|> const <|> var) >>= fun x -> return x) s and expr s = expression operators term s type poly = (int * int) list let rec add_poly p1 p2 = match p1, p2 with | [], _ -> p2 | _, [] -> p1 | (d1, c1) :: p1', (d2, c2) :: p2' -> if d1 = d2 then (d1, c1 + c2) :: add_poly p1' p2' else if d1 > d2 then (d2, c2) :: add_poly p1 p2' else (d1, c1) :: add_poly p1' p2 let mul_mono_with_mono (d1, c1) (d2, c2) = (d1 + d2, c1 * c2) let mul_poly_with_mono p m = List.map (mul_mono_with_mono m) p let rec mul_poly p1 p2 = match p1 with | [] -> [] | m :: rest -> add_poly (mul_poly_with_mono p2 m) (mul_poly p2 rest) let rec normalize = function | Var -> [(1, 1)] | Add (d1, d2) -> add_poly (normalize d1) (normalize d2) | Mul (d1, d2) -> mul_poly (normalize d1) (normalize d2) | Const x -> [(0, x)] | Deriv d -> derivate (normalize d) and derivate = function | [] -> [] | p -> List.map (fun (deg, coeff) -> (deg - 1, coeff * deg)) p |> List.filter (fun (d, _) -> d >= 0) let _ = let n = read_int () in let depth = read_int () in let s = read_line () in match parse_string expr s with | Failed -> failwith "parse error" | Ok (res, _) -> let d = normalize res in for i = 0 to depth do try Printf.printf "%d " (List.assoc i d) with Not_found -> Printf.printf "0 " done; print_endline ""