[m-rev.] For review: more store library procedures for Java

[James Goddard]

Estimated hours taken: 2
Branches: main

Implement some library procedures for Java.

library/store.m:
	Define generic_ref as having foreign_type "mercury.store.Ref"

	Implement the mercury.store.Ref class.

	Implement the following predicates in Java:
		new_ref/4
		unsafe_ref_value/4
		arg_ref/5
		new_arg_ref/5
		set_ref/4
		set_ref_value/4
		extract_ref_value/3
		unsafe_arg_ref/5
		unsafe_new_arg_ref/5

Index: store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.43
diff -u -d -r1.43 store.m
--- store.m	5 Feb 2004 01:54:46 -0000	1.43
+++ store.m	9 Feb 2004 05:54:05 -0000
@@ -381,6 +381,103 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pragma foreign_type(java, generic_ref(T, S), "mercury.store.Ref").
+:- pragma foreign_code("Java",
+"
+	public static class Ref {
+		// Object referenced.
+		public java.lang.Object		object;
+
+		// Specific field of object referenced, or null to
+		// specify the object itself.
+		public java.lang.reflect.Field	field;
+
+		// Constructors
+		public Ref(java.lang.Object init) {
+			object	= init;
+			field	= null;
+		}
+		public Ref(mercury.store.Ref ref, int num) {
+			object	= ref.getValue();
+			setField(num);
+		}
+		public Ref(java.lang.Object init, int num) {
+			object	= init;
+			setField(num);
+		}
+
+		// Set the field according to a given index.
+		public void setField(int num) {
+			try {
+				field = object.getClass().
+						getDeclaredFields()[num];
+			} catch (java.lang.SecurityException se) {
+				throw new java.lang.RuntimeException(
+						""Security manager denied "" +
+						""access to object fields"");
+			} catch (java.lang.ArrayIndexOutOfBoundsException e) {
+			  	throw new java.lang.RuntimeException(
+						""No such field in object"");
+			} catch (java.lang.Exception e) {
+				throw new java.lang.RuntimeException(
+						""Unable to set field: "" +
+						e.getMessage());
+			}
+		}
+
+		// Return the value of the reference.
+		public java.lang.Object getValue() {
+			if (field == null) {
+				return object;
+			} else {
+				try {
+					return field.get(object);
+				} catch (java.lang.IllegalAccessException e) {
+					throw new java.lang.RuntimeException(
+							""Field "" +
+							""inaccessible"");
+				} catch (java.lang.IllegalArgumentException e)
+				{
+					throw new java.lang.RuntimeException(
+							""Field-object "" +
+							""mismatch"");
+				} catch (java.lang.NullPointerException e) {
+					throw new java.lang.RuntimeException(
+							""Object is null"");
+				} catch (java.lang.Exception e) {
+					throw new java.lang.RuntimeException(
+							""Unable to access "" +
+							""field: "" +
+							e.getMessage());
+				}
+			}
+		}
+
+		// Update the value of the reference.
+		public void setValue(mercury.store.Ref ref) {
+			setValue(ref.getValue());
+		}
+		public void setValue(java.lang.Object value) {
+			try {
+				field.set(object, value);
+			} catch (java.lang.IllegalAccessException e) {
+				throw new java.lang.RuntimeException(
+						""Field inaccessible"");
+			} catch (java.lang.IllegalArgumentException e) {
+				throw new java.lang.RuntimeException(
+						""Field-object mismatch"");
+			} catch (java.lang.NullPointerException e) {
+				throw new java.lang.RuntimeException(
+						""Object is null"");
+			} catch (java.lang.Exception e) {
+				throw new java.lang.RuntimeException(
+						""Unable to access field: "" +
+						e.getMessage());
+			}
+		}
+	} // class Ref
+").
+
 :- pragma foreign_proc("C",
 	new_ref(Val::di, Ref::out, S0::di, S::uo),
 	[will_not_call_mercury, promise_pure],
@@ -392,6 +489,13 @@
 	S = S0;
 ").
 
+:- pragma foreign_proc("Java",
+	new_ref(Val::di, Ref::out, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	Ref = new mercury.store.Ref(Val);
+").
+
 copy_ref_value(Ref, Val) -->
 	/* XXX need to deep-copy non-atomic types */
 	unsafe_ref_value(Ref, Val).
@@ -411,6 +515,13 @@
 	S = S0;
 ").
 
+:- pragma foreign_proc("Java",
+	unsafe_ref_value(Ref::in, Val::uo, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	Val = Ref.getValue();
+").
+
 ref_functor(Ref, Functor, Arity) -->
 	unsafe_ref_value(Ref, Val),
 	{ functor(Val, Functor, Arity) }.
@@ -456,6 +567,13 @@
 	S = S0;
 }").
 
+:- pragma foreign_proc("Java",
+	arg_ref(Ref::in, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	ArgRef = new mercury.store.Ref(Ref, ArgNum);
+").
+
 :- pragma foreign_proc("C", 
 	new_arg_ref(Val::di, ArgNum::in, ArgRef::out, S0::di, S::uo),
 	[will_not_call_mercury, promise_pure],
@@ -504,6 +622,13 @@
 	S = S0;
 }").
 
+:- pragma foreign_proc("Java",
+	new_arg_ref(Val::di, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	ArgRef = new mercury.store.Ref(Val, ArgNum);
+").
+
 :- pragma foreign_proc("C", 
 	set_ref(Ref::in, ValRef::in, S0::di, S::uo),
 	[will_not_call_mercury, promise_pure],
@@ -512,6 +637,13 @@
 	S = S0;
 ").
 
+:- pragma foreign_proc("Java",
+	set_ref(Ref::in, ValRef::in, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	Ref.setValue(ValRef);
+").
+
 :- pragma foreign_proc("C",	
 	set_ref_value(Ref::in, Val::di, S0::di, S::uo),
 	[will_not_call_mercury, promise_pure],
@@ -520,6 +652,13 @@
 	S = S0;
 ").
 
+:- pragma foreign_proc("Java",
+	set_ref_value(Ref::in, Val::di, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	Ref.setValue(Val);
+").
+
 :- pragma foreign_proc("C",
 	extract_ref_value(_S::di, Ref::in, Val::out),
 	[will_not_call_mercury, promise_pure],
@@ -527,6 +666,13 @@
 	Val = * (MR_Word *) Ref;
 ").
 
+:- pragma foreign_proc("Java",
+	extract_ref_value(_S::di, Ref::in, Val::out),
+	[will_not_call_mercury, promise_pure],
+"
+	Val = Ref.getValue();
+").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -539,6 +685,13 @@
 	S = S0;
 }").
 
+:- pragma foreign_proc("Java",
+	unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	ArgRef = new mercury.store.Ref(Ref, Arg);
+").
+
 :- pragma foreign_proc("C",
 	unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, S0::di, S::uo),
 	[will_not_call_mercury, promise_pure],
@@ -548,3 +701,11 @@
 	ArgRef = (MR_Word) &Ptr[Arg];
 	S = S0;
 }").
+
+:- pragma foreign_proc("Java",
+	unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, _S0::di, _S::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	ArgRef = new mercury.store.Ref(Val, Arg);
+").
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------