[m-rev.] diff: fast_loose tabling

Zoltan Somogyi zs at cs.mu.OZ.AU
Tue Jun 7 12:59:33 AEST 2005


Add a new form of tabling pragma, fast_loose_memo. It differs from memo in
only one way: for arguments of user-defined types, instead of tabling every
single function symbol in the value, it tables a pointer to the term instead.
(Actually, it tables the contents of the selected argument register, so it
works even if the value is not a pointer.)

As the name implies, this form of tabling is faster than memo. The tradeoff
is that it is looser: if two invocations specify two terms that are at
different addresses but have the same value, this new form of tabling will
not recognize the commonality.

doc/reference_manual.texi:
	Document the new pragma.

compiler/prog_data.m:
	Generalize the type specifying eval methods to allow the expression
	of the new form of tabling.

compiler/prog_io_pragma.m:
	Parse the new form of tabling pragma.

compiler/hlds_pred.m:
	Handle the new, more general form of memoing.

	Add the required provisions for the representation of the new form
	of trie step in tables.

compiler/table_gen.m:
	Implement the new form of tabling as a minor variant of memo tabling.

	Convert this module to four-space indentation to reduce the number
	of bad line breaks.

compiler/layout_out.m:
compiler/prog_out.m:
	Conform to the changes above.

library/table_builtins.m:
	Add the primitives required to implement fast_loose_memo.

	Fix an old bug: make table_lookup_insert_poly call the right macro.

runtime/mercury_tabling.h:
runtime/mercury_tabling_macros.h:
runtime/mercury_tabling_preds.h:
	Provide the basic mechanism of fast_loose_memo tabling: a hash table
	that works on MR_Words.

runtime/mercury_stack_layout.h:
	Allow the representation of the new evaluation method and the new form
	of trie step.

tests/tabling/fast_loose.{m,exp}:
	Add this test case of the operation of fast_loose tabling. The test
	case pronounces success only if fast_loose_memo is measured to be
	significantly faster than plain memo.

tests/tabling/Mmakefile:
	Enable the new test case.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.163
diff -u -b -r1.163 hlds_pred.m
--- compiler/hlds_pred.m	26 May 2005 00:17:02 -0000	1.163
+++ compiler/hlds_pred.m	30 May 2005 02:49:09 -0000
@@ -1967,7 +1967,9 @@
 						% type, and thus the size of
 						% the corresponding trie node.
 	;	table_trie_step_user(type)
+	;	table_trie_step_user_fast_loose(type)
 	;	table_trie_step_poly
+	;	table_trie_step_poly_fast_loose
 	;	table_trie_step_typeinfo
 	;	table_trie_step_typeclassinfo.
 
@@ -3277,7 +3279,7 @@
 	;
 		Valid = yes
 	).
-valid_determinism_for_eval_method(eval_memo, Detism) = Valid :-
+valid_determinism_for_eval_method(eval_memo(_), Detism) = Valid :-
 	determinism_components(Detism, _, MaxSoln),
 	( MaxSoln = at_most_zero ->
 		Valid = no
@@ -3304,37 +3306,37 @@
 eval_method_needs_stratification(eval_normal) = no.
 eval_method_needs_stratification(eval_loop_check) = no.
 eval_method_needs_stratification(eval_table_io(_, _)) = no.
-eval_method_needs_stratification(eval_memo) = no.
+eval_method_needs_stratification(eval_memo(_)) = no.
 eval_method_needs_stratification(eval_minimal(_)) = yes.
 
 eval_method_has_per_proc_tabling_pointer(eval_normal) = no.
 eval_method_has_per_proc_tabling_pointer(eval_loop_check) = yes.
 eval_method_has_per_proc_tabling_pointer(eval_table_io(_, _)) = no.
-eval_method_has_per_proc_tabling_pointer(eval_memo) = yes.
+eval_method_has_per_proc_tabling_pointer(eval_memo(_)) = yes.
 eval_method_has_per_proc_tabling_pointer(eval_minimal(_)) = yes.
 
 eval_method_requires_tabling_transform(eval_normal) = no.
 eval_method_requires_tabling_transform(eval_loop_check) = yes.
 eval_method_requires_tabling_transform(eval_table_io(_, _)) = yes.
-eval_method_requires_tabling_transform(eval_memo) = yes.
+eval_method_requires_tabling_transform(eval_memo(_)) = yes.
 eval_method_requires_tabling_transform(eval_minimal(_)) = yes.
 
 eval_method_requires_ground_args(eval_normal) = no.
 eval_method_requires_ground_args(eval_loop_check) = yes.
 eval_method_requires_ground_args(eval_table_io(_, _)) = yes.
-eval_method_requires_ground_args(eval_memo) = yes.
+eval_method_requires_ground_args(eval_memo(_)) = yes.
 eval_method_requires_ground_args(eval_minimal(_)) = yes.
 
 eval_method_destroys_uniqueness(eval_normal) = no.
 eval_method_destroys_uniqueness(eval_loop_check) = yes.
 eval_method_destroys_uniqueness(eval_table_io(_, _)) = no.
-eval_method_destroys_uniqueness(eval_memo) = yes.
+eval_method_destroys_uniqueness(eval_memo(_)) = yes.
 eval_method_destroys_uniqueness(eval_minimal(_)) = yes.
 
 eval_method_change_determinism(eval_normal, Detism) = Detism.
 eval_method_change_determinism(eval_loop_check, Detism) = Detism.
 eval_method_change_determinism(eval_table_io(_, _), Detism) = Detism.
-eval_method_change_determinism(eval_memo, Detism) = Detism.
+eval_method_change_determinism(eval_memo(_), Detism) = Detism.
 eval_method_change_determinism(eval_minimal(_), Detism0) = Detism :-
 	det_conjunction_detism(semidet, Detism0, Detism).
 
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.48
diff -u -b -r1.48 layout_out.m
--- compiler/layout_out.m	26 May 2005 00:17:02 -0000	1.48
+++ compiler/layout_out.m	30 May 2005 02:49:09 -0000
@@ -988,7 +988,14 @@
 
 eval_method_to_c_string(eval_normal) =	      "MR_EVAL_METHOD_NORMAL".
 eval_method_to_c_string(eval_loop_check) =    "MR_EVAL_METHOD_LOOP_CHECK".
-eval_method_to_c_string(eval_memo) =          "MR_EVAL_METHOD_MEMO".
+eval_method_to_c_string(eval_memo(CallStrictness)) =  Str :-
+	(
+		CallStrictness = strict,
+		Str = "MR_EVAL_METHOD_MEMO_STRICT"
+	;
+		CallStrictness = fast_loose,
+		Str = "MR_EVAL_METHOD_MEMO_FAST_LOOSE"
+	).
 eval_method_to_c_string(eval_minimal(MinimalMethod)) = Str :-
 	(
 		MinimalMethod = stack_copy,
@@ -1817,8 +1824,16 @@
 		StepType = "MR_TABLE_STEP_USER",
 		MaybeEnumParam = no
 	;
+		Step = table_trie_step_user_fast_loose(_),
+		StepType = "MR_TABLE_STEP_USER_FAST_LOOSE",
+		MaybeEnumParam = no
+	;
 		Step = table_trie_step_poly,
 		StepType = "MR_TABLE_STEP_POLY",
+		MaybeEnumParam = no
+	;
+		Step = table_trie_step_poly_fast_loose,
+		StepType = "MR_TABLE_STEP_POLY_FAST_LOOSE",
 		MaybeEnumParam = no
 	;
 		Step = table_trie_step_typeinfo,
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.127
diff -u -b -r1.127 prog_data.m
--- compiler/prog_data.m	23 May 2005 03:15:40 -0000	1.127
+++ compiler/prog_data.m	23 May 2005 03:35:53 -0000
@@ -591,13 +591,18 @@
 	--->	eval_normal		% normal mercury
 					% evaluation
 	;	eval_loop_check		% loop check only
-	;	eval_memo		% memoing + loop check
+	;	eval_memo(call_table_strictness)
+					% memoing + loop check
 	;	eval_table_io(		% memoing I/O actions for debugging
 			table_io_is_decl,
 			table_io_is_unitize
 		)
 	;	eval_minimal(eval_minimal_method).
 					% minimal model evaluation
+
+:- type call_table_strictness
+	--->	strict
+	;	fast_loose.
 
 :- type table_io_is_decl
 	--->	table_io_decl		% The procedure is tabled for
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.82
diff -u -b -r1.82 prog_io_pragma.m
--- compiler/prog_io_pragma.m	23 May 2005 03:15:40 -0000	1.82
+++ compiler/prog_io_pragma.m	23 May 2005 03:35:53 -0000
@@ -822,7 +822,11 @@
 
 parse_pragma_type(ModuleName, "memo", PragmaTerms, ErrorTerm, _VarSet,
         Result) :-
-    parse_tabling_pragma(ModuleName, "memo", eval_memo,
+    parse_tabling_pragma(ModuleName, "memo", eval_memo(strict),
+        PragmaTerms, ErrorTerm, Result).
+parse_pragma_type(ModuleName, "fast_loose_memo", PragmaTerms, ErrorTerm,
+        _VarSet, Result) :-
+    parse_tabling_pragma(ModuleName, "fast_loose_memo", eval_memo(fast_loose),
         PragmaTerms, ErrorTerm, Result).
 parse_pragma_type(ModuleName, "loop_check", PragmaTerms, ErrorTerm, _VarSet,
         Result) :-
Index: compiler/prog_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_out.m,v
retrieving revision 1.57
diff -u -b -r1.57 prog_out.m
--- compiler/prog_out.m	30 Mar 2005 00:50:21 -0000	1.57
+++ compiler/prog_out.m	20 May 2005 01:47:26 -0000
@@ -306,7 +306,8 @@
 
 eval_method_to_string(eval_normal) =		"normal".
 eval_method_to_string(eval_loop_check) =	"loop_check".
-eval_method_to_string(eval_memo) =		"memo".
+eval_method_to_string(eval_memo(strict)) =	"memo".
+eval_method_to_string(eval_memo(fast_loose)) =	"fast_loose_memo".
 eval_method_to_string(eval_minimal(MinimalMethod)) = Str :-
 	(
 		MinimalMethod = own_stacks,
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.82
diff -u -b -r1.82 table_gen.m
--- compiler/table_gen.m	3 Jun 2005 07:04:16 -0000	1.82
+++ compiler/table_gen.m	6 Jun 2005 11:16:20 -0000
@@ -249,8 +249,7 @@
         ;
             TabledForIoAttr = tabled_for_descendant_io,
             AnnotationIsMissing = no,
-            % The procedure itself doesn't do any I/O, so don't
-            % transform it.
+            % The procedure itself doesn't do any I/O, so don't transform it.
             TransformInfo = no
         ;
             TabledForIoAttr = tabled_for_io,
@@ -448,16 +447,16 @@
         MaybeCallTableTip = yes(CallTableTip),
         MaybeProcTableInfo = yes(ProcTableInfo)
     ;
-        EvalMethod = eval_memo,
+        EvalMethod = eval_memo(CallStrictness),
         ( CodeModel = model_non ->
-            table_gen__create_new_memo_non_goal(Detism, OrigGoal,
-                PredId, ProcId, HeadVars,
+            table_gen__create_new_memo_non_goal(CallStrictness, Detism,
+                OrigGoal, PredId, ProcId, HeadVars,
                 NumberedInputVars, NumberedOutputVars,
                 VarTypes0, VarTypes, VarSet0, VarSet, TableInfo0, TableInfo,
                 CallTableTip, Goal, Steps)
         ;
-            table_gen__create_new_memo_goal(Detism, OrigGoal,
-                PredId, ProcId, TablingViaExtraArgs,
+            table_gen__create_new_memo_goal(CallStrictness, Detism,
+                OrigGoal, PredId, ProcId, TablingViaExtraArgs,
                 HeadVars, NumberedInputVars, NumberedOutputVars,
                 VarTypes0, VarTypes, VarSet0, VarSet,
                 TableInfo0, TableInfo, CallTableTip, Goal, Steps)
@@ -621,17 +620,17 @@
 create_new_loop_goal(Detism, OrigGoal, PredId, ProcId, TablingViaExtraArgs,
         HeadVars, NumberedInputVars, NumberedOutputVars, !VarTypes, !VarSet,
         !TableInfo, TableTipVar, Goal, Steps) :-
-    % even if the original goal doesn't use all of the headvars,
+    % Even if the original goal doesn't use all of the headvars,
     % the code generated by the tabling transformation does,
     % so we need to compute the nonlocals from the headvars rather
-    % than getting it from the nonlocals field in the original goal
+    % than getting it from the nonlocals field in the original goal.
     set__list_to_set(HeadVars, OrigNonLocals),
     OrigGoal = _ - OrigGoalInfo,
     goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
     goal_info_get_context(OrigGoalInfo, Context),
 
     ModuleInfo = !.TableInfo ^ table_module_info,
-    generate_simple_call_table_lookup_goal(loop_status_type,
+    generate_simple_call_table_lookup_goal(strict, loop_status_type,
         "table_loop_setup", NumberedInputVars, PredId, ProcId,
         TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
         TableTipVar, StatusVar, LookUpGoal, Steps),
@@ -852,20 +851,20 @@
 % If there are no output variables, then instead of creating an answer block
 % and filling it in, we call table_memo_mark_as_succeeded.
 
-:- pred create_new_memo_goal(determinism::in, hlds_goal::in,
-    pred_id::in, proc_id::in, bool::in,
+:- pred create_new_memo_goal(call_table_strictness::in, determinism::in,
+    hlds_goal::in, pred_id::in, proc_id::in, bool::in,
     list(prog_var)::in, list(var_mode_pos)::in, list(var_mode_pos)::in,
     vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
     table_info::in, table_info::out, prog_var::out, hlds_goal::out,
     list(table_trie_step)::out) is det.
 
-create_new_memo_goal(Detism, OrigGoal, PredId, ProcId, TablingViaExtraArgs,
-        HeadVars, NumberedInputVars, NumberedOutputVars, !VarTypes, !VarSet,
-        !TableInfo, TableTipVar, Goal, Steps) :-
-    % even if the original goal doesn't use all of the headvars,
+create_new_memo_goal(CallStrictness, Detism, OrigGoal, PredId, ProcId,
+        TablingViaExtraArgs, HeadVars, NumberedInputVars, NumberedOutputVars,
+        !VarTypes, !VarSet, !TableInfo, TableTipVar, Goal, Steps) :-
+    % Even if the original goal doesn't use all of the headvars,
     % the code generated by the tabling transformation does,
     % so we need to compute the nonlocals from the headvars rather
-    % than getting it from the nonlocals field in the original goal
+    % than getting it from the nonlocals field in the original goal.
     set__list_to_set(HeadVars, OrigNonLocals),
     OrigGoal = _ - OrigGoalInfo,
     goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
@@ -885,10 +884,10 @@
         CodeModel = model_non,
         error("create_new_memo_goal: model_non")
     ),
-    generate_simple_call_table_lookup_goal(StatusType, SetupPred,
-        NumberedInputVars, PredId, ProcId, TablingViaExtraArgs, Context,
-        !VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar, LookUpGoal,
-        Steps),
+    generate_simple_call_table_lookup_goal(CallStrictness, StatusType,
+        SetupPred, NumberedInputVars, PredId, ProcId, TablingViaExtraArgs,
+        Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar,
+        LookUpGoal, Steps),
 
     generate_error_goal(!.TableInfo, Context, infinite_recursion_msg,
         !VarTypes, !VarSet, ActiveGoal),
@@ -944,9 +943,8 @@
                 ModuleInfo, Context, ElseGoal)
         ;
             TablingViaExtraArgs = no,
-            generate_call("table_memo_mark_as_failed", failure,
-                [TableTipVar], impure_code, [], ModuleInfo,
-                Context, ElseGoal)
+            generate_call("table_memo_mark_as_failed", failure, [TableTipVar],
+                impure_code, [], ModuleInfo, Context, ElseGoal)
         ),
         InactiveGoalExpr = if_then_else([], RenamedOrigGoal,
             ThenGoal, ElseGoal),
@@ -974,24 +972,24 @@
     SwitchGoal = SwitchExpr - SwitchGoalInfo,
 
     GoalExpr = conj([LookUpGoal, SwitchGoal]),
-    goal_info_init_hide(OrigNonLocals, OrigInstMapDelta, Detism,
-        impure, Context, GoalInfo),
+    goal_info_init_hide(OrigNonLocals, OrigInstMapDelta, Detism, impure,
+        Context, GoalInfo),
     Goal = GoalExpr - GoalInfo.
 
-:- pred create_new_memo_non_goal(determinism::in, hlds_goal::in,
-    pred_id::in, proc_id::in,
+:- pred create_new_memo_non_goal(call_table_strictness::in, determinism::in,
+    hlds_goal::in, pred_id::in, proc_id::in,
     list(prog_var)::in, list(var_mode_pos)::in, list(var_mode_pos)::in,
     vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
     table_info::in, table_info::out, prog_var::out, hlds_goal::out,
     list(table_trie_step)::out) is det.
 
-create_new_memo_non_goal(Detism, OrigGoal, PredId, ProcId, HeadVars,
-        NumberedInputVars, NumberedOutputVars, !VarTypes, !VarSet, !TableInfo,
-        RecordVar, Goal, Steps) :-
-    % even if the original goal doesn't use all of the headvars,
+create_new_memo_non_goal(CallStrictness, Detism, OrigGoal, PredId, ProcId,
+        HeadVars, NumberedInputVars, NumberedOutputVars, !VarTypes, !VarSet,
+        !TableInfo, RecordVar, Goal, Steps) :-
+    % Even if the original goal doesn't use all of the headvars,
     % the code generated by the tabling transformation does,
     % so we need to compute the nonlocals from the headvars rather
-    % than getting it from the nonlocals field in the original goal
+    % than getting it from the nonlocals field in the original goal.
     set__list_to_set(HeadVars, OrigNonLocals),
     OrigGoal = _ - OrigGoalInfo,
     goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
@@ -1005,7 +1003,7 @@
     generate_error_goal(!.TableInfo, Context, need_minimal_model_msg,
         !VarTypes, !VarSet, NeedMinModelGoal),
 
-    generate_memo_non_call_table_lookup_goal(NumberedInputVars,
+    generate_memo_non_call_table_lookup_goal(CallStrictness, NumberedInputVars,
         PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
         RecordVar, StatusVar, LookUpGoal, Steps),
     generate_memo_non_save_goals(NumberedOutputVars, RecordVar, BlockSize,
@@ -1075,13 +1073,13 @@
 
     SwitchExpr = switch(StatusVar, cannot_fail, SwitchArms),
     set__insert(InactiveNonLocals, StatusVar, SwitchNonLocals),
-    goal_info_init_hide(SwitchNonLocals, InactiveInstmapDelta,
-        Detism, impure, Context, SwitchGoalInfo),
+    goal_info_init_hide(SwitchNonLocals, InactiveInstmapDelta, Detism, impure,
+        Context, SwitchGoalInfo),
     SwitchGoal = SwitchExpr - SwitchGoalInfo,
 
     GoalExpr = conj([LookUpGoal, SwitchGoal]),
-    goal_info_init_hide(OrigNonLocals, OrigInstMapDelta, Detism,
-        impure, Context, GoalInfo),
+    goal_info_init_hide(OrigNonLocals, OrigInstMapDelta, Detism, impure,
+        Context, GoalInfo),
     Goal = GoalExpr - GoalInfo.
 
 %-----------------------------------------------------------------------------%
@@ -1547,7 +1545,7 @@
         MakeGeneratorVarGoal),
 
     % XXX use tabling via foreign_proc
-    generate_call_table_lookup_goals(NumberedInputVars, PredId, ProcId,
+    generate_call_table_lookup_goals(strict, NumberedInputVars, PredId, ProcId,
         Context, !VarTypes, !VarSet, !TableInfo, _TableTipVar, _LookupGoals,
         Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
         LookupCodeStr),
@@ -1847,19 +1845,20 @@
     % Generate a goal for doing lookups in call tables for
     % loopcheck and memo predicates.
     %
-:- pred generate_simple_call_table_lookup_goal((type)::in, string::in,
-    list(var_mode_pos)::in, pred_id::in, proc_id::in, bool::in,
-    term__context::in, vartypes::in, vartypes::out,
+:- pred generate_simple_call_table_lookup_goal(call_table_strictness::in,
+    (type)::in, string::in, list(var_mode_pos)::in, pred_id::in, proc_id::in,
+    bool::in, term__context::in, vartypes::in, vartypes::out,
     prog_varset::in, prog_varset::out, table_info::in, table_info::out,
     prog_var::out, prog_var::out, hlds_goal::out,
     list(table_trie_step)::out) is det.
 
-generate_simple_call_table_lookup_goal(StatusType, SetupPred, NumberedVars,
-        PredId, ProcId, TablingViaExtraArgs, Context, !VarTypes, !VarSet,
-        !TableInfo, TableTipVar, StatusVar, Goal, Steps) :-
-    generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
-        !VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals, Steps,
-        PredTableVar, LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
+generate_simple_call_table_lookup_goal(CallStrictness, StatusType, SetupPred,
+        NumberedVars, PredId, ProcId, TablingViaExtraArgs, Context,
+        !VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar, Goal, Steps) :-
+    generate_call_table_lookup_goals(CallStrictness, NumberedVars,
+        PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo, TableTipVar,
+        LookupGoals, Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
+        LookupCodeStr),
     generate_new_table_var("Status", StatusType, !VarTypes, !VarSet,
         StatusVar),
     ModuleInfo = !.TableInfo ^ table_module_info,
@@ -1925,18 +1924,19 @@
     % Generate a goal for doing lookups in call tables for
     % model_non memo predicates.
     %
-:- pred generate_memo_non_call_table_lookup_goal(list(var_mode_pos)::in,
-    pred_id::in, proc_id::in, term__context::in,
+:- pred generate_memo_non_call_table_lookup_goal(call_table_strictness::in,
+    list(var_mode_pos)::in, pred_id::in, proc_id::in, term__context::in,
     vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
     table_info::in, table_info::out, prog_var::out, prog_var::out,
     hlds_goal::out, list(table_trie_step)::out) is det.
 
-generate_memo_non_call_table_lookup_goal(NumberedVars, PredId, ProcId, Context,
-        !VarTypes, !VarSet, !TableInfo, RecordVar, StatusVar, Goal, Steps) :-
-    generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
-        !VarTypes, !VarSet, !TableInfo, _TableTipVar, _LookupGoals,
-        Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
-        LookupCodeStr),
+generate_memo_non_call_table_lookup_goal(CallStrictness, NumberedVars,
+        PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
+        RecordVar, StatusVar, Goal, Steps) :-
+    generate_call_table_lookup_goals(CallStrictness, NumberedVars,
+        PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
+        _TableTipVar, _LookupGoals, Steps, PredTableVar,
+        LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
     ModuleInfo = !.TableInfo ^ table_module_info,
     generate_new_table_var("Record", memo_non_record_type, !VarTypes, !VarSet,
         RecordVar),
@@ -1986,9 +1986,10 @@
 generate_mm_call_table_lookup_goal(NumberedVars, PredId, ProcId,
         TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
         SubgoalVar, StatusVar, Goal, Steps) :-
-    generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
-        !VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals, Steps,
-        PredTableVar, LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
+    generate_call_table_lookup_goals(strict, NumberedVars, PredId, ProcId,
+        Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals,
+        Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
+        LookupCodeStr),
     ModuleInfo = !.TableInfo ^ table_module_info,
     generate_new_table_var("Subgoal", subgoal_type, !VarTypes, !VarSet,
         SubgoalVar),
@@ -2042,20 +2043,20 @@
 
 % Utility predicates used when creating call table lookup goals.
 
-:- pred generate_call_table_lookup_goals(list(var_mode_pos)::in,
-    pred_id::in, proc_id::in, term__context::in,
+:- pred generate_call_table_lookup_goals(call_table_strictness::in,
+    list(var_mode_pos)::in, pred_id::in, proc_id::in, term__context::in,
     vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
     table_info::in, table_info::out, prog_var::out,
     list(hlds_goal)::out, list(table_trie_step)::out, prog_var::out,
     list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
 
-generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
-        !VarTypes, !VarSet, !TableInfo, TableTipVar, Goals, Steps,
+generate_call_table_lookup_goals(CallStrictness, NumberedVars, PredId, ProcId,
+        Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, Goals, Steps,
         PredTableVar, ForeignArgs, PrefixGoals, CodeStr) :-
     generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet,
         PredTableVar, GetTableGoal),
-    generate_table_lookup_goals(NumberedVars, "CallTableNode", Context,
-        PredTableVar, TableTipVar, !VarTypes, !VarSet, !TableInfo,
+    generate_table_lookup_goals(NumberedVars, CallStrictness, "CallTableNode",
+        Context, PredTableVar, TableTipVar, !VarTypes, !VarSet, !TableInfo,
         LookupGoals, Steps, ForeignArgs, LookupPrefixGoals, CodeStr),
     Goals = [GetTableGoal | LookupGoals],
     PrefixGoals = [GetTableGoal | LookupPrefixGoals].
@@ -2087,40 +2088,41 @@
     % The generated code is used for lookups in both call tables
     % and answer tables.
     %
-:- pred generate_table_lookup_goals(list(var_mode_pos)::in, string::in,
+:- pred generate_table_lookup_goals(list(var_mode_pos)::in,
+    call_table_strictness::in, string::in,
     term__context::in, prog_var::in, prog_var::out,
     vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
     table_info::in, table_info::out, list(hlds_goal)::out,
     list(table_trie_step)::out, list(foreign_arg)::out,
     list(hlds_goal)::out, string::out) is det.
 
-generate_table_lookup_goals([], _, _, !TableVar, !VarTypes, !VarSet,
+generate_table_lookup_goals([], _, _, _, !TableVar, !VarTypes, !VarSet,
         !TableInfo, [], [], [], [], "").
-generate_table_lookup_goals([VarModePos | NumberedVars], Prefix, Context,
-        !TableVar, !VarTypes, !VarSet, !TableInfo, Goals ++ RestGoals,
-        [Step | Steps], ForeignArgs ++ RestForeignArgs,
+generate_table_lookup_goals([VarModePos | NumberedVars], CallStrictness,
+        Prefix, Context, !TableVar, !VarTypes, !VarSet, !TableInfo,
+        Goals ++ RestGoals, [Step | Steps], ForeignArgs ++ RestForeignArgs,
         PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
     VarModePos = var_mode_pos(Var, _, VarSeqNum),
     ModuleInfo = !.TableInfo ^ table_module_info,
     map__lookup(!.VarTypes, Var, VarType),
     classify_type(ModuleInfo, VarType) = TypeCat,
-    gen_lookup_call_for_type(TypeCat, VarType, Var, Prefix, VarSeqNum,
-        Context, !VarTypes, !VarSet, !TableInfo, !TableVar,
+    gen_lookup_call_for_type(CallStrictness, TypeCat, VarType, Var, Prefix,
+        VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo, !TableVar,
         Goals, Step, ForeignArgs, PrefixGoals, CodeStr),
-    generate_table_lookup_goals(NumberedVars, Prefix, Context,
+    generate_table_lookup_goals(NumberedVars, CallStrictness, Prefix, Context,
         !TableVar, !VarTypes, !VarSet, !TableInfo, RestGoals, Steps,
         RestForeignArgs, RestPrefixGoals, RestCodeStr).
 
-:- pred gen_lookup_call_for_type(type_category::in, (type)::in,
-    prog_var::in, string::in, int::in, term__context::in,
+:- pred gen_lookup_call_for_type(call_table_strictness::in, type_category::in,
+    (type)::in, prog_var::in, string::in, int::in, term__context::in,
     vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
     table_info::in, table_info::out, prog_var::in, prog_var::out,
     list(hlds_goal)::out, table_trie_step::out,
     list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
 
-gen_lookup_call_for_type(TypeCat, Type, ArgVar, Prefix, VarSeqNum, Context,
-        !VarTypes, !VarSet, !TableInfo, TableVar, NextTableVar,
-        Goals, Step, ExtraArgs, PrefixGoals, CodeStr) :-
+gen_lookup_call_for_type(CallStrictness, TypeCat, Type, ArgVar, Prefix,
+        VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo, TableVar,
+        NextTableVar, Goals, Step, ExtraArgs, PrefixGoals, CodeStr) :-
     ModuleInfo = !.TableInfo ^ table_module_info,
     VarName = Prefix ++ int_to_string(VarSeqNum),
     generate_new_table_var(VarName, trie_node_type, !VarTypes, !VarSet,
@@ -2163,12 +2165,29 @@
         lookup_tabling_category(TypeCat, MaybeCatStringStep),
         (
             MaybeCatStringStep = no,
-            ( prog_type__vars(Type, []) ->
+            prog_type__vars(Type, TypeVars),
+            (
+                CallStrictness = strict,
+                ( 
+                    TypeVars = [],
                 LookupPredName = "table_lookup_insert_user",
                 Step = table_trie_step_user(Type)
             ;
+                    TypeVars = [_ | _],
                 LookupPredName = "table_lookup_insert_poly",
                 Step = table_trie_step_poly
+                )
+            ;
+                CallStrictness = fast_loose,
+                ( 
+                    TypeVars = [],
+                    LookupPredName = "table_lookup_insert_user_fast_loose",
+                    Step = table_trie_step_user_fast_loose(Type)
+                ;
+                    TypeVars = [_ | _],
+                    LookupPredName = "table_lookup_insert_poly_fast_loose",
+                    Step = table_trie_step_poly_fast_loose
+                )
             ),
             make_type_info_var(Type, Context, !VarTypes, !VarSet,
                 !TableInfo, TypeInfoVar, ExtraGoals),
@@ -2268,7 +2287,7 @@
         [RecordArg, AnswerTableArg], [], "", GetPredCode, "",
         semipure_code, ground_vars([AnswerTableVar]),
         ModuleInfo, Context, GetAnswerTableGoal),
-    generate_table_lookup_goals(NumberedSaveVars, "AnswerTableNode",
+    generate_table_lookup_goals(NumberedSaveVars, strict, "AnswerTableNode",
         Context, AnswerTableVar, _AnswerTableTipVar,
         !VarTypes, !VarSet, !TableInfo, _LookupAnswerGoals, _,
         LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
@@ -2326,7 +2345,7 @@
     generate_call(GetPredName, det, [SubgoalVar, AnswerTableVar],
         semipure_code, ground_vars([AnswerTableVar]),
         ModuleInfo, Context, GetAnswerTableGoal),
-    generate_table_lookup_goals(NumberedSaveVars, "AnswerTableNode",
+    generate_table_lookup_goals(NumberedSaveVars, strict, "AnswerTableNode",
         Context, AnswerTableVar, AnswerTableTipVar, !VarTypes, !VarSet,
         !TableInfo, LookupAnswerGoals, _, LookupForeignArgs,
         LookupPrefixGoals, LookupCodeStr),
@@ -2407,9 +2426,10 @@
         CreateSaveCodeStr = CreateCodeStr ++ SaveCodeStr,
         ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
             BaseVarName ++ ");\n",
-        table_generate_foreign_proc(ShortcutPredName, det, tabling_c_attributes,
-            Args, SaveArgs, SaveDeclCodeStr ++ CreateSaveCodeStr, ShortcutStr,
-            "", impure_code, [], ModuleInfo, Context, ShortcutGoal),
+        table_generate_foreign_proc(ShortcutPredName, det,
+            tabling_c_attributes, Args, SaveArgs,
+            SaveDeclCodeStr ++ CreateSaveCodeStr, ShortcutStr, "",
+            impure_code, [], ModuleInfo, Context, ShortcutGoal),
         list__append(SavePrefixGoals, [ShortcutGoal], Goals)
     ;
         TablingViaExtraArgs = no,
@@ -2453,7 +2473,7 @@
         ModuleInfo, Context, GetAnswerTableGoal),
 
     % XXX use foreign_proc
-    generate_table_lookup_goals(NumberedOutputVars, "AnswerTableNode",
+    generate_table_lookup_goals(NumberedOutputVars, strict, "AnswerTableNode",
         Context, AnswerTableVar, AnswerTableTipVar, !VarTypes, !VarSet,
         !TableInfo, LookupAnswerGoals, _, _LookupForeignArgs,
         _LookupPrefixGoals, _LookupCodeStr),
@@ -2525,7 +2545,7 @@
             answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", " ++
             Name ++ ");\n"
     ; builtin_type(TypeCat) = no ->
-        % If used ForeignArg instead of GenericForeignArg, then
+        % If we used ForeignArg instead of GenericForeignArg, then
         % Var would be unboxed when assigned to Name, which we don't want.
         GenericForeignArg = foreign_arg(Var, yes(Name - in_mode),
             dummy_type_var),
@@ -2564,9 +2584,8 @@
     % Generate a goal for restoring the output arguments from
     % an answer block in memo predicates.
     %
-:- pred generate_memo_restore_goal(list(var_mode_pos)::in,
-    instmap_delta::in, prog_var::in, module_info::in,
-    bool::in, term__context::in,
+:- pred generate_memo_restore_goal(list(var_mode_pos)::in, instmap_delta::in,
+    prog_var::in, module_info::in, bool::in, term__context::in,
     vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
     hlds_goal::out) is det.
 
@@ -2579,9 +2598,8 @@
         generate_new_table_var("RestoreBlockVar", answer_block_type,
             !VarTypes, !VarSet, RestoreBlockVar),
         generate_restore_goals(NumberedOutputVars, OrigInstMapDelta,
-            RestoreBlockVar, ModuleInfo, Context,
-            !VarTypes, !VarSet, RestoreGoals,
-            RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
+            RestoreBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
+            RestoreGoals, RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
         (
             TablingViaExtraArgs = yes,
             BaseVarName = base_name,
@@ -2795,9 +2813,8 @@
         error("gen_restore_call_for_type: no inst")
     ),
     Arg = foreign_arg(Var, yes(Name - (free -> Inst)), ArgType),
-    CodeStr = "\tMR_" ++ RestorePredName ++ "(" ++
-        answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", " ++
-        Name ++ ");\n",
+    CodeStr = "\tMR_" ++ RestorePredName ++ "(" ++ answer_block_name ++ ", "
+        ++ int_to_string(Offset) ++ ", " ++ Name ++ ");\n",
     generate_call(RestorePredName, det, [TableVar, OffsetVar, Var],
         semipure_code, [Var - Inst], ModuleInfo, Context, Goal).
 
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.316
diff -u -b -r1.316 reference_manual.texi
--- doc/reference_manual.texi	26 Apr 2005 07:38:01 -0000	1.316
+++ doc/reference_manual.texi	20 May 2005 07:25:51 -0000
@@ -8856,6 +8856,13 @@
 does no loop checking, @samp{pragma loop_check} checks for loops
 and throws an exception if a loop is detected, while
 @samp{pragma minimal_model} computes the ``minimal model'' semantics.
+ at samp{pragma fast_loose_memo} is a variant of @samp{pragma memo}.
+While @samp{memo} tabling requires time proportional to the size of
+the input arguments to look up the current call in its table,
+ at samp{fast_loose_memo} requires constant time.
+The tradeoff is that @samp{fast_loose_memo} does not recognize
+calls as duplicates if they involve input arguments that are logically equal
+but are stored at different locations in memory.
 
 @c XXX we should fix this bug...
 @cartouche
@@ -8872,6 +8879,7 @@
 
 @example
 :- pragma memo(@var{Name}/@var{Arity}).
+:- pragma fast_loose_memo(@var{Name}/@var{Arity}).
 :- pragma loop_check(@var{Name}/@var{Arity}).
 :- pragma minimal_model(@var{Name}/@var{Arity}).
 @end example
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.43
diff -u -b -r1.43 table_builtin.m
--- library/table_builtin.m	3 Jun 2005 07:04:19 -0000	1.43
+++ library/table_builtin.m	3 Jun 2005 07:15:27 -0000
@@ -1223,11 +1223,25 @@
 :- impure pred table_lookup_insert_user(ml_trie_node::in, T::in,
 	ml_trie_node::out) is det.
 
+	% Lookup or insert a monomorphic user defined type in the given trie,
+	% tabling terms without traversing them. This makes the operation fast,
+	% but if a term was inserted previously, we will catch it only if the
+	% insert was the exact same memory cells. (This is the "loose" part.)
+:- impure pred table_lookup_insert_user_fast_loose(ml_trie_node::in, T::in,
+	ml_trie_node::out) is det.
+
 	% Lookup or insert a polymorphic user defined type in the given trie.
 	%
 :- impure pred table_lookup_insert_poly(ml_trie_node::in, T::in,
 	ml_trie_node::out) is det.
 
+	% Lookup or insert a polymorphic user defined type in the given trie,
+	% tabling terms without traversing them. This makes the operation fast,
+	% but if a term was inserted previously, we will catch it only if the
+	% insert was the exact same memory cells. (This is the "loose" part.)
+:- impure pred table_lookup_insert_poly_fast_loose(ml_trie_node::in, T::in,
+	ml_trie_node::out) is det.
+
 	% Lookup or insert a type_info in the given trie.
 	%
 :- impure pred table_lookup_insert_typeinfo(ml_trie_node::in,
@@ -1383,10 +1397,24 @@
 ").
 
 :- pragma foreign_proc("C",
+	table_lookup_insert_user_fast_loose(T0::in, V::in, T::out),
+	[will_not_call_mercury],
+"
+	MR_table_lookup_insert_user_fast_loose(T0, TypeInfo_for_T, V, T);
+").
+
+:- pragma foreign_proc("C",
 	table_lookup_insert_poly(T0::in, V::in, T::out),
 	[will_not_call_mercury],
 "
-	MR_table_lookup_insert_user(T0, TypeInfo_for_T, V, T);
+	MR_table_lookup_insert_poly(T0, TypeInfo_for_T, V, T);
+").
+
+:- pragma foreign_proc("C",
+	table_lookup_insert_poly_fast_loose(T0::in, V::in, T::out),
+	[will_not_call_mercury],
+"
+	MR_table_lookup_insert_poly_fast_loose(T0, TypeInfo_for_T, V, T);
 ").
 
 :- pragma foreign_proc("C",
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.89
diff -u -b -r1.89 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h	14 Apr 2005 02:35:01 -0000	1.89
+++ runtime/mercury_stack_layout.h	20 May 2005 02:32:44 -0000
@@ -627,7 +627,9 @@
 	MR_TABLE_STEP_FLOAT,
 	MR_TABLE_STEP_ENUM,
 	MR_TABLE_STEP_USER,
+	MR_TABLE_STEP_USER_FAST_LOOSE,
 	MR_TABLE_STEP_POLY,
+	MR_TABLE_STEP_POLY_FAST_LOOSE,
 	MR_TABLE_STEP_TYPEINFO,
 	MR_TABLE_STEP_TYPECLASSINFO
 } MR_Table_Trie_Step;
@@ -771,7 +773,8 @@
 typedef	enum {
 	MR_EVAL_METHOD_NORMAL,
 	MR_EVAL_METHOD_LOOP_CHECK,
-	MR_EVAL_METHOD_MEMO,
+	MR_EVAL_METHOD_MEMO_STRICT,
+	MR_EVAL_METHOD_MEMO_FAST_LOOSE,
 	MR_EVAL_METHOD_MINIMAL_STACK_COPY,
 	MR_EVAL_METHOD_MINIMAL_OWN_STACKS,
 	MR_EVAL_METHOD_TABLE_IO,
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.66
diff -u -b -r1.66 mercury_tabling.c
--- runtime/mercury_tabling.c	14 Dec 2004 01:07:24 -0000	1.66
+++ runtime/mercury_tabling.c	20 May 2005 05:43:32 -0000
@@ -37,6 +37,7 @@
 typedef struct MR_IntHashTableSlot_Struct       MR_IntHashTableSlot;
 typedef struct MR_FloatHashTableSlot_Struct     MR_FloatHashTableSlot;
 typedef struct MR_StringHashTableSlot_Struct    MR_StringHashTableSlot;
+typedef struct MR_WordHashTableSlot_Struct      MR_WordHashTableSlot;
 
 typedef struct MR_AllocRecord_Struct            MR_AllocRecord;
 
@@ -58,10 +59,17 @@
     MR_ConstString          key;
 };
 
+struct MR_WordHashTableSlot_Struct {
+    MR_WordHashTableSlot    *next;
+    MR_TableNode            data;
+    MR_Word                 key;
+};
+
 typedef union {
     MR_IntHashTableSlot     *int_slot_ptr;
     MR_FloatHashTableSlot   *float_slot_ptr;
     MR_StringHashTableSlot  *string_slot_ptr;
+    MR_WordHashTableSlot    *word_slot_ptr;
 } MR_HashTableSlotPtr;
 
 struct MR_AllocRecord_Struct {
@@ -455,6 +463,46 @@
 #undef  lookup_only
 }
 
+MR_TrieNode
+MR_word_hash_lookup_or_add(MR_TrieNode t, MR_Word key)
+{
+#define key_format              "%p"
+#define key_cast                (MR_Word)
+#define table_type              MR_WordHashTableSlot
+#define table_field             word_slot_ptr
+#define hash(key)               ((long) (key))
+#define equal_keys(k1, k2)      ((k1) == (k2))
+#define lookup_only             MR_FALSE
+#include "mercury_hash_lookup_or_add_body.h"
+#undef  key_format
+#undef  key_cast
+#undef  table_type
+#undef  table_field
+#undef  hash
+#undef  equal_keys
+#undef  lookup_only
+}
+
+MR_TrieNode
+MR_ptr_hash_lookup(MR_TrieNode t, MR_Word key)
+{
+#define key_format              "%p"
+#define key_cast                (MR_Word)
+#define table_type              MR_WordHashTableSlot
+#define table_field             word_slot_ptr
+#define hash(key)               ((long) (key))
+#define equal_keys(k1, k2)      ((k1) == (k2))
+#define lookup_only             MR_TRUE
+#include "mercury_hash_lookup_or_add_body.h"
+#undef  key_format
+#undef  key_cast
+#undef  table_type
+#undef  table_field
+#undef  hash
+#undef  equal_keys
+#undef  lookup_only
+}
+
 static int
 MR_cmp_ints(const void *p1, const void *p2)
 {
@@ -717,8 +765,6 @@
 
 /*
 ** This part defines the MR_table_type() function.
-**
-** Due to the depth of the control here, we'll use 4 space indentation.
 **
 ** NOTE: changes to this function will probably also have to be reflected
 ** in the places listed in mercury_type_info.h.
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.37
diff -u -b -r1.37 mercury_tabling.h
--- runtime/mercury_tabling.h	3 Jun 2005 07:04:22 -0000	1.37
+++ runtime/mercury_tabling.h	3 Jun 2005 07:15:28 -0000
@@ -191,6 +191,8 @@
 				MR_Float key);
 extern	MR_TrieNode	MR_string_hash_lookup_or_add(MR_TrieNode table,
 				MR_ConstString key);
+extern	MR_TrieNode	MR_word_hash_lookup_or_add(MR_TrieNode table,
+				MR_Word key);
 
 /*
 ** This function assumes that the table is a statically sized array,
@@ -224,7 +226,10 @@
 
 /*
 ** This function tables values of arbitrary types; the form of the data
-** structure depends on the actual type of the value.
+** structure depends on the actual type of the value. The tabling is done
+** by tabling all the function symbols of the value; unlike
+** MR_word_hash_lookup, this function *does* guarantee that all duplicates
+** will be detected.
 */
 
 extern	MR_TrieNode	MR_table_type(MR_TrieNode table,
@@ -244,6 +249,8 @@
 				MR_Float key);
 extern	MR_TrieNode	MR_string_hash_lookup(MR_TrieNode table,
 				MR_ConstString key);
+extern	MR_TrieNode	MR_word_hash_lookup(MR_TrieNode table,
+				MR_Word data_value);
 
 /*
 ** These functions return a dynamically resizable array (using the primitives
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_macros.h,v
retrieving revision 1.11
diff -u -b -r1.11 mercury_tabling_macros.h
--- runtime/mercury_tabling_macros.h	20 Jul 2004 04:41:25 -0000	1.11
+++ runtime/mercury_tabling_macros.h	20 May 2005 05:44:36 -0000
@@ -19,6 +19,9 @@
 #define MR_RAW_TABLE_ANY(table, type_info, value)			\
 	MR_table_type((table), (type_info), (value))
 
+#define MR_RAW_TABLE_ANY_FAST_LOOSE(table, type_info, value)		\
+	MR_word_hash_lookup_or_add((table), (value))
+
 #define MR_RAW_TABLE_TAG(table, tag)					\
 	MR_int_fix_index_lookup_or_add((table), 1 << MR_TAGBITS, (tag))
 
@@ -72,6 +75,27 @@
 		}							\
 	} while (0)
 
+#define	MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(table, table0, type_info, value) \
+	do {								\
+		(table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table0), (type_info), \
+			(value));					\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: any %x type %p => %p\n",	\
+				(table0), (value), (type_info), (table));\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_ANY_FAST_LOOSE(table, type_info, value)		\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table),		\
+			(type_info), (value));				\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: any %x type %p => %p\n",	\
+				prev_table, (value), (type_info),	\
+				(table));				\
+		}							\
+	} while (0)
+
 #define	MR_DEBUG_NEW_TABLE_TAG(table, table0, value)			\
 	do {								\
 		(table) = MR_RAW_TABLE_TAG((table0), (value));		\
@@ -263,6 +287,17 @@
 #define	MR_DEBUG_TABLE_ANY(table, type_info, value)			\
 	do {								\
 		(table) = MR_RAW_TABLE_ANY((table), (type_info), (value));\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(table, table0, type_info, value) \
+	do {								\
+		(table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table0), (type_info), \
+			(value));					\
+	} while (0)
+#define	MR_DEBUG_TABLE_ANY_FAST_LOOSE(table, type_info, value)		\
+	do {								\
+		(table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table), (type_info), \
+			(value));					\
 	} while (0)
 
 #define	MR_DEBUG_NEW_TABLE_TAG(table, table0, value)			\
Index: runtime/mercury_tabling_preds.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_preds.h,v
retrieving revision 1.5
diff -u -b -r1.5 mercury_tabling_preds.h
--- runtime/mercury_tabling_preds.h	3 Jun 2005 07:04:23 -0000	1.5
+++ runtime/mercury_tabling_preds.h	3 Jun 2005 07:15:29 -0000
@@ -56,11 +56,21 @@
         MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TI, V);             \
     } while(0)
 
+#define MR_table_lookup_insert_user_fast_loose(T0, TI, V, T)            \
+    do {                                                                \
+        MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(T, T0, (MR_TypeInfo) TI, V);  \
+    } while(0)
+
 #define MR_table_lookup_insert_poly(T0, TI, V, T)                       \
     do {                                                                \
         MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TI, V);             \
     } while(0)
 
+#define MR_table_lookup_insert_poly_fast_loose(T0, TI, V, T)            \
+    do {                                                                \
+        MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(T, T0, (MR_TypeInfo) TI, V);  \
+    } while(0)
+
 #define MR_table_lookup_insert_typeinfo(T0, TI, T)                      \
     do {                                                                \
         MR_DEBUG_NEW_TABLE_TYPEINFO(T, T0, (MR_TypeInfo) TI);           \
@@ -549,8 +559,7 @@
             Start = MR_io_tabling_start;                                \
             if (MR_io_tabling_counter > MR_io_tabling_counter_hwm)      \
             {                                                           \
-                MR_io_tabling_counter_hwm =                             \
-                    MR_io_tabling_counter;                              \
+                MR_io_tabling_counter_hwm = MR_io_tabling_counter;      \
             }                                                           \
                                                                         \
             MR_table_io_in_range_in_range_msg;                          \
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.35
diff -u -b -r1.35 Mmakefile
--- tests/tabling/Mmakefile	10 Jan 2005 05:30:25 -0000	1.35
+++ tests/tabling/Mmakefile	20 May 2005 05:39:48 -0000
@@ -10,6 +10,7 @@
 	expand_float \
 	expand_poly \
 	expand_tuple \
+	fast_loose \
 	fib \
 	fib_float \
 	fib_list \
Index: tests/tabling/fast_loose.exp
===================================================================
RCS file: tests/tabling/fast_loose.exp
diff -N tests/tabling/fast_loose.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/tabling/fast_loose.exp	20 May 2005 05:25:48 -0000
@@ -0,0 +1 @@
+fast_loose works
Index: tests/tabling/fast_loose.m
===================================================================
RCS file: tests/tabling/fast_loose.m
diff -N tests/tabling/fast_loose.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/tabling/fast_loose.m	20 May 2005 05:26:04 -0000
@@ -0,0 +1,87 @@
+:- module fast_loose.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module list.
+:- import_module require.
+
+main(!IO) :-
+	perform_trials(80, !IO).
+
+:- pred perform_trials(int::in, io::di, io::uo) is cc_multi.
+
+perform_trials(N, !IO) :-
+	trial(N, STime, FLTime),
+	% io__write_int(N, !IO),
+	% io__write_string(": ", !IO),
+	% io__write_int(STime, !IO),
+	% io__write_string("ms vs ", !IO),
+	% io__write_int(FLTime, !IO),
+	% io__write_string("ms\n", !IO),
+	(
+		(
+			STime > 10 * FLTime,
+			FLTime > 0	% strict takes ten times as long
+		;
+			STime > 100,	% strict takes at least 100 ms
+			FLTime < 1	% while fast_loose takes at most 1 ms
+		)
+	->
+		io__write_string("fast_loose works\n", !IO)
+	;
+		STime > 10000	% Strict takes at least 10 seconds
+	->
+		io__write_string("fast_loose does not appear to work\n", !IO)
+	;
+		% We couldn't get a measurable result with N,
+		% and it looks like we can afford a bigger trial.
+		perform_trials(N+5, !IO)
+	).
+
+:- pred trial(int::in, int::out, int::out) is cc_multi.
+
+trial(N, STime, FLTime) :-
+	benchmark_det(strict, N, SRes, 1, STime),
+	benchmark_det(fast_loose, N, FLRes, 1, FLTime),
+	require(unify(SRes, FLRes), "tabling produces wrong answer").
+
+:- pred strict(int::in, int::out) is det.
+
+strict(N, R) :-
+	strict_sum(iota(N), R).
+
+:- pred strict_sum(list(int)::in, int::out) is det.
+:- pragma memo(strict_sum/2).
+
+strict_sum([], 0).
+strict_sum([H | T], H + TS) :-
+	strict_sum(T, TS).
+
+:- pred fast_loose(int::in, int::out) is det.
+
+fast_loose(N, R) :-
+	fast_loose_sum(iota(N), R).
+
+:- pred fast_loose_sum(list(int)::in, int::out) is det.
+:- pragma fast_loose_memo(fast_loose_sum/2).
+
+fast_loose_sum([], 0).
+fast_loose_sum([H | T], H + TS) :-
+	fast_loose_sum(T, TS).
+
+:- func iota(int) = list(int).
+
+iota(N) = 
+	( N =< 0 ->
+		[]
+	;
+		[N | iota(N - 1)]
+	).
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.81
diff -u -b -r1.81 mercury_trace.c
--- trace/mercury_trace.c	13 May 2005 13:45:32 -0000	1.81
+++ trace/mercury_trace.c	20 May 2005 02:25:33 -0000
@@ -1451,13 +1451,17 @@
         /* nothing to do */
         return;
 
-    case MR_EVAL_METHOD_MEMO:
+    case MR_EVAL_METHOD_MEMO_STRICT:
+    case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
     case MR_EVAL_METHOD_LOOP_CHECK:
         if (MR_DETISM_DET_STACK(level_layout->MR_sle_detism)) {
             call_table = (MR_TrieNode) MR_based_stackvar(base_sp,
                 level_layout->MR_sle_maybe_call_table);
         } else {
-            if (eval_method == MR_EVAL_METHOD_MEMO) {
+            if (eval_method == MR_EVAL_METHOD_LOOP_CHECK) {
+                call_table = (MR_TrieNode) MR_based_framevar(base_curfr,
+                    level_layout->MR_sle_maybe_call_table);
+            } else {
                 MR_MemoNonRecordPtr record;
 
                 record = (MR_MemoNonRecordPtr) MR_based_framevar(base_curfr,
@@ -1468,9 +1472,6 @@
                 printf("reset: memo non record %p, call_table %p\n",
                         record, call_table);
 #endif
-            } else {
-                call_table = (MR_TrieNode) MR_based_framevar(base_curfr,
-                    level_layout->MR_sle_maybe_call_table);
             }
         }
 
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.205
diff -u -b -r1.205 mercury_trace_internal.c
--- trace/mercury_trace_internal.c	3 Jun 2005 07:04:33 -0000	1.205
+++ trace/mercury_trace_internal.c	6 Jun 2005 02:08:24 -0000
@@ -4451,7 +4451,8 @@
             return KEEP_INTERACTING;
 
         case MR_EVAL_METHOD_LOOP_CHECK:
-        case MR_EVAL_METHOD_MEMO:
+        case MR_EVAL_METHOD_MEMO_STRICT:
+        case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
         case MR_EVAL_METHOD_MINIMAL_STACK_COPY:
         case MR_EVAL_METHOD_MINIMAL_OWN_STACKS:
             break;
@@ -4574,7 +4575,8 @@
             fprintf(MR_mdb_out, ":\n");
             break;
 
-        case MR_EVAL_METHOD_MEMO:
+        case MR_EVAL_METHOD_MEMO_STRICT:
+        case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
             fprintf(MR_mdb_out, "memo table for ");
             MR_print_proc_id(MR_mdb_out, proc);
             fprintf(MR_mdb_out, ":\n");
@@ -4980,7 +4982,9 @@
     fprintf(MR_mdb_out, ">: ");
 
     eval_method = MR_sle_eval_method(proc);
-    if (eval_method == MR_EVAL_METHOD_MINIMAL_STACK_COPY) {
+    switch (eval_method) {
+        case MR_EVAL_METHOD_MINIMAL_STACK_COPY:
+            {
         MR_Subgoal  *subgoal;
         int         subgoal_num;
 
@@ -4991,7 +4995,11 @@
         } else {
             MR_trace_print_subgoal(proc, subgoal);
         }
-    } else if (eval_method == MR_EVAL_METHOD_MINIMAL_OWN_STACKS) {
+            }
+            break;
+
+        case MR_EVAL_METHOD_MINIMAL_OWN_STACKS:
+            {
         MR_GeneratorPtr generator;
 
         fprintf(MR_mdb_out, "trie node %p\n", table);
@@ -5001,7 +5009,12 @@
         } else {
             MR_trace_print_generator(proc, generator);
         }
-    } else if (eval_method == MR_EVAL_METHOD_MEMO) {
+            }
+            break;
+
+        case MR_EVAL_METHOD_MEMO_STRICT:
+        case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
+            {
         MR_Determinism  detism;
 
         detism = proc->MR_sle_detism;
@@ -5013,10 +5026,20 @@
             record = table->MR_memo_non_record;
             MR_print_memo_non_record(MR_mdb_out, proc, record);
         }
-    } else if (eval_method == MR_EVAL_METHOD_LOOP_CHECK) {
+            }
+            break;
+
+        case MR_EVAL_METHOD_LOOP_CHECK:
         MR_print_loopcheck_tip(MR_mdb_out, proc, table);
-    } else {
+            break;
+
+        case MR_EVAL_METHOD_NORMAL:
+        case MR_EVAL_METHOD_TABLE_IO:
+        case MR_EVAL_METHOD_TABLE_IO_DECL:
+        case MR_EVAL_METHOD_TABLE_IO_UNITIZE:
+        case MR_EVAL_METHOD_TABLE_IO_UNITIZE_DECL:
         MR_fatal_error("MR_trace_cmd_table_print_tip: bad eval method");
+            break;
     }
 }
 
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list