%-----------------------------------------------------------------------------% % Copyright (C) 1996-2003 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_util.m. % Main author: fjh. % % This module defines the types used by prog_io and its subcontractors % to return the results of parsing, and some utility predicates needed % by several of prog_io's submodules. % % Most parsing predicates must check for errors. They return either the % item(s) they were looking for, or an error indication. % % Most of the parsing predicates return a `maybe1(T)' % or a `maybe2(T1, T2)', which will either be the % `ok(ParseTree)' (or `ok(ParseTree1, ParseTree2)'), % if the parse is successful, or `error(Message, Term)' % if it is not. The `Term' there should be the term which % is syntactically incorrect. :- module parse_tree__prog_io_util. :- interface. :- import_module parse_tree__inst. :- import_module parse_tree__prog_data. :- import_module list, map, std_util, term, io. :- type maybe2(T1, T2) ---> error(string, term) ; ok(T1, T2). :- type maybe3(T1, T2, T3) ---> error(string, term) ; ok(T1, T2, T3). :- type maybe1(T) == maybe1(T, generic). :- type maybe1(T, U) ---> error(string, term(U)) ; ok(T). :- type maybe_functor == maybe_functor(generic). :- type maybe_functor(T) == maybe2(sym_name, list(term(T))). % ok(SymName, Args - MaybeFuncRetArg) ; error(Msg, Term). :- type maybe_pred_or_func(T) == maybe2(sym_name, pair(list(T), maybe(T))). :- type maybe_item_and_context == maybe2(item, prog_context). :- type var2tvar == map(var, tvar). :- type var2pvar == map(var, prog_var). :- type parser(T) == pred(term, maybe1(T)). :- mode parser :: pred(in, out) is det. :- pred add_context(maybe1(item), prog_context, maybe_item_and_context). :- mode add_context(in, in, out) is det. % % Various predicates to parse small bits of syntax. % These predicates simply fail if they encounter a syntax error. % :- pred parse_list_of_vars(term(T), list(var(T))). :- mode parse_list_of_vars(in, out) is semidet. % Parse a list of quantified variables, splitting it into % state variables and ordinary logic variables, respectively. % :- pred parse_quantifier_vars(term(T), list(var(T)), list(var(T))). :- mode parse_quantifier_vars(in, out, out) is semidet. :- pred parse_name_and_arity(module_name, term(_T), sym_name, arity). :- mode parse_name_and_arity(in, in, out, out) is semidet. :- pred parse_name_and_arity(term(_T), sym_name, arity). :- mode parse_name_and_arity(in, out, out) is semidet. :- pred parse_pred_or_func_name_and_arity(module_name, term(_T), pred_or_func, sym_name, arity). :- mode parse_pred_or_func_name_and_arity(in, in, out, out, out) is semidet. :- pred parse_pred_or_func_name_and_arity(term(_T), pred_or_func, sym_name, arity). :- mode parse_pred_or_func_name_and_arity(in, out, out, out) is semidet. :- pred parse_pred_or_func_and_args(maybe(module_name), term(_T), term(_T), string, maybe_pred_or_func(term(_T))). :- mode parse_pred_or_func_and_args(in, in, in, in, out) is det. :- pred parse_pred_or_func_and_args(term(_T), pred_or_func, sym_name, list(term(_T))). :- mode parse_pred_or_func_and_args(in, out, out, out) is semidet. :- pred convert_type(term(T), type). :- mode convert_type(in, out) is det. :- type allow_constrained_inst_var ---> allow_constrained_inst_var ; no_allow_constrained_inst_var. :- pred convert_mode_list(allow_constrained_inst_var, list(term), list(mode)). :- mode convert_mode_list(in, in, out) is semidet. :- pred convert_mode(allow_constrained_inst_var, term, mode). :- mode convert_mode(in, in, out) is semidet. :- pred convert_inst_list(allow_constrained_inst_var, list(term), list(inst)). :- mode convert_inst_list(in, in, out) is semidet. :- pred convert_inst(allow_constrained_inst_var, term, inst). :- mode convert_inst(in, in, out) is semidet. :- pred standard_det(string, determinism). :- mode standard_det(in, out) is semidet. % convert a "disjunction" (bunch of terms separated by ';'s) to a list :- pred disjunction_to_list(term(T), list(term(T))). :- mode disjunction_to_list(in, out) is det. % convert a "conjunction" (bunch of terms separated by ','s) to a list :- pred conjunction_to_list(term(T), list(term(T))). :- mode conjunction_to_list(in, out) is det. % list_to_conjunction(Context, First, Rest, Term). % convert a list to a "conjunction" (bunch of terms separated by ','s) :- pred list_to_conjunction(prog_context, term(T), list(term(T)), term(T)). :- mode list_to_conjunction(in, in, in, out) is det. % convert a "sum" (bunch of terms separated by '+' operators) to a list :- pred sum_to_list(term(T), list(term(T))). :- mode sum_to_list(in, out) is det. % Parse a comma-separated list (misleading described as % a "conjunction") of things. :- pred parse_list(parser(T), term, maybe1(list(T))). :- mode parse_list(parser, in, out) is det. :- pred map_parser(parser(T), list(term), maybe1(list(T))). :- mode map_parser(parser, in, out) is det. % The following /3, /4 and /5 predicates are to be used for reporting % warnings to stderr. This is preferable to using io__write_string, as % this checks the halt-at-warn option. % % This predicate is best used by predicates that do not have access to % module_info for a particular module. It sets the exit status to error % when a warning is encountered in a module, and the --halt-at-warn % option is set. :- pred report_warning(string::in, io__state::di, io__state::uo) is det. :- pred report_warning(io__output_stream::in, string::in, io__state::di, io__state::uo) is det. :- pred report_warning(string::in, int::in, string::in, io__state::di, io__state::uo) is det. %-----------------------------------------------------------------------------% :- implementation. % XXX we should not need to import hlds*.m here. % But currently we need to import hlds_data.m for the `cons_id' type % that is used in insts. :- import_module hlds__hlds_data. :- import_module libs__globals. :- import_module libs__options. :- import_module parse_tree__prog_io. :- import_module parse_tree__prog_io_goal. :- import_module parse_tree__prog_util. :- import_module bool, string, std_util, term, set. add_context(error(M, T), _, error(M, T)). add_context(ok(Item), Context, ok(Item, Context)). parse_name_and_arity(ModuleName, PredAndArityTerm, SymName, Arity) :- PredAndArityTerm = term__functor(term__atom("/"), [PredNameTerm, ArityTerm], _), parse_implicitly_qualified_term(ModuleName, PredNameTerm, PredNameTerm, "", ok(SymName, [])), ArityTerm = term__functor(term__integer(Arity), [], _). parse_name_and_arity(PredAndArityTerm, SymName, Arity) :- parse_name_and_arity(unqualified(""), PredAndArityTerm, SymName, Arity). parse_pred_or_func_name_and_arity(ModuleName, PorFPredAndArityTerm, PredOrFunc, SymName, Arity) :- PorFPredAndArityTerm = term__functor(term__atom(PredOrFuncStr), Args, _), ( PredOrFuncStr = "pred", PredOrFunc = predicate ; PredOrFuncStr = "func", PredOrFunc = function ), Args = [Arg], parse_name_and_arity(ModuleName, Arg, SymName, Arity). parse_pred_or_func_name_and_arity(PorFPredAndArityTerm, PredOrFunc, SymName, Arity) :- parse_pred_or_func_name_and_arity(unqualified(""), PorFPredAndArityTerm, PredOrFunc, SymName, Arity). parse_pred_or_func_and_args(Term, PredOrFunc, SymName, ArgTerms) :- parse_pred_or_func_and_args(no, Term, Term, "", ok(SymName, ArgTerms0 - MaybeRetTerm)), ( MaybeRetTerm = yes(RetTerm), PredOrFunc = function, list__append(ArgTerms0, [RetTerm], ArgTerms) ; MaybeRetTerm = no, PredOrFunc = predicate, ArgTerms = ArgTerms0 ). parse_pred_or_func_and_args(MaybeModuleName, PredAndArgsTerm, ErrorTerm, Msg, PredAndArgsResult) :- ( PredAndArgsTerm = term__functor(term__atom("="), [FuncAndArgsTerm, FuncResultTerm], _) -> FunctorTerm = FuncAndArgsTerm, MaybeFuncResult = yes(FuncResultTerm) ; FunctorTerm = PredAndArgsTerm, MaybeFuncResult = no ), ( MaybeModuleName = yes(ModuleName), parse_implicitly_qualified_term(ModuleName, FunctorTerm, ErrorTerm, Msg, Result) ; MaybeModuleName = no, parse_qualified_term(FunctorTerm, ErrorTerm, Msg, Result) ), ( Result = ok(SymName, Args), PredAndArgsResult = ok(SymName, Args - MaybeFuncResult) ; Result = error(ErrorMsg, Term), PredAndArgsResult = error(ErrorMsg, Term) ). parse_list_of_vars(term__functor(term__atom("[]"), [], _), []). parse_list_of_vars(term__functor(term__atom("[|]"), [Head, Tail], _), [V|Vs]) :- Head = term__variable(V), parse_list_of_vars(Tail, Vs). convert_type(T0, T) :- term__coerce(strip_prog_context(T0), T). % Strip out the prog_context fields, replacing them with empty % prog_context (as obtained by term__context_init/1) % in a type or list of types. % % This is necessary to allow maps indexed by class constraints. % Also, the version number computation for smart recompilation % relies on being able to unify program items, which won't % work if the types in the items contain context information. :- func strip_prog_context(term(T)) = term(T). strip_prog_context(term__variable(V)) = term__variable(V). strip_prog_context(term__functor(F, As, _)) = term__functor(F, list__map(strip_prog_context, As), term__context_init). convert_mode_list(_, [], []). convert_mode_list(AllowConstrainedInstVar, [H0|T0], [H|T]) :- convert_mode(AllowConstrainedInstVar, H0, H), convert_mode_list(AllowConstrainedInstVar, T0, T). % % The new operator for mode declarations is >>. % Previously we used ->, but this required a high-precedence % operator such as :: for the :- mode delcaration. % % Using >> allows us to use == for the :- mode declaration. % % Eventually we can stop supporting :: and -> in :- mode % declarations altogether. % convert_mode(AllowConstrainedInstVar, Term, Mode) :- ( ( Term = term__functor(term__atom(">>"), [InstA, InstB], _) ; Term = term__functor(term__atom("->"), [InstA, InstB], _) ) -> convert_inst(AllowConstrainedInstVar, InstA, ConvertedInstA), convert_inst(AllowConstrainedInstVar, InstB, ConvertedInstB), Mode = (ConvertedInstA -> ConvertedInstB) ; % Handle higher-order predicate modes: % a mode of the form % pred(, , ...) is % is an abbreviation for the inst mapping % ( pred(, , ...) is % -> pred(, , ...) is % ) Term = term__functor(term__atom("is"), [PredTerm, DetTerm], _), PredTerm = term__functor(term__atom("pred"), ArgModesTerms, _) -> DetTerm = term__functor(term__atom(DetString), [], _), standard_det(DetString, Detism), convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes), PredInstInfo = pred_inst_info(predicate, ArgModes, Detism), Inst = ground(shared, higher_order(PredInstInfo)), Mode = (Inst -> Inst) ; % Handle higher-order function modes: % a mode of the form % func(, , ...) = is % is an abbreviation for the inst mapping % ( func(, , ...) = is % -> func(, , ...) = is % ) Term = term__functor(term__atom("is"), [EqTerm, DetTerm], _), EqTerm = term__functor(term__atom("="), [FuncTerm, RetModeTerm], _), FuncTerm = term__functor(term__atom("func"), ArgModesTerms, _) -> DetTerm = term__functor(term__atom(DetString), [], _), standard_det(DetString, Detism), convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes0), convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode), list__append(ArgModes0, [RetMode], ArgModes), FuncInstInfo = pred_inst_info(function, ArgModes, Detism), Inst = ground(shared, higher_order(FuncInstInfo)), Mode = (Inst -> Inst) ; parse_qualified_term(Term, Term, "mode definition", R), R = ok(Name, Args), % should improve error reporting convert_inst_list(AllowConstrainedInstVar, Args, ConvertedArgs), Mode = user_defined_mode(Name, ConvertedArgs) ). convert_inst_list(_, [], []). convert_inst_list(AllowConstrainedInstVar, [H0|T0], [H|T]) :- convert_inst(AllowConstrainedInstVar, H0, H), convert_inst_list(AllowConstrainedInstVar, T0, T). convert_inst(_, term__variable(V0), inst_var(V)) :- term__coerce_var(V0, V). convert_inst(AllowConstrainedInstVar, Term, Result) :- Term = term__functor(term__atom(Name), Args0, _Context), ( convert_simple_builtin_inst(Name, Args0, Result0) -> Result = Result0 ; % The syntax for a higher-order pred inst is % % pred(, , ...) is % % where , , ... are a list of modes, % and is a determinism. Name = "is", Args0 = [PredTerm, DetTerm], PredTerm = term__functor(term__atom("pred"), ArgModesTerm, _) -> DetTerm = term__functor(term__atom(DetString), [], _), standard_det(DetString, Detism), convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes), PredInst = pred_inst_info(predicate, ArgModes, Detism), Result = ground(shared, higher_order(PredInst)) ; % The syntax for a higher-order func inst is % % func(, , ...) = is % % where , , ... are a list of modes, % is a mode, and is a determinism. Name = "is", Args0 = [EqTerm, DetTerm], EqTerm = term__functor(term__atom("="), [FuncTerm, RetModeTerm], _), FuncTerm = term__functor(term__atom("func"), ArgModesTerm, _) -> DetTerm = term__functor(term__atom(DetString), [], _), standard_det(DetString, Detism), convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes0), convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode), list__append(ArgModes0, [RetMode], ArgModes), FuncInst = pred_inst_info(function, ArgModes, Detism), Result = ground(shared, higher_order(FuncInst)) % `bound' insts ; Name = "bound", Args0 = [Disj] -> parse_bound_inst_list(AllowConstrainedInstVar, Disj, shared, Result) /* `bound_unique' is for backwards compatibility - use `unique' instead */ ; Name = "bound_unique", Args0 = [Disj] -> parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique, Result) ; Name = "unique", Args0 = [Disj] -> parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique, Result) ; Name = "mostly_unique", Args0 = [Disj] -> parse_bound_inst_list(AllowConstrainedInstVar, Disj, mostly_unique, Result) ; Name = "=<", Args0 = [VarTerm, InstTerm] -> AllowConstrainedInstVar = allow_constrained_inst_var, VarTerm = term__variable(Var), % Do not allow nested constrained_inst_vars. convert_inst(no_allow_constrained_inst_var, InstTerm, Inst), Result = constrained_inst_vars(set__make_singleton_set( term__coerce_var(Var)), Inst) % anything else must be a user-defined inst ; parse_qualified_term(Term, Term, "inst", ok(QualifiedName, Args1)), ( mercury_public_builtin_module(BuiltinModule), sym_name_get_module_name(QualifiedName, unqualified(""), BuiltinModule), % If the term is qualified with the `builtin' module % then it may be one of the simple builtin insts. % We call convert_inst recursively to check for this. unqualify_name(QualifiedName, UnqualifiedName), convert_simple_builtin_inst(UnqualifiedName, Args1, Result0), % However, if the inst is a user_inst defined inside % the `builtin' module then we need to make sure it is % properly module-qualified. Result0 \= defined_inst(user_inst(_, _)) -> Result = Result0 ; convert_inst_list(AllowConstrainedInstVar, Args1, Args), Result = defined_inst(user_inst(QualifiedName, Args)) ) ). % A "simple" builtin inst is one that has no arguments and no special % syntax. :- pred convert_simple_builtin_inst(string, list(term), inst). :- mode convert_simple_builtin_inst(in, in, out) is semidet. convert_simple_builtin_inst(Name, [], Inst) :- convert_simple_builtin_inst_2(Name, Inst). :- pred convert_simple_builtin_inst_2(string, inst). :- mode convert_simple_builtin_inst_2(in, out) is semidet. % `free' insts convert_simple_builtin_inst_2("free", free). % `any' insts convert_simple_builtin_inst_2("any", any(shared)). convert_simple_builtin_inst_2("unique_any", any(unique)). convert_simple_builtin_inst_2("mostly_unique_any", any(mostly_unique)). convert_simple_builtin_inst_2("clobbered_any", any(clobbered)). convert_simple_builtin_inst_2("mostly_clobbered_any", any(mostly_clobbered)). % `ground' insts convert_simple_builtin_inst_2("ground", ground(shared, none)). convert_simple_builtin_inst_2("unique", ground(unique, none)). convert_simple_builtin_inst_2("mostly_unique", ground(mostly_unique, none)). convert_simple_builtin_inst_2("clobbered", ground(clobbered, none)). convert_simple_builtin_inst_2("mostly_clobbered", ground(mostly_clobbered, none)). % `not_reached' inst convert_simple_builtin_inst_2("not_reached", not_reached). standard_det("det", det). standard_det("cc_nondet", cc_nondet). standard_det("cc_multi", cc_multidet). standard_det("nondet", nondet). standard_det("multi", multidet). standard_det("multidet", multidet). standard_det("semidet", semidet). standard_det("erroneous", erroneous). standard_det("failure", failure). :- pred parse_bound_inst_list(allow_constrained_inst_var::in, term::in, uniqueness::in, (inst)::out) is semidet. parse_bound_inst_list(AllowConstrainedInstVar, Disj, Uniqueness, bound(Uniqueness, Functors)) :- disjunction_to_list(Disj, List), convert_bound_inst_list(AllowConstrainedInstVar, List, Functors0), list__sort(Functors0, Functors), % check that the list doesn't specify the same functor twice \+ ( list__append(_, SubList, Functors), SubList = [F1, F2 | _], F1 = functor(ConsId, _), F2 = functor(ConsId, _) ). :- pred convert_bound_inst_list(allow_constrained_inst_var, list(term), list(bound_inst)). :- mode convert_bound_inst_list(in, in, out) is semidet. convert_bound_inst_list(_, [], []). convert_bound_inst_list(AllowConstrainedInstVar, [H0|T0], [H|T]) :- convert_bound_inst(AllowConstrainedInstVar, H0, H), convert_bound_inst_list(AllowConstrainedInstVar, T0, T). :- pred convert_bound_inst(allow_constrained_inst_var, term, bound_inst). :- mode convert_bound_inst(in, in, out) is semidet. convert_bound_inst(AllowConstrainedInstVar, InstTerm, functor(ConsId, Args)) :- InstTerm = term__functor(Functor, Args0, _), ( Functor = term__atom(_) -> parse_qualified_term(InstTerm, InstTerm, "inst", ok(SymName, Args1)), list__length(Args1, Arity), ConsId = cons(SymName, Arity) ; Args1 = Args0, list__length(Args1, Arity), make_functor_cons_id(Functor, Arity, ConsId) ), convert_inst_list(AllowConstrainedInstVar, Args1, Args). disjunction_to_list(Term, List) :- binop_term_to_list(";", Term, List). conjunction_to_list(Term, List) :- binop_term_to_list(",", Term, List). list_to_conjunction(_, Term, [], Term). list_to_conjunction(Context, First, [Second | Rest], Term) :- list_to_conjunction(Context, Second, Rest, Tail), Term = term__functor(term__atom(","), [First, Tail], Context). sum_to_list(Term, List) :- binop_term_to_list("+", Term, List). % general predicate to convert terms separated by any specified % operator into a list :- pred binop_term_to_list(string, term(T), list(term(T))). :- mode binop_term_to_list(in, in, out) is det. binop_term_to_list(Op, Term, List) :- binop_term_to_list_2(Op, Term, [], List). :- pred binop_term_to_list_2(string, term(T), list(term(T)), list(term(T))). :- mode binop_term_to_list_2(in, in, in, out) is det. binop_term_to_list_2(Op, Term, List0, List) :- ( Term = term__functor(term__atom(Op), [L, R], _Context) -> binop_term_to_list_2(Op, R, List0, List1), binop_term_to_list_2(Op, L, List1, List) ; List = [Term|List0] ). parse_list(Parser, Term, Result) :- conjunction_to_list(Term, List), map_parser(Parser, List, Result). map_parser(_, [], ok([])). map_parser(Parser, [X|Xs], Result) :- call(Parser, X, X_Result), map_parser(Parser, Xs, Xs_Result), combine_list_results(X_Result, Xs_Result, Result). % If a list of things contains multiple errors, then we only % report the first one. :- pred combine_list_results(maybe1(T), maybe1(list(T)), maybe1(list(T))). :- mode combine_list_results(in, in, out) is det. combine_list_results(error(Msg, Term), _, error(Msg, Term)). combine_list_results(ok(_), error(Msg, Term), error(Msg, Term)). combine_list_results(ok(X), ok(Xs), ok([X|Xs])). %-----------------------------------------------------------------------------% report_warning(Message) --> globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn), ( { HaltAtWarn = yes } -> io__set_exit_status(1) ; [] ), io__write_string(Message). report_warning(Stream, Message) --> globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn), ( { HaltAtWarn = yes } -> io__set_exit_status(1) ; [] ), io__write_string(Stream, Message). report_warning(FileName, LineNum, Message) --> { string__format("%s:%3d: Warning: %s\n", [s(FileName), i(LineNum), s(Message)], FullMessage) }, io__write_string(FullMessage), globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn), ( { HaltAtWarn = yes } -> io__set_exit_status(1) ; [] ). %------------------------------------------------------------------------------% parse_quantifier_vars(functor(atom("[]"), [], _), [], []). parse_quantifier_vars(functor(atom("[|]"), [H, T], _), SVs, Vs) :- ( H = functor(atom("!"), [variable(SV)], _), SVs = [SV | SVs0], parse_quantifier_vars(T, SVs0, Vs) ; H = variable(V), Vs = [V | Vs0], parse_quantifier_vars(T, SVs, Vs0) ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------%