[m-rev.] diff: typecheck.m search_insert speedups

[Zoltan Somogyi]

compiler/typecheck.m:
	Use the new map.search_insert predicate to speed up the code
	in a few places.


compiler/typecheck_info.m:
	Style fix.

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/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.467
diff -u -b -r1.467 typecheck.m
--- compiler/typecheck.m	18 Apr 2012 02:25:00 -0000	1.467
+++ compiler/typecheck.m	14 Jun 2012 07:04:58 -0000
@@ -1839,9 +1839,12 @@
     type_assign_get_var_types(TypeAssign0, VarTypes0),
     (
         ArgTypes0 = [Type | ArgTypes],
-        ( map.search(VarTypes0, Var, VarType) ->
+        map.search_insert(Var, Type, MaybeOldVarType, VarTypes0, VarTypes),
+        (
+            MaybeOldVarType = yes(OldVarType),
             (
-                type_assign_unify_type(TypeAssign0, VarType, Type, TypeAssign1)
+                type_assign_unify_type(TypeAssign0, OldVarType, Type,
+                    TypeAssign1)
             ->
                 NewTypeAssign = args(TypeAssign1, ArgTypes, ClassContext),
                 !:ArgTypeAssignSet = [NewTypeAssign | !.ArgTypeAssignSet]
@@ -1849,7 +1852,7 @@
                 true
             )
         ;
-            map.det_insert(Var, Type, VarTypes0, VarTypes),
+            MaybeOldVarType = no,
             type_assign_set_var_types(VarTypes, TypeAssign0, TypeAssign),
             NewTypeAssign = args(TypeAssign, ArgTypes, ClassContext),
             !:ArgTypeAssignSet = [NewTypeAssign | !.ArgTypeAssignSet]
@@ -1924,24 +1927,26 @@
     mer_type::in, type_assign_set::in, type_assign_set::out) is det.
 
 typecheck_var_has_type_2([], _, _, !TypeAssignSet).
-typecheck_var_has_type_2([TypeAssign0 | TypeAssignSet0], Var, Type,
+typecheck_var_has_type_2([TypeAssign0 | TypeAssigns0], Var, Type,
         !TypeAssignSet) :-
     type_assign_var_has_type(TypeAssign0, Var, Type, !TypeAssignSet),
-    typecheck_var_has_type_2(TypeAssignSet0, Var, Type, !TypeAssignSet).
+    typecheck_var_has_type_2(TypeAssigns0, Var, Type, !TypeAssignSet).
 
 :- pred type_assign_var_has_type(type_assign::in, prog_var::in, mer_type::in,
     type_assign_set::in, type_assign_set::out) is det.
 
 type_assign_var_has_type(TypeAssign0, Var, Type, !TypeAssignSet) :-
     type_assign_get_var_types(TypeAssign0, VarTypes0),
-    ( map.search(VarTypes0, Var, VarType) ->
-        ( type_assign_unify_type(TypeAssign0, VarType, Type, TypeAssign1) ->
+    map.search_insert(Var, Type, MaybeOldVarType, VarTypes0, VarTypes),
+    (
+        MaybeOldVarType = yes(OldVarType),
+        ( type_assign_unify_type(TypeAssign0, OldVarType, Type, TypeAssign1) ->
             !:TypeAssignSet = [TypeAssign1 | !.TypeAssignSet]
         ;
             !:TypeAssignSet = !.TypeAssignSet
         )
     ;
-        map.det_insert(Var, Type, VarTypes0, VarTypes),
+        MaybeOldVarType = no,
         type_assign_set_var_types(VarTypes, TypeAssign0, TypeAssign),
         !:TypeAssignSet = [TypeAssign | !.TypeAssignSet]
     ).
@@ -2274,7 +2279,9 @@
 type_assign_unify_var_var(X, Y, TypeAssign0, !TypeAssignSet) :-
     type_assign_get_var_types(TypeAssign0, VarTypes0),
     ( map.search(VarTypes0, X, TypeX) ->
-        ( map.search(VarTypes0, Y, TypeY) ->
+        map.search_insert(Y, TypeX, MaybeTypeY, VarTypes0, VarTypes),
+        (
+            MaybeTypeY = yes(TypeY),
             % Both X and Y already have types - just unify their types.
             ( type_assign_unify_type(TypeAssign0, TypeX, TypeY, TypeAssign3) ->
                 !:TypeAssignSet = [TypeAssign3 | !.TypeAssignSet]
@@ -2282,8 +2289,7 @@
                 !:TypeAssignSet = !.TypeAssignSet
             )
         ;
-            % Y is a fresh variable which hasn't been assigned a type yet.
-            map.det_insert(Y, TypeX, VarTypes0, VarTypes),
+            MaybeTypeY = no,
             type_assign_set_var_types(VarTypes, TypeAssign0, TypeAssign),
             !:TypeAssignSet = [TypeAssign | !.TypeAssignSet]
         )
@@ -2321,7 +2327,9 @@
         !ArgsTypeAssignSet) :-
     % Unify the type of Var with the type of the constructor.
     type_assign_get_var_types(TypeAssign0, VarTypes0),
-    ( map.search(VarTypes0, Y, TypeY) ->
+    map.search_insert(Y, ConsType, MaybeTypeY, VarTypes0, VarTypes),
+    (
+        MaybeTypeY = yes(TypeY),
         ( type_assign_unify_type(TypeAssign0, ConsType, TypeY, TypeAssign) ->
             % The constraints are empty here because none are added by
             % unification with a functor.
@@ -2332,9 +2340,9 @@
             true
         )
     ;
+        MaybeTypeY = no,
         % The constraints are empty here because none are added by
         % unification with a functor.
-        map.det_insert(Y, ConsType, VarTypes0, VarTypes),
         type_assign_set_var_types(VarTypes, TypeAssign0, TypeAssign),
         empty_hlds_constraints(EmptyConstraints),
         ArgsTypeAssign = args(TypeAssign, ArgTypes, EmptyConstraints),
@@ -2349,7 +2357,9 @@
         !TypeAssignSet) :-
     % Unify the type of Var with the type of the constructor.
     type_assign_get_var_types(TypeAssign0, VarTypes0),
-    ( map.search(VarTypes0, Y, TypeY) ->
+    map.search_insert(Y, ConsType, MaybeTypeY, VarTypes0, VarTypes),
+    (
+        MaybeTypeY = yes(TypeY),
         ( type_assign_unify_type(TypeAssign0, ConsType, TypeY, TypeAssign) ->
             % The constraints are empty here because none are added by
             % unification with a functor.
@@ -2358,9 +2368,9 @@
             true
         )
     ;
+        MaybeTypeY = no,
         % The constraints are empty here because none are added by
         % unification with a functor.
-        map.det_insert(Y, ConsType, VarTypes0, VarTypes),
         type_assign_set_var_types(VarTypes, TypeAssign0, TypeAssign),
         !:TypeAssignSet = [TypeAssign | !.TypeAssignSet]
     ).
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.38
diff -u -b -r1.38 typecheck_info.m
--- compiler/typecheck_info.m	24 Apr 2012 02:16:44 -0000	1.38
+++ compiler/typecheck_info.m	14 Jun 2012 07:04:58 -0000
@@ -230,19 +230,21 @@
     --->    type_assign(
                 var_types           :: vartypes,
                 type_varset         :: tvarset,
-                head_type_params    :: head_type_params,
+
                                     % Universally quantified type variables.
-                type_bindings       :: tsubst,
+                head_type_params    :: head_type_params,
+
                                     % Type bindings.
+                type_bindings       :: tsubst,
+
+                % The set of class constraints collected so far.
                 class_constraints   :: hlds_constraints,
-                                    % The set of class constraints
-                                    % collected so far.
+
+                % For each constraint found to be redundant, why is it so?
                 constraint_proofs   :: constraint_proof_map,
-                                    % For each constraint found to be
-                                    % redundant, why is it so?
+
+                % Maps constraint identifiers to the actual constraints.
                 constraint_map      :: constraint_map
-                                    % Maps constraint identifiers to the
-                                    % actual constraints.
             ).
 
 %-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
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/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/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glfw
cvs diff: Diffing extras/graphics/mercury_glfw/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/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
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
cvs diff: Diffing m4
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
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/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/lazy_list
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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/feedback
cvs diff: Diffing tests/feedback/mandelbrot
cvs diff: Diffing tests/feedback/mmc
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/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
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 messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------