Commits

camlspotter committed ec215df

op_prec was ... strange. rewriting

  • Participants
  • Parent commits 4ad7cb9

Comments (0)

Files changed (3)

    stoken
    ptoken
    op_prec
+   op_prec2
 
 LIB = planck
 
     you can override this behavior by modifying the reference. 
 *)
 
+(** Resolution *)
+
+val build : 'a t -> 'a
+(** [build at] analyzes all the required precedencies + associativities in 
+    the unresolved parse tree [at] and returns the resolution result. *)
+
+(** Building 
+
+    You can build ['a t] using the following functions 
+    without thinking anything about precedences or connectivity.
+    Then use [build] for all the resolution.
+
+    For example, for 
+
+       1 + ~2 * 3        (~ for unary minus)
+
+    Just build the ['a t] from left to right:
+
+    let e = infix "+" plus (terminal one) 
+                           (prefix "~" (terminal two))
+    in
+    let e' = infix "*" mult e (terminal three) in
+
+    Then run [build e'] to get the resolved tree of ['a].        
+    
+*)
+
 val terminal : 'a -> 'a t
 (** [terminal a] takes a terminal object and returns its unresolved tree.
     Terminal objects are leaves in parse trees which cannot be affected by operators: 
 val list : string -> ('a list -> 'a) -> 'a t list -> 'a t
 (** [list name f ats] creates the unresolved parse tree for the list style expression
     which is separated by the operator [name] and has the elements [ats]. *)
-
-val build : 'a t -> 'a
-(** [build at] analyzes all the required precedencies + associativities in 
-    the unresolved parse tree [at] and returns the resolution result. *)
+type op = { 
+  prec : float; (* just a joke :-) *)
+  kind : [ `Infix of [ `Left | `Right ] | `Prefix | `Postfix | `Noassoc ]
+}
+
+let prec_app = 1000.0
+
+let compare x y =
+  match compare x.prec y.prec with
+  | 1 -> `Strong
+  | -1 -> `Weak
+  | 0 ->
+      if x.kind = y.kind then 
+        match x.kind with
+        | `Infix `Left -> `Left
+        | `Infix `Right -> `Right
+        | `Prefix -> assert false
+        | `Postfix -> assert false
+        | `Noassoc -> `Error
+      else `Error
+  | _ -> assert false
+
+let tbl : (string, op) Hashtbl.t = Hashtbl.create 107
+
+(* List like e1, e2, ..., en is implemented as infix with special builder *)
+type 'v t = 
+  | Infix of op * ('v -> 'v -> 'v)
+  | List of op * ('v list -> 'v)
+  | Postfix of op * ('v -> 'v)
+  | Prefix of op * ('v -> 'v)
+  | Terminal of 'v
+  | MarkApp (** mark for application *)
+
+type 'v tree =
+  | Leaf of 'v
+  | App of 'v t * 'v tree list
+
+let build build_app = 
+  let rec build = function
+    | Leaf v -> v
+    | App (Infix (_, f), [e1; e2]) -> f (build e1) (build e2)
+    | App (List (_, f), es) -> f (List.map build es)
+    | App (Postfix (_, f), [e1])
+    | App (Prefix (_, f), [e1]) -> f (build e1)
+    | App (Terminal v, es) -> build_app v (List.map build es)
+    | _ -> assert false
+  in
+  build
+
+(* 
+   f x y => f <> x <> y
+   1 + 2 => 1 + 2
+   f ~ 2 => f <> ~ 2
+   1 + ~ 2 => 1 + ~ 2
+   f 2 dollar 4 => f <> 2 dollar <> 4
+*)
+
+let rec add_explicit_app st = function
+  | [] -> List.rev st
+  | (Terminal _ as t1) :: ((Terminal _ | Prefix _  | Postfix _):: _ as ts) ->
+      add_explicit_app (MarkApp :: t1 :: st) ts
+  | (Terminal _ as t1) :: [] -> 
+      add_explicit_app (t1 :: st) []
+  | (Prefix _ as t1) :: ts -> 
+      add_explicit_app (t1 :: st) ts
+  | (Postfix _ as t1) :: ts ->
+      add_explicit_app (MarkApp :: t1 :: st) ts
+  | t1 :: ((Infix _ | List _):: _ as ts) -> 
+      add_explicit_app (t1 :: st) ts
+  | ((Infix _ | List _)as t1) :: ts ->
+      add_explicit_app (t1 :: st) ts
+  | _ :: MarkApp :: _
+  | MarkApp :: _ -> assert false
+
+let prec = function
+  | (Infix (op, _) | List (op, _) | Postfix (op, _) | Prefix (op, _)) -> Some op.prec
+  | MarkApp -> Some prec_app
+  | Terminal _ -> None
+
+let find_weakest ts = List.fold_left (fun st t ->
+  match st, prec t with
+  | _, None -> st
+  | Some v, Some v' -> Some (min v v')
+  | None, vopt -> vopt) None ts
+
+