## ml.pkg
# Compiled by:
# src/app/future-lex/src/lexgen.lib# "So we shall now explain how to read the book.
# The right way is to put it in your desk during the day,
# below your pillow at night, devoting yourself to the reading,
# and solving the exercises till you know it by heart.
#
# "Unfortunately, I suspect the reader is looking for advice
# on how not to read, i.e. what to skip, and even better,
# how to read only some isolated highlights."
#
# --Saharon Shelah, "Classification Theory"
# ML core language representation and pretty-printing
package ml {
Raw_Lib7 = RAW List( Ml_Token )
also
Ml_Token = TOK String;
Cmp_Op = LT | GT | EQ | LEQ | GEQ;
Bool_Op = AND | OR;
# a subset of ML expressions and patterns that we use to represent the
# match DFA
Ml_Exp
= ML_VAR String
| ML_SYM regular_expression::sym::Point
| ML_CMP (Cmp_Op, Ml_Exp, Ml_Exp)
| ML_BOOL (Bool_Op, Ml_Exp, Ml_Exp)
| ML_CASE (Ml_Exp, List ((Ml_Pat, Ml_Exp)))
| ML_IF (Ml_Exp, Ml_Exp, Ml_Exp)
| ML_APP (String, List( Ml_Exp ))
| ML_LET (String, Ml_Exp, Ml_Exp)
| ML_FUN (String, List( String ), Ml_Exp, Ml_Exp)
| ML_SEQ List( Ml_Exp )
| ML_TUPLE List( Ml_Exp )
| ML_LIST List( Ml_Exp )
| ML_REF_GET Ml_Exp
| ML_REF_PUT (Ml_Exp, Ml_Exp)
| ML_RAW List( Ml_Token )
| ML_NEW_GROUP Ml_Exp
also
Ml_Pat
= ML_WILD
| ML_VAR_PATTERN String
| ML_INT_PATTERN regular_expression::sym::Point
| ML_CON_PATTERN (String, List( Ml_Pat ))
;
stipulate
package pp = plain_file_prettyprinter; # plain_file_prettyprinter is from src/lib/prettyprint/big/src/plain-file-prettyprinter.pkg herein
fun prettyprint_ml (pp, e)
=
prettyprint_expression (FALSE, FALSE, e)
where
fun str s = pp::lit pp s;
fun sp () = pp::blank pp 1;
fun nl () = pp::newline pp;
fun hbox () = pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::horizontal, 100 );
fun vbox () = pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 2, tabstops_are_every => 4 }, pp::vertical, 100 );
fun close () = pp::shut_box pp;
fun let_body (TRUE, prettyprint)
=>
{
nl();
str "herein";
vbox(); nl(); prettyprint(); close();
nl();
str "end";
};
let_body (FALSE, prettyprint)
=>
prettyprint ();
end;
fun prettyprint_expression (in_let, prev_g, e)
=
case e
#
(ML_VAR x) => let_body (in_let, \\ () = str x);
(ML_SYM n) => let_body (in_let, \\ () = str (regular_expression::symbol_to_string n));
(ML_CMP (cop, e1, e2))
=>
let_body
( in_let,
\\ ()
=
{
prettyprint_expression' e1;
sp();
str case cop
LT => "<";
GT => ">";
EQ => "=";
LEQ => "<=";
GEQ => ">=";
esac;
sp();
prettyprint_expression' e2;
}
);
(ML_BOOL (bop, e1, e2))
=>
let_body
( in_let,
\\ ()
=
{
prettyprint_expression' e1;
sp();
str case bop
AND => "and";
OR => "or";
esac;
sp();
prettyprint_expression' e2;
}
);
(ML_CASE (arg, pl))
=>
{ fun do_cases (_, [])
=>
();
do_cases (is_first, (p, e) ! r)
=>
{
nl();
# NOTE: the following seems to trigger a bug in the pp library (bad indent)
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::ragged_right, 100 );
hbox();
if is_first sp(); str "of";
else pp::blank pp 2; str ";";
fi;
sp();
prettyprint_pattern p; sp(); str "=>";
close();
sp();
hbox();
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::vertical, 100 );
prettyprint_expression' e;
close();
close();
close();
do_cases (FALSE, r);
};
end;
let_body
( in_let,
\\ () = { hbox();
str "(case";
sp();
str "(";
prettyprint_expression' arg;
str ")";
close();
do_cases (TRUE, pl);
nl ();
str "/* end case */)";
}
);
};
ML_APP (f, args)
=>
let_body
( in_let,
\\ () = { hbox();
str f;
str "(";
case args
[] => ();
[e] => prettyprint_expression' e;
(e ! r) => { prettyprint_expression' e;
apply
(\\ e = { str ", "; sp(); prettyprint_expression' e;})
r;
};
esac;
str ")";
close();
}
);
ML_IF (e1, e2, e3 as ML_IF _)
=>
let_body (
in_let,
\\ () = { pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::vertical, 100 );
vbox();
hbox(); str "if"; sp(); prettyprint_expression' e1; close(); nl();
hbox(); str "then"; sp();
vbox(); prettyprint_expression' e2; close();
close();
close(); nl();
hbox(); str "else"; sp();
prettyprint_expression' e3;
close();
close();
}
);
ML_IF (e1, e2, e3)
=>
let_body
( in_let,
\\ () = { vbox();
hbox(); str "if"; sp(); prettyprint_expression' e1; close(); nl();
hbox(); str "then"; sp();
vbox(); prettyprint_expression' e2; close();
close(); nl();
hbox(); str "else"; sp();
vbox(); prettyprint_expression' e3; close();
close();
close();
}
);
ML_LET (x, e1, e2)
=>
{ fun prettyprint ()
=
{ nl ();
hbox ();
str "my";
sp();
str x;
sp();
str "=";
sp();
prettyprint_expression' e1;
close();
prettyprint_expression (TRUE, FALSE, e2);
};
if in_let
prettyprint();
else
str "stipulate";
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::vertical, 100 );
prettyprint();
close();
fi;
};
ML_FUN (f, parameters, body, e)
=>
{ fun prettyprint prefix
=
{ nl();
hbox();
str prefix; sp(); str f; sp();
str "(";
case parameters
[] => ();
[x] => str x;
(x ! r) => {
str x; apply (\\ x => { str ", "; sp(); str x;}; end ) r;};
esac;
str ")"; sp(); str "="; sp();
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::vertical, 100 );
prettyprint_expression' body;
close();
close();
prettyprint_expression (TRUE, TRUE, e);
};
if in_let
prev_g ?? prettyprint "also"
:: prettyprint "fun";
else
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::vertical, 100 );
str "stipulate";
prettyprint "fun";
close();
fi;
};
ML_SEQ []
=>
let_body (in_let, \\ () = str "()");
ML_SEQ [e]
=>
prettyprint_expression (in_let, prev_g, e);
ML_SEQ (e ! r)
=>
{ fun prettyprint ()
=
{ prettyprint_expression' e;
apply
(\\ e = { str ";"; sp(); prettyprint_expression' e;})
r;
};
if in_let
nl(); str "herein";
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::ragged_right, 100 );
nl(); prettyprint();
close();
nl();
str "end";
else
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::ragged_right, 100 );
str "("; prettyprint(); str ")";
close();
fi;
};
ML_TUPLE []
=>
let_body (in_let, \\ () = str "()");
ML_TUPLE (e ! r)
=>
let_body (in_let, \\ () = { pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 2, tabstops_are_every => 4 }, pp::ragged_right, 100 );
str "(";
prettyprint_expression' e;
apply (\\ e = { str ", "; sp(); prettyprint_expression' e;})
r;
str ")";
close();
}
);
ML_LIST []
=>
let_body
( in_let,
\\ () = str "[]"
);
ML_LIST (e ! r)
=>
let_body
( in_let,
\\ () = { pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 2, tabstops_are_every => 4 }, pp::ragged_right, 100 );
str "[";
prettyprint_expression' e;
apply (\\ e = { str ", "; sp(); prettyprint_expression' e; })
r;
str "]";
close();
}
);
ML_REF_GET e
=>
let_body
( in_let,
\\ () = { str "!(";
prettyprint_expression' e;
str ")";
}
);
ML_REF_PUT (e1, e2)
=>
let_body
( in_let,
\\ () = { prettyprint_expression' e1;
str " := ";
prettyprint_expression' e2;
}
);
ML_RAW toks
=>
let_body
(
in_let,
\\ () = { hbox();
apply (\\ (TOK s) = str s)
toks;
close();
}
);
ML_NEW_GROUP e
=>
prettyprint_expression (in_let, FALSE, e);
esac
also
fun prettyprint_expression' e
=
prettyprint_expression (FALSE, FALSE, e)
also
fun prettyprint_pattern p
=
{ hbox();
prettyprint p;
close();
}
where
fun prettyprint (ML_WILD) => str "_";
prettyprint (ML_VAR_PATTERN x) => str x;
prettyprint (ML_INT_PATTERN n) => str (regular_expression::symbol_to_string n);
prettyprint (ML_CON_PATTERN (c, [])) => str c;
prettyprint (ML_CON_PATTERN (c, [p]))
=>
{
str c;
str "(";
prettyprint p;
str ")";
};
prettyprint (ML_CON_PATTERN (c, p ! r))
=>
{ str c;
str "(";
prettyprint p;
apply (\\ p = { str ", ";
prettyprint p;
}
)
r;
str ")";
};
end;
end;
end;
end; # stipulate
};