mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 05:12:33 +00:00
73131e8df3
Estimated hours taken: 0.75 library/*.m: compiler/*.m: Undo Zoltan's bogus update of all the copyright dates. The dates in the copyright header should reflect the years in which the file was modified (and no, changes to the copyright header itself don't count as modifications).
462 lines
16 KiB
Mathematica
462 lines
16 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-1997 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: prog_io_goal.m.
|
|
% Main author: fjh.
|
|
%
|
|
% This module defines the predicates that parse goals.
|
|
|
|
:- module prog_io_goal.
|
|
|
|
:- interface.
|
|
|
|
:- import_module prog_data, prog_io_util.
|
|
:- import_module list, term, varset.
|
|
|
|
% Convert a single term into a goal.
|
|
%
|
|
:- pred parse_goal(term, varset, goal, varset).
|
|
:- mode parse_goal(in, in, out, out) is det.
|
|
|
|
% Convert a term, possibly starting with `some [Vars]', into
|
|
% a list of variables and a goal. (If the term doesn't start
|
|
% with `some [Vars]', we return an empty list of variables.)
|
|
%
|
|
:- pred parse_some_vars_goal(term, varset, vars, goal, varset).
|
|
:- mode parse_some_vars_goal(in, in, out, out, out) is det.
|
|
|
|
% parse_lambda_expression/3 converts the first argument to a lambda/2
|
|
% expression into a list of variables, a list of their corresponding
|
|
% modes, and a determinism.
|
|
% The syntax of a lambda expression is
|
|
% `lambda([Var1::Mode1, ..., VarN::ModeN] is Det, Goal)'
|
|
% but this predicate just parses the first argument, i.e. the
|
|
% `[Var1::Mode1, ..., VarN::ModeN] is Det'
|
|
% part.
|
|
%
|
|
:- pred parse_lambda_expression(term, list(term), list(mode), determinism).
|
|
:- mode parse_lambda_expression(in, out, out, out) is semidet.
|
|
|
|
% parse_pred_expression/3 converts the first argument to a :-/2
|
|
% higher-order pred expression into a list of variables, a list
|
|
% of their corresponding modes, and a determinism. This is just
|
|
% a variant on parse_lambda_expression with a different syntax:
|
|
% `(pred(Var1::Mode1, ..., VarN::ModeN) is Det :- Goal)'.
|
|
%
|
|
:- pred parse_pred_expression(term, list(term), list(mode), determinism).
|
|
:- mode parse_pred_expression(in, out, out, out) is semidet.
|
|
|
|
% parse_dcg_pred_expression/3 converts the first argument to a -->/2
|
|
% higher-order dcg pred expression into a list of variables, a list
|
|
% of their corresponding modes and the two dcg argument modes, and a
|
|
% determinism.
|
|
% This is a variant of the higher-order pred syntax:
|
|
% `(pred(Var1::Mode1, ..., VarN::ModeN, DCG0Mode, DCGMode)
|
|
% is Det --> Goal)'.
|
|
%
|
|
:- pred parse_dcg_pred_expression(term, list(term), list(mode), determinism).
|
|
:- mode parse_dcg_pred_expression(in, out, out, out) is semidet.
|
|
|
|
% parse_func_expression/3 converts the first argument to a :-/2
|
|
% higher-order func expression into a list of variables, a list
|
|
% of their corresponding modes, and a determinism. The syntax
|
|
% of a higher-order func expression is
|
|
% `(func(Var1::Mode1, ..., VarN::ModeN) = (VarN1::ModeN1) is Det
|
|
% :- Goal)'.
|
|
%
|
|
:- pred parse_func_expression(term, list(term), list(mode), determinism).
|
|
:- mode parse_func_expression(in, out, out, out) is semidet.
|
|
|
|
% A QualifiedTerm is one of
|
|
% Name(Args)
|
|
% Module:Name(Args)
|
|
% (or if Args is empty, one of
|
|
% Name
|
|
% Module:Name)
|
|
% For backwards compatibility, we allow `__'
|
|
% as an alternative to `:'.
|
|
|
|
% sym_name_and_args takes a term and returns a sym_name and a list of
|
|
% argument terms.
|
|
% It fals if the input is not valid syntax for a QualifiedTerm.
|
|
:- pred sym_name_and_args(term, sym_name, list(term)).
|
|
:- mode sym_name_and_args(in, out, out) is semidet.
|
|
|
|
% parse_qualified_term/4 takes a term (and also the containing
|
|
% term, and a string describing the context from which it
|
|
% was called [e.g. "clause head"] and the containing term)
|
|
% and returns a sym_name and a list of argument terms.
|
|
% Returns an error on ill-formed input.
|
|
:- pred parse_qualified_term(term, term, string, maybe_functor).
|
|
:- mode parse_qualified_term(in, in, in, out) is det.
|
|
|
|
% parse_qualified_term(DefaultModName, Term,
|
|
% ContainingTerm, Msg, Result):
|
|
%
|
|
% parse_qualified_term/5 takes a default module name and a term,
|
|
% (and also the containing term, and a string describing
|
|
% the context from which it was called (e.g. "clause head"),
|
|
% and returns a sym_name and a list of argument terms.
|
|
% Returns an error on ill-formed input or a module qualifier that
|
|
% doesn't match the DefaultModName, if DefaultModName is not ""
|
|
% and not "mercury_builtin".
|
|
% parse_qualified_term/4 calls parse_qualified_term/5, and is
|
|
% used when no default module name exists.
|
|
|
|
:- pred parse_qualified_term(string, term, term, string, maybe_functor).
|
|
:- mode parse_qualified_term(in, in, in, in, out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds_data, purity.
|
|
:- import_module int, string, std_util.
|
|
|
|
% Parse a goal.
|
|
%
|
|
% We could do some error-checking here, but all errors are picked up
|
|
% in either the type-checker or parser anyway.
|
|
|
|
parse_goal(Term, VarSet0, Goal, VarSet) :-
|
|
% first, get the goal context
|
|
(
|
|
Term = term__functor(_, _, Context)
|
|
;
|
|
Term = term__variable(_),
|
|
term__context_init(Context)
|
|
),
|
|
% We just check if it matches the appropriate pattern
|
|
% for one of the builtins. If it doesn't match any of the
|
|
% builtins, then it's just a predicate call.
|
|
(
|
|
% check for builtins...
|
|
Term = term__functor(term__atom(Name), Args, Context),
|
|
parse_goal_2(Name, Args, VarSet0, GoalExpr, VarSet1)
|
|
->
|
|
Goal = GoalExpr - Context,
|
|
VarSet = VarSet1
|
|
;
|
|
% it's not a builtin
|
|
(
|
|
% check for predicate calls
|
|
sym_name_and_args(Term, SymName, Args)
|
|
->
|
|
VarSet = VarSet0,
|
|
Goal = call(SymName, Args, pure) - Context
|
|
;
|
|
% A call to a free variable, or to a number or string.
|
|
% Just translate it into a call to call/1 - the typechecker
|
|
% will catch calls to numbers and strings.
|
|
Goal = call(unqualified("call"), [Term], pure)
|
|
- Context,
|
|
VarSet = VarSet0
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred parse_goal_2(string, list(term), varset, goal_expr, varset).
|
|
:- mode parse_goal_2(in, in, in, out, out) is semidet.
|
|
parse_goal_2("true", [], V, true, V).
|
|
parse_goal_2("fail", [], V, fail, V).
|
|
parse_goal_2("=", [A, B], V, unify(A, B), V).
|
|
/******
|
|
Since (A -> B) has different semantics in standard Prolog
|
|
(A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
|
|
for the moment we'll just disallow it.
|
|
parse_goal_2("->", [A0, B0], V0, if_then(Vars, A, B), V) :-
|
|
parse_some_vars_goal(A0, V0, Vars, A, V1),
|
|
parse_goal(B0, V1, B, V).
|
|
******/
|
|
parse_goal_2(",", [A0, B0], V0, (A, B), V) :-
|
|
parse_goal(A0, V0, A, V1),
|
|
parse_goal(B0, V1, B, V).
|
|
parse_goal_2(";", [A0, B0], V0, R, V) :-
|
|
(
|
|
A0 = term__functor(term__atom("->"), [X0, Y0], _Context)
|
|
->
|
|
parse_some_vars_goal(X0, V0, Vars, X, V1),
|
|
parse_goal(Y0, V1, Y, V2),
|
|
parse_goal(B0, V2, B, V),
|
|
R = if_then_else(Vars, X, Y, B)
|
|
;
|
|
parse_goal(A0, V0, A, V1),
|
|
parse_goal(B0, V1, B, V),
|
|
R = (A;B)
|
|
).
|
|
/****
|
|
For consistency we also disallow if-then
|
|
parse_goal_2("if",
|
|
[term__functor(term__atom("then"), [A0, B0], _)], V0,
|
|
if_then(Vars, A, B), V) :-
|
|
parse_some_vars_goal(A0, V0, Vars, A, V1),
|
|
parse_goal(B0, V1, B, V).
|
|
****/
|
|
parse_goal_2("else", [
|
|
term__functor(term__atom("if"), [
|
|
term__functor(term__atom("then"), [A0, B0], _)
|
|
], _),
|
|
C0
|
|
], V0,
|
|
if_then_else(Vars, A, B, C), V) :-
|
|
parse_some_vars_goal(A0, V0, Vars, A, V1),
|
|
parse_goal(B0, V1, B, V2),
|
|
parse_goal(C0, V2, C, V).
|
|
parse_goal_2("not", [A0], V0, not(A), V) :-
|
|
parse_goal(A0, V0, A, V).
|
|
parse_goal_2("\\+", [A0], V0, not(A), V) :-
|
|
parse_goal(A0, V0, A, V).
|
|
parse_goal_2("all", [Vars0, A0], V0, all(Vars, A), V):-
|
|
term__vars(Vars0, Vars),
|
|
parse_goal(A0, V0, A, V).
|
|
|
|
% handle implication
|
|
parse_goal_2("<=", [A0, B0], V0, implies(B, A), V):-
|
|
parse_goal(A0, V0, A, V1),
|
|
parse_goal(B0, V1, B, V).
|
|
|
|
parse_goal_2("=>", [A0, B0], V0, implies(A, B), V):-
|
|
parse_goal(A0, V0, A, V1),
|
|
parse_goal(B0, V1, B, V).
|
|
|
|
% handle equivalence
|
|
parse_goal_2("<=>", [A0, B0], V0, equivalent(A, B), V):-
|
|
parse_goal(A0, V0, A, V1),
|
|
parse_goal(B0, V1, B, V).
|
|
|
|
parse_goal_2("some", [Vars0, A0], V0, some(Vars, A), V):-
|
|
term__vars(Vars0, Vars),
|
|
parse_goal(A0, V0, A, V).
|
|
|
|
% The following is a temporary hack to handle `is' in
|
|
% the parser - we ought to handle it in the code generation -
|
|
% but then `is/2' itself is a bit of a hack
|
|
%
|
|
parse_goal_2("is", [A, B], V, unify(A, B), V).
|
|
parse_goal_2("impure", [A0], V0, A, V) :-
|
|
parse_goal_with_purity(A0, V0, (impure), A, V).
|
|
parse_goal_2("semipure", [A0], V0, A, V) :-
|
|
parse_goal_with_purity(A0, V0, (semipure), A, V).
|
|
|
|
|
|
:- pred parse_goal_with_purity(term, varset, purity, goal_expr, varset).
|
|
:- mode parse_goal_with_purity(in, in, in, out, out) is det.
|
|
|
|
parse_goal_with_purity(A0, V0, Purity, A, V) :-
|
|
parse_goal(A0, V0, A1, V),
|
|
( A1 = call(Pred, Args, pure) - _ ->
|
|
A = call(Pred, Args, Purity)
|
|
;
|
|
% Inappropriate placement of an impurity marker, so we treat
|
|
% it like a predicate call. typecheck.m prints out something
|
|
% descriptive for these errors.
|
|
purity_name(Purity, PurityString),
|
|
A = call(unqualified(PurityString), [A0], pure)
|
|
).
|
|
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_some_vars_goal(A0, VarSet0, Vars, A, VarSet) :-
|
|
(
|
|
A0 = term__functor(term__atom("some"), [Vars0, A1], _Context)
|
|
->
|
|
term__vars(Vars0, Vars),
|
|
parse_goal(A1, VarSet0, A, VarSet)
|
|
;
|
|
Vars = [],
|
|
parse_goal(A0, VarSet0, A, VarSet)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_lambda_expression(LambdaExpressionTerm, Vars, Modes, Det) :-
|
|
LambdaExpressionTerm = term__functor(term__atom("is"),
|
|
[LambdaArgsTerm, DetTerm], _),
|
|
DetTerm = term__functor(term__atom(DetString), [], _),
|
|
standard_det(DetString, Det),
|
|
parse_lambda_args(LambdaArgsTerm, Vars, Modes).
|
|
|
|
:- pred parse_lambda_args(term, list(term), list(mode)).
|
|
:- mode parse_lambda_args(in, out, out) is semidet.
|
|
|
|
parse_lambda_args(Term, Vars, Modes) :-
|
|
( Term = term__functor(term__atom("."), [Head, Tail], _Context) ->
|
|
parse_lambda_arg(Head, Var, Mode),
|
|
Vars = [Var | Vars1],
|
|
Modes = [Mode | Modes1],
|
|
parse_lambda_args(Tail, Vars1, Modes1)
|
|
; Term = term__functor(term__atom("[]"), [], _) ->
|
|
Vars = [],
|
|
Modes = []
|
|
;
|
|
Vars = [Var],
|
|
Modes = [Mode],
|
|
parse_lambda_arg(Term, Var, Mode)
|
|
).
|
|
|
|
:- pred parse_lambda_arg(term, term, mode).
|
|
:- mode parse_lambda_arg(in, out, out) is semidet.
|
|
|
|
parse_lambda_arg(Term, VarTerm, Mode) :-
|
|
Term = term__functor(term__atom("::"), [VarTerm, ModeTerm], _),
|
|
convert_mode(ModeTerm, Mode).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_pred_expression(PredTerm, Vars, Modes, Det) :-
|
|
PredTerm = term__functor(term__atom("is"), [PredArgsTerm, DetTerm], _),
|
|
DetTerm = term__functor(term__atom(DetString), [], _),
|
|
standard_det(DetString, Det),
|
|
PredArgsTerm = term__functor(term__atom("pred"), PredArgsList, _),
|
|
parse_pred_expr_args(PredArgsList, Vars, Modes).
|
|
|
|
parse_dcg_pred_expression(PredTerm, Vars, Modes, Det) :-
|
|
PredTerm = term__functor(term__atom("is"), [PredArgsTerm, DetTerm], _),
|
|
DetTerm = term__functor(term__atom(DetString), [], _),
|
|
standard_det(DetString, Det),
|
|
PredArgsTerm = term__functor(term__atom("pred"), PredArgsList, _),
|
|
parse_dcg_pred_expr_args(PredArgsList, Vars, Modes).
|
|
|
|
parse_func_expression(FuncTerm, Vars, Modes, Det) :-
|
|
%
|
|
% parse a func expression with specified modes and determinism
|
|
%
|
|
FuncTerm = term__functor(term__atom("is"), [EqTerm, DetTerm], _),
|
|
EqTerm = term__functor(term__atom("="), [FuncArgsTerm, RetTerm], _),
|
|
DetTerm = term__functor(term__atom(DetString), [], _),
|
|
standard_det(DetString, Det),
|
|
FuncArgsTerm = term__functor(term__atom("func"), FuncArgsList, _),
|
|
parse_pred_expr_args(FuncArgsList, Vars0, Modes0),
|
|
parse_lambda_arg(RetTerm, RetVar, RetMode),
|
|
list__append(Vars0, [RetVar], Vars),
|
|
list__append(Modes0, [RetMode], Modes).
|
|
parse_func_expression(FuncTerm, Vars, Modes, Det) :-
|
|
%
|
|
% parse a func expression with unspecified modes and determinism
|
|
%
|
|
FuncTerm = term__functor(term__atom("="), [FuncArgsTerm, RetVar], _),
|
|
FuncArgsTerm = term__functor(term__atom("func"), Vars0, _),
|
|
%
|
|
% the argument modes default to `in',
|
|
% the return mode defaults to `out',
|
|
% and the determinism defaults to `det'.
|
|
%
|
|
InMode = user_defined_mode(qualified("mercury_builtin", "in"), []),
|
|
OutMode = user_defined_mode(qualified("mercury_builtin", "out"), []),
|
|
list__length(Vars0, NumVars),
|
|
list__duplicate(NumVars, InMode, Modes0),
|
|
RetMode = OutMode,
|
|
Det = det,
|
|
list__append(Modes0, [RetMode], Modes),
|
|
list__append(Vars0, [RetVar], Vars).
|
|
|
|
:- pred parse_pred_expr_args(list(term), list(term), list(mode)).
|
|
:- mode parse_pred_expr_args(in, out, out) is semidet.
|
|
|
|
parse_pred_expr_args([], [], []).
|
|
parse_pred_expr_args([Term|Terms], [Arg|Args], [Mode|Modes]) :-
|
|
parse_lambda_arg(Term, Arg, Mode),
|
|
parse_pred_expr_args(Terms, Args, Modes).
|
|
|
|
% parse_dcg_pred_expr_args is like parse_pred_expr_args except
|
|
% that the last two elements of the list are the modes of the
|
|
% two dcg arguments.
|
|
:- pred parse_dcg_pred_expr_args(list(term), list(term), list(mode)).
|
|
:- mode parse_dcg_pred_expr_args(in, out, out) is semidet.
|
|
|
|
parse_dcg_pred_expr_args([DCGModeTerm0, DCGModeTerm1], [],
|
|
[DCGMode0, DCGMode1]) :-
|
|
convert_mode(DCGModeTerm0, DCGMode0),
|
|
convert_mode(DCGModeTerm1, DCGMode1).
|
|
parse_dcg_pred_expr_args([Term|Terms], [Arg|Args], [Mode|Modes]) :-
|
|
Terms = [_, _|_],
|
|
parse_lambda_arg(Term, Arg, Mode),
|
|
parse_dcg_pred_expr_args(Terms, Args, Modes).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
sym_name_and_args(Term, SymName, Args) :-
|
|
parse_qualified_term(Term, Term, "", ok(SymName, Args)).
|
|
|
|
parse_qualified_term(Term, ContainingTerm, Msg, Result) :-
|
|
parse_qualified_term("", Term, ContainingTerm, Msg, Result).
|
|
|
|
parse_qualified_term(DefaultModName, Term, ContainingTerm, Msg, Result) :-
|
|
(
|
|
Term = term__functor(term__atom(":"), [ModuleTerm, NameArgsTerm],
|
|
_Context)
|
|
->
|
|
(
|
|
NameArgsTerm = term__functor(term__atom(Name), Args, _Context2)
|
|
->
|
|
(
|
|
ModuleTerm = term__functor(term__atom(Module), [], _Context3)
|
|
->
|
|
(
|
|
( Module = DefaultModName
|
|
; DefaultModName = ""
|
|
; DefaultModName = "mercury_builtin"
|
|
)
|
|
->
|
|
Result = ok(qualified(Module, Name), Args)
|
|
;
|
|
Result = error("module qualifier in definition does not match preceding `:- module' declaration", Term)
|
|
)
|
|
;
|
|
Result = error("module name identifier expected before ':' in qualified symbol name", Term)
|
|
)
|
|
;
|
|
Result = error("identifier expected after ':' in qualified symbol name", Term)
|
|
)
|
|
;
|
|
(
|
|
Term = term__functor(term__atom(Name), Args, _Context4)
|
|
->
|
|
(
|
|
string__sub_string_search(Name, "__", LeftLength),
|
|
LeftLength > 0
|
|
->
|
|
string__left(Name, LeftLength, Module),
|
|
string__length(Name, NameLength),
|
|
RightLength is NameLength - LeftLength - 2,
|
|
string__right(Name, RightLength, Name2),
|
|
(
|
|
( Module = DefaultModName
|
|
; DefaultModName = ""
|
|
; DefaultModName = "mercury_builtin"
|
|
)
|
|
->
|
|
Result = ok(qualified(Module, Name2), Args)
|
|
;
|
|
Result = error("module qualifier (name before `__') in definition does not match preceding `:- module' declaration", Term)
|
|
)
|
|
;
|
|
DefaultModName = ""
|
|
->
|
|
Result = ok(unqualified(Name), Args)
|
|
;
|
|
Result = ok(qualified(DefaultModName, Name), Args)
|
|
)
|
|
;
|
|
string__append("atom expected in ", Msg, ErrorMsg),
|
|
%
|
|
% since variables don't have any term__context,
|
|
% if Term is a variable, we use ContainingTerm instead
|
|
% (hopefully that _will_ have a term__context).
|
|
%
|
|
( Term = term__variable(_) ->
|
|
ErrorTerm = ContainingTerm
|
|
;
|
|
ErrorTerm = Term
|
|
),
|
|
Result = error(ErrorMsg, ErrorTerm)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|