[m-dev.] for review: turn off support for foriegn_code/3+
Tyson Dowd
trd at cs.mu.OZ.AU
Mon Jan 22 16:53:23 AEDT 2001
Hi,
I don't intend to commit this just yet, but when we have bootstrapped
"enough" I will bootcheck and then commit this. I am not sure when that will
be.
This is *just* for the mercury-latest branch.
I include the diff for library/array.m to give you an idea of what the
change looks like (extremely boring).
This change will also make sure we auto-detect the fact that you cannot
bootstrap this compiler with the release.
===================================================================
Estimated hours taken: 2
configure.in:
Check for foreign_proc, as we require it to work if we wish to
bootstrap.
compiler/prog_io_pragma.m:
Remove support for foreign_code/3+.
We only accept foreign_proc for these cases now.
library/*.m:
Turn foreign_code/3+ into foreign_proc by applying the
following subsitutions:
First turn all foreign_code into foreign_proc:
s/foreign_code\(/foreign_proc\(/g
Then turn back any foreign_proc with a string as its second
argument.
s/foreign_proc(\("[A-Za-z0-9+]*",[ \t\n]*")/foreign_code$1/g
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.243
diff -u -r1.243 configure.in
--- configure.in 2001/01/22 04:41:54 1.243
+++ configure.in 2001/01/22 05:30:13
@@ -87,12 +87,12 @@
:- implementation.
- % Check that we can declare foreign_code for C and MC++.
+ % Check that we can declare foreign_proc for C and MC++.
:- pred foo(int::out) is det.
- :- pragma foreign_code("C", foo(X::out),
+ :- pragma foreign_proc("C", foo(X::out),
[[will_not_call_mercury, thread_safe]],
" X = 42; ").
- :- pragma foreign_code("MC++", foo(X::out),
+ :- pragma foreign_proc("MC++", foo(X::out),
[[will_not_call_mercury, thread_safe]],
" X = 42; ").
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.27
diff -u -r1.27 prog_io_pragma.m
--- compiler/prog_io_pragma.m 2001/01/19 03:17:31 1.27
+++ compiler/prog_io_pragma.m 2001/01/22 05:28:35
@@ -88,10 +88,10 @@
ErrorTerm)
).
-parse_pragma_type(ModuleName, "foreign_code", PragmaTerms,
- ErrorTerm, VarSet, Result) :-
- parse_pragma_foreign_code_pragma(ModuleName, "foreign_code",
- PragmaTerms, ErrorTerm, VarSet, Result).
+parse_pragma_type(_ModuleName, "foreign_code", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_pragma_foreign_code_pragma("foreign_code",
+ PragmaTerms, ErrorTerm, Result).
parse_pragma_type(ModuleName, "foreign_proc", PragmaTerms,
ErrorTerm, VarSet, Result) :-
@@ -110,8 +110,8 @@
PragmaTerms = [term__functor(_, _, Context)]
->
LangC = term__functor(term__string("C"), [], Context),
- parse_pragma_foreign_code_pragma(ModuleName, "c_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Result)
+ parse_pragma_foreign_code_pragma("c_code",
+ [LangC | PragmaTerms], ErrorTerm, Result)
;
% arity > 1 (same as foreign_proc)
PragmaTerms = [term__functor(_, _, Context) | _]
@@ -169,16 +169,14 @@
% This predicate parses both c_code and foreign_code pragmas.
% Processing of foreign_proc (or c_code that defines a procedure)
% is handled in parse_pragma_foreign_proc_pragma below.
-:- pred parse_pragma_foreign_code_pragma(module_name, string,
- list(term), term, varset, maybe1(item)).
-:- mode parse_pragma_foreign_code_pragma(in, in, in, in, in, out) is det.
+:- pred parse_pragma_foreign_code_pragma(string, list(term), term,
+ maybe1(item)).
+:- mode parse_pragma_foreign_code_pragma(in, in, in, out) is det.
-parse_pragma_foreign_code_pragma(ModuleName, Pragma, PragmaTerms,
- ErrorTerm, VarSet, Result) :-
+parse_pragma_foreign_code_pragma(Pragma, PragmaTerms, ErrorTerm, Result) :-
string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
InvalidDeclStr),
-
Check1 = (func(PTerms1, ForeignLanguage) = Res is semidet :-
PTerms1 = [Just_Code_Term],
(
@@ -194,184 +192,9 @@
)
),
- % After foreign_proc has bootstrapped and the library has
- % been updated to use foreign_proc where appropriate, we
- % should uncomment this code and remove Check2, Check3,
- % Check5, Check6 and the other definition of CheckLength.
-/*
CheckLength = (func(PTermsLen, ForeignLanguage) = Res :-
(
Res0 = Check1(PTermsLen, ForeignLanguage)
- ->
- Res = Res0
- ;
- ErrMsg = "-- wrong number of arguments",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- ErrorTerm)
- )
- ),
-*/
-
- Check6 = (func(PTerms6, ForeignLanguage) = Res is semidet :-
- PTerms6 = [PredAndVarsTerm, FlagsTerm,
- FieldsTerm, FirstTerm, LaterTerm, SharedTerm],
- ( parse_pragma_foreign_code_attributes_term(
- ForeignLanguage, FlagsTerm, Flags) ->
- ( parse_pragma_keyword("local_vars", FieldsTerm, Fields,
- FieldsContext) ->
- ( parse_pragma_keyword("first_code", FirstTerm, First,
- FirstContext) ->
- ( parse_pragma_keyword("retry_code", LaterTerm, Later,
- LaterContext) ->
- ( parse_pragma_keyword("shared_code", SharedTerm,
- Shared, SharedContext) ->
- parse_pragma_foreign_code(ModuleName,
- Flags, PredAndVarsTerm,
- nondet(Fields, yes(FieldsContext),
- First, yes(FirstContext),
- Later, yes(LaterContext),
- share, Shared, yes(SharedContext)),
- VarSet, Res)
- ; parse_pragma_keyword("duplicated_code",
- SharedTerm, Shared, SharedContext) ->
- parse_pragma_foreign_code(ModuleName,
- Flags, PredAndVarsTerm,
- nondet(Fields, yes(FieldsContext),
- First, yes(FirstContext),
- Later, yes(LaterContext),
- duplicate, Shared, yes(SharedContext)),
- VarSet, Res)
- ; parse_pragma_keyword("common_code", SharedTerm,
- Shared, SharedContext) ->
- parse_pragma_foreign_code(ModuleName,
- Flags, PredAndVarsTerm,
- nondet(Fields, yes(FieldsContext),
- First, yes(FirstContext),
- Later, yes(LaterContext),
- automatic, Shared, yes(SharedContext)),
- VarSet, Res)
- ;
- ErrMsg = "-- invalid seventh argument, expecting `common_code(<code>)'",
- Res = error(string__append(InvalidDeclStr,
- ErrMsg), SharedTerm)
- )
- ;
- ErrMsg = "-- invalid sixth argument, expecting `retry_code(<code>)'",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- LaterTerm)
- )
- ;
- ErrMsg = "-- invalid fifth argument, expecting `first_code(<code>)'",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- FirstTerm)
- )
- ;
- ErrMsg = "-- invalid fourth argument, expecting `local_vars(<fields>)'",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- FieldsTerm)
- )
- ;
- ErrMsg = "-- invalid third argument, expecting foreign code attribute or list of attributes",
- Res = error(string__append(InvalidDeclStr, ErrMsg), FlagsTerm)
- )
- ),
-
- Check5 = (func(PTerms5, ForeignLanguage) = Res is semidet :-
- PTerms5 = [PredAndVarsTerm, FlagsTerm,
- FieldsTerm, FirstTerm, LaterTerm],
- term__context_init(DummyContext),
- SharedTerm = term__functor(term__atom("common_code"),
- [term__functor(term__string(""), [], DummyContext)],
- DummyContext),
- Res = Check6([PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm,
- LaterTerm, SharedTerm], ForeignLanguage)
- ),
-
- Check3 = (func(PTerms3, ForeignLanguage) = Res is semidet :-
- PTerms3 = [PredAndVarsTerm, FlagsTerm, CodeTerm],
- (
- CodeTerm = term__functor(term__string(Code), [], Context)
- ->
- ( parse_pragma_foreign_code_attributes_term(ForeignLanguage,
- FlagsTerm, Flags) ->
- parse_pragma_foreign_code(ModuleName, Flags,
- PredAndVarsTerm, ordinary(Code, yes(Context)),
- VarSet, Res)
- ; parse_pragma_foreign_code_attributes_term(ForeignLanguage,
- PredAndVarsTerm, Flags) ->
- % XXX we should issue a warning; this syntax is deprecated
- % We will continue to accept this if c_code is used, but
- % not with foreign_code
- ( Pragma = "c_code" ->
- parse_pragma_foreign_code(ModuleName,
- Flags, FlagsTerm, ordinary(Code, yes(Context)),
- VarSet, Res)
- ;
- ErrMsg = "-- invalid second argument, expecting predicate or function mode",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- PredAndVarsTerm)
- )
- ;
- ErrMsg = "-- invalid third argument, expecting a foreign code attribute or list of attributes",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- FlagsTerm)
- )
- ;
- ErrMsg = "-- invalid fourth argument, expecting string containing foreign code",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- CodeTerm)
- )
- ),
-
- Check2 = (func(PTerms2, ForeignLanguage) = Res is semidet :-
- PTerms2 = [PredAndVarsTerm, CodeTerm],
- % XXX we should issue a warning; this syntax is deprecated.
- % We will continue to accept this if c_code is used, but
- % not with foreign_code
- (
- Pragma = "c_code"
- ->
- % may_call_mercury is a conservative default.
- default_attributes(ForeignLanguage, Attributes),
- (
- CodeTerm = term__functor(term__string(Code), [],
- Context)
- ->
- parse_pragma_foreign_code(ModuleName,
- Attributes, PredAndVarsTerm, ordinary(Code,
- yes(Context)), VarSet, Res)
- ;
- ErrMsg = "-- expecting either `may_call_mercury' or `will_not_call_mercury', and a string for foreign code",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- CodeTerm)
- )
- ;
- ErrMsg = "-- doesn't say whether it can call mercury",
- Res = error(string__append(InvalidDeclStr, ErrMsg),
- ErrorTerm)
- )
- ),
-
-
- CheckLength = (func(PTermsLen, ForeignLanguage) = Res :-
- (
- Res0 = Check1(PTermsLen, ForeignLanguage)
- ->
- Res = Res0
- ;
- Res0 = Check2(PTermsLen, ForeignLanguage)
- ->
- Res = Res0
- ;
- Res0 = Check3(PTermsLen, ForeignLanguage)
- ->
- Res = Res0
- ;
- Res0 = Check5(PTermsLen, ForeignLanguage)
- ->
- Res = Res0
- ;
- Res0 = Check6(PTermsLen, ForeignLanguage)
->
Res = Res0
;
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.82
diff -u -r1.82 array.m
--- library/array.m 2001/01/12 14:08:46 1.82
+++ library/array.m 2001/01/22 05:33:54
@@ -560,21 +560,21 @@
}
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__init(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_make_array(Size, Item);
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__make_empty_array(Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_make_array(0, 0);
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__init(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
@@ -582,7 +582,7 @@
Array = (MR_Word) System::Array::CreateInstance(Item->GetType(), Size);
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__make_empty_array(Array::array_uo),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
@@ -595,27 +595,27 @@
%-----------------------------------------------------------------------------%
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__min(Array::array_ui, Min::out),
[will_not_call_mercury, thread_safe], "
/* Array not used */
Min = 0;
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__min(Array::in, Min::out),
[will_not_call_mercury, thread_safe], "
/* Array not used */
Min = 0;
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__min(Array::array_ui, Min::out),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
/* Array not used */
Min = 0;
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__min(Array::in, Min::out),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
@@ -623,23 +623,23 @@
Min = 0;
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__max(Array::array_ui, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__max(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__max(Array::array_ui, Max::out),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
Max = Array->get_Length() - 1;
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__max(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
@@ -653,24 +653,24 @@
%-----------------------------------------------------------------------------%
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__size(Array::array_ui, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__size(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__size(Array::array_ui, Max::out),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
Max = Array->get_Length() - 1;
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__size(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
@@ -702,7 +702,7 @@
%-----------------------------------------------------------------------------%
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__lookup(Array::array_ui, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
@@ -713,7 +713,7 @@
#endif
Item = array->elements[Index];
}").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
@@ -725,13 +725,13 @@
Item = array->elements[Index];
}").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__lookup(Array::array_ui, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
Item = Array->GetValue(Index);
}").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
@@ -741,7 +741,7 @@
%-----------------------------------------------------------------------------%
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__set(Array0::array_di, Index::in,
Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "{
@@ -755,7 +755,7 @@
Array = Array0;
}").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__set(Array0::array_di, Index::in,
Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "{
@@ -806,14 +806,14 @@
}
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__resize(Array0::array_di, Size::in, Item::in,
Array::array_uo), [will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_resize_array(
(MR_ArrayType *) Array0, Size, Item);
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__resize(_Array0::array_di, _Size::in, _Item::in,
_Array::array_uo), [will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this function"");
@@ -858,14 +858,14 @@
}
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__shrink(Array0::array_di, Size::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_shrink_array(
(MR_ArrayType *) Array0, Size);
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__shrink(_Array0::array_di, _Size::in, _Array::array_uo),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this function"");
@@ -901,7 +901,7 @@
}
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__copy(Array0::array_ui, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation((((MR_ArrayType *) Array0)->size) + 1,
@@ -909,7 +909,7 @@
Array = (MR_Word) ML_copy_array((MR_ArrayType *) Array0);
").
-:- pragma foreign_code("C",
+:- pragma foreign_proc("C",
array__copy(Array0::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation((((MR_ArrayType *) Array0)->size) + 1,
@@ -917,7 +917,7 @@
Array = (MR_Word) ML_copy_array((MR_ArrayType *) Array0);
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__copy(Array0::array_ui, Array::array_uo),
[will_not_call_mercury, thread_safe], "
// XXX need to deep copy it
@@ -926,7 +926,7 @@
").
-:- pragma foreign_code("MC++",
+:- pragma foreign_proc("MC++",
array__copy(Array0::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""foreign code for this function"");
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list