[m-rev.] for review: constant mutables

Zoltan Somogyi zs at cs.mu.OZ.AU
Wed Apr 26 16:47:11 AEST 2006


Support constant "mutables". Though this sounds like a contradiction in terms,
they can be useful, because in some cases they are the best alternative.

- For some types, e.g. arrays, there is no way to write manifest constants.

- For some other types, one can write manifest constants, but the compiler
  may be too slow in compiling clauses containing them if the constant is
  very large (even after my recent improvements).

- Using a tabled zero-arity function incurs overhead on every access to check
  whether the result was recorded previously or not. This is a bad idea e.g.
  in the inner loop of a scanner (which may want to use an array for the
  representation of the DFA).

compiler/prog_item.m:
	Add a new attribute to say whether the mutable is constant or not.

compiler/prog_io.m:
	Recognize the "constant" mutable attribute.

compiler/prog_mutable.m:
	Provide predicates to construct the signatures of the get and set
	predicates of constant mutables. Rename some existing predicates
	to better reflect their purpose.

compiler/make_hlds_passes.m:
compiler/modules.m:
	Modify the code for creating mutables' get, set and init predicates
	to do the right thing for constant mutables.

doc/reference_manual.texi:
	Document the new attribute.

tests/hard_coded/pure_mutable.{m,exp}:
	Test the new attribute.

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/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.40
diff -u -b -r1.40 make_hlds_passes.m
--- compiler/make_hlds_passes.m	20 Apr 2006 05:36:54 -0000	1.40
+++ compiler/make_hlds_passes.m	26 Apr 2006 05:27:32 -0000
@@ -456,40 +456,57 @@
     ( status_defined_in_this_module(ImportStatus, yes) ->
         module_info_get_name(!.ModuleInfo, ModuleName),
         %
-        % Create the non-pure access predicates.  These are always
-        % created, even if the `pure' attribute has been specified.
+        % Create the initialisation predicate.
+        %
+        InitPredDecl = mutable_init_pred_decl(ModuleName, Name),
+        add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
+            !IO),
+        IsConstant = mutable_var_constant(MutAttrs),
+        (
+            IsConstant = no,
+            %
+            % Create the standard, non-pure access predicates. These are
+            % always created for non-constant mutables, even if the
+            % `attach_to_io_state' attribute has been specified.
         %
-        NonPureGetPredDecl = prog_mutable.nonpure_get_pred_decl(ModuleName,
-            Name, Type, Inst),
-        add_item_decl_pass_1(NonPureGetPredDecl, Context, !Status, !ModuleInfo,
-            _, !IO),
-        NonPureSetPredDecl = prog_mutable.nonpure_set_pred_decl(ModuleName,
-            Name, Type, Inst),
-        add_item_decl_pass_1(NonPureSetPredDecl, Context, !Status, !ModuleInfo,
-            _, !IO),
-        %
-        % If requested, create the pure access predicates as well.
-        %
-        CreatePureInterface = mutable_var_attach_to_io_state(MutAttrs),
-        (
-            CreatePureInterface = yes,
-            PureGetPredDecl = prog_mutable.pure_get_pred_decl(ModuleName,
-                Name, Type, Inst),
-            add_item_decl_pass_1(PureGetPredDecl, Context, !Status,
+            StdGetPredDecl = std_get_pred_decl(ModuleName, Name, Type, Inst),
+            add_item_decl_pass_1(StdGetPredDecl, Context, !Status,
+                !ModuleInfo, _, !IO),
+            StdSetPredDecl = std_set_pred_decl(ModuleName, Name, Type, Inst),
+            add_item_decl_pass_1(StdSetPredDecl, Context, !Status,
+                !ModuleInfo, _, !IO),
+            %
+            % If requested, create the pure access predicates using
+            % the I/O state as well.
+            %
+            CreateIOInterface = mutable_var_attach_to_io_state(MutAttrs),
+            (
+                CreateIOInterface = yes,
+                IOGetPredDecl = io_get_pred_decl(ModuleName, Name, Type, Inst),
+                add_item_decl_pass_1(IOGetPredDecl, Context, !Status,
                 !ModuleInfo, _, !IO),
-            PureSetPredDecl = prog_mutable.pure_set_pred_decl(ModuleName,
-                Name, Type, Inst),
-            add_item_decl_pass_1(PureSetPredDecl, Context, !Status,
+                IOSetPredDecl = io_set_pred_decl(ModuleName, Name, Type, Inst),
+                add_item_decl_pass_1(IOSetPredDecl, Context, !Status,
                 !ModuleInfo, _, !IO)
         ;
-            CreatePureInterface = no
-        ),
+                CreateIOInterface = no
+            )
+        ;
+            IsConstant = yes,
         %
-        % Create the initialisation predicate.
+            % We create the "get" access predicate, which is pure since
+            % it always returns the same value, but we must also create
+            % a secret "set" predicate for use by the initialization code.
         %
-        InitPredDecl = prog_mutable.init_pred_decl(ModuleName, Name),
-        add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
-            !IO)
+            ConstantGetPredDecl = constant_get_pred_decl(ModuleName, Name,
+                Type, Inst),
+            add_item_decl_pass_1(ConstantGetPredDecl, Context, !Status,
+                !ModuleInfo, _, !IO),
+            ConstantSetPredDecl = constant_set_pred_decl(ModuleName, Name,
+                Type, Inst),
+            add_item_decl_pass_1(ConstantSetPredDecl, Context, !Status,
+                !ModuleInfo, _, !IO)
+        )
     ;
         true
     ).
@@ -706,8 +723,7 @@
         TargetMutableNames),
     (
         TargetMutableNames = [],
-        TargetMutableName = mutable_c_var_name(ModuleName,
-            MercuryMutableName)
+        TargetMutableName = mutable_c_var_name(ModuleName, MercuryMutableName)
     ;
         TargetMutableNames = [foreign_name(_, TargetMutableName)]
         % XXX We should really check that this is a valid identifier
@@ -764,7 +780,9 @@
                 ; Details = finalise_decl
                 )
             ;
-                ( Details = solver_type ; Details = foreign_imports ),
+                ( Details = solver_type
+                ; Details = foreign_imports
+                ),
                 unexpected(this_file, "Bad introduced clauses.")
             )
         )
@@ -772,7 +790,7 @@
         true
     ),
     GoalType = none,
-    % at this stage we only need know that it's not a promise declaration
+    % At this stage we only need know that it's not a promise declaration.
     module_add_clause(VarSet, PredOrFunc, PredName, Args, Body, !.Status,
         Context, GoalType, !ModuleInfo, !QualInfo, !IO).
 add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO) :-
@@ -875,10 +893,9 @@
         Pragma = type_spec(_, _, _, _, _, _, _, _)
     ->
         %
-        % XXX For the Java back-end, `pragma type_spec' can
-        % result in class names that exceed the limits on file
-        % name length.  So we ignore these pragmas for the
-        % Java back-end.
+        % XXX For the Java back-end, `pragma type_spec' can result in
+        % class names that exceed the limits on file name length.
+        % So we ignore these pragmas for the Java back-end.
         %
         globals.io_get_target(Target, !IO),
         ( Target = java ->
@@ -1199,32 +1216,49 @@
             true
         ),
 
-        %
-        % Add the `:- initialise' declaration and clause for the
-        % initialise predicate.
-        %
-        add_item_clause(initialise(compiler(mutable_decl),
-                mutable_init_pred_sym_name(ModuleName, Name), 0 /* Arity */),
-            !Status, Context, !ModuleInfo, !QualInfo, !IO),
-        %
-        % See the comments for prog_io.parse_mutable_decl for the reason
-        % why we _must_ use MutVarset here.
-        % 
-        InitClause = clause(compiler(mutable_decl), MutVarset, predicate,
-            mutable_init_pred_sym_name(ModuleName, Name), [],
-            call_expr(mutable_set_pred_sym_name(ModuleName, Name),
-                [InitTerm], purity_impure) - Context),
-        add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
-            !IO),
+        Constant = mutable_var_constant(MutAttrs),
+        (
+            Constant = yes,
+            InitSetPredName =
+                mutable_secret_set_pred_sym_name(ModuleName, Name),
+
+            set_purity(purity_pure, Attrs, ConstantGetAttrs),
+            ConstantGetClause = pragma(compiler(mutable_decl),
+                foreign_proc(ConstantGetAttrs,
+                    mutable_get_pred_sym_name(ModuleName, Name), predicate,
+                    [pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
+                    ProgVarSet0, InstVarset,
+                    ordinary("X = " ++ TargetMutableName ++ ";",
+                        yes(Context)))),
+            add_item_clause(ConstantGetClause, !Status, Context, !ModuleInfo,
+                !QualInfo, !IO),
+
+            % We don't need to trail the set action, since it is executed
+            % only once at initialization time.
+            ConstantSetClause = pragma(compiler(mutable_decl),
+                foreign_proc(Attrs,
+                    mutable_secret_set_pred_sym_name(ModuleName, Name),
+                    predicate,
+                    [pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
+                    ProgVarSet0, InstVarset,
+                    ordinary(TargetMutableName ++ " = X;", yes(Context)))),
+            add_item_clause(ConstantSetClause, !Status, Context, !ModuleInfo,
+                !QualInfo, !IO)
+        ;
+            Constant = no,
+            InitSetPredName = mutable_set_pred_sym_name(ModuleName, Name),
+
         set_purity(purity_semipure, Attrs, GetAttrs),
-        NonPureGetClause = pragma(compiler(mutable_decl),
+            StdGetClause = pragma(compiler(mutable_decl),
             foreign_proc(GetAttrs,
                 mutable_get_pred_sym_name(ModuleName, Name), predicate,
                 [pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
                 ProgVarSet0, InstVarset,
-                ordinary("X = " ++ TargetMutableName ++ ";", yes(Context)))),
-        add_item_clause(NonPureGetClause, !Status, Context, !ModuleInfo,
+                    ordinary("X = " ++ TargetMutableName ++ ";",
+                        yes(Context)))),
+            add_item_clause(StdGetClause, !Status, Context, !ModuleInfo,
             !QualInfo, !IO),
+
         TrailMutableUpdates = mutable_var_trailed(MutAttrs),
         (
             TrailMutableUpdates = untrailed,
@@ -1253,61 +1287,83 @@
                 TrailCode = ""
             )
         ),
-        NonPureSetClause = pragma(compiler(mutable_decl),
+            StdSetClause = pragma(compiler(mutable_decl),
             foreign_proc(Attrs,
                 mutable_set_pred_sym_name(ModuleName, Name), predicate,
                 [pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
                 ProgVarSet0, InstVarset,
                 ordinary(TrailCode ++ TargetMutableName ++ " = X;",
                 yes(Context)))),
-        add_item_clause(NonPureSetClause, !Status, Context, !ModuleInfo,
+            add_item_clause(StdSetClause, !Status, Context, !ModuleInfo,
             !QualInfo, !IO),
 
-        % Create pure access predicates for the mutable if requested.
+            % Create access predicates for the mutable via the I/O state
+            % if requested.
         %
         % XXX We don't define these directly in terms of the non-pure
         % access predicates because I/O tabling doesn't currently work
         % for impure/semipure predicates.  At the moment we just generate
         % another pair of foreign_procs.
 
-        ( mutable_var_attach_to_io_state(MutAttrs) = yes ->
-            set_tabled_for_io(tabled_for_io, Attrs1, PureIntAttrs0),
-            set_purity(purity_pure, PureIntAttrs0, PureIntAttrs),
+            IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
+            (
+                IOStateInterface = yes,
+                IOArgs = [
+                    pragma_var(IO0, "IO0", di_mode, native_if_possible),
+                    pragma_var(IO,  "IO",  uo_mode, native_if_possible)
+                ],
+                set_tabled_for_io(tabled_for_io, Attrs1, IOIntAttrs0),
+                set_purity(purity_pure, IOIntAttrs0, IOIntAttrs),
             varset.new_named_var(ProgVarSet0, "IO0", IO0, ProgVarSet1),
             varset.new_named_var(ProgVarSet1, "IO",  IO,  ProgVarSet),
-            PureSetClause = pragma(compiler(mutable_decl),
-                foreign_proc(PureIntAttrs,
+                IOSetClause = pragma(compiler(mutable_decl),
+                    foreign_proc(IOIntAttrs,
                     mutable_set_pred_sym_name(ModuleName, Name), predicate,
-                    [
-                        pragma_var(X,    "X",  in_mode(Inst), BoxPolicy),
-                        pragma_var(IO0, "IO0", di_mode, native_if_possible),
-                        pragma_var(IO,  "IO",  uo_mode, native_if_possible)
-                    ], ProgVarSet, InstVarset,
+                        [pragma_var(X,   "X",   in_mode(Inst), BoxPolicy)]
+                            ++ IOArgs,
+                        ProgVarSet, InstVarset,
                     ordinary(TargetMutableName ++ " = X; IO = IO0;",
                         yes(Context)
                     )
                 )
             ),
-            add_item_clause(PureSetClause, !Status, Context, !ModuleInfo,
+                add_item_clause(IOSetClause, !Status, Context, !ModuleInfo,
                 !QualInfo, !IO),
-            PureGetClause = pragma(compiler(mutable_decl),
-                foreign_proc(PureIntAttrs,
+
+                IOGetClause = pragma(compiler(mutable_decl),
+                    foreign_proc(IOIntAttrs,
                     mutable_get_pred_sym_name(ModuleName, Name), predicate,
-                    [
-                        pragma_var(X,    "X",  out_mode(Inst), BoxPolicy),
-                        pragma_var(IO0, "IO0", di_mode, native_if_possible),
-                        pragma_var(IO,  "IO",  uo_mode, native_if_possible)
-                    ], ProgVarSet, InstVarset,
+                        [pragma_var(X,    "X",  out_mode(Inst), BoxPolicy)]
+                            ++ IOArgs,
+                        ProgVarSet, InstVarset,
                     ordinary("X = " ++ TargetMutableName ++ "; IO = IO0;",
                         yes(Context)
                     )
                 )
             ),
-            add_item_clause(PureGetClause, !Status, Context, !ModuleInfo,
+                add_item_clause(IOGetClause, !Status, Context, !ModuleInfo,
                 !QualInfo, !IO)
         ;
-            true
+                IOStateInterface = no
         )
+        ),
+
+        %
+        % Add the `:- initialise' declaration and clause for the
+        % initialise predicate.
+        %
+        add_item_clause(initialise(compiler(mutable_decl),
+                mutable_init_pred_sym_name(ModuleName, Name), 0 /* Arity */),
+            !Status, Context, !ModuleInfo, !QualInfo, !IO),
+        %
+        % See the comments for prog_io.parse_mutable_decl for the reason
+        % why we _must_ use MutVarset here.
+        % 
+        InitClause = clause(compiler(mutable_decl), MutVarset, predicate,
+            mutable_init_pred_sym_name(ModuleName, Name), [],
+            call_expr(InitSetPredName, [InitTerm], purity_impure) - Context),
+        add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
+            !IO)
     ;
         true
     ).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.388
diff -u -b -r1.388 modules.m
--- compiler/modules.m	20 Apr 2006 05:36:58 -0000	1.388
+++ compiler/modules.m	26 Apr 2006 05:39:36 -0000
@@ -1332,25 +1332,35 @@
 
 handle_mutable_in_private_interface(ModuleName, Item - Context, !Items) :-
     ( Item = mutable(MutableName, Type, _Value, Inst, Attrs, _Varset) ->
-        NonPureGetPredDecl =
-            prog_mutable.nonpure_get_pred_decl(ModuleName, MutableName,
-                Type, Inst),
-        list.cons(NonPureGetPredDecl - Context, !Items),
-        NonPureSetPredDecl =
-            prog_mutable.nonpure_set_pred_decl(ModuleName, MutableName,
-                Type, Inst),
-        list.cons(NonPureSetPredDecl - Context, !Items),
-        ( mutable_var_attach_to_io_state(Attrs) = yes ->
+        ConstantInterface = mutable_var_constant(Attrs),
+        (
+            ConstantInterface = yes,
+            ConstantGetPredDecl =
+                constant_get_pred_decl(ModuleName, MutableName, Type, Inst),
+            list.cons(ConstantGetPredDecl - Context, !Items),
+            ConstantSetPredDecl =
+                constant_set_pred_decl(ModuleName, MutableName, Type, Inst),
+            list.cons(ConstantSetPredDecl - Context, !Items)
+        ;
+            ConstantInterface = no,
+            StdGetPredDecl =
+                std_get_pred_decl(ModuleName, MutableName, Type, Inst),
+            list.cons(StdGetPredDecl - Context, !Items),
+            StdSetPredDecl =
+                std_set_pred_decl(ModuleName, MutableName, Type, Inst),
+            list.cons(StdSetPredDecl - Context, !Items),
+            IOStateInterface = mutable_var_attach_to_io_state(Attrs),
+            (
+                IOStateInterface = yes,
             PureGetPredDecl = 
-                prog_mutable.pure_get_pred_decl(ModuleName, MutableName,
-                   Type, Inst),
+                    io_get_pred_decl(ModuleName, MutableName, Type, Inst),
             list.cons(PureGetPredDecl - Context, !Items),
             PureSetPredDecl = 
-                prog_mutable.pure_set_pred_decl(ModuleName, MutableName,
-                    Type, Inst),
+                    io_set_pred_decl(ModuleName, MutableName, Type, Inst),
             list.cons(PureSetPredDecl - Context, !Items)
         ;
-            true
+                IOStateInterface = no
+            )
         )
     ;
         list.cons(Item - Context, !Items) 
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.264
diff -u -b -r1.264 prog_io.m
--- compiler/prog_io.m	29 Mar 2006 08:07:16 -0000	1.264
+++ compiler/prog_io.m	26 Apr 2006 04:13:31 -0000
@@ -1890,7 +1890,8 @@
     --->    trailed(trailed)
     ;       thread_safe(thread_safe)
     ;       foreign_name(foreign_name)
-    ;       attach_to_io_state(bool).
+    ;       attach_to_io_state(bool)
+    ;       constant(bool).
 
 :- pred parse_mutable_attrs(term::in,
     maybe1(mutable_var_attributes)::out) is det.
@@ -1899,7 +1900,10 @@
     Attributes0 = default_mutable_attributes,
     ConflictingAttributes = [
         thread_safe(thread_safe) - thread_safe(not_thread_safe),
-        trailed(trailed) - trailed(untrailed)
+        trailed(trailed) - trailed(untrailed),
+        constant(yes) - trailed(trailed),
+        constant(yes) - thread_safe(not_thread_safe),
+        constant(yes) - attach_to_io_state(yes)
     ],
     (
         list_term_to_term_list(MutAttrsTerm, MutAttrTerms),
@@ -1938,6 +1942,16 @@
     set_mutable_add_foreign_name(ForeignName, !Attributes).
 process_mutable_attribute(attach_to_io_state(AttachToIOState), !Attributes) :-
     set_mutable_var_attach_to_io_state(AttachToIOState, !Attributes).
+process_mutable_attribute(constant(Constant), !Attributes) :-
+    set_mutable_var_constant(Constant, !Attributes),
+    (
+        Constant = yes,
+        set_mutable_var_thread_safe(thread_safe, !Attributes),
+        set_mutable_var_trailed(untrailed, !Attributes),
+        set_mutable_var_attach_to_io_state(no, !Attributes)
+    ;
+        Constant = no
+    ).
 
 :- pred parse_mutable_attr(term::in,
     maybe1(collected_mutable_attribute)::out) is det.
@@ -1960,6 +1974,9 @@
         ;
             String = "not_thread_safe",
             MutAttr = thread_safe(not_thread_safe)
+        ;
+            String = "constant",
+            MutAttr = constant(yes)
         )
     ->
         MutAttrResult = ok(MutAttr)
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.11
diff -u -b -r1.11 prog_item.m
--- compiler/prog_item.m	29 Mar 2006 08:07:18 -0000	1.11
+++ compiler/prog_item.m	26 Apr 2006 03:38:37 -0000
@@ -329,6 +329,7 @@
 :- func mutable_var_trailed(mutable_var_attributes) = trailed.
 :- func mutable_var_maybe_foreign_names(mutable_var_attributes)
     = maybe(list(foreign_name)).
+:- func mutable_var_constant(mutable_var_attributes) = bool.
 :- func mutable_var_attach_to_io_state(mutable_var_attributes) = bool.
 
 :- pred set_mutable_var_thread_safe(thread_safe::in,
@@ -343,6 +344,9 @@
 :- pred set_mutable_var_attach_to_io_state(bool::in,
     mutable_var_attributes::in, mutable_var_attributes::out) is det.
 
+:- pred set_mutable_var_constant(bool::in,
+    mutable_var_attributes::in, mutable_var_attributes::out) is det.
+
 %-----------------------------------------------------------------------------%
 %
 % Pragmas
@@ -761,17 +765,19 @@
                 mutable_trailed            :: trailed,
                 mutable_thread_safe        :: thread_safe,
                 mutable_foreign_names      :: maybe(list(foreign_name)),
-                mutable_attach_to_io_state :: bool
+                mutable_attach_to_io_state  :: bool,
+                mutable_constant            :: bool
             ).
 
 default_mutable_attributes =
-    mutable_var_attributes(trailed, not_thread_safe, no, no).
+    mutable_var_attributes(trailed, not_thread_safe, no, no, no).
 
 mutable_var_thread_safe(MVarAttrs) = MVarAttrs ^ mutable_thread_safe.
 mutable_var_trailed(MVarAttrs) = MVarAttrs ^ mutable_trailed.
 mutable_var_maybe_foreign_names(MVarAttrs) = MVarAttrs ^ mutable_foreign_names.
 mutable_var_attach_to_io_state(MVarAttrs) =
     MVarAttrs ^ mutable_attach_to_io_state.
+mutable_var_constant(MVarAttrs) = MVarAttrs ^ mutable_constant.
 
 set_mutable_var_thread_safe(ThreadSafe, !Attributes) :-
     !:Attributes = !.Attributes ^ mutable_thread_safe := ThreadSafe.
@@ -789,8 +795,10 @@
     ),
     !:Attributes = !.Attributes ^ mutable_foreign_names := MaybeForeignNames.
 set_mutable_var_attach_to_io_state(AttachToIOState, !Attributes) :-
-    !:Attributes =
-        !.Attributes ^ mutable_attach_to_io_state := AttachToIOState.
+    !:Attributes = !.Attributes ^ mutable_attach_to_io_state
+        := AttachToIOState.
+set_mutable_var_constant(Constant, !Attributes) :-
+    !:Attributes = !.Attributes ^ mutable_constant := Constant.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/prog_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mutable.m,v
retrieving revision 1.9
diff -u -b -r1.9 prog_mutable.m
--- compiler/prog_mutable.m	29 Mar 2006 08:07:18 -0000	1.9
+++ compiler/prog_mutable.m	26 Apr 2006 05:08:56 -0000
@@ -24,35 +24,48 @@
 
 %-----------------------------------------------------------------------------%
 
-    % Create a predmode declaration for a non-pure mutable get predicate.
+    % Create a predmode declaration for the semipure mutable get predicate.
     % (This is the default get predicate.)
     %
-:- func nonpure_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func std_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
 
-    % Create a predmode declaration for a non-pure mutable set predicate.
+    % Create a predmode declaration for the impure mutable set predicate.
     % (This is the default set predicate.)
     %
-:- func nonpure_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func std_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
 
-    % Create a predmode declaration for a pure mutable get predicate.
-    % (This is only created if the `pure' mutable attribute is given.)
+    % Create a predmode declaration for a get predicate for a constant mutable.
+    % (This is only created if the `constant' mutable attribute is given.)
     %
-:- func pure_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func constant_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
 
-    % Create a predmode declaration for a pure mutable set predicate.
-    % (This is only create the `pure' mutable attribute is give.)
+    % Create a predmode declaration for a set predicate for a constant mutable;
+    % this predicate is designed to be used only from the mutable's
+    % initialization predicate.
+    % (This is created only if the `constant' mutable attribute is given.)
     %
-:- func pure_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func constant_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
 
-    % Create a predmode declaration for the mutable initialisation
-    % predicate.
+    % Create a predmode declaration for a get predicate using the I/O state.
+    % (This is created only if the `pure' mutable attribute is given.)
     %
-:- func init_pred_decl(module_name, string) = item.
+:- func io_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
+
+    % Create a predmode declaration for a set predicate using the I/O state.
+    % (This is created only if the `pure' mutable attribute is given.)
+    %
+:- func io_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
+
+    % Create a predmode declaration for the mutable initialisation predicate.
+    %
+:- func mutable_init_pred_decl(module_name, string) = item.
 
 :- func mutable_get_pred_sym_name(sym_name, string) = sym_name.
 
 :- func mutable_set_pred_sym_name(sym_name, string) = sym_name.
 
+:- func mutable_secret_set_pred_sym_name(sym_name, string) = sym_name.
+
 :- func mutable_init_pred_sym_name(sym_name, string) = sym_name.
 
 :- func mutable_c_var_name(sym_name, string) = string.
@@ -73,7 +86,7 @@
 
 %-----------------------------------------------------------------------------%
 
-nonpure_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
+std_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
     VarSet = varset.init,
     InstVarSet = varset.init,
     ExistQVars = [],
@@ -84,7 +97,7 @@
         no /* with_type */, no /* with_inst */, yes(det),
         true /* condition */, purity_semipure, Constraints).
 
-nonpure_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
+std_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
     VarSet = varset.init,
     InstVarSet = varset.init,
     ExistQVars = [],
@@ -95,7 +108,29 @@
         no /* with_type */, no /* with_inst */, yes(det),
         true /* condition */, purity_impure, Constraints).
 
-pure_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
+constant_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
+    VarSet = varset.init,
+    InstVarSet = varset.init,
+    ExistQVars = [],
+    Constraints = constraints([], []),
+    GetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+        mutable_get_pred_sym_name(ModuleName, Name),
+        [type_and_mode(Type, out_mode(Inst))],
+        no /* with_type */, no /* with_inst */, yes(det),
+        true /* condition */, purity_pure, Constraints).
+
+constant_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
+    VarSet = varset.init,
+    InstVarSet = varset.init,
+    ExistQVars = [],
+    Constraints = constraints([], []),
+    SetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+        mutable_secret_set_pred_sym_name(ModuleName, Name),
+        [type_and_mode(Type, in_mode(Inst))],
+        no /* with_type */, no /* with_inst */, yes(det),
+        true /* condition */, purity_impure, Constraints).
+
+io_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
     VarSet = varset.init,
     InstVarSet = varset.init,
     ExistQVars = [],
@@ -108,7 +143,7 @@
         no /* with_type */, no /* with_inst */, yes(det),
         true /* condition */, purity_pure, Constraints).
 
-pure_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
+io_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
     VarSet = varset.init,
     InstVarSet = varset.init,
     ExistQVars = [],
@@ -121,7 +156,7 @@
         no /* with_type */, no /* with_inst */, yes(det),
         true /* condition */, purity_pure, Constraints).
 
-init_pred_decl(ModuleName, Name) = InitPredDecl :-
+mutable_init_pred_decl(ModuleName, Name) = InitPredDecl :-
     VarSet = varset.init,
     InstVarSet = varset.init,
     ExistQVars = [],
@@ -138,6 +173,9 @@
 
 mutable_set_pred_sym_name(ModuleName, Name) =
     qualified(ModuleName, "set_" ++ Name).
+
+mutable_secret_set_pred_sym_name(ModuleName, Name) =
+    qualified(ModuleName, "secret_initialization_only_set_" ++ Name).
 
 mutable_init_pred_sym_name(ModuleName, Name) =
     qualified(ModuleName, "initialise_mutable_" ++ Name).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
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.350
diff -u -b -r1.350 reference_manual.texi
--- doc/reference_manual.texi	11 Apr 2006 01:05:15 -0000	1.350
+++ doc/reference_manual.texi	26 Apr 2006 05:34:13 -0000
@@ -4777,6 +4777,12 @@
 :- pred set_varname(vartype::in(varinst),  io::di, io::uo) is det.
 @end example
 
+ at item @samp{constant}
+This attribute causes the compiler to construct
+only a @samp{get} access predicate, but not a @samp{set} access predicate.
+Since @samp{varname} will always have the initial value given to it,
+the @samp{get} access predicate is pure.
+
 @end table
 
 The Melbourne Mercury compiler also supports the following attribute.
cvs diff: Diffing extras
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/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_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/solver_types
cvs diff: Diffing extras/solver_types/library
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/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 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/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
Index: tests/hard_coded/pure_mutable.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/pure_mutable.exp,v
retrieving revision 1.1
diff -u -b -r1.1 pure_mutable.exp
--- tests/hard_coded/pure_mutable.exp	6 Oct 2005 08:26:11 -0000	1.1
+++ tests/hard_coded/pure_mutable.exp	26 Apr 2006 05:30:59 -0000
@@ -1,2 +1,3 @@
 Initial value of global = 561
 Final value of global = 562
+Value of const = 562
Index: tests/hard_coded/pure_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/pure_mutable.m,v
retrieving revision 1.1
diff -u -b -r1.1 pure_mutable.m
--- tests/hard_coded/pure_mutable.m	6 Oct 2005 08:26:11 -0000	1.1
+++ tests/hard_coded/pure_mutable.m	26 Apr 2006 04:13:00 -0000
@@ -15,9 +15,14 @@
 :- mutable(global, int, 561, ground,
 	[untrailed, thread_safe, attach_to_io_state]).
 
+:- mutable(const, int, 562, ground, [constant]).
+
 main(!IO) :-
 	get_global(X0, !IO),
 	io.format("Initial value of global = %d\n", [i(X0)], !IO),
 	set_global(X0 + 1, !IO),
 	get_global(X, !IO),
-	io.format("Final value of global = %d\n", [i(X)], !IO).
+	io.format("Final value of global = %d\n", [i(X)], !IO),
+
+	get_const(C),
+	io.format("Value of const = %d\n", [i(C)], !IO).
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
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:  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