Imported Upstream version 8.4~betaupstream/8.4_beta

1 files changed, 0 insertions, 183 deletions

diff --git a/dev/ocamlweb-doc/parse.ml b/dev/ocamlweb-doc/parse.ml
deleted file mode 100644
index b145fffd..00000000
--- a/dev/ocamlweb-doc/parse.ml
+++ /dev/null
@@ -1,183 +0,0 @@
-
-open Ast
-
-type assoc = L | R | N
-
-let level = function
-  | "--" -> 70,L
-  | "=" -> 70,N
-  | "+" -> 60,L
-  | "++" -> 60,R
-  | "+++" -> 60,R
-  | "-" -> 60,L
-  | "*" -> 50,L
-  | "/" -> 50,L
-  | "**" -> 40,R
-  | ":" -> (100,R)
-  | "->" -> (90,R)
-  | s -> failwith ("unknowm operator '"^s^"'")
-
-let fixity = function
-  | "--" -> [L]
-  | "=" -> [N]
-  | ("+"|"-"|"*"|"/") -> [L;N]
-  | "++" -> [R]
-  | _ -> [L;N;R]
-
-let ground_oper = function
-    ("-"|"+") -> true
-  | _ -> false
-
-let is_prefix op = List.mem L (fixity op)
-let is_infix op = List.mem N (fixity op)
-let is_postfix op = List.mem R (fixity op)
-
-let mk_inf op t1 t2 =
-  if not (is_infix op) then failwith (op^" not infix");
-  Infix(op,t1,t2)
-
-let mk_post op t =
-  if not (is_postfix op) then failwith (op^" not postfix");
-  Postfix(op,t)
-
-
-(* Pb avec ground_oper: pas de diff entre -1 et -(1) *)
-let mk_pre op t =
-  if not (is_prefix op) then failwith (op^" not prefix");
-  if ground_oper op then
-    match t with
-    | Int i -> Int (op^i)
-    | _     -> Prefix(op,t)
-  else Prefix(op,t)
-
-(* teste si on peut reduire op suivi d'un op de niveau (n,a)
-   si la reponse est false, c'est que l'op (n,a) doit se reduire
-   avant *)
-let red_left_op (nl,al) (nr,ar) =
-  if nl < nr then true
-  else
-    if nl = nr then
-      match al,ar with
-        | (L|N), L -> true
-        | R, (R|N) -> false
-        | R, L ->  failwith "conflit d'assoc: ambigu"
-        | (L|N), (R|N) -> failwith "conflit d'assoc: blocage"
-    else false
-
-
-type level = int * assoc
-type stack =
-  | PrefixOper of string list
-  | Term of constr_ast * stack
-  | Oper of string list * string * constr_ast * stack
-
-let rec str_ast = function
-  | Infix(op,t1,t2) -> str_ast t1 ^ " " ^ op ^ " " ^ str_ast t2
-  | Postfix(op,t) -> str_ast t ^ " " ^ op
-  | Prefix(op,t) -> op ^ " " ^ str_ast t
-  | _ -> "_"
-
-let rec str_stack = function
-  | PrefixOper ops -> String.concat " " (List.rev ops)
-  | Term (t,s) -> str_stack s ^ " (" ^ str_ast t ^ ")"
-  | Oper(ops,lop,t,s) ->
-      str_stack (Term(t,s)) ^ " " ^ lop ^ " " ^
-      String.concat " " (List.rev ops)
-
-let pps s = prerr_endline (str_stack s)
-let err s stk = failwith (s^": "^str_stack stk)
-
-
-let empty = PrefixOper []
-
-let check_fixity_term stk =
-  match stk with
-      Term _ -> err "2 termes successifs" stk
-    | _ -> ()
-
-let shift_term t stk =
-  check_fixity_term stk;
-  Term(t,stk)
-
-let shift_oper op stk =
-  match stk with
-    | Oper(ops,lop,t,s) -> Oper(op::ops,lop,t,s)
-    | Term(t,s) -> Oper([],op,t,s)
-    | PrefixOper ops -> PrefixOper (op::ops)
-
-let is_reducible lv stk =
-  match stk with
-    | Oper([],iop,_,_)  -> red_left_op (level iop) lv
-    | Oper(op::_,_,_,_) -> red_left_op (level op) lv
-    | PrefixOper(op::_) -> red_left_op (level op) lv
-    | _                 -> false
-
-let reduce_head (t,stk) =
-  match stk with
-    | Oper([],iop,t1,s) ->
-        (Infix(iop,t1,t), s)
-    | Oper(op::ops,lop,t',s) ->
-        (mk_pre op t, Oper(ops,lop,t',s))
-    | PrefixOper(op::ops) ->
-        (Prefix(op,t), PrefixOper ops)
-    | _ -> assert false
-
-let rec reduce_level lv (t,s) =
-  if is_reducible lv s then reduce_level lv (reduce_head (t, s))
-  else (t, s)
-
-let reduce_post op (t,s) =
-  let (t',s') = reduce_level (level op) (t,s) in
-  (mk_post op t', s')
-
-let reduce_posts stk =
-  match stk with
-      Oper(ops,iop,t,s) ->
-        let pts1 = reduce_post iop (t,s) in
-        List.fold_right reduce_post ops pts1
-    | Term(t,s) -> (t,s)
-    | PrefixOper _ -> failwith "reduce_posts"
-
-
-let shift_infix op stk =
-  let (t,s) = reduce_level (level op) (reduce_posts stk) in
-  Oper([],op,t,s)
-
-let is_better_infix op stk =
-  match stk with
-    | Oper(ops,iop,t,s) ->
-        is_postfix iop &&
-        List.for_all is_postfix ops &&
-        (not (is_prefix op) || red_left_op (level iop) (level op))
-    | Term _ -> false
-    | _ -> assert false
-
-let parse_oper op stk =
-  match stk with
-    | PrefixOper _ ->
-        if is_prefix op then shift_oper op stk else failwith "prefix_oper"
-    | Oper _ ->
-        if is_infix op then
-          if is_better_infix op stk then shift_infix op stk
-          else shift_oper op stk
-        else if is_prefix op then shift_oper op stk
-        else if is_postfix op then
-          let (t,s) = reduce_post op (reduce_posts stk) in
-          Term(t,s)
-        else assert false
-    | Term(t,s) ->
-        if is_infix op then shift_infix op stk
-        else if is_postfix op then
-          let (t2,s2) = reduce_post op (t,s) in Term(t2,s2)
-        else failwith "infix/postfix"
-
-let parse_term = shift_term
-
-let rec close_stack stk =
-  match stk with
-      Term(t,PrefixOper []) -> t
-    | PrefixOper _ -> failwith "expression sans atomes"
-    | _ ->
-        let (t,s) = reduce_head (reduce_posts stk) in
-        close_stack (Term(t,s))
-