[m-rev.] diff: make moose work with non-C backends
Julien Fischer
juliensf at csse.unimelb.edu.au
Wed Jan 19 00:00:43 AEDT 2011
Branches: main, 11.01
Don't use "cute" operator overloadings in moose - this allows us to compile it
with the non-C backends, some of which don't currently do the name mangling
which would otherwise be required.
Make the moose samples work again.
extras/moose/misc.m:
Delete this module -- overloading operators in this way was
never a particuarly good idea, especially as several of the
overloaded operators (now) mean other things in Mercury.
extras/moose/check.m:
extras/moose/grammar.m:
extras/moose/lalr.m:
extras/moose/mercury_syntax.m:
extras/moose/moose.m:
extras/moose/tables.m:
Conform to the above changes.
Import each module on its own line.
extras/moose/options.m:
As above.
Use the "multi" form of the option_ops type.
extras/moose/samples/try_alpha.m:
extras/moose/samples/try_expr.m:
Make these examples work again -- as written the typeclass
instance they contain does not satisfy the current restrictions
on the form of instance arguments.
Syntax and formatting cleanups.
Julien.
Index: check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/check.m,v
retrieving revision 1.6
diff -u -r1.6 check.m
--- check.m 21 Feb 2009 11:27:54 -0000 1.6
+++ check.m 18 Jan 2011 12:50:06 -0000
@@ -22,11 +22,16 @@
%------------------------------------------------------------------------------%
:- module check.
-
:- interface.
:- import_module grammar.
-:- import_module io, list, string, term.
+
+:- import_module io.
+:- import_module list.
+:- import_module string.
+:- import_module term.
+
+%------------------------------------------------------------------------------%
:- type check.error
---> error(list(string), context).
@@ -47,10 +52,15 @@
:- pred write_error(check.error, io.state, io.state).
:- mode write_error(in, di, uo) is det.
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
:- implementation.
-:- import_module misc.
-:- import_module map, require, set, solutions.
+:- import_module map.
+:- import_module require.
+:- import_module set.
+:- import_module solutions.
%------------------------------------------------------------------------------%
@@ -92,8 +102,8 @@
set.sorted_list_to_set(DeclIds, DeclSet),
map.keys(Clauses, ClauseIds),
set.sorted_list_to_set(ClauseIds, ClauseSet),
- NoDeclSet = ClauseSet - DeclSet,
- NoClauseSet = DeclSet - ClauseSet,
+ NoDeclSet = ClauseSet `set.difference` DeclSet,
+ NoClauseSet = DeclSet `set.difference` ClauseSet,
% Productions that have no rule declaration.
set.to_sorted_list(NoDeclSet, NoDeclList),
@@ -166,11 +176,11 @@
%------------------------------------------------------------------------------%
check_useless(Start, Clauses, Decls, Errors) :-
- StartSet = { Start },
+ StartSet = set.make_singleton_set(Start),
useful(StartSet, Clauses, StartSet, UsefulSet),
map.keys(Clauses, AllIds),
set.sorted_list_to_set(AllIds, AllSet),
- UselessSet = AllSet - UsefulSet,
+ UselessSet = AllSet `set.difference` UsefulSet,
set.to_sorted_list(UselessSet, UselessList),
list.filter_map((pred(UselessId::in, Error::out) is semidet :-
% Use search rather than lookup in case
@@ -199,8 +209,8 @@
Clause = clause(_Head, Prod, _VarSet, _Context),
nonterminal(UId, Prod)
), NewSet),
- New1 = NewSet - !.Useful,
- !:Useful = New1 \/ !.Useful,
+ New1 = NewSet `set.difference` !.Useful,
+ !:Useful = New1 `set.union`!.Useful,
useful(New1, Clauses, !Useful)
).
@@ -263,12 +273,12 @@
)
)
), NewFinSet),
- NewFin = NewFinSet - Fin0,
+ NewFin = NewFinSet `set.difference` Fin0,
( set.empty(NewFin) ->
true
;
- !:Inf = !.Inf - NewFin,
- Fin = Fin0 \/ NewFin,
+ !:Inf = !.Inf `set.difference` NewFin,
+ Fin = Fin0 `set.union` NewFin,
finite(!.Inf, Fin, Clauses, !:Inf)
).
Index: grammar.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/grammar.m,v
retrieving revision 1.10
diff -u -r1.10 grammar.m
--- grammar.m 21 Feb 2009 11:27:54 -0000 1.10
+++ grammar.m 18 Jan 2011 12:50:06 -0000
@@ -13,11 +13,16 @@
%------------------------------------------------------------------------------%
:- module grammar.
-
:- interface.
-:- import_module misc.
-:- import_module array, list, map, set, term, varset.
+:- import_module array.
+:- import_module list.
+:- import_module map.
+:- import_module set.
+:- import_module term.
+:- import_module varset.
+
+%------------------------------------------------------------------------------%
:- type grammar
---> grammar(
@@ -87,7 +92,7 @@
context % context of the declaration.
).
-:- type rules == (int -> (rule)).
+:- type rules == map(int, (rule)).
:- type (rule)
---> rule(
@@ -106,11 +111,11 @@
string
).
-:- type xforms == (nonterminal -> xform).
+:- type xforms == map(nonterminal, xform).
-:- type first == (nonterminal -> set(terminal)).
+:- type first == map(nonterminal, set(terminal)).
-:- type follow == (nonterminal -> set(terminal)).
+:- type follow == map(nonterminal, set(terminal)).
:- type state == int.
@@ -119,9 +124,11 @@
; shift(int)
; reduce(int).
-:- type actiontable == (state -> terminal -> action).
+:- type actiontable == map(state, map(terminal, action)).
+%:- type actiontable == (state -> terminal -> action).
-:- type gototable == (state -> nonterminal -> state).
+:- type gototable == map(state, map(nonterminal, state)).
+%:- type gototable == (state -> nonterminal -> state).
:- pred term_to_clause(term, varset, nonterminal, clause).
:- mode term_to_clause(in, in, out, out) is semidet.
@@ -145,13 +152,16 @@
:- func first(first, symbols, int) = set(terminal).
%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
:- implementation.
-:- import_module misc.
-:- import_module bool, int, require, pair, string, solutions.
-
-%------------------------------------------------------------------------------%
+:- import_module bool.
+:- import_module int.
+:- import_module require.
+:- import_module pair.
+:- import_module string.
+:- import_module solutions.
%------------------------------------------------------------------------------%
@@ -409,7 +419,7 @@
;
% There were no literals in the body of the rule,
% so it was an epsilon rule.
- ComputedFirst = { epsilon }
+ ComputedFirst = set.make_singleton_set(epsilon)
),
% Add the computed first set to what we currently
% know, noting whether or not anything has changed.
@@ -454,7 +464,8 @@
% this rule is certainly not nullable.
Elem = terminal(Id),
set.insert(Set0, Id, Set1),
- set.difference(Set1, { epsilon }, Set)
+ set.difference(Set1, set.make_singleton_set(epsilon),
+ Set)
;
Elem = nonterminal(Id),
( map.search(First, Id, Set1) ->
@@ -470,7 +481,8 @@
compute_first(I + 1, IMax, Elems, First,
Set2, Set)
;
- set.difference(Set2, { epsilon }, Set)
+ set.difference(Set2,
+ set.make_singleton_set(epsilon), Set)
)
;
% If we don't know anything about
@@ -560,7 +572,7 @@
compute_follow(Rules, Start, EOF, First, Follow) :-
map.init(Follow0),
% Rule 1
- map.set(Follow0, Start, { EOF }, Follow1),
+ map.set(Follow0, Start, set.make_singleton_set(EOF), Follow1),
collect_nonterminals(Rules, Ns),
Stuff0 = stuff(no, Ns, Rules, First, Follow1),
until((pred(Stuff1::in, Stuff3::out) is det :-
@@ -592,7 +604,8 @@
lookup(Elems, I, Elem),
( Elem = nonterminal(Id) ->
IdFollow0 = first(First, Elems, I + 1),
- difference(IdFollow0, { epsilon }, IdFollow),
+ difference(IdFollow0, set.make_singleton_set(epsilon),
+ IdFollow),
add_follow(Id, IdFollow, Stuff0, Stuff1)
;
Stuff1 = Stuff0
@@ -666,7 +679,7 @@
array.lookup(Elems, I, Elem),
(
Elem = terminal(Id),
- FirstI = { Id }
+ FirstI = set.make_singleton_set(Id)
;
Elem = nonterminal(Id),
map.lookup(First, Id, FirstI0),
@@ -678,7 +691,7 @@
)
)
;
- FirstI = { epsilon }
+ FirstI = set.make_singleton_set(epsilon)
).
%------------------------------------------------------------------------------%
Index: lalr.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/lalr.m,v
retrieving revision 1.6
diff -u -r1.6 lalr.m
--- lalr.m 21 Feb 2009 11:27:54 -0000 1.6
+++ lalr.m 18 Jan 2011 12:50:06 -0000
@@ -10,19 +10,26 @@
% This module builds the lalr items and lookaheads for the grammar.
%
%------------------------------------------------------------------------------%
-:- module lalr.
+:- module lalr.
:- interface.
-:- import_module grammar, misc.
-:- import_module int, io, set.
+:- import_module grammar.
+
+:- import_module int.
+:- import_module io.
+:- import_module map.
+:- import_module pair.
+:- import_module set.
+
+%------------------------------------------------------------------------------%
:- type item
---> item(prodnum, dot).
:- type items == set(item).
-:- type gotos == (items -> symbol -> items).
+:- type gotos == map(items, map(symbol, items)).
:- type lr1item
---> item(prodnum, dot, terminal).
@@ -33,13 +40,13 @@
:- type dot == int.
-:- type reaching == (nonterminal -> set(nonterminal)).
+:- type reaching == map(nonterminal, set(nonterminal)).
-:- type propaheads == (items -> item -> items -> items).
+:- type propaheads == map(items, map(item, map(items, items))).
-:- type lookaheads == (items -> item -> set(terminal)).
+:- type lookaheads == map(items, map(item, set(terminal))).
-:- type previews == (lookaheads - propaheads).
+:- type previews == pair(lookaheads, propaheads).
:- pred reaching(rules, first, reaching).
:- mode reaching(in, in, out) is det.
@@ -51,9 +58,18 @@
io.state, io.state).
:- mode lookaheads(in, in, in, in, in, out, di, uo) is det.
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
:- implementation.
-:- import_module array, bool, list, map, require, pair, term.
+:- import_module array.
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module pair.
+:- import_module require.
+:- import_module term.
%------------------------------------------------------------------------------%
@@ -116,21 +132,21 @@
true
;
!:Change = yes,
- As = As0 \/ { A },
+ As = As0 `set.union` set.make_singleton_set(A),
map.set(!.Reaching, C, As, !:Reaching)
)
;
!:Change = yes,
- As = { A },
+ As = set.make_singleton_set(A),
map.set(!.Reaching, C, As, !:Reaching)
).
%------------------------------------------------------------------------------%
lr0items(Productions, Reaching, C, Gotos) :-
- I0 = { item(0, 0) },
- C0 = { I0 },
- Pending = { I0 },
+ I0 = set.make_singleton_set(item(0, 0)),
+ C0 = set.make_singleton_set(I0),
+ Pending = set.make_singleton_set(I0),
map.init(Gotos0),
lr0items1(Pending, Productions, Reaching, Gotos0, Gotos, C0, C).
@@ -141,7 +157,7 @@
lr0items1(Pending0, Productions, Reaching, !Gotos, !C) :-
( set.remove_least(Pending0, J, Pending1) ->
set.to_sorted_list(J, JList),
- lr0items_1(JList, J, Productions, Reaching, !Gotos, empty,
+ lr0items_1(JList, J, Productions, Reaching, !Gotos, set.init,
NewSet),
set.to_sorted_list(NewSet, NewItems),
list.map((pred(Pair::in, J0::out) is det :-
@@ -150,9 +166,9 @@
map.lookup(I0Gotos, X, J0)
), NewItems, PendingList),
set.list_to_set(PendingList, NewPending0),
- NewPending = NewPending0 - !.C,
- !:C = !.C \/ NewPending,
- Pending = Pending1 \/ NewPending,
+ NewPending = NewPending0 `set.difference` !.C,
+ !:C = !.C `set.union` NewPending,
+ Pending = Pending1 `set.union` NewPending,
lr0items1(Pending, Productions, Reaching, !Gotos, !C)
;
true
@@ -204,13 +220,13 @@
( map.search(IGotos1, X, GotoIX0) ->
GotoIX1 = GotoIX0
;
- GotoIX1 = empty
+ GotoIX1 = set.init
),
- GotoIX = GotoIX1 \/ { NewItem },
+ GotoIX = GotoIX1 `set.union` set.make_singleton_set(NewItem),
set(IGotos1, X, GotoIX, IGotos),
set(!.Gotos, I, IGotos, !:Gotos),
( GotoIX \= GotoIX1 ->
- !:New = !.New \/ { I - X }
+ !:New = !.New `set.union` set.make_singleton_set(I - X)
;
true
).
@@ -246,8 +262,9 @@
%------------------------------------------------------------------------------%
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.from_assoc_list([item(0, 0) - set.make_singleton_set(($))], I0),
+ map.from_assoc_list([set.make_singleton_set(item(0, 0)) - I0],
+ !:Lookaheads),
map.init(Propaheads0),
set.to_sorted_list(C, CList),
lookaheads(CList, Gotos, Rules, First, Index,
@@ -284,7 +301,7 @@
lookaheads1([BItem | BItems], I, Gotos, Rules, First, Index, !Lookaheads) :-
BItem = item(Bp, Bd),
BItem0 = item(Bp, Bd, (*)),
- J0 = closure({ BItem0 }, Rules, First, Index),
+ J0 = closure(set.make_singleton_set(BItem0), Rules, First, Index),
set.to_sorted_list(J0, JList0),
% Reverse the list so that in add_spontaneous, the
% set insertions are in reverse sorted order not
@@ -305,7 +322,7 @@
set.to_sorted_list(!.New, NewList),
closure1(NewList, Rules, First, Index, [I0], Is),
do_union(Is, I1),
- !:New = I1 - I0,
+ !:New = I1 `set.difference` I0,
( set.empty(!.New) ->
I = I1
;
@@ -378,7 +395,7 @@
Is = [_|_],
do_union([I0|Is], [], I).
do_union([I0, I1|Is0], Is1, I) :-
- I2 = I0 \/ I1,
+ I2 = I0 `set.union` I1,
do_union(Is0, [I2|Is1], I).
:- pred lookaheads2(list(lr1item), item, items, gotos, rules,
@@ -449,7 +466,7 @@
( map.search(Y1, Ia, As0) ->
As1 = As0
;
- As1 = empty
+ set.init(As1)
),
set.insert(As1, A, As),
map.set(Y1, Ia, As, Y),
@@ -468,7 +485,7 @@
( map.search(X1, B, As0) ->
As1 = As0
;
- As1 = empty
+ set.init(As1)
),
set.insert(As1, Alpha, As),
map.set(X1, B, As, X),
@@ -515,7 +532,7 @@
),
propagate1(Items, I, Props, !Change, !Lookaheads).
-:- pred propagate2(list(items), (items -> items), set(terminal), bool, bool,
+:- pred propagate2(list(items), map(items, items), set(terminal), bool, bool,
lookaheads, lookaheads).
:- mode propagate2(in, in, in, in, out, in, out) is det.
@@ -540,11 +557,11 @@
( map.search(X1, Item, Ts1) ->
Ts2 = Ts1
;
- Ts2 = empty
+ set.init(Ts2)
),
- NewTs = Ts0 - Ts2,
+ NewTs = Ts0 `set.difference` Ts2,
( not set.empty(NewTs) ->
- Ts = Ts2 \/ NewTs,
+ Ts = Ts2 `set.union` NewTs,
map.set(X1, Item, Ts, X),
map.set(!.Lookaheads, I, X, !:Lookaheads),
!:Change = yes
Index: mercury_syntax.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/mercury_syntax.m,v
retrieving revision 1.6
diff -u -r1.6 mercury_syntax.m
--- mercury_syntax.m 21 Feb 2009 11:27:54 -0000 1.6
+++ mercury_syntax.m 18 Jan 2011 12:50:06 -0000
@@ -5,10 +5,14 @@
%----------------------------------------------------------------------------%
:- module mercury_syntax.
-
:- interface.
-:- import_module io, list, term, varset.
+:- import_module io.
+:- import_module list.
+:- import_module term.
+:- import_module varset.
+
+%----------------------------------------------------------------------------%
:- type (module) == list(element).
@@ -76,9 +80,16 @@
:- type vars == list(var).
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
:- implementation.
-:- import_module int, require, pair, string, term_io.
+:- import_module int.
+:- import_module pair.
+:- import_module require.
+:- import_module string.
+:- import_module term_io.
%------------------------------------------------------------------------------%
Index: misc.m
===================================================================
RCS file: misc.m
diff -N misc.m
--- misc.m 21 Feb 2009 11:27:54 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,41 +0,0 @@
-%----------------------------------------------------------------------------%
-% Copyright (C) 1998-2000, 2003, 2006 The University of Melbourne.
-% This file may only be copied under the terms of the GNU General
-% Public License - see the file COPYING in the Mercury Distribution.
-%----------------------------------------------------------------------------%
-
-:- module misc.
-:- interface.
-
-:- import_module map.
-:- import_module pair.
-:- import_module set.
-
-:- type '' ---> ''.
-
-:- type (T1 -> T2) == map(T1, T2).
-
-:- type (T1 - T2) == pair(T1, T2).
-
-:- func empty = set(T).
-
-:- func { T } = set(T).
-
-:- func (set(T) /\ set(T)) = set(T).
-
-:- func (set(T) \/ set(T)) = set(T).
-
-:- func (set(T) - set(T)) = set(T).
-
-:- implementation.
-
-empty = Empty :-
- set.init(Empty).
-
-{ Elem } = Set :- set.singleton_set(Set, Elem).
-
-A /\ B = C :- set.intersect(A, B, C).
-
-A \/ B = C :- set.union(A, B, C).
-
-A - B = C :- set.difference(A, B, C).
Index: moose.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/moose.m,v
retrieving revision 1.12
diff -u -r1.12 moose.m
--- moose.m 21 Feb 2009 11:27:54 -0000 1.12
+++ moose.m 18 Jan 2011 12:50:06 -0000
@@ -12,18 +12,41 @@
%----------------------------------------------------------------------------%
:- module moose.
-
:- interface.
:- import_module io.
+%----------------------------------------------------------------------------%
+
:- pred main(io::di, io::uo) is det.
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
:- implementation.
-:- import_module grammar, lalr, tables, check, mercury_syntax, misc, options.
-:- import_module array, bool, getopt, int, list, map, require.
-:- import_module set, pair, string, term, term_io, varset.
+:- import_module check.
+:- import_module grammar.
+:- import_module lalr.
+:- import_module mercury_syntax.
+:- import_module options.
+:- import_module tables.
+
+:- import_module array.
+:- import_module bool.
+:- import_module getopt.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module pair.
+:- import_module require.
+:- import_module set.
+:- import_module string.
+:- import_module term.
+:- import_module term_io.
+:- import_module varset.
+
+%----------------------------------------------------------------------------%
main(!IO) :-
parse_options(MOptions, Args, !IO),
@@ -490,7 +513,7 @@
write_state_actions(SS, End, StateActions, !IO)
), Table, !IO).
-:- pred write_state_actions(string, term, (terminal -> action),
+:- pred write_state_actions(string, term, map(terminal, action),
io, io).
:- mode write_state_actions(in, in, in, di, uo) is det.
@@ -585,7 +608,7 @@
write_element(nolines, Element, !IO),
io.nl(!IO).
-:- pred write_state_gotos(string, (nonterminal -> grammar.state), io, io).
+:- pred write_state_gotos(string, map(nonterminal, grammar.state), io, io).
:- mode write_state_gotos(in, in, di, uo) is det.
write_state_gotos(SS, StateActions, !IO) :-
Index: options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/options.m,v
retrieving revision 1.3
diff -u -r1.3 options.m
--- options.m 21 Feb 2009 11:27:54 -0000 1.3
+++ options.m 18 Jan 2011 12:50:06 -0000
@@ -5,10 +5,14 @@
%----------------------------------------------------------------------------%
:- module options.
-
:- interface.
-:- import_module getopt, io, list, string.
+:- import_module getopt.
+:- import_module io.
+:- import_module list.
+:- import_module string.
+
+%----------------------------------------------------------------------------%
:- type option
---> help
@@ -31,17 +35,24 @@
:- pred parse_options(maybe_options, list(string), io.state, io.state).
:- mode parse_options(out, out, di, uo) is det.
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+
:- implementation.
-:- import_module bool, char, std_util.
+:- import_module bool.
+:- import_module char.
+:- import_module std_util.
+
+%----------------------------------------------------------------------------%
parse_options(MOpts, Args, !IO) :-
io.command_line_arguments(Args0, !IO),
- OptionOpts = option_ops(short, long, defaults),
+ OptionOpts = option_ops_multi(short, long, defaults),
getopt.process_options(OptionOpts, Args0, Args, MOpts).
-:- pred short(char, option).
-:- mode short(in, out) is semidet.
+:- pred short(char::in, option::out) is semidet.
short('h', help).
short('v', verbose).
@@ -52,8 +63,7 @@
short('i', dump_items).
short('r', dump_rules).
-:- pred long(string, option).
-:- mode long(in, out) is semidet.
+:- pred long(string::in, option::out) is semidet.
long("help", help).
long("verbose", verbose).
@@ -64,22 +74,17 @@
long("dump-items", dump_items).
long("dump-rules", dump_rules).
-:- pred defaults(option, option_data).
-:- mode defaults(out, out) is nondet.
-
-defaults(Opt, Data) :-
- semidet_succeed,
- defaults0(Opt, Data).
-
-:- pred defaults0(option, option_data).
-:- mode defaults0(out, out) is multi.
-
-defaults0(help, bool(no)).
-defaults0(verbose, bool(no)).
-defaults0(dump_action, bool(no)).
-defaults0(dump_first, bool(no)).
-defaults0(dump_follow, bool(no)).
-defaults0(dump_goto, bool(no)).
-defaults0(dump_items, bool(no)).
-defaults0(dump_rules, bool(no)).
+:- pred defaults(option::out, option_data::out) is multi.
+defaults(help, bool(no)).
+defaults(verbose, bool(no)).
+defaults(dump_action, bool(no)).
+defaults(dump_first, bool(no)).
+defaults(dump_follow, bool(no)).
+defaults(dump_goto, bool(no)).
+defaults(dump_items, bool(no)).
+defaults(dump_rules, bool(no)).
+
+%----------------------------------------------------------------------------%
+:- end_module options.
+%----------------------------------------------------------------------------%
Index: tables.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/tables.m,v
retrieving revision 1.4
diff -u -r1.4 tables.m
--- tables.m 21 Feb 2009 11:27:54 -0000 1.4
+++ tables.m 18 Jan 2011 12:50:06 -0000
@@ -5,15 +5,21 @@
%----------------------------------------------------------------------------%
:- module tables.
-
:- interface.
-:- import_module grammar, lalr, misc.
-:- import_module int, list, set.
+:- import_module grammar.
+:- import_module lalr.
+
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module set.
+
+%----------------------------------------------------------------------------%
-:- type states == (items -> int).
+:- type states == map(items, int).
-:- type shifts == (nonterminal -> set(terminal)).
+:- type shifts == map(nonterminal, set(terminal)).
:- type actionerrors == list(actionerr).
@@ -42,9 +48,17 @@
:- pred gotos(set(items), states, gotos, gototable).
:- mode gotos(in, in, in, out) is det.
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
:- implementation.
-:- import_module array, bool, map, require, std_util, term.
+:- import_module array.
+:- import_module bool.
+:- import_module map.
+:- import_module require.
+:- import_module std_util.
+:- import_module term.
%------------------------------------------------------------------------------%
@@ -58,7 +72,7 @@
),
list.map(map.lookup(First), Ns1, Ts1),
list.foldl(set.union, Ts1, Ts0, Ts2),
- Ts = Ts2 - { epsilon },
+ Ts = Ts2 `set.difference` set.make_singleton_set(epsilon),
map.set(!.Shifts, N, Ts, !:Shifts)
), First, !Shifts).
@@ -106,13 +120,13 @@
map.lookup(Gotos, I, IGs),
(
X = terminal(T0),
- Ts = { T0 }
+ Ts = set.make_singleton_set(T0)
;
X = nonterminal(N),
( map.search(Shifts, N, Ts0) ->
Ts = Ts0
;
- Ts = empty
+ set.init(Ts)
)
),
set.to_sorted_list(Ts, TList),
Index: samples/try_alpha.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/samples/try_alpha.m,v
retrieving revision 1.3
diff -u -r1.3 try_alpha.m
--- samples/try_alpha.m 31 May 2006 06:29:11 -0000 1.3
+++ samples/try_alpha.m 18 Jan 2011 12:50:06 -0000
@@ -1,40 +1,59 @@
-:- module try_alpha.
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+:- module try_alpha.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
-:- import_module alpha, list.
+:- import_module alpha.
-:- type token_list == list(token).
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+ % We need to wrap this up using a notag type in order to satisfy the
+ % requirements on the form that type class instance arguments can take.
+ %
+:- type token_list
+ ---> token_list(list(token)).
:- instance parser_state(token_list) where [
- get_token(eof, [], []),
- get_token(T, [T | Ts], Ts),
+ get_token(eof, token_list([]), token_list([])),
+ get_token(T, token_list([T | Ts]), token_list(Ts)),
- unget_token(T, Ts) = [T | Ts]
+ unget_token(T, token_list(Ts)) = token_list([T | Ts])
].
-main -->
- read_line(Res0),
- (
- { Res0 = ok(Chars) },
- ( { scan(Chars, Toks) },
- { parse(Res, Toks, RemainingToks) },
- write(Res), nl,
- write(RemainingToks), nl
- ),
- main
- ;
- { Res0 = eof }
- ;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- write_string(Msg), nl
- ).
-
+main(!IO) :-
+ read_line(Res0, !IO),
+ (
+ Res0 = ok(Chars),
+ scan(Chars, Toks),
+ parse(Res, token_list(Toks), token_list(RemainingToks)),
+ io.write(Res, !IO),
+ io.nl(!IO),
+ io.write(RemainingToks, !IO),
+ io.nl(!IO),
+ main(!IO)
+ ;
+ Res0 = eof
+ ;
+ Res0 = error(Err),
+ io.error_message(Err, Msg),
+ io.write_string(Msg, !IO),
+ io.nl(!IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+:- end_module try_alpha.
+%-----------------------------------------------------------------------------%
Index: samples/try_expr.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/moose/samples/try_expr.m,v
retrieving revision 1.3
diff -u -r1.3 try_expr.m
--- samples/try_expr.m 31 May 2006 06:29:11 -0000 1.3
+++ samples/try_expr.m 18 Jan 2011 12:50:06 -0000
@@ -1,40 +1,58 @@
-:- module try_expr.
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+:- module try_expr.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
-:- import_module expr, list.
+:- import_module expr.
+:- import_module list.
-:- type token_list == list(token).
+%-----------------------------------------------------------------------------%
+
+ % We need to wrap this up using a notag type in order to satisfy the
+ % requirements on the form that type class instance arguments can take.
+ %
+:- type token_list
+ ---> token_list(list(token)).
:- instance parser_state(token_list) where [
- get_token(eof, [], []),
- get_token(T, [T | Ts], Ts),
+ get_token(eof, token_list([]), token_list([])),
+ get_token(T, token_list([T | Ts]), token_list(Ts)),
- unget_token(T, Ts) = [T | Ts]
+ unget_token(T, token_list(Ts)) = token_list([T | Ts])
].
-main -->
- read_line(Res0),
- (
- { Res0 = ok(Chars) },
- ( { scan(Chars, Toks) },
- { parse(Res, Toks, RemainingToks) },
- write(Res), nl,
- write(RemainingToks), nl
- ),
- main
- ;
- { Res0 = eof }
- ;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- write_string(Msg), nl
- ).
-
+main(!IO) :-
+ read_line(Res0, !IO),
+ (
+ Res0 = ok(Chars),
+ scan(Chars, Toks),
+ parse(Res, token_list(Toks), token_list(RemainingToks)),
+ io.write(Res, !IO),
+ io.nl(!IO),
+ io.write(RemainingToks, !IO),
+ io.nl(!IO),
+ main(!IO)
+ ;
+ Res0 = eof
+ ;
+ Res0 = error(Err),
+ io.error_message(Err, Msg),
+ io.write_string(Msg, !IO),
+ io.nl(!IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+:- end_module try_expr.
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list