# scan.pkg
#
#
# Read the output of format.pkg and reconstruct the original
# portable_graph::graph.
#
# Compiled by:
# src/app/makelib/portable-graph/portable-graph-stuff.libstipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package pg = portable_graph; # portable_graph is from src/app/makelib/portable-graph/portable-graph.pkg package pur = fil::pur; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkgherein
package scan_portable: (weak)
api {
exception PARSE_ERROR String;
#
input: fil::Input_Stream -> pg::Graph;
}
{
exception PARSE_ERROR String;
fun input ins
=
{ s = fil::get_instream ins;
fun skip_line s
=
the_else (null_or::map #2 (pur::read_line s), s);
fun allof l s
=
fold_forward (\\ (f, s) = f s) s l;
fun skip_ws s
=
case (pur::read_one s)
#
NULL => s;
THE (c, s') => if (char::is_space c) skip_ws s';
else s;
fi;
esac;
fun maybeident s
=
{ s = skip_ws s;
finish = string::implode o reverse;
fun loop (s, a)
=
case (pur::read_one s)
#
NULL => THE (finish a, s);
THE (c, s')
=>
if (char::is_alphanumeric c) loop (s', c ! a);
else THE (finish a, s);
fi;
esac;
case (pur::read_one s)
#
NULL => NULL;
THE (c, s')
=>
if (char::is_alpha c) loop (s', [c]);
else NULL;
fi;
esac;
};
fun ident s
=
case (maybeident s)
#
THE (i, s') => (i, s');
#
NULL => raise exception PARSE_ERROR "expected: identifier";
esac;
fun maybestring s
=
{ s = skip_ws s;
fun eof ()
=
raise exception PARSE_ERROR "unexpected EOF in string";
fun loop (s, a)
=
case (pur::read_one s)
#
NULL => eof ();
#
THE ('"', s')
=>
case (string::from_string (string::implode (reverse a)))
#
THE x => THE (x, s');
NULL => raise exception PARSE_ERROR "illegal string syntax";
esac;
THE ('\\', s')
=>
case (pur::read_one s')
#
NULL => eof ();
THE (c, s'') => loop (s'', c ! '\\' ! a);
esac;
THE (c, s')
=>
loop (s', c ! a);
esac;
case (pur::read_one s)
#
THE ('"', s') => loop (s', []);
_ => raise exception PARSE_ERROR "expected: string";
esac;
};
fun string s
=
case (maybestring s)
#
THE (x, s') => (x, s');
NULL => raise exception PARSE_ERROR "expected: String";
esac;
fun expect c s
=
{ s = skip_ws s;
fun notc what
=
raise exception PARSE_ERROR (cat ["expected: ", char::to_string c,
", found: ", what]);
case (pur::read_one s)
#
NULL => notc "EOF";
THE (c', s') => if (c == c' ) s'; else notc (char::to_string c'); fi;
esac;
};
fun expect_id i s
=
{ my (i', s') = ident s;
if (i == i') s';
else raise exception PARSE_ERROR (cat ["expected: ", i, ", found: ", i']);
fi;
};
fun varlist s
=
{ fun eof ()
=
raise exception PARSE_ERROR "unexpected EOF in varlist";
s = allof [expect '[', skip_ws] s;
fun rest s
=
{ s = skip_ws s;
case (pur::read_one s)
#
NULL => eof ();
THE (']', s') => ([], s');
THE (',', s')
=>
{ my (h, s'') = ident s';
my (t, s''') = rest s'';
(h ! t, s''');
};
THE (c, _)
=>
raise exception PARSE_ERROR
(cat ["expected , or ], found: ",
char::to_string c]);
esac;
};
case (pur::read_one s)
#
NULL => eof ();
THE (']', s') => ([], s');
THE _
=>
{ my (h, s') = ident s;
my (t, s'') = rest s';
(h ! t, s'');
};
esac;
};
fun def s
=
case (maybeident s)
#
THE ("my", s)
=>
{ s = allof [expect '(', expect_id "c", expect ','] s;
my (lhs, s) = ident s;
s = allof [expect ')', expect '='] s;
my (f, s) = ident s;
s = expect_id "c" s;
fun def (rhs, s)
=
THE (pg::DEF { lhs, rhs }, s);
fun comp native
=
{ my (r, s) = string s;
my (e, s) = ident s;
my (ss, s) = ident s;
def (pg::COMPILE { src => (r, native),
env => e, syms => ss },
s);
};
fun symbol ns
=
{ my (n, s) = string s;
#
def (pg::SYM (ns, n), s);
};
case f
"syms"
=>
{ my (l, s) = varlist s;
def (pg::SYMS l, s);
};
"import"
=>
{ my (l, s) = ident s;
my (ss, s) = ident s;
def (pg::IMPORT { lib => l, syms => ss }, s);
};
"compile" => comp FALSE;
"ncompile" => comp TRUE;
"merge"
=>
{ my (l, s) = varlist s;
def (pg::MERGE l, s);
};
"filter"
=>
{ my (e, s) = ident s;
my (ss, s) = ident s;
def (pg::FILTER { env => e, syms => ss }, s);
};
"sgn" => symbol pg::SGN;
"str" => symbol pg::PACKAGE;
"fct" => symbol pg::GENERIC;
x => raise exception PARSE_ERROR ("unknown function: " + x);
esac;
};
_ => NULL;
esac;
fun deflist s
=
{ fun loop (s, a)
=
case (def s)
THE (d, s') => loop (s', d ! a);
NULL => (reverse a, s);
esac;
loop (s, []);
};
fun graph s
=
{ s = allof [skip_line, expect_id "\\"] s;
#
(varlist s) -> (imports, s);
s = allof [expect '=', expect '>', expect_id "stipulate",
expect_id "use", expect_id "PGOps"] s;
(deflist s) -> (defs, s);
s = allof [expect_id "herein", expect_id "export", expect_id "c"] s;
(ident s) -> (export, s);
# gobble up remaining boilerplate...
s = allof [ expect_id "end",
expect '|',
expect '_',
expect '=',
expect '>',
expect_id "raise",
expect_id "exception",
expect_id "DIE",
#2 o string,
expect ')',
skip_line
]
s;
fil::set_instream (ins, s);
pg::GRAPH
{ imports,
defs,
export
};
};
graph s;
};
};
end;
# Author: Matthias Blume (blume@research.bell-labs.com)
# (C) 2001 Lucent Technologies, Bell Labs
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.