path: root/devel/omake/files/patch-src_libmojave-external_util_lm__parser.ml

$NetBSD: patch-ax,v 1.1 2010/12/17 09:40:14 wiz Exp $

From upstream SVN.

--- src/libmojave-external/util/lm_parser.ml.orig	2007-01-25 18:31:18.000000000 +0000
+++ src/libmojave-external/util/lm_parser.ml
@@ -282,15 +282,11 @@ struct
       let debug = "ProdItem"
 
       let hash item =
-         let { prod_item_name   = name;
-               prod_item_left   = left;
-               prod_item_right  = right;
-               prod_item_action = action
-             } = item
-         in
+         let name = item.prod_item_name in
+         let action = item.prod_item_action in
          let hash = hash_combine (IVar.hash name) (IAction.hash action) in
-         let hash = ivar_list_hash hash left in
-         let hash = ivar_list_hash hash right in
+         let hash = ivar_list_hash hash item.prod_item_left in
+         let hash = ivar_list_hash hash item.prod_item_right in
             hash
 
       let compare item1 item2 =
@@ -657,18 +653,12 @@ struct
             fprintf buf "@ %a: %a" (pp_print_ivar info) v (pp_print_pda_action info) action) actions
 
    let pp_print_prod_item_core info buf item =
-      let { prod_item_action = action;
-            prod_item_name   = name;
-            prod_item_left   = left;
-            prod_item_right  = right
-          } = item
-      in
       let hash = info.info_hash in
          fprintf buf "%a ::=%a .%a (%a)" (**)
-            (pp_print_ivar hash) name
-            (pp_print_ivars hash) (List.rev left)
-            (pp_print_ivars hash) right
-            (pp_print_iaction hash) action
+            (pp_print_ivar hash) item.prod_item_name
+            (pp_print_ivars hash) (List.rev item.prod_item_left)
+            (pp_print_ivars hash) item.prod_item_right
+            (pp_print_iaction hash) item.prod_item_action
 
    let pp_print_prod_item info buf item =
       pp_print_prod_item_core info buf (ProdItem.get info.info_hash.hash_prod_item_state item)
@@ -678,40 +668,27 @@ struct
             fprintf buf "@ %a" (pp_print_prod_item info) item) items
 
    let pp_print_state info buf state =
-      let { info_state_items = items } = State.get info.info_hash.hash_state_state state in
+      let items = (State.get info.info_hash.hash_state_state state).info_state_items in
          eprintf "@[<v 3>State %d" (State.hash state);
          pp_print_prod_item_set info buf items;
          eprintf "@]"
 
    let pp_print_info_item info buf info_item =
-      let { info_hash = hash;
-            info_hash_state_item = hash_state_item
-          } = info
-      in
-      let { info_item_index = index;
-            info_item_entries = entries
-          } = info_item
-      in
-         fprintf buf "@[<v 3>State %d:" index;
+      let hash = info.info_hash in
+      let hash_state_item = info.info_hash_state_item in
+         fprintf buf "@[<v 3>State %d:" info_item.info_item_index;
          Array.iter (fun entry ->
-               let { prop_state_item = state_item;
-                     prop_vars = lookahead
-                   } = entry
-               in
+               let state_item = entry.prop_state_item in
+               let lookahead = entry.prop_vars in
                let _, prod_item = StateItem.get hash_state_item state_item in
-                  fprintf buf "@ @[<hv 3>%a@ @[<b 2>#%a@]@]" (pp_print_prod_item info) prod_item (pp_print_ivar_set hash) lookahead) entries;
+                  fprintf buf "@ @[<hv 3>%a@ @[<b 2>#%a@]@]" (pp_print_prod_item info) prod_item (pp_print_ivar_set hash) lookahead) info_item.info_item_entries;
          fprintf buf "@]"
 
    let pp_print_info buf info =
-      let { info_grammar = gram;
-            info_nullable = nullable;
-            info_first = first;
-            info_hash = hash
-          } = info
-      in
-         fprintf buf "@[<v 0>%a" pp_print_grammar gram;
-         fprintf buf "@ @[<b 3>Nullable:%a@]" (pp_print_ivar_set hash) nullable;
-         fprintf buf "@ @[<v 3>First:%a@]" (pp_print_ivar_table hash) first;
+      let hash = info.info_hash in
+         fprintf buf "@[<v 0>%a" pp_print_grammar info.info_grammar;
+         fprintf buf "@ @[<b 3>Nullable:%a@]" (pp_print_ivar_set hash) info.info_nullable;
+         fprintf buf "@ @[<v 3>First:%a@]" (pp_print_ivar_table hash) info.info_first;
          fprintf buf "@]"
 
    let pp_print_lookahead hash buf look =
@@ -917,16 +894,11 @@ struct
       let changed, prods =
          VarMTable.fold_all (fun (changed, prods) _ prodlist ->
                List.fold_left (fun (changed, prods) prod ->
-                     let { prod_action = action;
-                           prod_name   = name;
-                           prod_prec   = pre
-                         } = prod
-                     in
-                        if ActionSet.mem actions action then
-                           changed, prods
-                        else
-                           let prod = { prod with prod_prec = PrecTable.find prec_translate pre } in
-                              true, VarMTable.add prods name prod) (changed, prods) prodlist) (false, prod1) prod2
+                     if ActionSet.mem actions prod.prod_action then
+                        changed, prods
+                     else
+                        let prod = { prod with prod_prec = PrecTable.find prec_translate prod.prod_prec } in
+                           true, VarMTable.add prods prod.prod_name prod) (changed, prods) prodlist) (false, prod1) prod2
       in
 
       (* Union of the start symbols *)
@@ -1012,12 +984,10 @@ struct
       let step first prods =
          IVarTable.fold (fun (first, changed) _ prods ->
                List.fold_left (fun (first, changed) prod ->
-                     let { prod_item_name = x;
-                           prod_item_right = rhs
-                         } = ProdItem.get prod_state prod
-                     in
+                     let prod_item = ProdItem.get prod_state prod in
+                     let x = prod_item.prod_item_name in
                      let set = IVarTable.find first x in
-                     let set' = first_rhs nullable first set rhs in
+                     let set' = first_rhs nullable first set prod_item.prod_item_right in
                      let set, changed =
                         if changed || IVarSet.cardinal set' <> IVarSet.cardinal set then
                            set', true
@@ -1059,10 +1029,8 @@ struct
     * Get the set of first symbols that can begin a list.
     *)
    let lookahead info rhs =
-      let { info_first = first;
-            info_nullable = nullable
-          } = info
-      in
+      let first = info.info_first in
+      let nullable = info.info_nullable in
       let rec search set rhs =
          match rhs with
             v :: rhs ->
@@ -1274,14 +1242,10 @@ struct
       let hash = info.info_hash.hash_prod_item_state in
          ProdItemSet.fold (fun delta prod_item ->
                let core = ProdItem.get hash prod_item in
-               let { prod_item_left = left;
-                     prod_item_right = right
-                   } = core
-               in
-                  match right with
+                  match core.prod_item_right with
                      v :: right ->
                         let core =
-                           { core with prod_item_left = v :: left;
+                           { core with prod_item_left = v :: core.prod_item_left;
                                        prod_item_right = right
                            }
                         in
@@ -1517,11 +1481,7 @@ struct
       let goto_table = StateTable.find shift_table state in
       let prod_item_hash = info.info_hash.hash_prod_item_state in
       let prod_item_core = ProdItem.get prod_item_hash prod_item in
-      let { prod_item_left = left;
-            prod_item_right = right
-          } = prod_item_core
-      in
-         match right with
+         match prod_item_core.prod_item_right with
             v :: right ->
                (* If v is a nonterminal, then also propagate to initial items *)
                let prop_items =
@@ -1534,7 +1494,7 @@ struct
                (* Propagate directly to the next state *)
                let next_state = IVarTable.find goto_table v in
                let next_item_core =
-                  { prod_item_core with prod_item_left = v :: left;
+                  { prod_item_core with prod_item_left = v :: prod_item_core.prod_item_left;
                                         prod_item_right = right
                   }
                in
@@ -1833,8 +1793,8 @@ struct
                      item :: items ->
                         let core = ProdItem.get hash item in
                         let empty_flag =
-                           match core with
-                              { prod_item_left = []; prod_item_right = [] } ->
+                           match core.prod_item_left, core.prod_item_right with
+                              [], [] ->
                                  true
                             | _ ->
                                  false
@@ -1865,14 +1825,12 @@ struct
                      look)
 
    let reduce_actions info empties prop_table =
-      let { info_head_lookahead = look_table } = info in
+      let look_table = info.info_head_lookahead in
       let hash = info.info_hash.hash_prod_item_state in
       let hash_state_item = info.info_hash_state_item in
          Array.fold_left (fun actions entry ->
-               let { prop_state_item = state_item;
-                     prop_vars = look3
-                   } = entry
-               in
+               let state_item = entry.prop_state_item in
+               let look3 = entry.prop_vars in
                let state, item = StateItem.get hash_state_item state_item in
                let core = ProdItem.get hash item in
                   match core.prod_item_right with
@@ -1902,8 +1860,8 @@ struct
     * Error messages.
     *)
    let shift_reduce_conflict info state v shift_state reduce_item =
-      let { info_hash = hash } = info in
-      let { hash_prod_item_state = hash_prod_item } = hash in
+      let hash = info.info_hash in
+      let hash_prod_item = hash.hash_prod_item_state in
       let pp_print_ivar = pp_print_ivar hash in
       let pp_print_iaction = pp_print_iaction hash in
       let reduce_core = ProdItem.get hash_prod_item reduce_item in
@@ -1917,8 +1875,8 @@ struct
             raise (Invalid_argument "Lm_parser.shift_reduce_conflict\n\tset MP_DEBUG=parse_conflict_is_warning to ignore this error")
 
    let reduce_reduce_conflict info state v reduce_item action =
-      let { info_hash = hash } = info in
-      let { hash_prod_item_state = hash_prod_item } = hash in
+      let hash = info.info_hash in
+      let hash_prod_item = hash.hash_prod_item_state in
       let pp_print_ivar = pp_print_ivar hash in
       let pp_print_iaction = pp_print_iaction hash in
       let reduce_core = ProdItem.get hash_prod_item reduce_item in
@@ -1936,24 +1894,18 @@ struct
     * This is finally the stage where we check for conflicts.
     *)
    let process_reduce_actions info reduce_actions action_table =
-      let { info_grammar         = gram;
-            info_prec            = var_prec_table;
-            info_hash = { hash_prod_item_state = hash_prod_item }
-          } = info
-      in
-      let { gram_prec_table = prec_table } = gram in
+      let gram = info.info_grammar in
+      let var_prec_table = info.info_prec in
+      let hash_prod_item = info.info_hash.hash_prod_item_state in
+      let prec_table = gram.gram_prec_table in
       let state_item_hash = info.info_hash_state_item in
          StateItemTable.fold (fun action_table state_item look ->
                let look = lookahead_set look in
                let state, item = StateItem.get state_item_hash state_item in
-               let { prod_item_name   = name;
-                     prod_item_action = action;
-                     prod_item_left   = left;
-                     prod_item_prec   = prec_name
-                   } = ProdItem.get hash_prod_item item
-               in
+               let prod_item = ProdItem.get hash_prod_item item in
+               let prec_name = prod_item.prod_item_prec in
                let assoc = Precedence.assoc prec_table prec_name in
-               let reduce = ReduceAction (action, name, List.length left) in
+               let reduce = ReduceAction (prod_item.prod_item_action, prod_item.prod_item_name, List.length prod_item.prod_item_left) in
                let actions = StateTable.find action_table state in
                let actions =
                   IVarSet.fold (fun actions v ->
@@ -2006,7 +1958,8 @@ struct
                { prod_item_right = [];
                  prod_item_action = action;
                  prod_item_name = name;
-                 prod_item_left = left
+                 prod_item_left = left;
+                 prod_item_prec = _
                } ->
                   let state_item = StateItem.create info.info_hash_state_item (state, item) in
                   let lookahead = prop_table.(StateItem.hash state_item).prop_vars in
@@ -2027,18 +1980,14 @@ struct
     * Flatten a production state to a pda description.
     *)
    let pda_info_of_items info prop_table state items =
-      let { info_first = first;
-            info_hash_state_item = hash_state_item;
-            info_hash = { hash_prod_item_state = hash_prod_item }
-          } = info
-      in
+      let first = info.info_first in
+      let hash_state_item = info.info_hash_state_item in
+      let hash_prod_item = info.info_hash.hash_prod_item_state in
       let items, next =
          ProdItemSet.fold (fun (items, next) prod_item ->
                let core = ProdItem.get hash_prod_item prod_item in
-               let { prod_item_left  = left;
-                     prod_item_right = right
-                   } = core
-               in
+               let left = core.prod_item_left in
+               let right = core.prod_item_right in
                let item =
                   { pda_item_left  = left;
                     pda_item_right = right
@@ -2094,7 +2043,7 @@ struct
       (* Build the PDA states *)
       let table =
          State.map_array (fun state core ->
-               let { info_state_items = items } = core in
+               let items = core.info_state_items in
                   { pda_delta  = pda_delta (StateTable.find trans_table state);
                     pda_reduce = reduce_early info prop_table state items;
                     pda_info   = pda_info_of_items info prop_table state items
@@ -2155,7 +2104,7 @@ struct
     * Exceptions.
     *)
    let parse_error loc hash run _stack state (v : ivar) =
-      let { pda_info = { pda_items = items; pda_next = next } } = run.run_states.(state) in
+      let { pda_items = items; pda_next = next } = run.run_states.(state).pda_info in
       let pp_print_ivar = pp_print_ivar hash in
       let buf = stdstr in
          fprintf buf "@[<v 0>Syntax error on token %a" pp_print_ivar v;
@@ -2188,7 +2137,7 @@ struct
 
    let pda_loop hash run arg start =
       let rec pda_lookahead arg stack state tok =
-         let { pda_delta = delta } = run.run_states.(state) in
+         let delta = run.run_states.(state).pda_delta in
          let v, loc, x = tok in
             match
                (try IVarTable.find delta v with
@@ -2323,24 +2272,24 @@ struct
    let prec_max = Precedence.prec_max
 
    let add_assoc info pre assoc =
-      let { parse_grammar = gram } = info in
-      let { gram_prec_table = prec_table } = gram in
+      let gram = info.parse_grammar in
+      let prec_table = gram.gram_prec_table in
       let prec_table = Precedence.add_assoc prec_table pre assoc in
       let gram = { gram with gram_prec_table = prec_table } in
       let info = { parse_grammar = gram; parse_pda = None } in
          info
 
    let create_prec_lt info pre assoc =
-      let { parse_grammar = gram } = info in
-      let { gram_prec_table = prec_table } = gram in
+      let gram = info.parse_grammar in
+      let prec_table = gram.gram_prec_table in
       let prec_table, pre = Precedence.create_prec_lt prec_table pre assoc in
       let gram = { gram with gram_prec_table = prec_table } in
       let info = { parse_grammar = gram; parse_pda = None } in
          info, pre
 
    let create_prec_gt info pre assoc =
-      let { parse_grammar = gram } = info in
-      let { gram_prec_table = prec_table } = gram in
+      let gram = info.parse_grammar in
+      let prec_table = gram.gram_prec_table in
       let prec_table, pre = Precedence.create_prec_gt prec_table pre assoc in
       let gram = { gram with gram_prec_table = prec_table } in
       let info = { parse_grammar = gram; parse_pda = None } in