[m-rev.] for review: more changes to moose
Julien Fischer
juliensf at students.cs.mu.OZ.AU
Tue Jul 15 19:10:45 AEST 2003
Estimated hours taken: 5.
Branches: main.
This change doesn't alter any functionality. It just cleans up some
notation and (hopefully) makes the code a little easier to understand.
The changes are:
- Remove instances of `:' as a module qualifier.
- Add more module qualifiers.
- Use state variables for threading the IO state.
- Use state variables for accumulators.
- Remove some unused predicates.
extras/moose/check.m:
extras/moose/lalr.m:
extras/moose/mercury_syntax.m:
extras/moose/moose.m:
extras/moose/options.m:
extras/moose/tables.m:
Make changes as listed above.
extras/moose/grammar.m:
Replace calls to predicate grammar.foldl/4 with calls to
function array.foldl/3 from standard library. Delete grammar.foldl/4.
Other changes as above.
extras/moose/misc.m:
Remove predicate between/3 since it isn't used anywhere.
Other changes as above.
Index: check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/check.m,v
retrieving revision 1.2
diff -u -r1.2 check.m
--- check.m 9 Jul 2003 07:43:38 -0000 1.2
+++ check.m 15 Jul 2003 08:34:11 -0000
@@ -28,23 +28,23 @@
:- import_module grammar.
:- import_module io, list, string, term.
-:- type check:error
+:- type check__error
---> error(list(string), context).
-:- pred check_rule_decls(list(rule_decl), rule_decls, list(check:error)).
+:- pred check_rule_decls(list(rule_decl), rule_decls, list(check__error)).
:- mode check_rule_decls(in, out, out) is det.
-:- pred check_clauses(list(clause), rule_decls, clauses, list(check:error)).
+:- pred check_clauses(list(clause), rule_decls, clauses, list(check__error)).
:- mode check_clauses(in, in, out, out) is det.
-:- pred check_useless(nonterminal, clauses, rule_decls, list(check:error)).
+:- pred check_useless(nonterminal, clauses, rule_decls, list(check__error)).
:- mode check_useless(in, in, in, out) is det.
-:- pred check_inf_derivations(clauses, rule_decls, list(check:error)).
+:- pred check_inf_derivations(clauses, rule_decls, list(check__error)).
:- mode check_inf_derivations(in, in, out) is det.
% write an error message to stderr.
-:- pred write_error(check:error, io__state, io__state).
+:- pred write_error(check__error, io__state, io__state).
:- mode write_error(in, di, uo) is det.
:- implementation.
@@ -59,27 +59,27 @@
check_rule_decls(DeclList, Decls0, Decls, Errors).
:- pred check_rule_decls(list(rule_decl), rule_decls, rule_decls,
- list(check:error)).
+ list(check__error)).
:- mode check_rule_decls(in, in, out, out) is det.
-check_rule_decls([], Decls, Decls, []).
-check_rule_decls([Decl|DeclList], Decls0, Decls, Errors) :-
+check_rule_decls([], !Decls, []).
+check_rule_decls([Decl | DeclList], !Decls, Errors) :-
Decl = rule(DeclId, _Args, _VarSet, DeclContext),
% Look to see if we already have a declaration for this rule.
- ( search(Decls0, DeclId, PrevDecl) ->
+ ( map__search(!.Decls, DeclId, PrevDecl) ->
PrevDecl = rule(_, _, _, PrevDeclContext),
id(DeclId, Name, Arity),
- format("The previous declaration for %s/%d is here.",
+ string__format("The previous declaration for %s/%d is here.",
[s(Name), i(Arity)], Msg0),
Err0 = error([Msg0], PrevDeclContext),
- format("Duplicate declaration for %s/%d.",
+ string__format("Duplicate declaration for %s/%d.",
[s(Name), i(Arity)], Msg1),
Err1 = error([Msg1], DeclContext),
- Errors = [Err0, Err1|Errors0],
- check_rule_decls(DeclList, Decls0, Decls, Errors0)
+ Errors = [Err0, Err1 | Errors0],
+ check_rule_decls(DeclList, !Decls, Errors0)
;
- set(Decls0, DeclId, Decl, Decls1),
- check_rule_decls(DeclList, Decls1, Decls, Errors)
+ map__set(!.Decls, DeclId, Decl, !:Decls),
+ check_rule_decls(DeclList, !Decls, Errors)
).
%------------------------------------------------------------------------------%
@@ -88,20 +88,20 @@
init(Clauses0),
check_clauses0(ClauseList, Decls, Clauses0, Clauses, Errors0),
- keys(Decls, DeclIds),
+ map__keys(Decls, DeclIds),
set__sorted_list_to_set(DeclIds, DeclSet),
- keys(Clauses, ClauseIds),
+ map__keys(Clauses, ClauseIds),
set__sorted_list_to_set(ClauseIds, ClauseSet),
NoDeclSet = ClauseSet - DeclSet,
NoClauseSet = DeclSet - ClauseSet,
% Productions that have no rule declaration.
set__to_sorted_list(NoDeclSet, NoDeclList),
- map((pred(NoDeclId::in, NoDeclError::out) is det :-
- lookup(Clauses, NoDeclId, List),
+ list__map((pred(NoDeclId::in, NoDeclError::out) is det :-
+ map__lookup(Clauses, NoDeclId, List),
( List = [clause(_, _, _, NoDeclContext)|_] ->
id(NoDeclId, NoDeclName, NoDeclArity),
- format("No rule declaration for %s/%d.",
+ string__format("No rule declaration for %s/%d.",
[s(NoDeclName), i(NoDeclArity)], NoDeclMsg),
NoDeclError = error([NoDeclMsg], NoDeclContext)
;
@@ -111,31 +111,31 @@
% Rules that have no productions.
set__to_sorted_list(NoClauseSet, NoClauseList),
- map((pred(NoClauseId::in, NoClauseError::out) is det :-
- lookup(Decls, NoClauseId, Decl),
+ list__map((pred(NoClauseId::in, NoClauseError::out) is det :-
+ map__lookup(Decls, NoClauseId, Decl),
Decl = rule(_, _, _, NoClauseContext),
id(NoClauseId, NoClauseName, NoClauseArity),
- format("No productions for %s/%d.",
+ string__format("No productions for %s/%d.",
[s(NoClauseName), i(NoClauseArity)], NoClauseMsg),
NoClauseError = error([NoClauseMsg], NoClauseContext)
), NoClauseList, Errors2),
- condense([Errors0, Errors1, Errors2], Errors).
+ list__condense([Errors0, Errors1, Errors2], Errors).
:- pred check_clauses0(list(clause), rule_decls, clauses, clauses,
- list(check:error)).
+ list(check__error)).
:- mode check_clauses0(in, in, in, out, out) is det.
-check_clauses0([], _Decls, Clauses, Clauses, []).
-check_clauses0([Clause|ClauseList], Decls, Clauses0, Clauses, Errors) :-
+check_clauses0([], _Decls, !Clauses, []).
+check_clauses0([Clause | ClauseList], Decls, !Clauses, Errors) :-
Clause = clause(Head, Prod, _, Context),
Id = nonterminal(Head),
- ( map__search(Clauses0, Id, ClauseList0) ->
- append(ClauseList0, [Clause], ClauseList1)
+ ( map__search(!.Clauses, Id, ClauseList0) ->
+ list__append(ClauseList0, [Clause], ClauseList1)
;
ClauseList1 = [Clause]
),
- set(Clauses0, Id, ClauseList1, Clauses1),
+ map__set(!.Clauses, Id, ClauseList1, !:Clauses),
% Look for used nonterminals that are not declared.
solutions((pred(NonTermId::out) is nondet :-
@@ -147,19 +147,20 @@
list__map((pred(UnDeclaredId::in, UnDeclaredError::out) is det :-
id(Id, CN, CA),
id(UnDeclaredId, NN, NA),
- format("In production for %s/%d,", [s(CN), i(CA)], Msg0),
- format(" the nonterminal %s/%d is undeclared.",
+ string__format("In production for %s/%d,",
+ [s(CN), i(CA)], Msg0),
+ string__format(" the nonterminal %s/%d is undeclared.",
[s(NN), i(NA)], Msg1),
UnDeclaredError = error([Msg0, Msg1], Context)
), UnDeclaredIds, Errors0),
(
Errors0 = [],
- check_clauses0(ClauseList, Decls, Clauses1, Clauses, Errors)
+ check_clauses0(ClauseList, Decls, !Clauses, Errors)
;
% Not tail recursive, so only do it if we have to.
Errors0 = [_|_],
- check_clauses0(ClauseList, Decls, Clauses1, Clauses, Errors1),
- append(Errors0, Errors1, Errors)
+ check_clauses0(ClauseList, Decls, !Clauses, Errors1),
+ list__append(Errors0, Errors1, Errors)
).
%------------------------------------------------------------------------------%
@@ -171,14 +172,14 @@
set__sorted_list_to_set(AllIds, AllSet),
UselessSet = AllSet - UsefulSet,
set__to_sorted_list(UselessSet, UselessList),
- filter_map((pred(UselessId::in, Error::out) is semidet :-
+ list__filter_map((pred(UselessId::in, Error::out) is semidet :-
% Use search rather than lookup in case
% it was an undeclared rule.
- search(Decls, UselessId, Decl),
+ map__search(Decls, UselessId, Decl),
Decl = rule(_Id, _Args, _VarSet, Context),
UselessId = Name / Arity,
- format("Grammar rule %s/%d is not used.", [s(Name), i(Arity)],
- Msg),
+ string__format("Grammar rule %s/%d is not used.",
+ [s(Name), i(Arity)], Msg),
Error = error([Msg], Context)
), UselessList, Errors).
@@ -187,9 +188,9 @@
:- pred useful(set(nonterminal), clauses, set(nonterminal), set(nonterminal)).
:- mode useful(in, in, in, out) is det.
-useful(New0, Clauses, Useful0, Useful) :-
+useful(New0, Clauses, !Useful) :-
( set__empty(New0) ->
- Useful = Useful0
+ true
;
solutions_set((pred(UId::out) is nondet :-
set__member(Id, New0),
@@ -198,9 +199,9 @@
Clause = clause(_Head, Prod, _VarSet, _Context),
nonterminal(UId, Prod)
), NewSet),
- New1 = NewSet - Useful0,
- Useful1 = New1 \/ Useful0,
- useful(New1, Clauses, Useful1, Useful)
+ New1 = NewSet - !.Useful,
+ !:Useful = New1 \/ !.Useful,
+ useful(New1, Clauses, !Useful)
).
:- pred nonterminal(nonterminal, prod).
@@ -225,16 +226,16 @@
check_inf_derivations(Clauses, Decls, Errors) :-
map__keys(Clauses, AllIds),
set__sorted_list_to_set(AllIds, InfSet0),
- init(FinSet0),
+ set__init(FinSet0),
finite(InfSet0, FinSet0, Clauses, InfSet),
set__to_sorted_list(InfSet, InfList),
- filter_map((pred(InfId::in, Error::out) is semidet :-
+ list__filter_map((pred(InfId::in, Error::out) is semidet :-
% Use search rather than lookup in case
% it was an undeclared rule.
- search(Decls, InfId, Decl),
+ map__search(Decls, InfId, Decl),
Decl = rule(_Id, _Args, _VarSet, Context),
InfId = Name / Arity,
- format("Rule %s/%d does not have any finite derivations.",
+ string__format("Rule %s/%d does not have any finite derivations.",
[s(Name), i(Arity)], Msg),
Error = error([Msg], Context)
), InfList, Errors).
@@ -242,9 +243,9 @@
:- pred finite(set(nonterminal), set(nonterminal), clauses, set(nonterminal)).
:- mode finite(in, in, in, out) is det.
-finite(Inf0, Fin0, Clauses, Inf) :-
+finite(!.Inf, Fin0, Clauses, !:Inf) :-
solutions_set((pred(NewFinId::out) is nondet :-
- set__member(NewFinId, Inf0),
+ set__member(NewFinId, !.Inf),
% search rather than lookup in case the nonterminal
% doesn't have any clauses. This may lead to
% spurious infinite derivations.
@@ -257,17 +258,18 @@
;
NonTerms = [_|_],
all [NId] (
- list__member(NId, NonTerms) => set__member(NId, Fin0)
+ list__member(NId, NonTerms) =>
+ set__member(NId, Fin0)
)
)
), NewFinSet),
NewFin = NewFinSet - Fin0,
( set__empty(NewFin) ->
- Inf = Inf0
+ true
;
- Inf1 = Inf0 - NewFin,
- Fin1 = Fin0 \/ NewFin,
- finite(Inf1, Fin1, Clauses, Inf)
+ !:Inf = !.Inf - NewFin,
+ Fin = Fin0 \/ NewFin,
+ finite(!.Inf, Fin, Clauses, !:Inf)
).
:- pred nonterminals(prod, list(nonterminal)).
@@ -297,15 +299,15 @@
%------------------------------------------------------------------------------%
-write_error(error(MsgLines, Context)) -->
- { Context = context(File, Line) },
- { format("%s:%d: ", [s(File), i(Line)], ContextMsg) },
- stderr_stream(StdErr),
- foldl((pred(Msg::in, di, uo) is det -->
- write_string(StdErr, ContextMsg),
- write_string(StdErr, Msg),
- nl(StdErr)
- ), MsgLines).
+write_error(error(MsgLines, Context), !IO) :-
+ Context = term__context(File, Line),
+ string__format("%s:%d: ", [s(File), i(Line)], ContextMsg),
+ io__stderr_stream(StdErr, !IO),
+ list__foldl((pred(Msg::in, !.IO::di, !:IO::uo) is det :-
+ io__write_string(StdErr, ContextMsg, !IO),
+ io__write_string(StdErr, Msg, !IO),
+ io__nl(StdErr, !IO)
+ ), MsgLines, !IO).
%------------------------------------------------------------------------------%
Index: grammar.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/grammar.m,v
retrieving revision 1.6
diff -u -r1.6 grammar.m
--- grammar.m 9 Jul 2003 07:43:38 -0000 1.6
+++ grammar.m 15 Jul 2003 07:56:39 -0000
@@ -50,8 +50,7 @@
; ( prod , prod )
; { prod ; prod }
; action(term)
- ; [] % epsilon
- .
+ ; []. % epsilon
:- type name == string.
:- type arity == int.
@@ -60,27 +59,23 @@
---> epsilon % epsilon isn't really a terminal, but it avoids the
% need for wrappers in the FIRST(alpha) situations.
; (name / arity)
- ; ($) % the special end-of-input symbol
- ; (*) % the dummy symbol used for lookahead computation.
- .
+ ; ($) % the special end-of-input symbol
+ ; (*). % the dummy symbol used for lookahead computation.
:- type nonterminal
---> start % S' - the distinguished start symbol. Will always
% correspond to prodnum == 0.
- ; (name / arity)
- .
+ ; (name / arity).
:- type symbol
---> terminal(terminal)
- ; nonterminal(nonterminal)
- .
+ ; nonterminal(nonterminal).
:- type symbols == array(symbol).
:- type bodyterm
---> terminal(term)
- ; nonterminal(term)
- .
+ ; nonterminal(term).
:- type rule_decls == map(nonterminal, rule_decl).
@@ -122,8 +117,7 @@
:- type action
---> accept
; shift(int)
- ; reduce(int)
- .
+ ; reduce(int).
:- type actiontable == (state -> terminal -> action).
@@ -185,7 +179,8 @@
; Atom = atom("{}"), Args = [Goal] ->
Prod = action(Goal)
; Atom = atom("{}"), Args = [Goal | Goals] ->
- foldl((pred(G::in, Left::in, (Left, action(G))::out) is det),
+ list__foldl(
+ (pred(G::in, Left::in, (Left, action(G))::out) is det),
Goals, action(Goal), Prod)
; Atom = atom("[]"), Args = [] ->
Prod = []
@@ -229,7 +224,7 @@
map__init(Follow0),
Grammar0 = grammar(Rules0, AllClauses, XForms, Nont0, ClauseIndex0,
First0, Follow0),
- list.foldl(transform_clause_list, ClauseList, Grammar0, Grammar1),
+ list__foldl(transform_clause_list, ClauseList, Grammar0, Grammar1),
compute_first0(Grammar1, Grammar2),
compute_follow0(Grammar2, Grammar3),
Grammar3 = grammar(Rules3, AllClauses3, XForms3, Nont3, ClauseIndex3,
@@ -256,9 +251,9 @@
),
varset__init(VarSet0),
varset__new_vars(VarSet0, Arity, Vars, VarSet1),
- foldl((pred(V::in, VS0::in, VS::out) is det :-
- var_to_int(V, I),
- format("V%d", [i(I)], N),
+ list__foldl((pred(V::in, VS0::in, VS::out) is det :-
+ term__var_to_int(V, I),
+ string__format("V%d", [i(I)], N),
varset__name_var(VS0, V, N, VS)
), Vars, VarSet1, VarSet),
term__var_list_to_term_list(Vars, Args),
@@ -274,24 +269,24 @@
grammar, grammar).
:- mode transform_clause_list(in, in, out) is det.
-transform_clause_list(Id - Clauses, Grammar0, Grammar) :-
- foldl(transform_clause(Id), Clauses, Grammar0, Grammar).
+transform_clause_list(Id - Clauses, !Grammar) :-
+ list__foldl(transform_clause(Id), Clauses, !Grammar).
:- pred transform_clause(nonterminal, clause, grammar, grammar).
:- mode transform_clause(in, in, in, out) is det.
-transform_clause(Id, Clause, Grammar0, Grammar) :-
+transform_clause(Id, Clause, !Grammar) :-
Clause = clause(Head, Prod, Varset, Context),
solutions(transform_prod(Prod), Bodies),
- foldl(add_rule(Id, Head, Varset, Context), Bodies, Grammar0, Grammar).
+ list__foldl(add_rule(Id, Head, Varset, Context), Bodies, !Grammar).
:- pred add_rule(nonterminal, term, varset, context,
- pair(list(bodyterm), list(term)), grammar, grammar).
+ pair(list(bodyterm), list(term)), grammar, grammar).
:- mode add_rule(in, in, in, in, in, in, out) is det.
-add_rule(Id, Head, Varset, Context, BodyTerms - Actions, Grammar0, Grammar) :-
- Grammar0 = grammar(Rules0, C, Xfs, Nont0, ClauseIndex0, F, L),
- map((pred(BodyTerm::in, BodyId::out) is det :-
+add_rule(Id, Head, Varset, Context, BodyTerms - Actions, !Grammar) :-
+ !.Grammar = grammar(Rules0, C, Xfs, Nont0, ClauseIndex0, F, L),
+ list__map((pred(BodyTerm::in, BodyId::out) is det :-
(
BodyTerm = terminal(Term),
( Term = functor(atom(Name), Args, _) ->
@@ -322,7 +317,7 @@
Prods = [Nont0]
),
map__set(ClauseIndex0, Id, Prods, ClauseIndex),
- Grammar = grammar(Rules, C, Xfs, Nont, ClauseIndex, F, L).
+ !:Grammar = grammar(Rules, C, Xfs, Nont, ClauseIndex, F, L).
:- pred transform_prod(prod, pair(list(bodyterm), list(term))).
:- mode transform_prod(in, out) is multi.
@@ -371,10 +366,10 @@
:- pred compute_first0(grammar, grammar).
:- mode compute_first0(in, out) is det.
-compute_first0(Grammar0, Grammar) :-
- Grammar0 = grammar(Rules, Clauses, Xfs, Nont, Index, _, Follow),
+compute_first0(!Grammar) :-
+ !.Grammar = grammar(Rules, Clauses, Xfs, Nont, Index, _, Follow),
compute_first(Rules, First),
- Grammar = grammar(Rules, Clauses, Xfs, Nont, Index, First, Follow).
+ !:Grammar = grammar(Rules, Clauses, Xfs, Nont, Index, First, Follow).
:- type first_stuff
---> stuff(
@@ -391,7 +386,7 @@
until((pred(Stuff1::in, Stuff3::out) is det :-
Stuff1 = stuff(_, N1, R1, F1),
Stuff2 = stuff(no, N1, R1, F1),
- foldl(compute_first, Rules, Stuff2, Stuff3)
+ map__foldl(compute_first, Rules, Stuff2, Stuff3)
),
(pred(StuffN::in) is semidet :-
StuffN = stuff(no, _, _, _)
@@ -491,9 +486,9 @@
:- mode collect_terminals(in, out) is det.
collect_terminals(Rules, Terminals) :-
- foldl((pred(_RN::in, Rule::in, Ts0::in, Ts::out) is det :-
+ map__foldl((pred(_RN::in, Rule::in, Ts0::in, Ts::out) is det :-
Rule = rule(_Id, _Head, Elems, _, _, _, _),
- foldl((pred(Elem::in, Ts1::in, Ts2::out) is det :-
+ Ts = array__foldl((func(Elem, Ts1) = Ts2 :-
(
Elem = terminal(Id),
Ts2 = [Id|Ts1]
@@ -501,7 +496,7 @@
Elem = nonterminal(_Id_),
Ts2 = Ts1
)
- ), Elems, Ts0, Ts)
+ ), Elems, Ts0)
), Rules, [], TerminalsList),
set__list_to_set(TerminalsList, Terminals).
@@ -509,33 +504,13 @@
:- mode collect_nonterminals(in, out) is det.
collect_nonterminals(Rules, Nonterminals) :-
- foldl((pred(_RN ::in, Rule::in, Ts0::in, Ts::out) is det :-
+ map__foldl((pred(_RN ::in, Rule::in, Ts0::in, Ts::out) is det :-
Rule = rule(Id, _Head, _Elems, _, _, _Varset, _Context),
Ts = [Id|Ts0]
), Rules, [], NonterminalsList),
set__list_to_set(NonterminalsList, Nonterminals0),
set__to_sorted_list(Nonterminals0, Nonterminals).
- % YYY This probably belongs in array.m
-:- pred foldl(pred(T, U, U), array(T), U, U).
-:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
-
-foldl(Closure, Array, Acc0, Acc) :-
- array__max(Array, Max),
- foldl(0, Max, Closure, Array, Acc0, Acc).
-
-:- pred foldl(int, int, pred(T, U, U), array(T), U, U).
-:- mode foldl(in, in, pred(in, in, out) is det, in, in, out) is det.
-
-foldl(I, IMax, Closure, Array, Acc0, Acc) :-
- ( I =< IMax ->
- lookup(Array, I, Elem),
- call(Closure, Elem, Acc0, Acc1),
- foldl(I + 1, IMax, Closure, Array, Acc1, Acc)
- ;
- Acc = Acc0
- ).
-
% YYY This probably belongs in the library somewhere.
:- pred while(pred(T), pred(T, T), T, T).
:- mode while(pred(in) is semidet, pred(in, out) is det, in, out) is det.
@@ -712,6 +687,6 @@
:- mode add_rule(in, in, in, out) is det.
add_rule(Rules0, Num, Rule, Rules) :-
- set(Rules0, Num, Rule, Rules).
+ map__set(Rules0, Num, Rule, Rules).
%------------------------------------------------------------------------------%
Index: lalr.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/lalr.m,v
retrieving revision 1.3
diff -u -r1.3 lalr.m
--- lalr.m 9 Jul 2003 07:43:38 -0000 1.3
+++ lalr.m 15 Jul 2003 08:32:47 -0000
@@ -65,50 +65,44 @@
:- pred reaching(list(prodnum), rules, first, bool, reaching, reaching).
:- mode reaching(in, in, in, in, in, out) is det.
-reaching([], _Productions, _First, no, Reaching, Reaching).
-reaching([], Productions, First, yes, Reaching0, Reaching) :-
+reaching([], _Productions, _First, no, !Reaching).
+reaching([], Productions, First, yes, !Reaching) :-
prodnums(Productions, ProdNums),
- reaching(ProdNums, Productions, First, no, Reaching0, Reaching).
-reaching([ProdNum|ProdNums], Productions, First, Ch0, Reaching0, Reaching) :-
- lookup(Productions, ProdNum, Prod),
+ reaching(ProdNums, Productions, First, no, !Reaching).
+reaching([ProdNum|ProdNums], Productions, First, !.Change, !Reaching) :-
+ map__lookup(Productions, ProdNum, Prod),
Prod = rule(NonTerminal, _Head, Symbols, _, _, _V, _C),
array__max(Symbols, PMax),
- reaching(0, PMax, Symbols, First, NonTerminal, Ch0, Ch1,
- Reaching0, Reaching1),
- reaching(ProdNums, Productions, First, Ch1, Reaching1, Reaching).
+ reaching(0, PMax, Symbols, First, NonTerminal, !Change, !Reaching),
+ reaching(ProdNums, Productions, First, !.Change, !Reaching).
:- pred reaching(int, int, symbols, first, nonterminal, bool, bool,
reaching, reaching).
:- mode reaching(in, in, in, in, in, in, out, in, out) is det.
-reaching(SN, Max, Symbols, First, C, Ch0, Ch, Reaching0, Reaching) :-
+reaching(SN, Max, Symbols, First, C, !Change, !Reaching) :-
( SN > Max ->
- Ch = Ch0,
- Reaching = Reaching0
+ true
;
array__lookup(Symbols, SN, Symbol),
(
- Symbol = terminal(_),
- Ch = Ch0,
- Reaching = Reaching0
+ Symbol = terminal(_)
;
Symbol = nonterminal(A),
- reaches(C, A, Ch0, Ch1, Reaching0, Reaching1),
- ( map__search(Reaching1, A, AR) ->
+ reaches(C, A, !Change, !Reaching),
+ ( map__search(!.Reaching, A, AR) ->
set__to_sorted_list(AR, ARList),
- list__foldl2(reaches(C), ARList, Ch1, Ch2,
- Reaching1, Reaching2)
+ list__foldl2(reaches(C), ARList, !Change,
+ !Reaching)
;
- Ch2 = Ch1,
- Reaching2 = Reaching1
+ true
),
map__lookup(First, A, FirstA),
( set__member(epsilon, FirstA) ->
- reaching(SN + 1, Max, Symbols, First, C,
- Ch2, Ch, Reaching2, Reaching)
+ reaching(SN + 1, Max, Symbols, First, C,
+ !Change, !Reaching)
;
- Ch = Ch2,
- Reaching2 = Reaching
+ true
)
)
).
@@ -116,20 +110,19 @@
:- pred reaches(nonterminal, nonterminal, bool, bool, reaching, reaching).
:- mode reaches(in, in, in, out, in, out) is det.
-reaches(C, A, Ch0, Ch, Reaching0, Reaching) :-
- ( map__search(Reaching0, C, As0) ->
+reaches(C, A, !Change, !Reaching) :-
+ ( map__search(!.Reaching, C, As0) ->
( set__member(A, As0) ->
- Ch = Ch0,
- Reaching = Reaching0
+ true
;
- Ch = yes,
+ !:Change = yes,
As = As0 \/ { A },
- map__set(Reaching0, C, As, Reaching)
+ map__set(!.Reaching, C, As, !:Reaching)
)
;
- Ch = yes,
+ !:Change = yes,
As = { A },
- map__set(Reaching0, C, As, Reaching)
+ map__set(!.Reaching, C, As, !:Reaching)
).
%------------------------------------------------------------------------------%
@@ -145,25 +138,24 @@
set(items), set(items)).
:- mode lr0items1(in, in, in, in, out, in, out) is det.
-lr0items1(Pending0, Productions, Reaching, Gotos0, Gotos, C0, C) :-
- ( remove_least(Pending0, J, Pending1) ->
+lr0items1(Pending0, Productions, Reaching, !Gotos, !C) :-
+ ( set__remove_least(Pending0, J, Pending1) ->
set__to_sorted_list(J, JList),
- lr0items_1(JList, J, Productions, Reaching, Gotos0, Gotos1,
- empty, NewSet),
+ lr0items_1(JList, J, Productions, Reaching, !Gotos, empty,
+ NewSet),
set__to_sorted_list(NewSet, NewItems),
- map((pred(Pair::in, J0::out) is det :-
+ list__map((pred(Pair::in, J0::out) is det :-
Pair = I0 - X,
- lookup(Gotos1, I0, I0Gotos),
- lookup(I0Gotos, X, J0)
+ map__lookup(!.Gotos, I0, I0Gotos),
+ map__lookup(I0Gotos, X, J0)
), NewItems, PendingList),
set__list_to_set(PendingList, NewPending0),
- NewPending = NewPending0 - C0,
- C1 = C0 \/ NewPending,
+ NewPending = NewPending0 - !.C,
+ !:C = !.C \/ NewPending,
Pending = Pending1 \/ NewPending,
- lr0items1(Pending, Productions, Reaching, Gotos1, Gotos, C1, C)
+ lr0items1(Pending, Productions, Reaching, !Gotos, !C)
;
- Gotos = Gotos0,
- C = C0
+ true
).
:- type new == set(pair(items, symbol)).
@@ -171,101 +163,95 @@
:- pred lr0items_1(list(item), items, rules, reaching, gotos, gotos, new, new).
:- mode lr0items_1(in, in, in, in, in, out, in, out) is det.
-lr0items_1([], _I, _Productions, _Reaching, Gotos, Gotos, New, New).
-lr0items_1([BItem|RestItems], I, Productions, Reaching, Gotos0, Gotos,
- New0, New) :-
+lr0items_1([], _I, _Productions, _Reaching, !Gotos, !New).
+lr0items_1([BItem | RestItems], I, Productions, Reaching, !Gotos, !New) :-
BItem = item(BProdNum, BDot),
- lookup(Productions, BProdNum, BProd),
+ map__lookup(Productions, BProdNum, BProd),
BProd = rule(_NonTerminal, _Head, BSyms, _, _, _V, _C),
array__max(BSyms, BMax),
(
BDot =< BMax
->
- lookup(BSyms, BDot, X),
- addgoto(I, X, item(BProdNum, BDot + 1), Gotos0, Gotos1,
- New0, New1)
+ array__lookup(BSyms, BDot, X),
+ addgoto(I, X, item(BProdNum, BDot + 1), !Gotos, !New)
;
- Gotos1 = Gotos0,
- New1 = New0
+ true
),
(
BDot =< BMax,
lookup(BSyms, BDot, nonterminal(C))
->
- ( search(Reaching, C, As) ->
+ ( map__search(Reaching, C, As) ->
set__to_sorted_list(As, AXList)
;
AXList = []
),
- addAs([C|AXList], I, Productions, Gotos1, Gotos2, New1, New2)
+ addAs([C|AXList], I, Productions, !Gotos, !New)
;
- Gotos2 = Gotos1,
- New2 = New1
+ true
),
- lr0items_1(RestItems, I, Productions, Reaching, Gotos2, Gotos,
- New2, New).
+ lr0items_1(RestItems, I, Productions, Reaching, !Gotos, !New).
:- pred addgoto(items, symbol, item, gotos, gotos, new, new).
:- mode addgoto(in, in, in, in, out, in, out) is det.
-addgoto(I, X, NewItem, Gotos0, Gotos, New0, New) :-
- ( search(Gotos0, I, IGotos0) ->
+addgoto(I, X, NewItem, !Gotos, !New) :-
+ ( map__search(!.Gotos, I, IGotos0) ->
IGotos1 = IGotos0
;
init(IGotos1)
),
- ( search(IGotos1, X, GotoIX0) ->
+ ( map__search(IGotos1, X, GotoIX0) ->
GotoIX1 = GotoIX0
;
GotoIX1 = empty
),
GotoIX = GotoIX1 \/ { NewItem },
set(IGotos1, X, GotoIX, IGotos),
- set(Gotos0, I, IGotos, Gotos),
+ set(!.Gotos, I, IGotos, !:Gotos),
( GotoIX \= GotoIX1 ->
- New = New0 \/ { I - X }
+ !:New = !.New \/ { I - X }
;
- New = New0
+ true
).
:- pred addAs(list(nonterminal), items, rules, gotos, gotos, new, new).
:- mode addAs(in, in, in, in, out, in, out) is det.
-addAs([], _I, _Productions, Gotos, Gotos, New, New).
-addAs([A|As], I, Productions, Gotos0, Gotos, New0, New) :-
+addAs([], _I, _Productions, !Gotos, !New).
+addAs([A|As], I, Productions, !Gotos, !New) :-
prodnums(Productions, ProdNums),
- addAs_2(ProdNums, A, I, Productions, Gotos0, Gotos1, New0, New1),
- addAs(As, I, Productions, Gotos1, Gotos, New1, New).
+ addAs_2(ProdNums, A, I, Productions, !Gotos, !New),
+ addAs(As, I, Productions, !Gotos, !New).
:- pred addAs_2(list(prodnum), nonterminal, items, rules, gotos, gotos,
new, new).
:- mode addAs_2(in, in, in, in, in, out, in, out) is det.
-addAs_2([], _A, _I, _Productions, Gotos, Gotos, New, New).
-addAs_2([Pn|Pns], A, I, Productions, Gotos0, Gotos, New0, New) :-
- lookup(Productions, Pn, Prod),
+addAs_2([], _A, _I, _Productions, !Gotos, !New).
+addAs_2([Pn|Pns], A, I, Productions, !Gotos, !New) :-
+ map__lookup(Productions, Pn, Prod),
(
Prod = rule(A, _Head, Symbols, _, _, _V, _C),
array__max(Symbols, Max),
Max >= 0
->
- lookup(Symbols, 0, X),
- addgoto(I, X, item(Pn, 1), Gotos0, Gotos1, New0, New1)
+ array__lookup(Symbols, 0, X),
+ addgoto(I, X, item(Pn, 1), !Gotos, !New)
;
- Gotos1 = Gotos0,
- New1 = New0
+ true
),
- addAs_2(Pns, A, I, Productions, Gotos1, Gotos, New1, New).
+ addAs_2(Pns, A, I, Productions, !Gotos, !New).
%------------------------------------------------------------------------------%
-lookaheads(C, Gotos, Rules, First, Index, Lookaheads) -->
- { map__from_assoc_list([item(0, 0) - { ($) }], I0) },
- { map__from_assoc_list([{item(0, 0)} - I0], Lookaheads0) },
- { init(Propaheads0) },
- { set__to_sorted_list(C, CList) },
- { lookaheads(CList, Gotos, Rules, First, Index,
- Lookaheads0 - Propaheads0, Lookaheads1 - Propaheads) },
+lookaheads(C, Gotos, Rules, First, Index, !:Lookaheads, !IO) :-
+ map__from_assoc_list([item(0, 0) - { ($) }], I0),
+ map__from_assoc_list([{item(0, 0)} - I0], !:Lookaheads),
+ map__init(Propaheads0),
+ set__to_sorted_list(C, CList),
+ lookaheads(CList, Gotos, Rules, First, Index,
+ !.Lookaheads - Propaheads0, !:Lookaheads - Propaheads),
%foldl((pred(_I::in, IPs::in, di, uo) is det -->
% foldl((pred(Item::in, ItemsMap::in, di, uo) is det -->
% write(Item), write_string(" :\n"),
@@ -277,27 +263,25 @@
% ), ItemsMap), nl
% ), IPs), nl
%), Propaheads),
- stderr_stream(StdErr),
- write_string(StdErr, "\tpropagating...\n"),
- { propagate(C, Propaheads, Lookaheads1, Lookaheads) }.
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr, "\tpropagating...\n", !IO),
+ propagate(C, Propaheads, !Lookaheads).
:- pred lookaheads(list(items), gotos, rules, first, index, previews, previews).
:- mode lookaheads(in, in, in, in, in, in, out) is det.
-lookaheads([], _Gotos, _Rules, _First, _Index, Lookaheads, Lookaheads).
-lookaheads([K|Ks], Gotos, Rules, First, Index, Lookaheads0, Lookaheads) :-
+lookaheads([], _Gotos, _Rules, _First, _Index, !Lookaheads).
+lookaheads([K | Ks], Gotos, Rules, First, Index, !Lookaheads) :-
set__to_sorted_list(K, KList),
- lookaheads1(KList, K, Gotos, Rules, First, Index,
- Lookaheads0, Lookaheads1),
- lookaheads(Ks, Gotos, Rules, First, Index, Lookaheads1, Lookaheads).
+ lookaheads1(KList, K, Gotos, Rules, First, Index, !Lookaheads),
+ lookaheads(Ks, Gotos, Rules, First, Index, !Lookaheads).
:- pred lookaheads1(list(item), items, gotos, rules, first, index,
previews, previews).
:- mode lookaheads1(in, in, in, in, in, in, in, out) is det.
-lookaheads1([], _I, _Gotos, _Rules, _First, _Index, Lookaheads, Lookaheads).
-lookaheads1([BItem|BItems], I, Gotos, Rules, First, Index,
- Lookaheads0, Lookaheads) :-
+lookaheads1([], _I, _Gotos, _Rules, _First, _Index, !Lookaheads).
+lookaheads1([BItem | BItems], I, Gotos, Rules, First, Index, !Lookaheads) :-
BItem = item(Bp, Bd),
BItem0 = item(Bp, Bd, (*)),
J0 = closure({ BItem0 }, Rules, First, Index),
@@ -305,35 +289,35 @@
% Reverse the list so that in add_spontaneous, the
% set insertions are in reverse sorted order not
% sorted order thereby taking to cost from O(n) to O(1).
- reverse(JList0, JList),
- lookaheads2(JList, BItem, I, Gotos, Rules, Lookaheads0, Lookaheads1),
- lookaheads1(BItems, I, Gotos, Rules, First, Index,
- Lookaheads1, Lookaheads).
+ list__reverse(JList0, JList),
+ lookaheads2(JList, BItem, I, Gotos, Rules, !Lookaheads),
+ lookaheads1(BItems, I, Gotos, Rules, First, Index, !Lookaheads).
:- func closure(lr1items, rules, first, index) = lr1items.
+
closure(I0, Rules, First, Index) = I :-
closure(Rules, First, Index, I0, I0, I).
:- pred closure(rules, first, index, lr1items, lr1items, lr1items).
:- mode closure(in, in, in, in, in, out) is det.
-closure(Rules, First, Index, New0, I0, I) :-
- set__to_sorted_list(New0, NewList),
+closure(Rules, First, Index, !.New, I0, I) :-
+ set__to_sorted_list(!.New, NewList),
closure1(NewList, Rules, First, Index, [I0], Is),
do_union(Is, I1),
- New = I1 - I0,
- ( empty(New) ->
+ !:New = I1 - I0,
+ ( set__empty(!.New) ->
I = I1
;
- closure(Rules, First, Index, New, I1, I)
+ closure(Rules, First, Index, !.New, I1, I)
).
:- pred closure1(list(lr1item), rules, first, index,
list(lr1items), list(lr1items)).
:- mode closure1(in, in, in, in, in, out) is det.
-closure1([], _Rules, _First, _Index, I, I).
-closure1([AItem|AItems], Rules, First, Index, I0, I) :-
+closure1([], _Rules, _First, _Index, !I).
+closure1([AItem | AItems], Rules, First, Index, !I) :-
AItem = item(Ap, Ad, Asym),
map__lookup(Rules, Ap, rule(_, _, Asyms, _, _, _, _)),
array__max(Asyms, AMax),
@@ -359,14 +343,14 @@
map__lookup(Index, Bn, Bps),
make_items(Bps, BfList, [], NList),
set__sorted_list_to_set(NList, N),
- I1 = [N|I0]
+ list__append([N], !I)
;
- I1 = I0
+ true
)
;
- I1 = I0
+ true
),
- closure1(AItems, Rules, First, Index, I1, I).
+ closure1(AItems, Rules, First, Index, !I).
% create the union of a list of sets.
% The simple `foldl' way has O(n^2) cost, so we do a
@@ -401,176 +385,173 @@
previews, previews).
:- mode lookaheads2(in, in, in, in, in, in, out) is det.
-lookaheads2([], _B, _I, _Gotos, _Rules, Lookaheads, Lookaheads).
-lookaheads2([A|As], B, I, Gotos, Rules, Lookaheads0, Lookaheads) :-
+lookaheads2([], _B, _I, _Gotos, _Rules, !Lookaheads).
+lookaheads2([A | As], B, I, Gotos, Rules, !Lookaheads) :-
A = item(Ap, Ad, Alpha),
- lookup(Rules, Ap, rule(_, _, ASyms, _, _, _, _)),
+ map__lookup(Rules, Ap, rule(_, _, ASyms, _, _, _, _)),
array__max(ASyms, AMax),
( Ad =< AMax ->
- lookup(ASyms, Ad, X),
+ array__lookup(ASyms, Ad, X),
( Gix = goto(Gotos, I, X) ->
Ad1 = Ad + 1,
( Alpha = (*) ->
- add_propagated(I, B, Gix, item(Ap, Ad1),
- Lookaheads0, Lookaheads1)
+ add_propagated(I, B, Gix, item(Ap, Ad1),
+ !Lookaheads)
;
- add_spontaneous(Gix, item(Ap, Ad1), Alpha,
- Lookaheads0, Lookaheads1)
+ add_spontaneous(Gix, item(Ap, Ad1), Alpha,
+ !Lookaheads)
)
;
- Lookaheads1 = Lookaheads0
+ true
)
;
- Lookaheads1 = Lookaheads0
+ true
),
- lookaheads2(As, B, I, Gotos, Rules, Lookaheads1, Lookaheads).
+ lookaheads2(As, B, I, Gotos, Rules, !Lookaheads).
:- pred make_items(list(prodnum), list(terminal), list(lr1item), list(lr1item)).
:- mode make_items(in, in, in, out) is det.
-make_items([], _, Items, Items).
-make_items([Bp|Bps], BfList, Items0, Items) :-
- make_items1(Bp, BfList, Items0, Items1),
- make_items(Bps, BfList, Items1, Items).
+make_items([], _, !Items).
+make_items([Bp | Bps], BfList, !Items) :-
+ make_items1(Bp, BfList, !Items),
+ make_items(Bps, BfList, !Items).
:- pred make_items1(prodnum, list(terminal), list(lr1item), list(lr1item)).
:- mode make_items1(in, in, in, out) is det.
-make_items1(_, [], Items, Items).
-make_items1(Bp, [Bt|Bts], Items0, Items) :-
- Items1 = [item(Bp, 0, Bt)|Items0],
- make_items1(Bp, Bts, Items1, Items).
+make_items1(_, [], !Items).
+make_items1(Bp, [Bt | Bts], !Items) :-
+ list__append([item(Bp, 0, Bt)], !Items),
+ make_items1(Bp, Bts, !Items).
:- func goto(gotos, items, symbol) = items.
:- mode (goto(in, in, in) = out) is semidet.
goto(Gotos, I, X) = A :-
- search(Gotos, I, IXs),
- search(IXs, X, A).
+ map__search(Gotos, I, IXs),
+ map__search(IXs, X, A).
:- pred add_propagated(items, item, items, item, previews, previews).
:- mode add_propagated(in, in, in, in, in, out) is det.
add_propagated(I, B, Ia, A, L - P0, L - P) :-
- ( search(P0, I, X0) ->
+ ( map__search(P0, I, X0) ->
X1 = X0
;
- init(X1)
+ map__init(X1)
),
- ( search(X1, B, Y0) ->
+ ( map__search(X1, B, Y0) ->
Y1 = Y0
;
- init(Y1)
+ map__init(Y1)
),
- ( search(Y1, Ia, As0) ->
+ ( map__search(Y1, Ia, As0) ->
As1 = As0
;
As1 = empty
),
- insert(As1, A, As),
- set(Y1, Ia, As, Y),
- set(X1, B, Y, X),
- set(P0, I, X, P).
+ set__insert(As1, A, As),
+ map__set(Y1, Ia, As, Y),
+ map__set(X1, B, Y, X),
+ map__set(P0, I, X, P).
:- pred add_spontaneous(items, item, terminal, previews, previews).
:- mode add_spontaneous(in, in, in, in, out) is det.
add_spontaneous(I, B, Alpha, L0 - P, L - P) :-
- ( search(L0, I, X0) ->
+ ( map__search(L0, I, X0) ->
X1 = X0
;
- init(X1)
+ map__init(X1)
),
- ( search(X1, B, As0) ->
+ ( map__search(X1, B, As0) ->
As1 = As0
;
As1 = empty
),
- insert(As1, Alpha, As),
- set(X1, B, As, X),
- set(L0, I, X, L).
+ set__insert(As1, Alpha, As),
+ map__set(X1, B, As, X),
+ map__set(L0, I, X, L).
:- pred propagate(set(items), propaheads, lookaheads, lookaheads).
:- mode propagate(in, in, in, out) is det.
-propagate(C, Props, Lookaheads0, Lookaheads) :-
+propagate(C, Props, !Lookaheads) :-
set__to_sorted_list(C, CList),
- propagate(CList, Props, no, Change, Lookaheads0, Lookaheads1),
+ propagate(CList, Props, no, Change, !Lookaheads),
(
- Change = no,
- Lookaheads = Lookaheads1
+ Change = no
;
Change = yes,
- propagate(C, Props, Lookaheads1, Lookaheads)
+ propagate(C, Props, !Lookaheads)
).
:- pred propagate(list(items), propaheads, bool, bool, lookaheads, lookaheads).
:- mode propagate(in, in, in, out, in, out) is det.
-propagate([], _Props, Ch, Ch, L, L).
-propagate([I|Is], Props, Ch0, Ch, L0, L) :-
+propagate([], _Props, !Change, !Lookaheads).
+propagate([I | Is], Props, !Change, !Lookaheads) :-
set__to_sorted_list(I, IList),
- propagate1(IList, I, Props, Ch0, Ch1, L0, L1),
- propagate(Is, Props, Ch1, Ch, L1, L).
+ propagate1(IList, I, Props, !Change, !Lookaheads),
+ propagate(Is, Props, !Change, !Lookaheads).
:- pred propagate1(list(item), items, propaheads, bool, bool,
lookaheads, lookaheads).
:- mode propagate1(in, in, in, in, out, in, out) is det.
-propagate1([], _I, _Props, Ch, Ch, L, L).
-propagate1([Item|Items], I, Props, Ch0, Ch, L0, L) :-
+propagate1([], _I, _Props, !Change, !Lookaheads).
+propagate1([Item | Items], I, Props, !Change, !Lookaheads) :-
(
- search(L0, I, X),
- search(X, Item, Ts),
- search(Props, I, Y),
- search(Y, Item, Ps)
+ map__search(!.Lookaheads, I, X),
+ map__search(X, Item, Ts),
+ map__search(Props, I, Y),
+ map__search(Y, Item, Ps)
->
- keys(Ps, Pkeys),
- propagate2(Pkeys, Ps, Ts, Ch0, Ch1, L0, L1)
+ map__keys(Ps, Pkeys),
+ propagate2(Pkeys, Ps, Ts, !Change, !Lookaheads)
;
- Ch1 = Ch0,
- L1 = L0
+ true
),
- propagate1(Items, I, Props, Ch1, Ch, L1, L).
+ propagate1(Items, I, Props, !Change, !Lookaheads).
:- pred propagate2(list(items), (items -> items), set(terminal), bool, bool,
lookaheads, lookaheads).
:- mode propagate2(in, in, in, in, out, in, out) is det.
-propagate2([], _Ps, _Ts, Ch, Ch, L, L).
-propagate2([I|Pks], Ps, Ts, Ch0, Ch, L0, L) :-
- lookup(Ps, I, Ips),
+propagate2([], _Ps, _Ts, !Change, !Lookaheads).
+propagate2([I|Pks], Ps, Ts, !Change, !Lookaheads) :-
+ map__lookup(Ps, I, Ips),
set__to_sorted_list(Ips, IPList),
- propagate3(IPList, I, Ts, Ch0, Ch1, L0, L1),
- propagate2(Pks, Ps, Ts, Ch1, Ch, L1, L).
+ propagate3(IPList, I, Ts, !Change, !Lookaheads),
+ propagate2(Pks, Ps, Ts, !Change, !Lookaheads).
:- pred propagate3(list(item), items, set(terminal), bool, bool,
lookaheads, lookaheads).
:- mode propagate3(in, in, in, in, out, in, out) is det.
-propagate3([], _I, _Ts, Ch, Ch, L, L).
-propagate3([Item|Items], I, Ts0, Ch0, Ch, L0, L) :-
- ( search(L0, I, X0) ->
+propagate3([], _I, _Ts, !Change, !Lookaheads).
+propagate3([Item | Items], I, Ts0, !Change, !Lookaheads) :-
+ ( map__search(!.Lookaheads, I, X0) ->
X1 = X0
;
- init(X1)
+ map__init(X1)
),
- ( search(X1, Item, Ts1) ->
+ ( map__search(X1, Item, Ts1) ->
Ts2 = Ts1
;
Ts2 = empty
),
NewTs = Ts0 - Ts2,
- ( not empty(NewTs) ->
+ ( not set__empty(NewTs) ->
Ts = Ts2 \/ NewTs,
- set(X1, Item, Ts, X),
- set(L0, I, X, L1),
- Ch1 = yes
+ map__set(X1, Item, Ts, X),
+ map__set(!.Lookaheads, I, X, !:Lookaheads),
+ !:Change = yes
;
- Ch1 = Ch0,
- L1 = L0
+ true
),
- propagate3(Items, I, Ts0, Ch1, Ch, L1, L).
+ propagate3(Items, I, Ts0, !Change, !Lookaheads).
%------------------------------------------------------------------------------%
@@ -578,6 +559,6 @@
:- mode prodnums(in, out) is det.
prodnums(Rules, ProdNums) :-
- keys(Rules, ProdNums).
+ map__keys(Rules, ProdNums).
%------------------------------------------------------------------------------%
Index: mercury_syntax.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/mercury_syntax.m,v
retrieving revision 1.1
diff -u -r1.1 mercury_syntax.m
--- mercury_syntax.m 22 Nov 2001 10:07:05 -0000 1.1
+++ mercury_syntax.m 15 Jul 2003 08:18:15 -0000
@@ -85,55 +85,54 @@
%------------------------------------------------------------------------------%
-read_module(Result) -->
- read_module([], [], Result0),
- { Result0 = module(Module0, Errors0) },
- { reverse(Module0, Module) },
- { reverse(Errors0, Errors) },
- { Result = module(Module, Errors) }.
+read_module(Result, !IO) :-
+ read_module([], [], Result0, !IO),
+ Result0 = module(Module0, Errors0),
+ list__reverse(Module0, Module),
+ list__reverse(Errors0, Errors),
+ Result = module(Module, Errors).
:- type element_result
---> element(element)
; eof
- ; error(string, int)
- .
+ ; error(string, int).
:- pred read_module(module, list(module_error), module_result,
io__state, io__state).
:- mode read_module(in, in, out, di, uo) is det.
-read_module(Module0, Errors0, Result) -->
- read_element(Result0),
+read_module(Module, Errors, !:Result, !IO) :-
+ read_element(!:Result, !IO),
(
- { Result0 = eof },
- { Result = module(Module0, Errors0) }
+ !.Result = eof,
+ !:Result = module(Module, Errors)
;
- { Result0 = element(Element) },
- read_module([Element|Module0], Errors0, Result)
+ !.Result = element(Element),
+ read_module([Element | Module], Errors, !:Result, !IO)
;
- { Result0 = error(Msg, Line) },
- read_module(Module0, [error(Msg, Line)|Errors0], Result)
+ !.Result = error(Msg, Line),
+ read_module(Module, [error(Msg, Line) | Errors], !:Result, !IO)
).
:- pred read_element(element_result, io__state, io__state).
:- mode read_element(out, di, uo) is det.
-read_element(Result) -->
- read_term(Result0),
+read_element(!:Result, !IO) :-
+ read_term(!:Result, !IO),
(
- { Result0 = eof },
- { Result = eof }
+ !.Result = eof,
+ !:Result = eof
;
- { Result0 = error(Msg, Line) },
- { Result = error(Msg, Line) }
+ !.Result = error(Msg, Line),
+ !:Result = error(Msg, Line)
;
- { Result0 = term(VarSet, Term) },
- ( { classify(Term, VarSet, Element0) } ->
- { Element = Element0 }
+ !.Result = term(VarSet, Term),
+ ( classify(Term, VarSet, Element0) ->
+ Element = Element0
;
- { Element = misc(Term, VarSet) }
+ Element = misc(Term, VarSet)
),
- { Result = element(Element) }
+ !:Result = element(Element)
).
:- pred classify(term, varset, element).
@@ -186,102 +185,101 @@
%------------------------------------------------------------------------------%
-write_module(_Lines, []) --> [].
-write_module(Lines, [Element|Module]) -->
- write_element(Lines, Element),
- nl,
- write_module(Lines, Module).
-
-write_element(Lines, pred(PredDecl, VarSet)) -->
- { cons_decl("pred", PredDecl, Term) },
- write_term(Lines, 0, VarSet, Term),
- dot_nl.
-
-write_element(Lines, func(FuncDecl, VarSet)) -->
- { cons_decl("func", FuncDecl, Term) },
- write_term(Lines, 0, VarSet, Term),
- dot_nl.
+write_module(_Lines, [], !IO).
+write_module(Lines, [Element | Module], !IO) :-
+ write_element(Lines, Element, !IO),
+ io__nl(!IO),
+ write_module(Lines, Module, !IO).
+
+write_element(Lines, pred(PredDecl, VarSet), !IO) :-
+ cons_decl("pred", PredDecl, Term),
+ write_term(Lines, 0, VarSet, Term, !IO),
+ dot_nl(!IO).
+
+write_element(Lines, func(FuncDecl, VarSet), !IO) :-
+ cons_decl("func", FuncDecl, Term),
+ write_term(Lines, 0, VarSet, Term, !IO),
+ dot_nl(!IO).
-write_element(Lines, type(TypeDecl, VarSet)) -->
+write_element(Lines, type(TypeDecl, VarSet), !IO) :-
(
- { TypeDecl = abstr(AbstrTerm) },
- { cons_decl("type", AbstrTerm, Term) },
- write_term(Lines, 0, VarSet, Term)
- ;
- { TypeDecl = equiv(Head, Body) },
- { get_context(Head, Context) },
- { EqivTerm = functor(atom("=="), [Head, Body], Context) },
- { cons_decl("type", EqivTerm, Term) },
- write_term(Lines, 0, VarSet, Term)
- ;
- { TypeDecl = disj(Head, Body) },
- { get_context(Head, Context) },
- { cons_type_body(Body, BodyTerm) },
- { DeclTerm = functor(atom("--->"), [Head, BodyTerm], Context) },
- { cons_decl("type", DeclTerm, Term) },
- write_term(Lines, 0, VarSet, Term)
+ TypeDecl = abstr(AbstrTerm),
+ cons_decl("type", AbstrTerm, Term),
+ write_term(Lines, 0, VarSet, Term, !IO)
+ ;
+ TypeDecl = equiv(Head, Body),
+ get_context(Head, Context),
+ EqivTerm = functor(atom("=="), [Head, Body], Context),
+ cons_decl("type", EqivTerm, Term),
+ write_term(Lines, 0, VarSet, Term, !IO)
+ ;
+ TypeDecl = disj(Head, Body),
+ get_context(Head, Context),
+ cons_type_body(Body, BodyTerm),
+ DeclTerm = functor(atom("--->"), [Head, BodyTerm], Context),
+ cons_decl("type", DeclTerm, Term),
+ write_term(Lines, 0, VarSet, Term, !IO)
),
- dot_nl.
+ dot_nl(!IO).
-write_element(Lines, mode(ModeDecl, VarSet)) -->
- { cons_decl("mode", ModeDecl, Term) },
- write_term(Lines, 0, VarSet, Term),
- dot_nl.
-
-write_element(Lines, inst(InstDecl, VarSet)) -->
- { cons_decl("inst", InstDecl, Term) },
- write_term(Lines, 0, VarSet, Term),
- dot_nl.
-
-write_element(Lines, class(ClassDecl, VarSet)) -->
- { cons_decl("class", ClassDecl, Term) },
- write_term(Lines, 0, VarSet, Term),
- dot_nl.
-
-write_element(Lines, instance(InstanceDecl, VarSet)) -->
- { cons_decl("instance", InstanceDecl, Term) },
- write_term(Lines, 0, VarSet, Term),
- dot_nl.
-
-write_element(Lines, misc(Term, VarSet)) -->
- write_term(Lines, 0, VarSet, Term),
- dot_nl.
-
-write_element(Lines, clause(Head, Goal, VarSet)) -->
- write_term(Lines, 0, VarSet, Head),
- write_string(" :-\n"),
- write_goal(Lines, 1, normal, Goal, VarSet),
- dot_nl.
-
-write_element(Lines, dcg_clause(Head, Goal, VarSet)) -->
- write_term(Lines, 0, VarSet, Head),
- write_string(" -->\n"),
- write_goal(Lines, 1, dcg, Goal, VarSet),
- dot_nl.
+write_element(Lines, mode(ModeDecl, VarSet), !IO) :-
+ cons_decl("mode", ModeDecl, Term),
+ write_term(Lines, 0, VarSet, Term, !IO),
+ dot_nl(!IO).
+
+write_element(Lines, inst(InstDecl, VarSet), !IO) :-
+ cons_decl("inst", InstDecl, Term),
+ write_term(Lines, 0, VarSet, Term, !IO),
+ dot_nl(!IO).
+
+write_element(Lines, class(ClassDecl, VarSet), !IO) :-
+ cons_decl("class", ClassDecl, Term),
+ write_term(Lines, 0, VarSet, Term, !IO),
+ dot_nl(!IO).
+
+write_element(Lines, instance(InstanceDecl, VarSet), !IO) :-
+ cons_decl("instance", InstanceDecl, Term),
+ write_term(Lines, 0, VarSet, Term, !IO),
+ dot_nl(!IO).
+
+write_element(Lines, misc(Term, VarSet), !IO) :-
+ write_term(Lines, 0, VarSet, Term, !IO),
+ dot_nl(!IO).
+
+write_element(Lines, clause(Head, Goal, VarSet), !IO) :-
+ write_term(Lines, 0, VarSet, Head, !IO),
+ io__write_string(" :-\n", !IO),
+ write_goal(Lines, 1, normal, Goal, VarSet, !IO),
+ dot_nl(!IO).
+
+write_element(Lines, dcg_clause(Head, Goal, VarSet), !IO) :-
+ write_term(Lines, 0, VarSet, Head, !IO),
+ io__write_string(" -->\n", !IO),
+ write_goal(Lines, 1, dcg, Goal, VarSet, !IO),
+ dot_nl(!IO).
%------------------------------------------------------------------------------%
:- type goal_type
---> normal
- ; dcg
- .
+ ; dcg.
:- pred write_goal_term(lines, int, goal_type, term, varset,
io__state, io__state).
:- mode write_goal_term(in, in, in, in, in, di, uo) is det.
-write_goal_term(Lines, Ind, Type, Term, VarSet) -->
- ( { term_to_conj(Term, Conjuncts) } ->
- write_conjuncts(Lines, Ind, Type, Conjuncts, VarSet)
- ; { term_to_ite(Term, IfThens, Else) } ->
- write_ite_terms(Lines, Ind, Type, IfThens, Else, VarSet)
- ; { term_to_disj(Term, Disjuncts) } ->
- write_disjuncts(Lines, Ind, Type, Disjuncts, VarSet)
+write_goal_term(Lines, Ind, Type, Term, VarSet, !IO) :-
+ ( term_to_conj(Term, Conjuncts) ->
+ write_conjuncts(Lines, Ind, Type, Conjuncts, VarSet, !IO)
+ ; term_to_ite(Term, IfThens, Else) ->
+ write_ite_terms(Lines, Ind, Type, IfThens, Else, VarSet, !IO)
+ ; term_to_disj(Term, Disjuncts) ->
+ write_disjuncts(Lines, Ind, Type, Disjuncts, VarSet, !IO)
;
% Too bad if it is a quantifier, { Goal }, etc.
% Also too bad if it contains a pred expression...
% You can add pretty things here...
- write_term(Lines, Ind, VarSet, Term)
+ write_term(Lines, Ind, VarSet, Term, !IO)
).
:- pred term_to_conj(term, list(term)).
@@ -323,24 +321,24 @@
io__state, io__state).
:- mode write_conjuncts(in, in, in, in, in, di, uo) is det.
-write_conjuncts(_Lines, Ind, Type, [], _VarSet) -->
- write_ind(Ind),
+write_conjuncts(_Lines, Ind, Type, [], _VarSet, !IO) :-
+ write_ind(Ind, !IO),
(
- { Type = normal },
- write_string("true")
+ Type = normal,
+ io__write_string("true", !IO)
;
- { Type = dcg },
- write_string("{ true }")
+ Type = dcg,
+ io__write_string("{ true }", !IO)
).
-write_conjuncts(Lines, Ind, Type, [Goal], VarSet) -->
- write_goal_term(Lines, Ind, Type, Goal, VarSet).
+write_conjuncts(Lines, Ind, Type, [Goal], VarSet, !IO) :-
+ write_goal_term(Lines, Ind, Type, Goal, VarSet, !IO).
-write_conjuncts(Lines, Ind, Type, [Goal|Goals], VarSet) -->
- { Goals = [_|_] },
- write_goal_term(Lines, Ind, Type, Goal, VarSet),
- write_string(",\n"),
- write_conjuncts(Lines, Ind, Type, Goals, VarSet).
+write_conjuncts(Lines, Ind, Type, [Goal | Goals], VarSet, !IO) :-
+ Goals = [_|_],
+ write_goal_term(Lines, Ind, Type, Goal, VarSet, !IO),
+ io__write_string(",\n", !IO),
+ write_conjuncts(Lines, Ind, Type, Goals, VarSet, !IO).
%------------------------------------------------------------------------------%
@@ -348,36 +346,36 @@
io__state, io__state).
:- mode write_disjuncts(in, in, in, in, in, di, uo) is det.
-write_disjuncts(Lines, Ind, Type, Goals, VarSet) -->
- write_ind(Ind),
- write_string("(\n"),
- write_disjuncts0(Lines, Ind, Type, Goals, VarSet), nl,
- write_ind(Ind),
- write_string(")").
+write_disjuncts(Lines, Ind, Type, Goals, VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("(\n", !IO),
+ write_disjuncts0(Lines, Ind, Type, Goals, VarSet, !IO), io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(")", !IO).
:- pred write_disjuncts0(lines, int, goal_type, list(term), varset,
io__state, io__state).
:- mode write_disjuncts0(in, in, in, in, in, di, uo) is det.
-write_disjuncts0(_Lines, Ind, Type, [], _VarSet) -->
- write_ind(Ind),
+write_disjuncts0(_Lines, Ind, Type, [], _VarSet, !IO) :-
+ write_ind(Ind, !IO),
(
- { Type = normal },
- write_string("fail")
+ Type = normal,
+ io__write_string("fail", !IO)
;
- { Type = dcg },
- write_string("{ fail }")
+ Type = dcg,
+ io__write_string("{ fail }", !IO)
).
-write_disjuncts0(Lines, Ind, Type, [Goal], VarSet) -->
- write_goal_term(Lines, Ind + 1, Type, Goal, VarSet), nl.
-
-write_disjuncts0(Lines, Ind, Type, [Goal|Goals], VarSet) -->
- { Goals = [_|_] },
- write_goal_term(Lines, Ind + 1, Type, Goal, VarSet), nl,
- write_ind(Ind),
- write_string(";\n"),
- write_disjuncts0(Lines, Ind, Type, Goals, VarSet).
+write_disjuncts0(Lines, Ind, Type, [Goal], VarSet, !IO) :-
+ write_goal_term(Lines, Ind + 1, Type, Goal, VarSet, !IO), io__nl(!IO).
+
+write_disjuncts0(Lines, Ind, Type, [Goal | Goals], VarSet, !IO) :-
+ Goals = [_|_],
+ write_goal_term(Lines, Ind + 1, Type, Goal, VarSet, !IO), io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(";\n", !IO),
+ write_disjuncts0(Lines, Ind, Type, Goals, VarSet, !IO).
%------------------------------------------------------------------------------%
@@ -385,36 +383,41 @@
io__state, io__state).
:- mode write_ite_terms(in, in, in, in, in, in, di, uo) is det.
-write_ite_terms(Lines, Ind, Type, IfThens, Else, VarSet) -->
- write_ind(Ind),
- write_string("(\n"),
- write_ite_terms0(Lines, Ind, Type, IfThens, VarSet),
- write_ind(Ind),
- write_string(";\n"),
- write_goal_term(Lines, Ind + 1, Type, Else, VarSet), nl,
- write_ind(Ind),
- write_string(")").
+write_ite_terms(Lines, Ind, Type, IfThens, Else, VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("(\n", !IO),
+ write_ite_terms0(Lines, Ind, Type, IfThens, VarSet, !IO),
+ write_ind(Ind, !IO),
+ io__write_string(";\n", !IO),
+ write_goal_term(Lines, Ind + 1, Type, Else, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(")", !IO).
:- pred write_ite_terms0(lines, int, goal_type, list(pair(term)), varset,
io__state, io__state).
:- mode write_ite_terms0(in, in, in, in, in, di, uo) is det.
-write_ite_terms0(_Lines, _Ind, _Type, [], _VarSet) -->
- { error("no if-thens") }.
-write_ite_terms0(Lines, Ind, Type, [If - Then], VarSet) -->
- write_goal_term(Lines, Ind + 1, Type, If, VarSet), nl,
- write_ind(Ind),
- write_string("->\n"),
- write_goal_term(Lines, Ind + 1, Type, Then, VarSet), nl.
-write_ite_terms0(Lines, Ind, Type, [If - Then|Rest], VarSet) -->
- { Rest = [_|_] },
- write_goal_term(Lines, Ind + 1, Type, If, VarSet), nl,
- write_ind(Ind),
- write_string("->\n"),
- write_goal_term(Lines, Ind + 1, Type, Then, VarSet), nl,
- write_ind(Ind),
- write_string(";\n"),
- write_ite_terms0(Lines, Ind, Type, Rest, VarSet).
+write_ite_terms0(_Lines, _Ind, _Type, [], _VarSet, !IO) :-
+ error("no if-thens").
+write_ite_terms0(Lines, Ind, Type, [If - Then], VarSet, !IO) :-
+ write_goal_term(Lines, Ind + 1, Type, If, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string("->\n", !IO),
+ write_goal_term(Lines, Ind + 1, Type, Then, VarSet, !IO),
+ io__nl(!IO).
+write_ite_terms0(Lines, Ind, Type, [If - Then | Rest], VarSet, !IO) :-
+ Rest = [_|_],
+ write_goal_term(Lines, Ind + 1, Type, If, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string("->\n", !IO),
+ write_goal_term(Lines, Ind + 1, Type, Then, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(";\n", !IO),
+ write_ite_terms0(Lines, Ind, Type, Rest, VarSet, !IO).
%------------------------------------------------------------------------------%
@@ -431,7 +434,7 @@
:- mode get_context(in, out) is det.
get_context(variable(_), Context) :-
- context_init(Context).
+ term__context_init(Context).
get_context(functor(_, _, Context), Context).
%------------------------------------------------------------------------------%
@@ -439,34 +442,34 @@
:- pred write_ind(int, io__state, io__state).
:- mode write_ind(in, di, uo) is det.
-write_ind(N) -->
- ( { N > 0 } ->
- write_string(" "),
- write_ind(N - 1)
+write_ind(N, !IO) :-
+ ( N > 0 ->
+ io__write_string(" ", !IO),
+ write_ind(N - 1, !IO)
;
- []
+ true
).
:- pred dot_nl(io__state, io__state).
:- mode dot_nl(di, uo) is det.
-dot_nl --> write_string(".\n").
+dot_nl(!IO) :- io__write_string(".\n", !IO).
:- pred write_term(lines, int, varset, term, io__state, io__state).
:- mode write_term(in, in, in, in, di, uo) is det.
-write_term(lines, Ind, VarSet, Term) -->
- { get_context(Term, context(File, Line)) },
- ( { File = "", Line = 0 } ->
- []
+write_term(lines, Ind, VarSet, Term, !IO) :-
+ get_context(Term, context(File, Line)),
+ ( File = "", Line = 0 ->
+ true
;
- format("#%d\n", [i(Line)])
+ io__format("#%d\n", [i(Line)], !IO)
),
- write_ind(Ind),
- write_term(VarSet, Term).
-write_term(nolines, Ind, VarSet, Term) -->
- write_ind(Ind),
- write_term(VarSet, Term).
+ write_ind(Ind, !IO),
+ write_term(VarSet, Term, !IO).
+write_term(nolines, Ind, VarSet, Term, !IO) :-
+ write_ind(Ind, !IO),
+ write_term(VarSet, Term, !IO).
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
@@ -577,92 +580,101 @@
%------------------------------------------------------------------------------%
-write_goal(VarSet, Goal) -->
- write_goal(nolines, 1, normal, Goal, VarSet).
+write_goal(VarSet, Goal, !IO) :-
+ write_goal(nolines, 1, normal, Goal, VarSet, !IO).
:- pred write_goal(lines, int, goal_type, goal, varset, io__state, io__state).
:- mode write_goal(in, in, in, in, in, di, uo) is det.
-write_goal(Lines, Ind, _GoalType, call(Term), VarSet) -->
- write_term(Lines, Ind, VarSet, Term).
+write_goal(Lines, Ind, _GoalType, call(Term), VarSet, !IO) :-
+ write_term(Lines, Ind, VarSet, Term, !IO).
-write_goal(Lines, Ind, GoalType, =(LHS, RHS, Context), VarSet) -->
- { UnifyTerm = functor(atom("="), [LHS, RHS], Context) },
+write_goal(Lines, Ind, GoalType, =(LHS, RHS, Context), VarSet, !IO) :-
+ UnifyTerm = functor(atom("="), [LHS, RHS], Context),
(
- { GoalType = dcg },
- { Term = functor(atom("{}"), [UnifyTerm], Context) }
+ GoalType = dcg,
+ Term = functor(atom("{}"), [UnifyTerm], Context)
;
- { GoalType = normal },
- { Term = UnifyTerm }
+ GoalType = normal,
+ Term = UnifyTerm
),
- write_term(Lines, Ind, VarSet, Term).
+ write_term(Lines, Ind, VarSet, Term, !IO).
-write_goal(Lines, Ind, GoalType, conj(Goals), VarSet) -->
- write_conj(Lines, Ind, GoalType, Goals, VarSet).
+write_goal(Lines, Ind, GoalType, conj(Goals), VarSet, !IO) :-
+ write_conj(Lines, Ind, GoalType, Goals, VarSet, !IO).
-write_goal(Lines, Ind, GoalType, disj(Goals), VarSet) -->
- write_disj(Lines, Ind, GoalType, Goals, VarSet).
+write_goal(Lines, Ind, GoalType, disj(Goals), VarSet, !IO) :-
+ write_disj(Lines, Ind, GoalType, Goals, VarSet, !IO).
-write_goal(Lines, Ind, GoalType, ite(If, Then, Else0), VarSet) -->
- { collect_ite(Else0, IfThens0, Else) },
- write_ite(Lines, Ind, GoalType, [If - Then|IfThens0], Else, VarSet).
-
-write_goal(Lines, Ind, GoalType, not(Goal), VarSet) -->
- write_ind(Ind),
- write_string("not (\n"),
- write_goal(Lines, Ind + 1, GoalType, Goal, VarSet), nl,
- write_ind(Ind),
- write_string(")").
-
-write_goal(Lines, Ind, GoalType, exists(Vars, Goal), VarSet) -->
- write_ind(Ind),
- write_string("some ["),
- write_vars(Vars, VarSet),
- write_string("] (\n"),
- write_goal(Lines, Ind + 1, GoalType, Goal, VarSet), nl,
- write_ind(Ind),
- write_string(")").
-
-write_goal(Lines, Ind, GoalType, forall(Vars, Goal), VarSet) -->
- write_ind(Ind),
- write_string("all ["),
- write_vars(Vars, VarSet),
- write_string("] (\n"),
- write_goal(Lines, Ind + 1, GoalType, Goal, VarSet), nl,
- write_ind(Ind),
- write_string(")").
+write_goal(Lines, Ind, GoalType, ite(If, Then, Else0), VarSet, !IO) :-
+ collect_ite(Else0, IfThens0, Else),
+ write_ite(Lines, Ind, GoalType, [If - Then | IfThens0], Else, VarSet, !IO).
+
+write_goal(Lines, Ind, GoalType, not(Goal), VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("not (\n", !IO),
+ write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(")", !IO).
+
+write_goal(Lines, Ind, GoalType, exists(Vars, Goal), VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("some [", !IO),
+ write_vars(Vars, VarSet, !IO),
+ io__write_string("] (\n", !IO),
+ write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(")", !IO).
+
+write_goal(Lines, Ind, GoalType, forall(Vars, Goal), VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("all [", !IO),
+ write_vars(Vars, VarSet, !IO),
+ io__write_string("] (\n", !IO),
+ write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(")", !IO).
/*
-write_goal(Lines, Ind, GoalType, (A => B), VarSet) -->
- write_ind(Ind),
- write_string("((\n"),
- write_goal(Lines, Ind, GoalType, A, VarSet), nl,
- write_ind(Ind),
- write_string(") => (\n"),
- write_goal(Lines, Ind, GoalType, A, VarSet), nl,
- write_ind(Ind),
- write_string("))").
+write_goal(Lines, Ind, GoalType, (A => B), VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("((\n", !IO),
+ write_goal(Lines, Ind, GoalType, A, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(") => (\n", !IO),
+ write_goal(Lines, Ind, GoalType, A, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string("))", !IO).
*/
-write_goal(Lines, Ind, GoalType, (A <= B), VarSet) -->
- write_ind(Ind),
- write_string("((\n"),
- write_goal(Lines, Ind, GoalType, A, VarSet), nl,
- write_ind(Ind),
- write_string(") <= (\n"),
- write_goal(Lines, Ind, GoalType, B, VarSet), nl,
- write_ind(Ind),
- write_string("))").
-
-write_goal(Lines, Ind, GoalType, (A <=> B), VarSet) -->
- write_ind(Ind),
- write_string("((\n"),
- write_goal(Lines, Ind, GoalType, A, VarSet), nl,
- write_ind(Ind),
- write_string(") <=> (\n"),
- write_goal(Lines, Ind, GoalType, B, VarSet), nl,
- write_ind(Ind),
- write_string("))").
+write_goal(Lines, Ind, GoalType, (A <= B), VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("((\n", !IO),
+ write_goal(Lines, Ind, GoalType, A, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(") <= (\n", !IO),
+ write_goal(Lines, Ind, GoalType, B, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string("))", !IO).
+
+write_goal(Lines, Ind, GoalType, (A <=> B), VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("((\n", !IO),
+ write_goal(Lines, Ind, GoalType, A, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(") <=> (\n", !IO),
+ write_goal(Lines, Ind, GoalType, B, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string("))", !IO).
%------------------------------------------------------------------------------%
@@ -670,24 +682,24 @@
io__state, io__state).
:- mode write_conj(in, in, in, in, in, di, uo) is det.
-write_conj(_Lines, Ind, Type, [], _VarSet) -->
- write_ind(Ind),
+write_conj(_Lines, Ind, Type, [], _VarSet, !IO) :-
+ write_ind(Ind, !IO),
(
- { Type = normal },
- write_string("true")
+ Type = normal,
+ io__write_string("true", !IO)
;
- { Type = dcg },
- write_string("{ true }")
+ Type = dcg,
+ io__write_string("{ true }", !IO)
).
-write_conj(Lines, Ind, Type, [Goal], VarSet) -->
- write_goal(Lines, Ind, Type, Goal, VarSet).
+write_conj(Lines, Ind, Type, [Goal], VarSet, !IO) :-
+ write_goal(Lines, Ind, Type, Goal, VarSet, !IO).
-write_conj(Lines, Ind, Type, [Goal|Goals], VarSet) -->
- { Goals = [_|_] },
- write_goal(Lines, Ind, Type, Goal, VarSet),
- write_string(",\n"),
- write_conj(Lines, Ind, Type, Goals, VarSet).
+write_conj(Lines, Ind, Type, [Goal|Goals], VarSet, !IO) :-
+ Goals = [_|_],
+ write_goal(Lines, Ind, Type, Goal, VarSet, !IO),
+ io__write_string(",\n", !IO),
+ write_conj(Lines, Ind, Type, Goals, VarSet, !IO).
%------------------------------------------------------------------------------%
@@ -695,36 +707,36 @@
io__state, io__state).
:- mode write_disj(in, in, in, in, in, di, uo) is det.
-write_disj(Lines, Ind, Type, Goals, VarSet) -->
- write_ind(Ind),
- write_string("(\n"),
- write_disj0(Lines, Ind, Type, Goals, VarSet), nl,
- write_ind(Ind),
- write_string(")").
+write_disj(Lines, Ind, Type, Goals, VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("(\n", !IO),
+ write_disj0(Lines, Ind, Type, Goals, VarSet, !IO), io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(")", !IO).
:- pred write_disj0(lines, int, goal_type, list(goal), varset,
io__state, io__state).
:- mode write_disj0(in, in, in, in, in, di, uo) is det.
-write_disj0(_Lines, Ind, Type, [], _VarSet) -->
- write_ind(Ind + 1),
+write_disj0(_Lines, Ind, Type, [], _VarSet, !IO) :-
+ write_ind(Ind + 1, !IO),
(
- { Type = normal },
- write_string("fail")
+ Type = normal,
+ io__write_string("fail", !IO)
;
- { Type = dcg },
- write_string("{ fail }")
+ Type = dcg,
+ io__write_string("{ fail }", !IO)
).
-write_disj0(Lines, Ind, Type, [Goal], VarSet) -->
- write_goal(Lines, Ind + 1, Type, Goal, VarSet), nl.
-
-write_disj0(Lines, Ind, Type, [Goal|Goals], VarSet) -->
- { Goals = [_|_] },
- write_goal(Lines, Ind + 1, Type, Goal, VarSet), nl,
- write_ind(Ind),
- write_string(";\n"),
- write_disj0(Lines, Ind, Type, Goals, VarSet).
+write_disj0(Lines, Ind, Type, [Goal], VarSet, !IO) :-
+ write_goal(Lines, Ind + 1, Type, Goal, VarSet, !IO), io__nl(!IO).
+
+write_disj0(Lines, Ind, Type, [Goal | Goals], VarSet, !IO) :-
+ Goals = [_|_],
+ write_goal(Lines, Ind + 1, Type, Goal, VarSet, !IO), io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(";\n", !IO),
+ write_disj0(Lines, Ind, Type, Goals, VarSet, !IO).
%------------------------------------------------------------------------------%
@@ -744,48 +756,53 @@
io__state, io__state).
:- mode write_ite(in, in, in, in, in, in, di, uo) is det.
-write_ite(Lines, Ind, Type, IfThens, Else, VarSet) -->
- write_ind(Ind),
- write_string("(\n"),
- write_ite0(Lines, Ind, Type, IfThens, VarSet),
- write_ind(Ind),
- write_string(";\n"),
- write_goal(Lines, Ind + 1, Type, Else, VarSet), nl,
- write_ind(Ind),
- write_string(")").
+write_ite(Lines, Ind, Type, IfThens, Else, VarSet, !IO) :-
+ write_ind(Ind, !IO),
+ io__write_string("(\n", !IO),
+ write_ite0(Lines, Ind, Type, IfThens, VarSet, !IO),
+ write_ind(Ind, !IO),
+ io__write_string(";\n", !IO),
+ write_goal(Lines, Ind + 1, Type, Else, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(")", !IO).
:- pred write_ite0(lines, int, goal_type, list(pair(goal)), varset,
io__state, io__state).
:- mode write_ite0(in, in, in, in, in, di, uo) is det.
-write_ite0(_Lines, _Ind, _Type, [], _VarSet) -->
- { error("no if-thens") }.
-write_ite0(Lines, Ind, Type, [If - Then], VarSet) -->
- write_goal(Lines, Ind + 1, Type, If, VarSet), nl,
- write_ind(Ind),
- write_string("->\n"),
- write_goal(Lines, Ind + 1, Type, Then, VarSet), nl.
-write_ite0(Lines, Ind, Type, [If - Then|Rest], VarSet) -->
- { Rest = [_|_] },
- write_goal(Lines, Ind + 1, Type, If, VarSet), nl,
- write_ind(Ind),
- write_string("->\n"),
- write_goal(Lines, Ind + 1, Type, Then, VarSet), nl,
- write_ind(Ind),
- write_string(";\n"),
- write_ite0(Lines, Ind, Type, Rest, VarSet).
+write_ite0(_Lines, _Ind, _Type, [], _VarSet, !IO) :-
+ error("no if-thens").
+write_ite0(Lines, Ind, Type, [If - Then], VarSet, !IO) :-
+ write_goal(Lines, Ind + 1, Type, If, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string("->\n", !IO),
+ write_goal(Lines, Ind + 1, Type, Then, VarSet, !IO),
+ io__nl(!IO).
+write_ite0(Lines, Ind, Type, [If - Then | Rest], VarSet, !IO) :-
+ Rest = [_|_],
+ write_goal(Lines, Ind + 1, Type, If, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string("->\n", !IO),
+ write_goal(Lines, Ind + 1, Type, Then, VarSet, !IO),
+ io__nl(!IO),
+ write_ind(Ind, !IO),
+ io__write_string(";\n", !IO),
+ write_ite0(Lines, Ind, Type, Rest, VarSet, !IO).
%------------------------------------------------------------------------------%
:- pred write_vars(vars, varset, io__state, io__state).
:- mode write_vars(in, in, di, uo) is det.
-write_vars([], _) --> [].
-write_vars([V], VarSet) -->
- write_variable(V, VarSet).
-write_vars([V|Vs], VarSet) -->
- { Vs = [_|_] },
- write_variable(V, VarSet),
- write_string(", "),
- write_vars(Vs, VarSet).
+write_vars([], _, !IO).
+write_vars([V], VarSet, !IO) :-
+ term_io__write_variable(V, VarSet, !IO).
+write_vars([V | Vs], VarSet, !IO) :-
+ Vs = [_|_],
+ term_io__write_variable(V, VarSet, !IO),
+ io__write_string(", ", !IO),
+ write_vars(Vs, VarSet, !IO).
Index: misc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/misc.m,v
retrieving revision 1.1
diff -u -r1.1 misc.m
--- misc.m 22 May 2000 05:22:04 -0000 1.1
+++ misc.m 9 Jul 2003 08:21:58 -0000
@@ -8,7 +8,7 @@
:- interface.
-:- import_module int, map, set, std_util.
+:- import_module map, set, std_util.
:- type '' ---> ''.
@@ -26,9 +26,6 @@
:- func (set(T) - set(T)) = set(T).
-:- pred between(int, int, int).
-:- mode between(in, in, out) is nondet.
-
:- implementation.
empty = Empty :-
@@ -41,12 +38,3 @@
A \/ B = C :- set__union(A, B, C).
A - B = C :- set__difference(A, B, C).
-
-between(Min, Max, Z) :-
- Min =< Max,
- (
- Z = Min
- ;
- between(Min + 1, Max, Z)
- ).
-
Index: moose.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/moose.m,v
retrieving revision 1.6
diff -u -r1.6 moose.m
--- moose.m 9 Jul 2003 07:43:38 -0000 1.6
+++ moose.m 15 Jul 2003 08:54:46 -0000
@@ -25,59 +25,61 @@
:- import_module array, bool, getopt, int, list, map, require.
:- import_module set, std_util, string, term, term_io, varset.
-main -->
- parse_options(MOptions, Args),
+main(!IO) :-
+ parse_options(MOptions, Args, !IO),
(
- { MOptions = ok(Options) },
- { lookup_bool_option(Options, help, Help) },
- ( { Help = yes } ->
- help
+ MOptions = ok(Options),
+ lookup_bool_option(Options, help, Help),
+ ( Help = yes ->
+ help(!IO)
;
- main2(Options, Args)
+ main2(Options, Args, !IO)
)
;
- { MOptions = error(String) },
- stderr_stream(StdErr),
- write_string(StdErr, String),
- nl(StdErr)
+ MOptions = error(String),
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr, String, !IO),
+ nl(StdErr, !IO)
).
:- pred main2(options::in, list(string)::in, io__state::di, io__state::uo).
-main2(_Options, []) -->
- stderr_stream(StdErr),
- write_string(StdErr, "no input files.\n"),
- help.
-main2(Options, [Name0|Names]) -->
- { figure_out_names(Name0, InName, OutName) },
- see(InName, Res0),
+
+main2(_Options, [], !IO) :-
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr, "no input files.\n", !IO),
+ help(!IO).
+main2(Options, [Name0 | Names], !IO) :-
+ figure_out_names(Name0, InName, OutName),
+ io__see(InName, Res0, !IO),
(
- { Res0 = ok },
- tell(OutName, Res1),
+ Res0 = ok,
+ io__tell(OutName, Res1, !IO),
(
- { Res1 = ok },
- process(Options),
- told
+ Res1 = ok,
+ process(Options, !IO),
+ io__told(!IO)
;
- { Res1 = error(Err) },
- { error_message(Err, Msg) },
- stderr_stream(StdErr),
- write_string(StdErr, Msg),
- nl(StdErr)
+ Res1 = error(Err),
+ io__error_message(Err, Msg),
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr, Msg, !IO),
+ nl(StdErr, !IO)
)
;
- { Res0 = error(Err) },
- { error_message(Err, Msg) },
- stderr_stream(StdErr),
- write_string(StdErr, Msg),
- nl(StdErr)
+ Res0 = error(Err),
+ io__error_message(Err, Msg),
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr, Msg, !IO),
+ nl(StdErr, !IO)
),
- ( { Names = [_|_] } ->
- main2(Options, Names)
+ ( Names = [_|_] ->
+ main2(Options, Names, !IO)
;
- []
+ true
).
:- pred figure_out_names(string::in, string::out, string::out) is det.
+
figure_out_names(Name0, InName, OutName) :-
( string__remove_suffix(Name0, ".moo", Name1) ->
Name = Name1
@@ -103,36 +105,39 @@
:- pred process(options::in, io__state::di, io__state::uo) is det.
-process(Options) -->
- { lookup_bool_option(Options, verbose, Verbse) },
- ( { Verbse = yes } -> report_stats ; [] ),
- read_module(Result),
- { Result = module(Module, Errors) },
+process(Options, !IO) :-
+ lookup_bool_option(Options, verbose, Verbse),
+ ( Verbse = yes -> report_stats(!IO) ; true ),
+ read_module(Result, !IO),
+ Result = module(Module, Errors),
(
- { Errors = [_|_] },
- stderr_stream(StdErr),
- foldl((pred(Err::in, di, uo) is det -->
- { Err = error(Msg, Line) },
- format(StdErr, "%d: %s\n", [i(Line), s(Msg)])
- ), Errors)
+ Errors = [_|_],
+ io__stderr_stream(StdErr, !IO),
+ list__foldl((pred(Err::in, !.IO::di, !:IO::uo) is det :-
+ Err = error(Msg, Line),
+ io__format(StdErr, "%d: %s\n", [i(Line), s(Msg)], !IO)
+ ), Errors, !IO)
;
- { Errors = [] },
- { get_moose_elements(Module, [], Remainder0, (implementation),
+ Errors = [],
+ get_moose_elements(Module, [], Remainder0, (implementation),
[], MParser, [], RuleDecls, [], ClauseList,
- [], XFormList) },
+ [], XFormList),
(
- { MParser = [] },
- stderr_stream(StdErr),
- write_string(StdErr, "error: no parse/6 declaration.\n")
+ MParser = [],
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr,
+ "error: no parse/6 declaration.\n", !IO)
;
- { MParser = [Parser] },
- { reverse(Remainder0, Remainder) },
+ MParser = [Parser],
+ list__reverse(Remainder0, Remainder),
process_2(Options, Remainder, Parser,
- RuleDecls, ClauseList, XFormList)
+ RuleDecls, ClauseList, XFormList, !IO)
;
- { MParser = [_,_|_] },
- stderr_stream(StdErr),
- write_string(StdErr, "error: more than one parse/4 declaration.\n")
+ MParser = [_,_|_],
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr,
+ "error: more than one parse/4 declaration.\n",
+ !IO)
)
).
@@ -140,103 +145,106 @@
list(xform), io__state, io__state).
:- mode process_2(in, in, in, in, in, in, di, uo) is det.
-process_2(Options, Module, Parser, Decls0, Clauses0, XFormList) -->
- { lookup_bool_option(Options, verbose, Verbse) },
- ( { Verbse = yes } -> report_stats ; [] ),
+process_2(Options, Module, Parser, Decls0, Clauses0, XFormList, !IO) :-
+ lookup_bool_option(Options, verbose, Verbse),
+ ( Verbse = yes -> report_stats(!IO) ; true ),
- { check_rule_decls(Decls0, Decls, DeclErrors) },
- foldl(write_error, DeclErrors),
+ check_rule_decls(Decls0, Decls, DeclErrors),
+ list__foldl(write_error, DeclErrors, !IO),
- { check_clauses(Clauses0, Decls, Clauses, ClauseErrors) },
- foldl(write_error, ClauseErrors),
+ check_clauses(Clauses0, Decls, Clauses, ClauseErrors),
+ list__foldl(write_error, ClauseErrors, !IO),
- { Parser = parser(WhereAmI, StartId, EndTerm, TokenType, _Prefix,
- InAtom, OutAtom) },
+ Parser = parser(WhereAmI, StartId, EndTerm, TokenType, _Prefix, InAtom,
+ OutAtom),
- { check_useless(StartId, Clauses, Decls, UselessErrors) },
- foldl(write_error, UselessErrors),
+ check_useless(StartId, Clauses, Decls, UselessErrors),
+ list__foldl(write_error, UselessErrors, !IO),
- { check_inf_derivations(Clauses, Decls, InfErrors) },
- foldl(write_error, InfErrors),
+ check_inf_derivations(Clauses, Decls, InfErrors),
+ list__foldl(write_error, InfErrors, !IO),
(
- { DeclErrors = [] },
- { ClauseErrors = [] },
- { UselessErrors = [] },
- { InfErrors = [] }
+ DeclErrors = [],
+ ClauseErrors = [],
+ UselessErrors = [],
+ InfErrors = []
->
- write_module(nolines, Module), nl,
- { lookup(Decls, StartId, StartDecl) },
+ write_module(nolines, Module, !IO), io__nl(!IO),
+ map__lookup(Decls, StartId, StartDecl),
write_parser(WhereAmI, StartId, StartDecl, TokenType,
- InAtom, OutAtom),
+ InAtom, OutAtom, !IO),
write_action_type_class(WhereAmI, XFormList, Decls,
- TokenType, InAtom, OutAtom),
+ TokenType, InAtom, OutAtom, !IO),
- stderr_stream(StdErr),
- write_string(StdErr, "constructing grammar...\n"),
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr, "constructing grammar...\n", !IO),
- { map__init(Xfns0) },
- { foldl((pred(XForm::in, Xf0::in, Xf::out) is det :-
+ map__init(Xfns0),
+ list__foldl((pred(XForm::in, Xf0::in, Xf::out) is det :-
XForm = xform(XfNt, _),
map__det_insert(Xf0, XfNt, XForm, Xf)
- ), XFormList, Xfns0, XForms) },
+ ), XFormList, Xfns0, XForms),
- { construct_grammar(StartId, Clauses, XForms, Grammar) },
- { Grammar = grammar(Rules, _, Xfns, _, Index, First, _Follow) },
- { reaching(Rules, First, Reaching) },
-
- write_string(StdErr, "constructing lr(0) items...\n"),
- { lr0items(Rules, Reaching, C, Gotos) },
- write_string(StdErr, "determining lookaheads...\n"),
- lookaheads(C, Gotos, Rules, First, Index, Lookaheads),
- write_string(StdErr, "computing the action table...\n"),
- { shifts(C, Rules, First, Reaching, Shifts) },
- { actions(C, Rules, Lookaheads, Gotos, Shifts,
- States, ActionTable, ActionErrs) },
- foldl2((pred(Err::in, HasEs0::in, HasEs::out, di, uo) is det -->
+ construct_grammar(StartId, Clauses, XForms, Grammar),
+ Grammar = grammar(Rules, _, Xfns, _, Index, First, _Follow),
+ reaching(Rules, First, Reaching),
+
+ io__write_string(StdErr, "constructing lr(0) items...\n", !IO),
+ lr0items(Rules, Reaching, C, Gotos),
+ io__write_string(StdErr, "determining lookaheads...\n", !IO),
+ lookaheads(C, Gotos, Rules, First, Index, Lookaheads, !IO),
+ io__write_string(StdErr, "computing the action table...\n",
+ !IO),
+ shifts(C, Rules, First, Reaching, Shifts),
+ actions(C, Rules, Lookaheads, Gotos, Shifts, States,
+ ActionTable, ActionErrs),
+ list__foldl2(
+ (pred(Err::in, HasEs0::in, HasEs::out, !.IO::di,
+ !:IO::uo) is det :-
(
- { Err = warning(Warning) },
- { HasEs = HasEs0 },
+ Err = warning(Warning),
+ HasEs = HasEs0,
(
- { Warning = shiftreduce(_S, Rp) },
- write_string(StdErr,
- "shift reduce conflict involving:\n\t"),
- write_rule(StdErr, Rp, Rules)
+ Warning = shiftreduce(_S, Rp),
+ io__write_string(StdErr,
+ "shift reduce conflict involving:\n\t", !IO),
+ write_rule(StdErr, Rp, Rules, !IO)
)
;
- { Err = error(Error) },
- { HasEs = yes },
+ Err = error(Error),
+ HasEs = yes,
(
- { Error = shiftshift(_, _) },
- write_string(StdErr,
- "shift shift error.\n")
+ Error = shiftshift(_, _),
+ io__write_string(StdErr,
+ "shift shift error.\n", !IO)
;
- { Error = reducereduce(R0, R1) },
- write_string(StdErr,
- "reduce reduce conflict involving:\n\t"),
- write_rule(StdErr, R0, Rules),
- write_string(StdErr, "\t"),
- write_rule(StdErr, R1, Rules)
+ Error = reducereduce(R0, R1),
+ io__write_string(StdErr, "reduce reduce conflict involving:\n\t",
+ !IO),
+ write_rule(StdErr, R0, Rules, !IO),
+ io__write_string(StdErr, "\t", !IO),
+ write_rule(StdErr, R1, Rules, !IO)
;
- { Error = misc(Ac1, Ac2) },
- write_string(StdErr,
- "misc conflict involving:\n\t"),
- write(StdErr, Ac1),
- write_string(StdErr, "\n\t"),
- write(StdErr, Ac2),
- write_string(StdErr, "\n")
+ Error = misc(Ac1, Ac2),
+ io__write_string(StdErr,
+ "misc conflict involving:\n\t",
+ !IO),
+ io__write(StdErr, Ac1, !IO),
+ io__write_string(StdErr, "\n\t", !IO),
+ io__write(StdErr, Ac2, !IO),
+ io__write_string(StdErr, "\n", !IO)
)
)
- ), ActionErrs, no, _HasErrors),
- write_action_table(ActionTable, TokenType, EndTerm),
- write_string(StdErr, "computing the goto table...\n"),
- { gotos(C, States, Gotos, GotoTable) },
- write_goto_table(GotoTable, Decls),
- write_reductions(Rules, ActionTable, TokenType,
- InAtom, OutAtom, Xfns),
- []
+ ), ActionErrs, no, _HasErrors, !IO),
+ write_action_table(ActionTable, TokenType, EndTerm, !IO),
+ io__write_string(StdErr, "computing the goto table...\n", !IO),
+ gotos(C, States, Gotos, GotoTable),
+ write_goto_table(GotoTable, Decls, !IO),
+ write_reductions(Rules, ActionTable, TokenType, InAtom,
+ OutAtom, Xfns, !IO)
;
- []
+ true
).
%------------------------------------------------------------------------------%
@@ -245,11 +253,12 @@
string, string, string, io__state, io__state).
:- mode write_action_type_class(in, in, in, in, in, in, di, uo) is det.
-write_action_type_class(Where, XForms, Decls, TokenType, InAtom, OutAtom) -->
- ( { Where = (interface) } ->
- write_string(":- interface.\n\n")
+write_action_type_class(Where, XForms, Decls, TokenType, InAtom, OutAtom,
+ !IO) :-
+ ( Where = (interface) ->
+ io__write_string(":- interface.\n\n", !IO)
;
- []
+ true
),
io__format("\
:- typeclass parser_state(T) where [
@@ -259,37 +268,36 @@
mode unget_token(in, %s) = %s is det\
",
[s(TokenType), s(InAtom), s(OutAtom),
- s(TokenType), s(InAtom), s(OutAtom)]
+ s(TokenType), s(InAtom), s(OutAtom)], !IO
),
- ( { not XForms = [] } ->
- io__write_string(",\n")
+ ( not XForms = [] ->
+ io__write_string(",\n", !IO)
;
- []
+ true
),
- { WriteIn = (pred(_Anything::in, di, uo) is det -->
- io__write_string("in"))
- },
- { WriteXForm = (pred(XForm::in, di, uo) is det -->
- { XForm = xform(NT, MethodName) },
- { lookup(Decls, NT, RuleDecl) },
- { RuleDecl = rule(_NT, Types, VarSet, _Context) },
- io__format("\tfunc %s(", [s(MethodName)]),
- io__write_list(Types, ", ", term_io__write_term(VarSet)),
- ( { Types \= [] } -> io__write_string(", ") ; [] ),
- io__write_string("T) = T,\n"),
-
- io__format("\tmode %s(", [s(MethodName)]),
- io__write_list(Types, ", ", WriteIn),
- ( { Types \= [] } -> io__write_string(", ") ; [] ),
- io__format("%s) = %s is det", [s(InAtom), s(OutAtom)])
- )
- },
- io__write_list(XForms, ",\n", WriteXForm),
- io__write_string("\n].\n"),
- ( { Where = (interface) } ->
- write_string(":- implementation.\n\n")
+ WriteIn = (pred(_Anything::in, !.IO::di, !:IO::uo) is det :-
+ io__write_string("in", !IO)
+ ),
+ WriteXForm = (pred(XForm::in, !.IO::di, !:IO::uo) is det :-
+ XForm = xform(NT, MethodName),
+ map__lookup(Decls, NT, RuleDecl),
+ RuleDecl = rule(_NT, Types, VarSet, _Context),
+ io__format("\tfunc %s(", [s(MethodName)], !IO),
+ io__write_list(Types, ", ", term_io__write_term(VarSet), !IO),
+ ( Types \= [] -> io__write_string(", ", !IO) ; true ),
+ io__write_string("T) = T,\n", !IO),
+
+ io__format("\tmode %s(", [s(MethodName)], !IO),
+ io__write_list(Types, ", ", WriteIn, !IO),
+ ( Types \= [] -> io__write_string(", ", !IO) ; true ),
+ io__format("%s) = %s is det", [s(InAtom), s(OutAtom)], !IO)
+ ),
+ io__write_list(XForms, ",\n", WriteXForm, !IO),
+ io__write_string("\n].\n", !IO),
+ ( Where = (interface) ->
+ io__write_string(":- implementation.\n\n", !IO)
;
- []
+ true
).
%------------------------------------------------------------------------------%
@@ -297,32 +305,33 @@
:- pred write_rule(output_stream, int, rules, io__state, io__state).
:- mode write_rule(in, in, in, di, uo) is det.
-write_rule(Stream, RN, Rules) -->
- { lookup(Rules, RN, Rule) },
- write_int(Stream, RN), write_string(Stream, ": "),
- { Rule = rule(NT, _, Syms, _, _, _, _) },
- write(Stream, NT),
- write_string(Stream, " ->\t"),
- write_syms(Stream, 0, 999, Syms),
- write_string(Stream, "\n").
+write_rule(Stream, RN, Rules, !IO) :-
+ map__lookup(Rules, RN, Rule),
+ io__write_int(Stream, RN, !IO),
+ io__write_string(Stream, ": ", !IO),
+ Rule = rule(NT, _, Syms, _, _, _, _),
+ io__write(Stream, NT, !IO),
+ io__write_string(Stream, " ->\t", !IO),
+ write_syms(Stream, 0, 999, Syms, !IO),
+ io__write_string(Stream, "\n", !IO).
:- pred write_syms(output_stream, int, int, symbols, io__state, io__state).
:- mode write_syms(in, in, in, in, di, uo) is det.
-write_syms(Stream, N, Dot, Syms) -->
- ( { N = Dot } ->
- write_string(Stream, ". ")
- ;
- []
- ),
- { array__max(Syms, Max) },
- ( { N =< Max } ->
- { lookup(Syms, N, Sym) },
- write(Stream, Sym),
- write_string(Stream, " "),
- write_syms(Stream, N + 1, Dot, Syms)
+write_syms(Stream, N, Dot, Syms, !IO) :-
+ ( N = Dot ->
+ io__write_string(Stream, ". ", !IO)
+ ;
+ true
+ ),
+ array__max(Syms, Max),
+ ( N =< Max ->
+ array__lookup(Syms, N, Sym),
+ io__write(Stream, Sym, !IO),
+ io__write_string(Stream, " ", !IO),
+ write_syms(Stream, N + 1, Dot, Syms, !IO)
;
- []
+ true
).
%------------------------------------------------------------------------------%
@@ -333,88 +342,54 @@
:- mode get_moose_elements(in, in, out, in, in, out, in, out, in, out,
in, out) is det.
-get_moose_elements([], Remainder, Remainder, _WhereAmI, MParser, MParser,
- RuleDecls, RuleDecls, Clauses, Clauses, Actions, Actions).
-get_moose_elements([Element|Elements], Remainder0, Remainder, WhereAmI0,
- MParser0, MParser, RuleDecls0, RuleDecls, Clauses0, Clauses,
- Actions0, Actions) :-
+get_moose_elements([], !Remainder, _, !MParser, !RuleDecls, !Clauses, !Actions).
+get_moose_elements([Element | Elements], !Remainder, !.WhereAmI, !MParser,
+ !RuleDecls, !Clauses, !Actions) :-
(
Element = misc(ClauseTerm, ClauseVarSet),
term_to_clause(ClauseTerm, ClauseVarSet, _, Clause)
->
- WhereAmI = WhereAmI0,
- Remainder1 = Remainder0,
- MParser1 = MParser0,
- RuleDecls1 = RuleDecls0,
- Clauses1 = [Clause|Clauses0],
- Actions1 = Actions0
+ list.append([Clause], !Clauses)
;
Element = misc(MiscTerm0, _),
interface_term(MiscTerm0)
->
- WhereAmI = (interface),
- Remainder1 = [Element|Remainder0],
- MParser1 = MParser0,
- RuleDecls1 = RuleDecls0,
- Clauses1 = Clauses0,
- Actions1 = Actions0
+ !:WhereAmI = (interface),
+ list.append([Element], !Remainder)
;
Element = misc(MiscTerm1, _),
implementation_term(MiscTerm1)
->
- WhereAmI = (implementation),
- Remainder1 = [Element|Remainder0],
- MParser1 = MParser0,
- RuleDecls1 = RuleDecls0,
- Clauses1 = Clauses0,
- Actions1 = Actions0
+ !:WhereAmI = (implementation),
+ list.append([Element], !Remainder)
;
Element = misc(MiscTerm2, MiscVarSet2),
rule_term(MiscTerm2, MiscVarSet2, RuleDecl)
->
- WhereAmI = WhereAmI0,
- Remainder1 = Remainder0,
- MParser1 = MParser0,
- RuleDecls1 = [RuleDecl|RuleDecls0],
- Clauses1 = Clauses0,
- Actions1 = Actions0
+ list.append([RuleDecl], !RuleDecls)
;
Element = misc(MiscTerm3, MiscVarSet3),
- parser_term(MiscTerm3, MiscVarSet3, WhereAmI0, Parser)
+ parser_term(MiscTerm3, MiscVarSet3, !.WhereAmI, Parser)
->
- WhereAmI = WhereAmI0,
- Remainder1 = Remainder0,
- MParser1 = [Parser|MParser0],
- RuleDecls1 = RuleDecls0,
- Clauses1 = Clauses0,
- Actions1 = Actions0
+ list.append([Parser], !MParser)
;
Element = misc(MiscTerm4, _),
xform_term(MiscTerm4, XForm)
->
- WhereAmI = WhereAmI0,
- Remainder1 = Remainder0,
- MParser1 = MParser0,
- RuleDecls1 = RuleDecls0,
- Clauses1 = Clauses0,
- Actions1 = [XForm|Actions0]
- ;
- WhereAmI = WhereAmI0,
- Remainder1 = [Element|Remainder0],
- MParser1 = MParser0,
- RuleDecls1 = RuleDecls0,
- Clauses1 = Clauses0,
- Actions1 = Actions0
- ),
- get_moose_elements(Elements, Remainder1, Remainder, WhereAmI,
- MParser1, MParser, RuleDecls1, RuleDecls, Clauses1, Clauses,
- Actions1, Actions).
+ list.append([XForm], !Actions)
+ ;
+ list.append([Element], !Remainder)
+ ),
+ get_moose_elements(Elements, !Remainder, !.WhereAmI, !MParser,
+ !RuleDecls, !Clauses, !Actions).
:- pred interface_term(term::in) is semidet.
+
interface_term(functor(atom(":-"), [functor(atom("interface"), [], _)], _)).
:- pred implementation_term(term::in) is semidet.
-implementation_term(functor(atom(":-"),
+
+implementation_term(functor(atom(":-"),
[functor(atom("implementation"), [], _)], _)).
:- pred rule_term(term, varset, rule_decl).
@@ -431,8 +406,8 @@
parser_term(functor(atom(":-"), [functor(atom("parse"), Args, _)], _),
_VarSet, WhereAmI, Decl) :-
- Args = [StartIdTerm, TokTerm, EndTerm,
- PrefixTerm, InAtomTerm, OutAtomTerm],
+ Args = [StartIdTerm, TokTerm, EndTerm, PrefixTerm, InAtomTerm,
+ OutAtomTerm],
StartIdTerm = functor(atom("/"), [functor(atom(Name), [], _),
functor(integer(Arity), _, _)], _),
StartId = Name / Arity,
@@ -440,8 +415,8 @@
PrefixTerm = functor(atom(PrefixAtom), [], _),
InAtomTerm = functor(atom(InAtom), [], _),
OutAtomTerm = functor(atom(OutAtom), [], _),
- Decl = parser(WhereAmI, StartId, EndTerm, TokAtom,
- PrefixAtom, InAtom, OutAtom).
+ Decl = parser(WhereAmI, StartId, EndTerm, TokAtom, PrefixAtom, InAtom,
+ OutAtom).
:- pred xform_term(term, xform).
:- mode xform_term(in, out) is semidet.
@@ -463,9 +438,9 @@
:- pred help(io__state, io__state).
:- mode help(di, uo) is det.
-help -->
- stderr_stream(StdErr),
- write_string(StdErr, "\
+help(!IO) :-
+ io__stderr_stream(StdErr, !IO),
+ io__write_string(StdErr, "\
usage: moose <options> file ...
-h|--help help
-a|--dump-action dump the action table
@@ -474,17 +449,17 @@
-a|--dump-goto dump the goto table
-a|--dump-items dump the item sets
-a|--dump-rules dump the flattened rules
-" ).
+", !IO).
%------------------------------------------------------------------------------%
:- pred write_action_table(actiontable, string, term, io__state, io__state).
:- mode write_action_table(in, in, in, di, uo) is det.
-write_action_table(Table, TT, End) -->
- io__format(":- inst state_no --->\n\t\t", []),
- io__write_list(map__keys(Table), "\n\t;\t", io__write_int),
- io__format(".\n:- inst state_nos == list_skel(state_no).\n\n", []),
+write_action_table(Table, TT, End, !IO) :-
+ io__format(":- inst state_no --->\n\t\t", [], !IO),
+ io__write_list(map__keys(Table), "\n\t;\t", io__write_int, !IO),
+ io__format(".\n:- inst state_nos == list_skel(state_no).\n\n", [], !IO),
io__format("\
:- type parsing_action
---> shift
@@ -495,10 +470,11 @@
:- mode actions(in(state_no), in, out, out(state_no)) is semidet.
",
- [s(TT)]
- ),
- foldl((pred(State::in, StateActions::in, di,uo) is det -->
- { format("0x%x", [i(State)], SS) },
+ [s(TT)],
+ !IO),
+ map__foldl((pred(State::in, StateActions::in, !.IO::di,
+ !:IO::uo) is det :-
+ string__format("0x%x", [i(State)], SS),
io__format("\
actions(%s, Tok, Action, Value) :-
actions%s(Tok, Action, Value).
@@ -507,39 +483,39 @@
:- mode actions%s(in, out, out(state_no)) is semidet.
",
- [s(SS), s(SS), s(SS), s(TT), s(SS)]
- ),
- write_state_actions(SS, End, StateActions)
- ), Table).
+ [s(SS), s(SS), s(SS), s(TT), s(SS)],
+ !IO),
+ write_state_actions(SS, End, StateActions, !IO)
+ ), Table, !IO).
:- pred write_state_actions(string, term, (terminal -> action),
io__state, io__state).
:- mode write_state_actions(in, in, in, di, uo) is det.
-write_state_actions(SS, End, StateActions) -->
- { format("actions%s", [s(SS)], Name) },
- foldl((pred(Terminal::in, Action::in, di, uo) is det -->
- { terminal_to_term(Terminal, End, Token) },
- { context_init(Ctxt) },
- { Term = functor(atom(Name),
+write_state_actions(SS, End, StateActions, !IO) :-
+ string__format("actions%s", [s(SS)], Name),
+ map__foldl((pred(Terminal::in, Action::in, !.IO::di, !:IO::uo) is det :-
+ terminal_to_term(Terminal, End, Token),
+ term__context_init(Ctxt),
+ Term = functor(atom(Name),
[Token,
functor(atom(Kind), [], Ctxt),
- functor(integer(Val), [], Ctxt)], Ctxt) },
+ functor(integer(Val), [], Ctxt)], Ctxt),
(
- { Action = shift(Val) },
- { Kind = "shift" }
+ Action = shift(Val),
+ Kind = "shift"
;
- { Action = reduce(Val) },
- { Kind = "reduce" }
+ Action = reduce(Val),
+ Kind = "reduce"
;
- { Action = accept },
- { Kind = "accept" },
- { Val = 0 }
+ Action = accept,
+ Kind = "accept",
+ Val = 0
),
- { init(Varset) },
- term_io__write_term_nl(Varset, Term)
- ), StateActions),
- nl.
+ varset__init(Varset),
+ term_io__write_term_nl(Varset, Term, !IO)
+ ), StateActions, !IO),
+ io__nl(!IO).
:- pred terminal_to_term(terminal, term, term).
:- mode terminal_to_term(in, in, out) is det.
@@ -547,10 +523,10 @@
terminal_to_term(epsilon, _, _) :-
error("terminal_to_term: unexpected epsilon").
terminal_to_term(Name/Arity, _, Term) :-
- init(V0),
- new_vars(V0, Arity, Vars, _),
- context_init(Ctxt),
- map((pred(Var::in, T::out) is det :-
+ varset__init(V0),
+ varset__new_vars(V0, Arity, Vars, _),
+ term__context_init(Ctxt),
+ list__map((pred(Var::in, T::out) is det :-
T = variable(Var)
), Vars, Args),
Term = functor(atom(Name), Args, Ctxt).
@@ -563,16 +539,16 @@
:- pred write_goto_table(gototable, rule_decls, io__state, io__state).
:- mode write_goto_table(in, in, di, uo) is det.
-write_goto_table(Table, DeclTable) -->
- { values(DeclTable, Decls) },
- write_nonterminal_type(Decls),
- write_string("\
+write_goto_table(Table, DeclTable, !IO) :-
+ map__values(DeclTable, Decls),
+ write_nonterminal_type(Decls, !IO),
+ io__write_string("\
:- pred gotos(int, nonterminal, int).
:- mode gotos(in(state_no), in, out(state_no)) is semidet.
-" ),
- foldl((pred(State::in, StateActions::in, di,uo) is det -->
- { format("0x%x", [i(State)], SS) },
+", !IO),
+ WriteGotos = (pred(State::in, Actions::in, !.IO::di, !:IO::uo) is det :-
+ string__format("0x%x", [i(State)], SS),
io__format("\
gotos(%s, NT, NS) :-
gotos%s(NT, NS).
@@ -581,16 +557,16 @@
:- mode gotos%s(in, out) is semidet.
",
- [s(SS), s(SS), s(SS), s(SS)]
- ),
- write_state_gotos(SS, StateActions)
- ), Table).
+ [s(SS), s(SS), s(SS), s(SS)], !IO),
+ write_state_gotos(SS, Actions, !IO)
+ ),
+ map__foldl(WriteGotos, Table, !IO).
:- pred write_nonterminal_type(list(rule_decl), io__state, io__state).
:- mode write_nonterminal_type(in, di, uo) is det.
-write_nonterminal_type(Ds) -->
- { map((pred(Decl::in, NTType::out) is det :-
+write_nonterminal_type(Ds, !IO) :-
+ list__map((pred(Decl::in, NTType::out) is det :-
Decl = rule(NT, Args, _VS, TC),
(
NT = start,
@@ -599,29 +575,29 @@
NT = Name/_Arity
),
NTType = functor(atom(Name), Args, TC)
- ), Ds, NTTypes) },
- { context_init(Ctxt) },
- { init(Varset) },
- { Type = disj(functor(atom("nonterminal"), [], Ctxt), NTTypes) },
- { Element = type(Type, Varset) },
- write_element(nolines, Element),
- nl.
+ ), Ds, NTTypes),
+ term__context_init(Ctxt),
+ varset__init(Varset),
+ Type = disj(functor(atom("nonterminal"), [], Ctxt), NTTypes),
+ Element = type(Type, Varset),
+ write_element(nolines, Element, !IO),
+ io__nl(!IO).
:- pred write_state_gotos(string, (nonterminal -> grammar__state),
io__state, io__state).
:- mode write_state_gotos(in, in, di, uo) is det.
-write_state_gotos(SS, StateActions) -->
- { format("gotos%s", [s(SS)], Name) },
- foldl((pred(NT::in, NS::in, di, uo) is det -->
- { nonterminal_to_term(NT, Token) },
- { context_init(Ctxt) },
- { Term = functor(atom(Name),
- [Token, functor(integer(NS), [], Ctxt)], Ctxt) },
- { init(Varset) },
- term_io__write_term_nl(Varset, Term)
- ), StateActions),
- nl.
+write_state_gotos(SS, StateActions, !IO) :-
+ string__format("gotos%s", [s(SS)], Name),
+ map__foldl((pred(NT::in, NS::in, !.IO::di, !:IO::uo) is det :-
+ nonterminal_to_term(NT, Token),
+ term__context_init(Ctxt),
+ Term = functor(atom(Name),
+ [Token, functor(integer(NS), [], Ctxt)], Ctxt),
+ varset__init(Varset),
+ term_io__write_term_nl(Varset, Term, !IO)
+ ), StateActions, !IO),
+ io__nl(!IO).
:- pred nonterminal_to_term(nonterminal, term).
:- mode nonterminal_to_term(in, out) is det.
@@ -629,10 +605,10 @@
nonterminal_to_term(start, _) :-
error("nonterminal_to_term: unexpected start").
nonterminal_to_term(Name/Arity, Term) :-
- init(V0),
- new_vars(V0, Arity, Vars, _),
- context_init(Ctxt),
- map((pred(Var::in, T::out) is det :-
+ varset__init(V0),
+ varset__new_vars(V0, Arity, Vars, _),
+ term__context_init(Ctxt),
+ list__map((pred(Var::in, T::out) is det :-
T = variable(Var)
), Vars, Args),
Term = functor(atom(Name), Args, Ctxt).
@@ -643,30 +619,30 @@
io__state, io__state).
:- mode write_parser(in, in, in, in, in, in, di, uo) is det.
-write_parser(Where, NT, Decl, _TT, InAtom, OutAtom) -->
+write_parser(Where, NT, Decl, _TT, InAtom, OutAtom, !IO) :-
(
- { NT = StartName/StartArity }
+ NT = StartName/StartArity
;
- { NT = start },
- { error("write_parser: start!") }
+ NT = start,
+ error("write_parser: start!")
),
- { Decl = rule(_, DeclArgs, DeclVarset, DeclCtxt) },
- { init(Varset0) },
- { mkstartargs(StartArity, [], StartArgs, Varset0, Varset) },
- { StartTerm = functor(atom(StartName), StartArgs, Ctxt) },
- { context_init(Ctxt) },
- { ParseResultType = type(disj(functor(atom("parse_result"), [], Ctxt),
- [OkayType, ErrorType]), DeclVarset) },
- { OkayType = functor(atom(StartName), DeclArgs, DeclCtxt) },
- { ErrorType = functor(atom("error"), [
- functor(atom("string"), [], Ctxt)], Ctxt) },
- ( { Where = (interface) } ->
- write_string(":- interface.\n\n")
+ Decl = rule(_, DeclArgs, DeclVarset, DeclCtxt),
+ varset__init(Varset0),
+ mkstartargs(StartArity, [], StartArgs, Varset0, Varset),
+ StartTerm = functor(atom(StartName), StartArgs, Ctxt),
+ term__context_init(Ctxt),
+ ParseResultType = type(disj(functor(atom("parse_result"), [], Ctxt),
+ [OkayType, ErrorType]), DeclVarset),
+ OkayType = functor(atom(StartName), DeclArgs, DeclCtxt),
+ ErrorType = functor(atom("error"), [
+ functor(atom("string"), [], Ctxt)], Ctxt),
+ ( Where = (interface) ->
+ io__write_string(":- interface.\n\n", !IO)
;
- []
+ true
),
- write_element(nolines, ParseResultType),
- nl,
+ write_element(nolines, ParseResultType, !IO),
+ io__nl(!IO),
io__format("\
:- import_module list.
@@ -674,12 +650,12 @@
:- mode parse(out, %s, %s) is det.
",
- [s(InAtom), s(OutAtom)]
- ),
- ( { Where = (interface) } ->
- write_string(":- implementation.\n\n")
+ [s(InAtom), s(OutAtom)],
+ !IO),
+ ( Where = (interface) ->
+ io__write_string(":- implementation.\n\n", !IO)
;
- []
+ true
),
io__format("\
parse(Result, Toks0, Toks) :-
@@ -708,14 +684,14 @@
;
What = accept,
( Sy0 = [n(",
- [s(InAtom), s(OutAtom)]
- ),
- write_term(Varset, StartTerm),
- write_string(")] ->
- Res = ("
- ),
- write_term(Varset, StartTerm),
- write_string("),
+ [s(InAtom), s(OutAtom)],
+ !IO),
+ term_io__write_term(Varset, StartTerm, !IO),
+ io__write_string(")] ->
+ Res = (",
+ !IO),
+ term_io__write_term(Varset, StartTerm, !IO),
+ io__write_string("),
Toks = Toks1
;
error(""parse: internal accept error"")
@@ -729,22 +705,21 @@
St0 = [],
error(""parse: state stack underflow"")
).
-"
- ).
+",
+ !IO).
:- pred mkstartargs(int, list(term), list(term), varset, varset).
:- mode mkstartargs(in, in, out, in, out) is det.
-mkstartargs(N, Ts0, Ts, VS0, VS) :-
+mkstartargs(N, !Terms, !Varset) :-
( N =< 0 ->
- Ts = Ts0,
- VS = VS0
+ true
;
- format("V%d", [i(N)], VarName),
- new_named_var(VS0, VarName, Var, VS1),
- T = variable(Var),
- Ts1 = [T|Ts0],
- mkstartargs(N - 1, Ts1, Ts, VS1, VS)
+ string__format("V%d", [i(N)], VarName),
+ varset__new_named_var(!.Varset, VarName, Var, !:Varset),
+ Term = term__variable(Var),
+ list__append([Term], !Terms),
+ mkstartargs(N - 1, !Terms, !Varset)
).
%------------------------------------------------------------------------------%
@@ -753,7 +728,7 @@
io__state, io__state).
:- mode write_reductions(in, in, in, in, in, in, di, uo) is det.
-write_reductions(Rules, Table, TT, InAtom, OutAtom, Xfns) -->
+write_reductions(Rules, Table, TT, InAtom, OutAtom, Xfns, !IO) :-
io__format("\
:- import_module require, std_util.
@@ -764,8 +739,8 @@
; t(%s).
",
- [s(TT)]
- ),
+ [s(TT)],
+ !IO),
io__format("
:- pred reduce(int, statestack, statestack,
symbolstack, symbolstack, P, P) <= parser_state(P).
@@ -789,8 +764,8 @@
).
",
- [s(InAtom), s(OutAtom)]
- ),
+ [s(InAtom), s(OutAtom)],
+ !IO),
io__format("\
:- pred reduce0(int, statestack, statestack,
symbolstack, symbolstack, P, P) <= parser_state(P).
@@ -798,21 +773,22 @@
in, out, %s, %s) is det.
",
- [s(InAtom), s(OutAtom)]
- ),
- foldl((pred(Rn::in, Rule::in, di, uo) is det -->
- ( { Rn = 0 } ->
+ [s(InAtom), s(OutAtom)],
+ !IO),
+ map__foldl((pred(Rn::in, Rule::in, !.IO::di, !:IO::uo) is det :-
+ ( Rn = 0 ->
io__write_string("\
reduce0(0x0, _, _, _, _, _, _) :-
reduce0_error(0x0).
-" )
+",
+ !IO)
;
- { RedName = format("reduce0x%x", [i(Rn)]) },
- { RnS = format("0x%x", [i(Rn)]) },
+ RedName = string__format("reduce0x%x", [i(Rn)]),
+ RnS = string__format("0x%x", [i(Rn)]),
io__format("\
reduce0(%s, S0, S, T0, T, U0, U) :-
%s(S0, S, T0, T, U0, U).
@@ -821,60 +797,60 @@
P, P) <= parser_state(P).
:- mode %s(in(state_nos), out(state_nos), in, out, %s, %s) is det.
",
- [s(RnS), s(RedName), s(RedName), s(RedName),
- s(InAtom), s(OutAtom)]
- ),
- { Rule = rule(RNt, Head, _, Body, Actions, Varset0, _C) },
- { new_named_var(Varset0, "M_St0", St0v, Varset1) },
- { St0 = variable(St0v) },
- { new_named_var(Varset1, "M_St1", St1v, Varset2) },
- { St1 = variable(St1v) },
- { new_named_var(Varset2, "M_Sy0", Sy0v, Varset3) },
- { Sy0 = variable(Sy0v) },
- { new_named_var(Varset3, "M_Sy1", Sy1v, Varset4) },
- { Sy1 = variable(Sy1v) },
- { new_named_var(Varset4, "M_RedRes", Resv, Varset5) },
- { Res = variable(Resv) },
- { ResS = functor(atom("n"), [variable(Resv)], Ctxt) },
- { new_named_var(Varset5, "M_D", Dv, Varset6) },
- { _D = variable(Dv) },
- { new_named_var(Varset6, "M_S", Sv, Varset7) },
- { _S = variable(Sv) },
- { new_named_var(Varset7, "M_St", Stv, Varset8) },
- { St = variable(Stv) },
- { new_named_var(Varset8, "M_Sy", Syv, Varset9) },
- { Sy = variable(Syv) },
- { new_named_var(Varset9, "M_Ts0", Ts0v, Varset10) },
- { Ts0 = variable(Ts0v) },
- { new_named_var(Varset10, "M_Ts", Tsv, Varset11) },
- { Ts = variable(Tsv) },
- { context_init(Ctxt) },
- { format("reduction 0x%x failed!", [i(Rn)], Err) },
- { mkstacks(Body, St1, Sts, Sy1, Sys, Varset11, Varset12) },
- { Cond = functor(atom(","), [
+ [s(RnS), s(RedName), s(RedName), s(RedName),
+ s(InAtom), s(OutAtom)],
+ !IO),
+ Rule = rule(RNt, Head, _, Body, Actions, Varset0, _C),
+ varset__new_named_var(Varset0, "M_St0", St0v, Varset1),
+ St0 = variable(St0v),
+ varset__new_named_var(Varset1, "M_St1", St1v, Varset2),
+ St1 = variable(St1v),
+ varset__new_named_var(Varset2, "M_Sy0", Sy0v, Varset3),
+ Sy0 = variable(Sy0v),
+ varset__new_named_var(Varset3, "M_Sy1", Sy1v, Varset4),
+ Sy1 = variable(Sy1v),
+ varset__new_named_var(Varset4, "M_RedRes", Resv, Varset5),
+ Res = variable(Resv),
+ ResS = functor(atom("n"), [variable(Resv)], Ctxt),
+ varset__new_named_var(Varset5, "M_D", Dv, Varset6),
+ _D = variable(Dv),
+ varset__new_named_var(Varset6, "M_S", Sv, Varset7),
+ _S = variable(Sv),
+ varset__new_named_var(Varset7, "M_St", Stv, Varset8),
+ St = variable(Stv),
+ varset__new_named_var(Varset8, "M_Sy", Syv, Varset9),
+ Sy = variable(Syv),
+ varset__new_named_var(Varset9, "M_Ts0", Ts0v, Varset10),
+ Ts0 = variable(Ts0v),
+ varset__new_named_var(Varset10, "M_Ts", Tsv, Varset11),
+ Ts = variable(Tsv),
+ term__context_init(Ctxt),
+ string__format("reduction 0x%x failed!", [i(Rn)], Err),
+ mkstacks(Body, St1, Sts, Sy1, Sys, Varset11, Varset12),
+ Cond = functor(atom(","), [
functor(atom("="), [St0, Sts], Ctxt),
functor(atom("="), [Sy0, Sys], Ctxt)
- ], Ctxt) },
- { Red = functor(atom("="), [Res, Head], Ctxt) },
- { append(Actions, [Red], AllActions0) },
- { reverse(AllActions0, AllActions) },
- { ConsStack = functor(atom(","), [
+ ], Ctxt),
+ Red = functor(atom("="), [Res, Head], Ctxt),
+ list__append(Actions, [Red], AllActions0),
+ list__reverse(AllActions0, AllActions),
+ ConsStack = functor(atom(","), [
functor(atom("="), [Sy, functor(atom("[|]"),
[ResS, Sy1], Ctxt)], Ctxt),
- functor(atom("="), [St, St1], Ctxt)], Ctxt) },
- { mkactions(AllActions, ConsStack, Then0) },
+ functor(atom("="), [St, St1], Ctxt)], Ctxt),
+ mkactions(AllActions, ConsStack, Then0),
(
- { search(Xfns, RNt, xform(_, XFormName)) },
- { Head = functor(_, HeadArgs, _) }
+ map__search(Xfns, RNt, xform(_, XFormName)),
+ Head = functor(_, HeadArgs, _)
->
- { append(HeadArgs, [Ts0], Then1Args) },
- { XFTerm = functor(atom(XFormName), Then1Args, Ctxt) }
+ list__append(HeadArgs, [Ts0], Then1Args),
+ XFTerm = functor(atom(XFormName), Then1Args, Ctxt)
;
- { XFTerm = Ts0 }
+ XFTerm = Ts0
),
- { Then1 = functor(atom("="), [Ts, XFTerm], Ctxt) },
- { Then = functor(atom(","), [Then0, Then1], Ctxt) },
- { BodyTerm = functor(atom(";"),[
+ Then1 = functor(atom("="), [Ts, XFTerm], Ctxt),
+ Then = functor(atom(","), [Then0, Then1], Ctxt),
+ BodyTerm = functor(atom(";"),[
functor(atom("->"), [
Cond,
Then
@@ -882,32 +858,33 @@
functor(atom("error"),
[functor(string(Err), [], Ctxt)],
Ctxt
- )], Ctxt) },
- ( { term_to_goal(BodyTerm, Goal0) } ->
- { Goal = Goal0 }
+ )], Ctxt),
+ ( term_to_goal(BodyTerm, Goal0) ->
+ Goal = Goal0
;
- { error("write_reductions: failed to convert goal") }
+ error("write_reductions: failed to convert goal")
),
- { Clause = clause(
- functor(atom(RedName), [St0, St, Sy0, Sy, Ts0, Ts], Ctxt),
- Goal, Varset12) },
- write_element(lines, Clause),
- nl
+ Clause = clause(
+ functor(atom(RedName), [St0, St, Sy0, Sy, Ts0, Ts],
+ Ctxt),
+ Goal, Varset12),
+ write_element(lines, Clause, !IO),
+ io__nl(!IO)
)
- ), Rules),
- foldl((pred(State::in, _TerminalAction::in, di, uo) is det -->
- ( if not { Rules `contains` State } then
+ ), Rules, !IO),
+ WriteReduceError = (pred(State::in, _::in, !.IO::di, !:IO::uo) is det :-
+ ( if not map__contains(Rules, State)
+ then
io__format("\
reduce0(0x%x, _, _, _, _, _, _) :-
reduce0_error(0x%x).
-",
- [i(State), i(State)]
- )
- )
- ),
- Table
+",
+ [i(State), i(State)], !IO)
+ else true
+ )
),
+ map__foldl(WriteReduceError, Table, !IO),
io__format("\
:- pred reduce0_error(int).
:- mode reduce0_error(in) is erroneous.
@@ -915,17 +892,15 @@
reduce0_error(State) :-
error(string__format(""reduce in state 0x%%x"", [i(State)])).
-",
- []
- ).
+", [], !IO).
:- pred mkstacks(list(bodyterm), term, term, term, term, varset, varset).
:- mode mkstacks(in, in, out, in, out, in, out) is det.
-mkstacks([], St, St, Sy, Sy, VS, VS).
-mkstacks([E0|Es], St0, St, Sy0, Sy, VS0, VS) :-
- new_var(VS0, U, VS1),
- context_init(Ctxt),
+mkstacks([], !St, !Sy, !VS).
+mkstacks([E0 | Es], !St, !Sy, !VS) :-
+ varset__new_var(!.VS, U, !:VS),
+ term__context_init(Ctxt),
(
E0 = terminal(ET),
E = functor(atom("t"), [ET], Ctxt)
@@ -933,18 +908,18 @@
E0 = nonterminal(EN),
E = functor(atom("n"), [EN], Ctxt)
),
- Sy1 = functor(atom("[|]"), [E, Sy0], Ctxt),
- St1 = functor(atom("[|]"), [variable(U), St0], Ctxt),
- mkstacks(Es, St1, St, Sy1, Sy, VS1, VS).
+ !:Sy = functor(atom("[|]"), [E, !.Sy], Ctxt),
+ !:St = functor(atom("[|]"), [variable(U), !.St], Ctxt),
+ mkstacks(Es, !St, !Sy, !VS).
:- pred mkactions(list(term), term, term).
:- mode mkactions(in, in, out) is det.
-mkactions([], Term, Term).
-mkactions([E|Es], Term0, Term) :-
- context_init(Ctxt),
- Term1 = functor(atom(","), [E, Term0], Ctxt),
- mkactions(Es, Term1, Term).
+mkactions([], !Term).
+mkactions([E | Es], !Term) :-
+ term__context_init(Ctxt),
+ !:Term = functor(atom(","), [E, !.Term], Ctxt),
+ mkactions(Es, !Term).
%------------------------------------------------------------------------------%
@@ -952,7 +927,7 @@
:- mode sub(in, in, out) is det.
sub(Orig, Subs, Final) :-
- foldl((pred(Sub::in, S0::in, S1::out) is det :-
+ list__foldl((pred(Sub::in, S0::in, S1::out) is det :-
Sub = From - To,
string__replace_all(S0, From, To, S1)
), Subs, Orig, Final).
Index: options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/options.m,v
retrieving revision 1.1
diff -u -r1.1 options.m
--- options.m 22 May 2000 05:22:05 -0000 1.1
+++ options.m 9 Jul 2003 16:00:35 -0000
@@ -35,10 +35,10 @@
:- import_module bool, char, std_util.
-parse_options(MOpts, Args) -->
- io__command_line_arguments(Args0),
- { OptionOpts = option_ops(short, long, defaults) },
- { getopt__process_options(OptionOpts, Args0, Args, MOpts) }.
+parse_options(MOpts, Args, !IO) :-
+ io__command_line_arguments(Args0, !IO),
+ OptionOpts = option_ops(short, long, defaults),
+ getopt__process_options(OptionOpts, Args0, Args, MOpts).
:- pred short(char, option).
:- mode short(in, out) is semidet.
Index: tables.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/tables.m,v
retrieving revision 1.1
diff -u -r1.1 tables.m
--- tables.m 22 May 2000 05:22:05 -0000 1.1
+++ tables.m 15 Jul 2003 08:30:27 -0000
@@ -48,120 +48,115 @@
%------------------------------------------------------------------------------%
-shifts(_C, _Rules, First, Reaching, Shifts) :-
- init(Shifts0),
- foldl((pred(N::in, Ts0::in, Ss0::in, Ss::out) is det :-
- ( search(Reaching, N, Ns0) ->
+shifts(_C, _Rules, First, Reaching, !:Shifts) :-
+ map__init(!:Shifts),
+ map__foldl((pred(N::in, Ts0::in, !.Shifts::in, !:Shifts::out) is det :-
+ ( map__search(Reaching, N, Ns0) ->
set__to_sorted_list(Ns0, Ns1)
;
Ns1 = []
),
- map(lookup(First), Ns1, Ts1),
- foldl(union, Ts1, Ts0, Ts2),
+ list__map(map__lookup(First), Ns1, Ts1),
+ list__foldl(set__union, Ts1, Ts0, Ts2),
Ts = Ts2 - { epsilon },
- set(Ss0, N, Ts, Ss)
- ), First, Shifts0, Shifts).
+ map__set(!.Shifts, N, Ts, !:Shifts)
+ ), First, !Shifts).
%------------------------------------------------------------------------------%
-actions(C, Rules, Lookaheads, Gotos, Shifts, States, Actions, Errs) :-
+actions(C, Rules, Lookaheads, Gotos, Shifts, !:States, !:Actions, Errs) :-
set__to_sorted_list(C, CList),
- init(States0),
- number_states(CList, 0, States0, States),
- init(Actions0),
- actions1(CList, Rules, Lookaheads, States, Gotos, Shifts,
- Actions0, Actions, [], Errs).
+ map__init(!:States),
+ number_states(CList, 0, !States),
+ map__init(!:Actions),
+ actions1(CList, Rules, Lookaheads, !.States, Gotos, Shifts, !Actions,
+ [], Errs).
:- pred number_states(list(items), int, states, states).
:- mode number_states(in, in, in, out) is det.
-number_states([], _N, States, States).
-number_states([I|Is], N, States0, States) :-
- map__det_insert(States0, I, N, States1),
- number_states(Is, N + 1, States1, States).
+number_states([], _N, !States).
+number_states([I | Is], N, !States) :-
+ map__det_insert(!.States, I, N, !:States),
+ number_states(Is, N + 1, !States).
:- pred actions1(list(items), rules, lookaheads, states, gotos, shifts,
actiontable, actiontable, actionerrors, actionerrors).
:- mode actions1(in, in, in, in, in, in, in, out, in, out) is det.
-actions1([], _Rules, _Lookaheads, _States, _Gotos, _Shifts,
- Actions, Actions, Errs, Errs).
-actions1([I|Is], Rules, Lookaheads, States, Gotos, Shifts,
- Actions0, Actions, Errs0, Errs) :-
- lookup(States, I, Sn),
+actions1([], _Rules, _Lookaheads, _States, _Gotos, _Shifts, !Actions, !Errs).
+actions1([I | Is], Rules, Lookaheads, States, Gotos, Shifts, !Actions, !Errs) :-
+ map__lookup(States, I, Sn),
set__to_sorted_list(I, IList),
- actions2(IList, I, Sn, Rules, Lookaheads, States, Gotos, Shifts,
- Actions0, Actions1, Errs0, Errs1),
- actions1(Is, Rules, Lookaheads, States, Gotos, Shifts,
- Actions1, Actions, Errs1, Errs).
+ actions2(IList, I, Sn, Rules, Lookaheads, States, Gotos, Shifts,
+ !Actions, !Errs),
+ actions1(Is, Rules, Lookaheads, States, Gotos, Shifts, !Actions, !Errs).
:- pred actions2(list(item), items, state, rules, lookaheads, states, gotos,
shifts, actiontable, actiontable, actionerrors, actionerrors).
:- mode actions2(in, in, in, in, in, in, in, in, in, out, in, out) is det.
-actions2([], _I, _Sn, _Rules, _LA, _States, _Gotos, _Shifts,
- Actions, Actions, Errs, Errs).
-actions2([A|As], I, Sn, Rules, LA, States, Gotos, Shifts,
- Actions0, Actions, Errs0, Errs) :-
+actions2([], _I, _Sn, _Rules, _LA, _States, _Gotos, _Shifts, !Actions, !Errs).
+actions2([A | As], I, Sn, Rules, LA, States, Gotos, Shifts, !Actions, !Errs) :-
A = item(Ip, Id),
- lookup(Rules, Ip, rule(_, _, Syms, _, _, _, _)),
+ map__lookup(Rules, Ip, rule(_, _, Syms, _, _, _, _)),
array__max(Syms, Max),
( Id =< Max ->
- lookup(Syms, Id, X),
- lookup(Gotos, I, IGs),
+ array__lookup(Syms, Id, X),
+ map__lookup(Gotos, I, IGs),
(
X = terminal(T0),
Ts = { T0 }
;
X = nonterminal(N),
- ( search(Shifts, N, Ts0) ->
+ ( map__search(Shifts, N, Ts0) ->
Ts = Ts0
;
Ts = empty
)
),
set__to_sorted_list(Ts, TList),
- foldl2((pred(T::in, Ac0::in, Ac::out, in, out) is det -->
- { lookup(IGs, terminal(T), J) },
- { lookup(States, J, Jn) },
- addaction(Sn, T, shift(Jn), Ac0, Ac)
- ), TList, Actions0, Actions1, Errs0, Errs1)
+ list__foldl2((pred(T::in, !.Actions::in, !:Actions::out,
+ !.Errs::in, !:Errs::out) is det :-
+ map__lookup(IGs, terminal(T), J),
+ map__lookup(States, J, Jn),
+ addaction(Sn, T, shift(Jn), !Actions, !Errs)
+ ), TList, !Actions, !Errs)
;
% A -> alpha .
(
- search(LA, I, ILAs),
- search(ILAs, A, Alphas)
+ map__search(LA, I, ILAs),
+ map__search(ILAs, A, Alphas)
->
set__to_sorted_list(Alphas, AlphaList),
- foldl2((pred(T::in, A0::in, A1::out, in, out) is det -->
- ( { Ip = 0, T = ($) } ->
- addaction(Sn, T, accept, A0, A1)
+ list__foldl2((pred(T::in, !.Actions::in, !:Actions::out, !.Errs::in, !:Errs::out) is det :-
+ ( Ip = 0, T = ($) ->
+ addaction(Sn, T, accept, !Actions,
+ !Errs)
;
- addaction(Sn, T, reduce(Ip), A0, A1)
+ addaction(Sn, T, reduce(Ip), !Actions,
+ !Errs)
)
- ), AlphaList, Actions0, Actions1, Errs0, Errs1)
+ ), AlphaList, !Actions, !Errs)
;
- Actions1 = Actions0,
- Errs1 = Errs0
+ true
)
),
- actions2(As, I, Sn, Rules, LA, States, Gotos, Shifts,
- Actions1, Actions, Errs1, Errs).
+ actions2(As, I, Sn, Rules, LA, States, Gotos, Shifts, !Actions, !Errs).
:- pred addaction(state, terminal, action, actiontable, actiontable,
actionerrors, actionerrors).
:- mode addaction(in, in, in, in, out, in, out) is det.
-addaction(Sn, T, A0, Actions0, Actions, Errs0, Errs) :-
- ( search(Actions0, Sn, State0) ->
+addaction(Sn, T, A0, !Actions, !Errs) :-
+ ( map__search(!.Actions, Sn, State0) ->
State1 = State0
;
- init(State1)
+ map__init(State1)
),
- ( search(State1, T, A1) ->
+ ( map__search(State1, T, A1) ->
( A0 = A1 ->
- A = A1,
- Errs = Errs0
+ A = A1
;
(
A0 = shift(S),
@@ -176,7 +171,7 @@
)
->
A = A2,
- Errs = [Err|Errs0]
+ list__append([Err], !Errs)
;
A = A0,
(
@@ -192,33 +187,34 @@
;
Err = error(misc(A0, A1))
),
- Errs = [Err|Errs0]
+ list__append([Err], !Errs)
)
;
- A = A0,
- Errs = Errs0
+ A = A0
),
- set(State1, T, A, State),
- set(Actions0, Sn, State, Actions).
+ map__set(State1, T, A, State),
+ map__set(!.Actions, Sn, State, !:Actions).
%------------------------------------------------------------------------------%
-gotos(_C, States, Gotos, GotoTable) :-
- init(GotoTable0),
- foldl((pred(I0::in, IGs::in, in, out) is det -->
- { lookup(States, I0, Sf) },
- foldl((pred(Sym::in, J0::in, GT0::in, GT::out) is det :-
+gotos(_C, States, Gotos, !:GotoTable) :-
+ map__init(!:GotoTable),
+ map__foldl((pred(I0::in, IGs::in, !.GotoTable::in,
+ !:GotoTable::out) is det :-
+ map__lookup(States, I0, Sf),
+ map__foldl((pred(Sym::in, J0::in, !.GotoTable::in,
+ !:GotoTable::out) is det :-
( Sym = nonterminal(N) ->
- lookup(States, J0, St),
- ( search(GT0, Sf, X0) ->
+ map__lookup(States, J0, St),
+ ( map__search(!.GotoTable, Sf, X0) ->
X1 = X0
;
- init(X1)
+ map__init(X1)
),
- set(X1, N, St, X),
- set(GT0, Sf, X, GT)
+ map__set(X1, N, St, X),
+ map__set(!.GotoTable, Sf, X, !:GotoTable)
;
- GT = GT0
+ true
)
- ), IGs)
- ), Gotos, GotoTable0, GotoTable).
+ ), IGs, !GotoTable)
+ ), Gotos, !GotoTable).
--------------------------------------------------------------------------
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