## make-graph-g.pkg
#
# Mythryl-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
# Compiled by:
# src/app/yacc/src/mythryl-yacc.lib### "If you believe everything you read,
### better not read."
###
### -- Japanese proverb
generic package make_graph_g (
package internal_grammar: Internal_Grammar; # Internal_Grammar is from src/app/yacc/src/internal-grammar.api package core: Core; # Core is from src/app/yacc/src/core.api package core_utils: Core_Stuff; # Core_Stuff is from src/app/yacc/src/core-stuff.api sharing internal_grammar == core::internal_grammar
== core_utils::internal_grammar;
sharing core_utils::core == core;
)
: (weak) Lr_Graph # Lr_Graph is from src/app/yacc/src/lr-graph.api{
include package rw_vector;
include package list;
infix my 9 sub;
package core = core;
package grammar = internal_grammar::grammar; # internal_grammar is from src/app/yacc/src/grammar.pkg package internal_grammar = internal_grammar;
include package core;
include package core::grammar;
include package core_utils;
include package internal_grammar;
package node_set
=
redblack_ord_set_g (
package {
Element = Core;
eq = eq_core;
gt = gt_core;
}
);
include package node_set;
exception SHIFT (Int, Symbol);
Graph = { edges: Rw_Vector( List { edge: Symbol, to: Core } ),
nodes: List( Core ), node_array: Rw_Vector( Core ) };
fun edges (CORE (_, i),{ edges, ... }:Graph)
=
edges[i];
fun nodes ( { nodes, ... } : Graph)
=
nodes;
fun shift ( { edges, nodes, ... } : Graph)
(a as (i, symbol))
=
find edges[i]
where
fun find NIL
=>
raise exception (SHIFT a);
find ( { edge, to=>CORE (_, state) } ! r)
=>
if (gt_symbol (symbol, edge) ) find r;
elif (eq_symbol (edge, symbol) ) state;
else raise exception (SHIFT a);
fi;
end;
end;
fun core ( { node_array, ... } : Graph)
( i )
=
node_array[i];
fun make_graph_fn (g as (GRAMMAR { start, ... } ))
=
{ my { shifts, produces, rules, eps_prods }
=
core_utils::make_funcs g;
fun add_goto ((symbol, a), (nodes, edges, future, num)) # "I have seen the future and it's like the present, only longer." -- Dan Quisenberry
=
case (find (CORE (a, 0), nodes))
NULL =>
{ core = CORE (a, num);
edge = { edge=>symbol, to=>core };
( set (core, nodes),
edge ! edges,
core ! future,
num + 1
);
};
THE c
=>
{ edge = { edge=>symbol, to=>c };
(nodes, edge ! edges, future, num);
};
esac;
fun f (nodes, node_list, edge_list, NIL, NIL, num)
=>
{ nodes = reverse node_list;
{ nodes,
edges => rw_vector::from_list (reverse edge_list),
node_array => rw_vector::from_list nodes
};
};
f (nodes, node_list, edge_list, NIL, y, num)
=>
f (nodes, node_list, edge_list, reverse y, NIL, num);
f (nodes, node_list, edge_list, h ! t, y, num)
=>
{ my (nodes, edges, future, num)
=
list::fold_backward add_goto (nodes,[], y, num) (shifts h);
f (nodes, h ! node_list, edges ! edge_list, t, future, num);
};
end;
{ produces,
rules,
eps_prods,
graph => { make_item = \\ (r as (RULE { rhs, ... } ))
=>
ITEM { rule=>r, dot=>0, rhs_after=>rhs }; end ;
initial_item_list = map make_item (produces start);
ordered_item_list = list::fold_backward core::set [] initial_item_list;
initial = CORE (ordered_item_list, 0);
f (empty, NIL, NIL,[initial], NIL, 1);
}
};
}; # fun make_graph_fn
fun pr_graph (a as (nonterm_to_string, term_to_string, print))
(g )
=
{ print_core = print_core a;
print_symbol = print o nonterm_to_string;
nodes = nodes g;
fun print_edges n
=
list::apply
( \\ { edge, to=>CORE (_, state) }
=>
{ print "\tshift on ";
print_symbol edge;
print " to ";
print (int::to_string state);
print "\n";
}; end
)
(edges (n, g));
list::apply
(\\ c => { print_core c; print "\n"; print_edges c;}; end )
nodes;
};
};