$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 UTC +++ 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 "@[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 "@[State %d:" index; + let hash = info.info_hash in + let hash_state_item = info.info_hash_state_item in + fprintf buf "@[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 "@ @[%a@ @[#%a@]@]" (pp_print_prod_item info) prod_item (pp_print_ivar_set hash) lookahead) entries; + fprintf buf "@ @[%a@ @[#%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 "@[%a" pp_print_grammar gram; - fprintf buf "@ @[Nullable:%a@]" (pp_print_ivar_set hash) nullable; - fprintf buf "@ @[First:%a@]" (pp_print_ivar_table hash) first; + let hash = info.info_hash in + fprintf buf "@[%a" pp_print_grammar info.info_grammar; + fprintf buf "@ @[Nullable:%a@]" (pp_print_ivar_set hash) info.info_nullable; + fprintf buf "@ @[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 "@[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