[m-rev.] diff: clean up CLP(R) interface
Julien Fischer
juliensf at cs.mu.OZ.AU
Thu Mar 3 15:25:29 AEDT 2005
Estimated hours taken: 1.5
Branches: main, release
Clean up the CLP(R) interface. The main change here is
to remove deprecated syntax that causes warnings to be
issued by the 0.12 branch.
clpr/Mmakefile:
Don't warn about the module cfloat_lib not exporting
anything.
clpr/cfloat.m:
clpr/cfloat_float.m:
clpr/dump.m:
clpr/float_cfloat.m:
Replace deprecated inst and mode syntax.
Use the new foreign language interface.
Conform to our current C and Mercury coding
standards.
Various minor formatting changes.
clpr/samples/laplace.m:
clpr/samples/sum_list.m:
clpr/samples/tranny.m:
Replace deprecated inst and mode syntax.
clpr/samples/tranny.exp:
Update the expected output for this test case.
The `_v<n>' variable numbers have changed.
Julien.
Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/clpr/Mmakefile,v
retrieving revision 1.23
diff -u -r1.23 Mmakefile
--- Mmakefile 14 Mar 2002 04:41:22 -0000 1.23
+++ Mmakefile 3 Mar 2005 03:46:36 -0000
@@ -24,6 +24,8 @@
$(subst .tr.,$(grade),$(findstring .tr.,$(grade))) \
$(filter %.tr,$(grade)))
+MCFLAGS-cfloat_lib += --no-warn-nothing-exported
+
# Enable C debugging
#MGNUCFLAGS = -g
#MLFLAGS = -g
Index: cfloat.m
===================================================================
RCS file: /home/mercury1/repository/clpr/cfloat.m,v
retrieving revision 1.36.2.1
diff -u -r1.36.2.1 cfloat.m
--- cfloat.m 3 Mar 2005 03:39:18 -0000 1.36.2.1
+++ cfloat.m 3 Mar 2005 04:09:20 -0000
@@ -26,56 +26,59 @@
:- interface.
+:- import_module list.
+
%-----------------------------------------------------------------------------%
:- inst constrained == any.
-:- mode co::(free -> constrained). % constrain a free variable
-:- mode ca::(constrained -> constrained). % constraint across
+:- mode co == free >> constrained. % constrain a free variable
+:- mode ca == constrained >> constrained. % constraint across
% (add a constraint)
-:- mode cg::(constrained -> ground). % constraint grounded
+:- mode cg == constrained >> ground. % constraint grounded
% This is probably a handy set of modes too...
-%:- import_module list.
-:- inst list_of_constrained == bound([] ; [constrained|list_of_constrained]).
-:- mode list_co::(free -> list_of_constrained).
-:- mode list_ca::(list_of_constrained -> list_of_constrained).
-:- mode list_cg::(list_of_constrained -> ground).
+
+:- inst list_of_constrained == list(constrained).
+:- mode list_co == free >> list_of_constrained.
+:- mode list_ca == list_of_constrained >> list_of_constrained.
+:- mode list_cg == list_of_constrained >> ground.
%-----------------------------------------------------------------------------%
:- solver type cfloat.
-
-% NOTE:
-% The order of the mode declarations for most of the following preds is
-% important, since the mode checker tries the given modes of a pred in the
+% NOTE: the order of the mode declarations for most of the following preds
+% is important, since the mode checker tries the given modes of a pred in the
% order they are declared, and we don't want it to use an implied mode.
-
- % initialise a solver variable
-:- pred cfloat__init(cfloat).
-:- mode cfloat__init(co) is det.
+ % Initialise a solver variable.
+ %
+:- pred cfloat__init(cfloat::co) is det.
% negation
+ %
:- func '-'(cfloat) = cfloat.
:- mode '-'(ca) = ca is semidet.
:- mode '-'(co) = ca is det.
:- mode '-'(ca) = co is det.
% equality
+ %
:- pred '=='(cfloat, cfloat).
:- mode '=='(ca, ca) is semidet.
:- mode '=='(co, ca) is det.
:- mode '=='(ca, co) is det.
% disequality
+ %
:- pred \==(cfloat, cfloat).
:- mode \==(ca, ca) is semidet.
:- mode \==(co, ca) is det.
:- mode \==(ca, co) is det.
% addition
+ %
:- func '+'(cfloat, cfloat) = cfloat.
:- mode '+'(ca, ca) = ca is semidet.
:- mode '+'(ca, co) = ca is det.
@@ -83,6 +86,7 @@
:- mode '+'(ca, ca) = co is det.
% subtraction
+ %
:- func '-'(cfloat, cfloat) = cfloat.
:- mode '-'(ca, ca) = ca is semidet.
:- mode '-'(ca, co) = ca is det.
@@ -90,6 +94,7 @@
:- mode '-'(ca, ca) = co is det.
% multiplication
+ %
:- func '*'(cfloat, cfloat) = cfloat.
:- mode '*'(ca, ca) = ca is semidet.
:- mode '*'(ca, co) = ca is semidet. % semidet since eg. 0*X=1 fails
@@ -102,6 +107,7 @@
% division
% X / Y = Z :- X = Y * Z, Y \== 0.
+ %
:- func '/'(cfloat, cfloat) = cfloat.
:- mode '/'(ca, ca) = ca is semidet.
:- mode '/'(ca, co) = ca is semidet. % semidet since eg. 0/X=1 fails
@@ -113,6 +119,7 @@
:- mode '/'(co, co) = co is det.
% X > Y
+ %
:- pred '>'(cfloat, cfloat).
:- mode '>'(ca, ca) is semidet.
:- mode '>'(co, ca) is det.
@@ -120,6 +127,7 @@
:- mode '>'(co, co) is det.
% X >= Y
+ %
:- pred '>='(cfloat, cfloat).
:- mode '>='(ca, ca) is semidet.
:- mode '>='(co, ca) is det.
@@ -127,6 +135,7 @@
:- mode '>='(co, co) is det.
% X < Y
+ %
:- pred '<'(cfloat, cfloat).
:- mode '<'(ca, ca) is semidet.
:- mode '<'(ca, co) is det.
@@ -134,6 +143,7 @@
:- mode '<'(co, co) is det.
% X =< Y
+ %
:- pred '=<'(cfloat, cfloat).
:- mode '=<'(ca, ca) is semidet.
:- mode '=<'(ca, co) is det.
@@ -144,6 +154,7 @@
% min(X, Y) = (if X < Y then X else Y).
% Operationally: generally delays until X and Y are ground.
+ %
:- func min(cfloat, cfloat) = cfloat.
:- mode min(ca, ca) = ca is semidet.
:- mode min(co, ca) = ca is semidet.
@@ -156,6 +167,7 @@
% max(X, Y) = (if X > Y then X else Y).
% Operationally: generally delays until X and Y are ground.
+ %
:- func max(cfloat, cfloat) = cfloat.
:- mode max(ca, ca) = ca is semidet.
:- mode max(co, ca) = ca is semidet.
@@ -168,6 +180,7 @@
% abs(X) = max(X, -X).
% Operationally: generally delays until X is ground.
+ %
:- func abs(cfloat) = cfloat.
:- mode abs(ca) = ca is semidet.
:- mode abs(co) = ca is semidet.
@@ -176,6 +189,7 @@
% The usual mathematical sine function.
% Operationally: generally delays until argument is ground.
+ %
:- func sin(cfloat) = cfloat.
:- mode sin(ca) = ca is semidet.
:- mode sin(co) = ca is semidet.
@@ -184,6 +198,7 @@
% The usual mathematical cosine function.
% Operationally: generally delays until argument is ground.
+ %
:- func cos(cfloat) = cfloat.
:- mode cos(ca) = ca is semidet.
:- mode cos(co) = ca is semidet.
@@ -193,6 +208,7 @@
% The inverse of the sin function restricted to [-1,1] -> [-pi,].
% Reports a runtime error if the argument or result is out of range.
% Generally delays until either argument or result is ground.
+ %
:- func arcsin(cfloat) = cfloat.
:- mode arcsin(ca) = ca is semidet.
:- mode arcsin(co) = ca is semidet.
@@ -202,6 +218,7 @@
% The inverse of the sin function restricted to [-1,1] -> [-pi,].
% Reports a runtime error if the argument or result is out of range.
% Generally delays until either argument or result is ground.
+ %
:- func arccos(cfloat) = cfloat.
:- mode arccos(ca) = ca is semidet.
:- mode arccos(co) = ca is semidet.
@@ -216,7 +233,7 @@
% given the constraints on X; if there is no unique value, then
% the predicate will abort at runtime.
% XXX should this be `cc_multi' rather than `det'?
-
+ %
:- pred cfloat__get_val(cfloat, float).
:- mode cfloat__get_val(ca, out) is det.
@@ -356,7 +373,7 @@
any is ground,
equality is cfloat__eq.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_conf.h""
#include ""mercury_trail.h""
@@ -406,7 +423,7 @@
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
static ML_cfloat_choicepoint ML_cfloat_first_choicepoint;
static ML_cfloat_choicepoint * ML_cfloat_current_cp =
@@ -503,7 +520,7 @@
}
").
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#ifndef ML_CFLOAT_HEADER_GUARD
#define ML_CFLOAT_HEADER_GUARD
@@ -882,7 +899,7 @@
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
/*
INIT init_cfloat_module
*/
@@ -1463,4 +1480,6 @@
(void) ML_cfloat_arccos(Svar1, Svar2);
").
+%-----------------------------------------------------------------------------%
+:- end_module cfloat.
%-----------------------------------------------------------------------------%
Index: cfloat_float.m
===================================================================
RCS file: /home/mercury1/repository/clpr/cfloat_float.m,v
retrieving revision 1.2
diff -u -r1.2 cfloat_float.m
--- cfloat_float.m 6 Sep 1997 11:29:38 -0000 1.2
+++ cfloat_float.m 3 Mar 2005 04:03:55 -0000
@@ -21,17 +21,22 @@
:- interface.
:- import_module cfloat, float.
+%-----------------------------------------------------------------------------%
+
% cfloat-float equality
+ %
:- pred ==(cfloat, float).
:- mode ==(ca, in) is semidet.
:- mode ==(co, in) is det.
% cfloat-float disequality
+ %
:- pred \==(cfloat, float).
:- mode \==(ca, in) is semidet.
:- mode \==(co, in) is det.
% addition
+ %
:- func '+'(cfloat, float) = cfloat.
:- mode '+'(ca, in) = ca is semidet.
:- mode '+'(co, in) = ca is det.
@@ -39,6 +44,7 @@
:- mode '+'(co, in) = co is det.
% subtraction
+ %
:- func '-'(cfloat, float) = cfloat.
:- mode '-'(ca, in) = ca is semidet.
:- mode '-'(co, in) = ca is det.
@@ -46,6 +52,7 @@
:- mode '-'(co, in) = co is det.
% multiplication
+ %
:- func '*'(cfloat, float) = cfloat.
:- mode '*'(ca, in) = ca is semidet.
:- mode '*'(co, in) = ca is semidet. % semidet since eg. X*0=1 fails
@@ -55,6 +62,7 @@
% division
% note that division by a zero float results in a runtime error
% (whereas division by a zero cfloat just fails)
+ %
:- func '/'(cfloat, float) = cfloat.
:- mode '/'(ca, in) = ca is semidet.
:- mode '/'(co, in) = ca is det.
@@ -62,25 +70,32 @@
:- mode '/'(co, in) = co is det.
% X > Y
+ %
:- pred '>'(cfloat, float).
:- mode '>'(ca, in) is semidet.
:- mode '>'(co, in) is det.
% X >= Y
+ %
:- pred '>='(cfloat, float).
:- mode '>='(ca, in) is semidet.
:- mode '>='(co, in) is det.
% X < Y
+ %
:- pred '<'(cfloat, float).
:- mode '<'(ca, in) is semidet.
:- mode '<'(co, in) is det.
% X =< Y
+ %
:- pred '=<'(cfloat, float).
:- mode '=<'(ca, in) is semidet.
:- mode '=<'(co, in) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
X == Y :- cfloat__eq_float(X, Y).
@@ -95,3 +110,7 @@
X >= Y :- cfloat__ge_float(X, Y).
X < Y :- cfloat__lt_float(X, Y).
X =< Y :- cfloat__le_float(X, Y).
+
+%-----------------------------------------------------------------------------%
+:- end_module cfloat_float.
+%-----------------------------------------------------------------------------%
Index: dump.m
===================================================================
RCS file: /home/mercury1/repository/clpr/dump.m,v
retrieving revision 1.15
diff -u -r1.15 dump.m
--- dump.m 7 Dec 2000 13:16:55 -0000 1.15
+++ dump.m 3 Mar 2005 04:01:12 -0000
@@ -12,12 +12,15 @@
% Stability: low/medium.
%
%-----------------------------------------------------------------------------%
+
:- module dump.
:- interface.
:- import_module cfloat, list, string, io.
+%-----------------------------------------------------------------------------%
+
% dump_one_solution(Pred, IO0, IO) is true iff
% there is some constraint C between variables in CfloatList
% such that Pred(CfloatsList, NameList) is satisfied if C holds,
@@ -25,38 +28,46 @@
% to stdout, using the names in the corresponding list NamesList;
% or, Pred(CfloatList, NameList) has no solution, and IO is
% obtained from IO0 by writing "No solutions.\n" to stdout.
-:- pred dump_one_solution(
- pred(list(cfloat), list(string)), io__state, io__state).
+ %
+:- pred dump_one_solution(pred(list(cfloat), list(string)), io, io).
:- mode dump_one_solution(
pred(list_co, out) is cc_nondet, di, uo) is cc_multi.
:- mode dump_one_solution(
pred(list_co, out) is semidet, di, uo) is cc_multi.
-:- pred dump_cfloat(cfloat::ca, io__state::di, io__state::uo) is cc_multi.
% dump_cfloat(X, IO0, IO) is true iff
% IO is obtained from IO0 by writing either
% a floating point value F such that X has value F,
% or
% "_v<N>", where <N> is an integer.
+ %
+:- pred dump_cfloat(cfloat::ca, io::di, io::uo) is cc_multi.
% XXX this one is a non-logical hack, use only for debugging
+ %
:- impure pred unsafe_dump(list(cfloat)::list_ca, list(string)::in) is det.
% XXX this one is a non-logical hack, use only for debugging
+ %
:- impure pred unsafe_dump_cfloat(cfloat::ca) is det.
% for debugging only... this pred (non-logically) dumps the CLP(R)
% tableaus to standard error at runtime.
+ %
:- impure pred unsafe_dump_tableaus is det.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module int, require.
-:- pragma c_header_code("#include ""clpr/solver.h""").
-:- pragma c_header_code("#include ""clpr/clpr_misc.h""").
+:- pragma foreign_decl("C", "#include ""clpr/solver.h""").
+:- pragma foreign_decl("C", "#include ""clpr/clpr_misc.h""").
-:- pragma c_code(dump_cfloat(Svar::ca, IO0::di, IO::uo), will_not_call_mercury,
+:- pragma foreign_proc("C",
+ dump_cfloat(Svar::ca, IO0::di, IO::uo),
+ [promise_pure, will_not_call_mercury],
"{
double val;
if (CLPR_is_ground(Svar, &val)) {
@@ -68,7 +79,9 @@
}").
-:- pragma c_code(unsafe_dump_cfloat(Svar::ca), will_not_call_mercury,
+:- pragma foreign_proc("C",
+ unsafe_dump_cfloat(Svar::ca),
+ [promise_pure, will_not_call_mercury],
"{
double val;
if (CLPR_is_ground(Svar, &val)) {
@@ -81,17 +94,17 @@
% WARNING: The implementation of this predicate is non-logical.
:- pragma promise_pure(dump_one_solution/3).
-dump_one_solution(Pred) -->
- ( { call(Pred, Vars, VarNames) } ->
- { impure unsafe_dump(Vars, VarNames) }
+dump_one_solution(Pred, !IO) :-
+ ( Pred(Vars, VarNames) ->
+ impure unsafe_dump(Vars, VarNames)
;
- io__write_string("No solution.\n")
+ io.write_string("No solution.\n", !IO)
).
- % unfortunately the standard same_length predicate in list.m
+ % Unfortunately the standard same_length predicate in list.m
% doesn't have this mode...
-:- pred same_len(list(T1), list(T2)).
-:- mode same_len(list_ca, in) is semidet.
+ %
+:- pred same_len(list(T1)::list_ca, list(T2)::in) is semidet.
same_len([], []).
same_len([_|Xs], [_|Ys]) :- same_len(Xs, Ys).
@@ -100,26 +113,22 @@
% relationships between the cfloats in the list CfloatList to
% stdout, using the names given in the list NamesList.
% Perhaps these should be one assoc_list(?).
-
+ %
unsafe_dump(Cfloats, Names) :-
- % Ensure Cfloats and names have the same length
- (
- same_len(Cfloats, Names)
- ->
+ % Ensure Cfloats and names have the same length
+ ( same_len(Cfloats, Names) ->
% convert the mercury list of cfloats to a CLP(R)
% representation.
- dump__mercury_cfloat_list_to_clpr_list(Cfloats, CLPRVars),
+ dump.mercury_cfloat_list_to_clpr_list(Cfloats, CLPRVars),
% convert the mercury list of strings to the required
% CLP(R) representation
- dump__mercury_string_list_to_clpr_dump_string(Names, CLPRNames),
- impure dump__do_dump(CLPRVars, CLPRNames),
- impure dump__free(CLPRVars, CLPRNames)
+ dump.mercury_string_list_to_clpr_dump_string(Names, CLPRNames),
+ impure dump.do_dump(CLPRVars, CLPRNames),
+ impure dump.free(CLPRVars, CLPRNames)
;
error("list length mismatch in dump")
).
-
-
% convert the mercury cfloat list to a CLP(R) representation.
% The required representation is a CLPR_tagged pointer;
% CLPR_NIL is the empty list, a CLPR_CONS CLPR_tagged pointer
@@ -128,113 +137,127 @@
% CONS (etc.). The cfloat itself is a pointer to a single
% cell. This cell has the CLPR_tag PAR, and the value (with
% the CLPR_tag taken off) is the variable's CLPR_solver_id.
-
-:- pred dump__mercury_cfloat_list_to_clpr_list(list(cfloat)::list_ca,
+ %
+:- pred dump.mercury_cfloat_list_to_clpr_list(list(cfloat)::list_ca,
c_pointer::out) is det.
-dump__mercury_cfloat_list_to_clpr_list([], Empty) :-
- dump__get_clpr_empty_list(Empty).
-dump__mercury_cfloat_list_to_clpr_list([V|Vs], Result) :-
- dump__mercury_cfloat_list_to_clpr_list(Vs, Tail),
- dump__make_clpr_cfloat_list(V, Tail, Result).
-
-:- pragma c_header_code("#include <stdio.h>").
-:- pragma c_header_code("#include ""clpr/emul.h""").
-:- pragma c_header_code("#include ""clpr/compile.h""").
-
-:- pred dump__get_clpr_empty_list(c_pointer::out) is det.
-:- pragma c_code(dump__get_clpr_empty_list(Empty::out), will_not_call_mercury,
- "
- Empty = addtag(CLPR_TAG_NIL, 0);
- "
- ).
-:- pred dump__make_clpr_cfloat_list(cfloat::ca, c_pointer::in, c_pointer::out)
+dump.mercury_cfloat_list_to_clpr_list([], Empty) :-
+ dump.get_clpr_empty_list(Empty).
+dump.mercury_cfloat_list_to_clpr_list([V|Vs], Result) :-
+ dump.mercury_cfloat_list_to_clpr_list(Vs, Tail),
+ dump.make_clpr_cfloat_list(V, Tail, Result).
+
+:- pragma foreign_decl("C", "#include <stdio.h>").
+:- pragma foreign_decl("C", "#include ""clpr/emul.h""").
+:- pragma foreign_decl("C", "#include ""clpr/compile.h""").
+
+:- pred dump.get_clpr_empty_list(c_pointer::out) is det.
+:- pragma foreign_proc("C",
+ dump.get_clpr_empty_list(Empty::out),
+ [promise_pure, will_not_call_mercury],
+"
+ Empty = addtag(CLPR_TAG_NIL, 0);
+").
+
+:- pred dump.make_clpr_cfloat_list(cfloat::ca, c_pointer::in, c_pointer::out)
is det.
-:- pragma c_code(dump__make_clpr_cfloat_list(Head::ca, Tail::in, TheList::out),
- will_not_call_mercury,
- "
- {
- CLPR_int *HeadPtr;
- CLPR_int **ListPtr;
-
- ListPtr = malloc(2 * sizeof(CLPR_int *));
- HeadPtr = malloc(sizeof(CLPR_int));
- if (ListPtr == NULL || HeadPtr == NULL)
- MR_fatal_error(""malloc() failed in dump"");
- *HeadPtr = addtag(TAG_PAR, Head);
- ListPtr[0] = HeadPtr;
- ListPtr[1] = (CLPR_int *) Tail;
- TheList = addtag(CLPR_TAG_CONS, ListPtr);
- }
- "
- ).
+
+:- pragma foreign_proc("C",
+ dump.make_clpr_cfloat_list(Head::ca, Tail::in, TheList::out),
+ [promise_pure, will_not_call_mercury],
+"{
+ CLPR_int *HeadPtr;
+ CLPR_int **ListPtr;
+
+ ListPtr = malloc(2 * sizeof(CLPR_int *));
+ HeadPtr = malloc(sizeof(CLPR_int));
+ if (ListPtr == NULL || HeadPtr == NULL) {
+ MR_fatal_error(""malloc() failed in dump"");
+ }
+
+ *HeadPtr = addtag(TAG_PAR, Head);
+ ListPtr[0] = HeadPtr;
+ ListPtr[1] = (CLPR_int *) Tail;
+ TheList = addtag(CLPR_TAG_CONS, ListPtr);
+}").
% Convert the Mercury list of strings to the required CLP(R)
% representation - a single string, with the individual strings
- % separated by the value DUMP_SEPARATOR
-:-pred dump__mercury_string_list_to_clpr_dump_string(list(string)::in,
+ % separated by the value DUMP_SEPARATOR.
+ %
+:-pred dump.mercury_string_list_to_clpr_dump_string(list(string)::in,
c_pointer::out) is det.
-dump__mercury_string_list_to_clpr_dump_string(Strings, CLPRString) :-
- dump__total_string_length(Strings, StringsLength),
- list__length(Strings, NumStrings),
- CLPRStringLength is StringsLength + NumStrings,
- dump__allocate_clpr_string(CLPRStringLength, CLPRString0),
- dump__add_strings(Strings, CLPRString0, 0, CLPRString).
-
-:- pred dump__total_string_length(list(string)::in, int::out) is det.
-dump__total_string_length([], 0).
-dump__total_string_length([X|Xs], Result) :-
- string__length(X, Length),
- dump__total_string_length(Xs, TheRest),
- Result is Length + TheRest.
-
-:- pred dump__allocate_clpr_string(int::in, c_pointer::out) is det.
-:- pragma c_code(dump__allocate_clpr_string(Length::in, CLPRString::out),
- will_not_call_mercury,
+
+dump.mercury_string_list_to_clpr_dump_string(Strings, CLPRString) :-
+ dump.total_string_length(Strings, StringsLength),
+ list.length(Strings, NumStrings),
+ CLPRStringLength = StringsLength + NumStrings,
+ dump.allocate_clpr_string(CLPRStringLength, CLPRString0),
+ dump.add_strings(Strings, CLPRString0, 0, CLPRString).
+
+:- pred dump.total_string_length(list(string)::in, int::out) is det.
+
+dump.total_string_length([], 0).
+dump.total_string_length([X | Xs], Result) :-
+ string.length(X, Length),
+ dump.total_string_length(Xs, TheRest),
+ Result = Length + TheRest.
+
+:- pred dump.allocate_clpr_string(int::in, c_pointer::out) is det.
+:- pragma foreign_proc("C",
+ dump.allocate_clpr_string(Length::in, CLPRString::out),
+ [promise_pure, will_not_call_mercury],
"{
char *s;
- if ((s = malloc(Length * sizeof(char))) == NULL)
+ if ((s = malloc(Length * sizeof(char))) == NULL) {
MR_fatal_error(
- ""malloc() failed in dump__allocate_clpr_string"");
+ ""malloc() failed in dump.allocate_clpr_string"");
+ }
CLPRString = (MR_Word) s;
}").
-:- pred dump__add_strings(list(string)::in, c_pointer::in, int::in,
+:- pred dump.add_strings(list(string)::in, c_pointer::in, int::in,
c_pointer::out) is det.
-dump__add_strings([], CLPRString, _, CLPRString).
-dump__add_strings([X|Xs], CLPRString0, Index, CLPRString) :-
- dump__add_single_string(X, CLPRString0, Index, CLPRString1),
- string__length(X, XLength),
- NewIndex is Index + XLength + 1,
- dump__add_strings(Xs, CLPRString1, NewIndex, CLPRString).
-:- pred dump__add_single_string(string::in, c_pointer::in, int::in,
+dump.add_strings([], CLPRString, _, CLPRString).
+dump.add_strings([X | Xs], CLPRString0, Index, CLPRString) :-
+ dump.add_single_string(X, CLPRString0, Index, CLPRString1),
+ string.length(X, XLength),
+ NewIndex = Index + XLength + 1,
+ dump.add_strings(Xs, CLPRString1, NewIndex, CLPRString).
+
+:- pred dump.add_single_string(string::in, c_pointer::in, int::in,
c_pointer::out) is det.
-:- pragma c_code(dump__add_single_string(TheString::in, CLPRString0::in,
- Index::in, CLPRString::out), will_not_call_mercury,
- "
- {
- char *CLPRTmp, *StringTmp;
-
- CLPRTmp = (char *) CLPRString0;
- StringTmp = (char *) TheString;
-
- CLPRString = CLPRString0;
- CLPRTmp += Index;
- while (*StringTmp != '\\0')
- *CLPRTmp++ = *StringTmp++;
- *CLPRTmp = DUMP_SEPARATOR;
- }
- "
- ).
+:- pragma foreign_proc("C",
+ dump.add_single_string(TheString::in, CLPRString0::in,
+ Index::in, CLPRString::out),
+ [promise_pure, will_not_call_mercury],
+"{
+ char *CLPRTmp, *StringTmp;
+
+ CLPRTmp = (char *) CLPRString0;
+ StringTmp = (char *) TheString;
-:- pragma c_header_code("extern void CLPR_dump1(FILE *, CLPR_int *, char *);").
-:- impure pred dump__do_dump(c_pointer::in, c_pointer::in) is det.
-:- pragma c_code(dump__do_dump(Vars::in, Names::in), will_not_call_mercury,
- "CLPR_dump1(stdout, (CLPR_int *)&Vars, (char *)Names);").
+ CLPRString = CLPRString0;
+ CLPRTmp += Index;
+ while (*StringTmp != '\\0') {
+ *CLPRTmp++ = *StringTmp++;
+ *CLPRTmp = DUMP_SEPARATOR;
+ }
+}").
+
+:- pragma foreign_decl("C", "extern void CLPR_dump1(FILE *, CLPR_int *, char *);").
+
+:- impure pred dump.do_dump(c_pointer::in, c_pointer::in) is det.
+:- pragma foreign_proc("C",
+ dump.do_dump(Vars::in, Names::in),
+ [will_not_call_mercury],
+"
+ CLPR_dump1(stdout, (CLPR_int *)&Vars, (char *)Names);
+").
-:- pragma c_header_code("static void free_clpr_list_mem(MR_Word list);").
-:- pragma c_code("
+:- pragma foreign_decl("C", "static void free_clpr_list_mem(MR_Word list);").
+:- pragma foreign_code("C", "
static void free_clpr_list_mem(MR_Word list)
{
if (CLPR_tag(list) == CLPR_TAG_CONS) {
@@ -247,12 +270,24 @@
").
% Free our dynamically allocated memory.
-:- impure pred dump__free(c_pointer::in, c_pointer::in) is det.
-:- pragma c_code(dump__free(Vars::in, TheString::in), will_not_call_mercury,
- "
- free_clpr_list_mem(Vars);
- free((char *) TheString);
- ").
+ %
+:- impure pred dump.free(c_pointer::in, c_pointer::in) is det.
+:- pragma foreign_proc("C",
+ dump.free(Vars::in, TheString::in),
+ [will_not_call_mercury],
+"
+ free_clpr_list_mem(Vars);
+ free((char *) TheString);
+").
+
+:- pragma foreign_decl("C", "extern void CLPR_print_tableaus(void);").
+:- pragma foreign_proc("C",
+ unsafe_dump_tableaus,
+ [may_call_mercury],
+"
+ CLPR_print_tableaus();
+").
-:- pragma c_header_code("extern void CLPR_print_tableaus(void);").
-:- pragma c_code(unsafe_dump_tableaus, "CLPR_print_tableaus();").
+%----------------------------------------------------------------------------%
+:- end_module dump.
+%----------------------------------------------------------------------------%
Index: float_cfloat.m
===================================================================
RCS file: /home/mercury1/repository/clpr/float_cfloat.m,v
retrieving revision 1.3
diff -u -r1.3 float_cfloat.m
--- float_cfloat.m 6 Sep 1997 11:29:39 -0000 1.3
+++ float_cfloat.m 3 Mar 2005 04:02:41 -0000
@@ -21,17 +21,22 @@
:- interface.
:- import_module cfloat, float.
+%-----------------------------------------------------------------------------%
+
% cfloat-float equality
+ %
:- pred ==(float, cfloat).
:- mode ==(in, ca) is semidet.
:- mode ==(in, co) is det.
% cfloat-float disequality
+ %
:- pred \==(float, cfloat).
:- mode \==(in, ca) is semidet.
:- mode \==(in, co) is det.
% addition
+ %
:- func '+'(float, cfloat) = cfloat.
:- mode '+'(in, ca) = ca is semidet.
:- mode '+'(in, co) = ca is det.
@@ -39,6 +44,7 @@
:- mode '+'(in, co) = co is det.
% subtraction
+ %
:- func '-'(float, cfloat) = cfloat.
:- mode '-'(in, ca) = ca is semidet.
:- mode '-'(in, co) = ca is det.
@@ -46,6 +52,7 @@
:- mode '-'(in, co) = co is det.
% multiplication
+ %
:- func '*'(float, cfloat) = cfloat.
:- mode '*'(in, ca) = ca is semidet.
:- mode '*'(in, co) = ca is semidet. % semidet since eg. X*0=1 fails
@@ -53,6 +60,7 @@
:- mode '*'(in, co) = co is det.
% division
+ %
:- func '/'(float, cfloat) = cfloat.
:- mode '/'(in, ca) = ca is semidet.
:- mode '/'(in, co) = ca is semidet. % semidet since eg. X/0=1 fails
@@ -60,25 +68,32 @@
:- mode '/'(in, co) = co is semidet. % XXX really det
% X > Y
+ %
:- pred '>'(float, cfloat).
:- mode '>'(in, ca) is semidet.
:- mode '>'(in, co) is det.
% X >= Y
+ %
:- pred '>='(float, cfloat).
:- mode '>='(in, ca) is semidet.
:- mode '>='(in, co) is det.
% X < Y
+ %
:- pred '<'(float, cfloat).
:- mode '<'(in, ca) is semidet.
:- mode '<'(in, co) is det.
% X =< Y
+ %
:- pred '=<'(float, cfloat).
:- mode '=<'(in, ca) is semidet.
:- mode '=<'(in, co) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
X == Y :- cfloat__eq_float(Y, X).
@@ -93,3 +108,7 @@
X >= Y :- cfloat__ge_float(Y, X).
X < Y :- cfloat__lt_float(Y, X).
X =< Y :- cfloat__le_float(Y, X).
+
+%-----------------------------------------------------------------------------%
+:- end_module float_cfloat.
+%-----------------------------------------------------------------------------%
Index: samples/laplace.m
===================================================================
RCS file: /home/mercury1/repository/clpr/samples/laplace.m,v
retrieving revision 1.2
diff -u -r1.2 laplace.m
--- samples/laplace.m 14 Sep 1997 12:03:50 -0000 1.2
+++ samples/laplace.m 3 Mar 2005 04:12:43 -0000
@@ -20,10 +20,10 @@
:- mode vec_ca == list_ca.
:- mode vec_cg == list_cg.
-:- inst mat_of_constrained == bound([];[vec_of_constrained|mat_of_constrained]).
-:- mode mat_co :: (free -> mat_of_constrained).
-:- mode mat_ca :: (mat_of_constrained -> mat_of_constrained).
-:- mode mat_cg :: (mat_of_constrained -> ground).
+:- inst mat_of_constrained == list(vec_of_constrained).
+:- mode mat_co == free >> mat_of_constrained.
+:- mode mat_ca == mat_of_constrained >> mat_of_constrained.
+:- mode mat_cg == mat_of_constrained >> ground.
:- pred laplace(matrix::mat_ca) is semidet.
laplace([_, _]).
Index: samples/sum_list.m
===================================================================
RCS file: /home/mercury1/repository/clpr/samples/sum_list.m,v
retrieving revision 1.3
diff -u -r1.3 sum_list.m
--- samples/sum_list.m 16 Jan 1998 06:56:23 -0000 1.3
+++ samples/sum_list.m 3 Mar 2005 04:13:08 -0000
@@ -34,7 +34,7 @@
(
X > 0
->
- X0 is X - 1,
+ X0 = X - 1,
cfloat__init(Y),
make_cfloat_list(X0, Ys),
Result = [Y|Ys]
Index: samples/tranny.exp
===================================================================
RCS file: /home/mercury1/repository/clpr/samples/tranny.exp,v
retrieving revision 1.4
diff -u -r1.4 tranny.exp
--- samples/tranny.exp 16 Jan 1998 06:56:54 -0000 1.4
+++ samples/tranny.exp 3 Mar 2005 04:10:38 -0000
@@ -8,10 +8,10 @@
cc1 at 15.000000 [1.225225, 0.081126, -1.306351]
cc2 at _v17 [0.000000]
gnd at 0.000000 [-1.237477, -0.068874, 1.306351]
-in at _v34 [0.000000]
+in at _v22 [0.000000]
b at 6.887387 [0.012252, 0.068874, -0.081126, 0.000000]
e at 6.187387 [0.000000, 1.237477, -1.237477]
-out at _v49 [0.000000]
+out at _v37 [0.000000]
Transistor state = active
go2.
Index: samples/tranny.m
===================================================================
RCS file: /home/mercury1/repository/clpr/samples/tranny.m,v
retrieving revision 1.5.8.1
diff -u -r1.5.8.1 tranny.m
--- samples/tranny.m 3 Mar 2005 03:39:19 -0000 1.5.8.1
+++ samples/tranny.m 3 Mar 2005 04:14:07 -0000
@@ -40,7 +40,7 @@
:- type circuit_node ---> n(node, cfloat, list(cfloat)).
% Node name, Voltate, Collector Currents
-:- inst circuit_node = bound(n(ground, any, list_skel(any))).
+:- inst circuit_node == bound(n(ground, any, list_skel(any))).
:- type resistor_name ---> r1 ; r2 ; r3 ; r4 ; re ; rc.
:- type capacitor_name ---> c1 ; c2 ; c3 ; c4.
@@ -54,7 +54,7 @@
:- type diode_data ---> diode_data(diode_code, diode_state,
cfloat, cfloat).
% Diode code, Diode state, Vf, Vbreak.
-:- inst diode_data = bound( diode_data(ground, ground, any, any)).
+:- inst diode_data == bound( diode_data(ground, ground, any, any)).
:- type diode_code ---> di1.
:- type diode_state ---> forward ; reverse.
@@ -65,7 +65,7 @@
transistor_data, transistor_data
).
% Type, Code, State, Mean, Min, Max.
-:- inst transistor_info = bound(info(
+:- inst transistor_info == bound(info(
ground, ground, ground,
transistor_data,
transistor_data,
@@ -73,7 +73,7 @@
)).
:- type transistor_data ---> data(cfloat, cfloat, cfloat, cfloat).
% Beta, Vbe, Vcestat, Vt).
-:- inst transistor_data = bound(data(any, any, any, any)).
+:- inst transistor_data == bound(data(any, any, any, any)).
:- type transistor_type ---> npn ; pnp.
:- type transistor_code ---> tr0 ; tr1.
--------------------------------------------------------------------------
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