use rustyfi_syntax::cst;
use rustyfi_syntax::cst::ast::{TypeApp, TypeAtom, TypeExpr, TypeProd};
use rustyfi_syntax::cst_v1;
use rustyfi_syntax::RustyfiVersion;
use crate::types::{CmdArgType, MonoType, PolyType, Row};
use crate::v1::surface::{self, SurfaceEnv};
#[derive(Debug, Clone, PartialEq)]
pub enum BoundaryError {
ForkedTypeExport {
binding: String,
ty_name: String,
from: RustyfiVersion,
to: RustyfiVersion,
note: &'static str,
},
}
impl std::fmt::Display for BoundaryError {
fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
match self {
BoundaryError::ForkedTypeExport {
binding,
ty_name,
from,
to,
note,
} => {
write!(
f,
"cross-version import (X3): {}exports a value whose type \
names `{ty_name}`, version-forked between {from:?} and \
{to:?} with no proven-identical runtime representation — \
{note}",
if binding.is_empty() {
String::new()
} else {
format!("`{binding}` ")
}
)
}
}
}
}
impl std::error::Error for BoundaryError {}
pub fn reject_type_names() -> std::collections::BTreeSet<String> {
let mut set = crate::typecheck::forked_type_names();
set.insert("page".to_string());
set
}
pub fn reject_type_names_from_v006() -> std::collections::BTreeSet<String> {
let mut set = reject_type_names();
set.insert("code".to_string());
set
}
pub(crate) fn forked_note(name: &str) -> &'static str {
match name {
"page" => {
"0.0.6's page is a 9-ctor ADT (Value::Ctor); 0.1's is a length*length \
tuple (Value::Product) — no shared runtime representation"
}
"math-boxes" => {
"math-boxes is 0.1-only (the evaluated math tree); math must relabel to \
math-text, never math-boxes (X3.8/S2) — no 0.0.6 value is ever a \
math-boxes to begin with"
}
"math-text" => {
"0.0.6 has no math-text primitive; a 0.0.6 package's OWN type named \
math-text is an unrelated opaque user nominal, not a math value"
}
"deco" | "deco-set" => {
"0.0.6 deco returns `graphics list`; 0.1 deco returns a single `graphics` \
— the return shape differs, so crossing needs a value-level adapter. \
X3b/X4b (classify_deco_exports/deco_coercion_prelude, and their reverse \
twins) generate a POSITIONAL eta-expanding wrapper, which covers a \
`deco`/`deco-set` TAIL after any number of MANDATORY arguments, at top \
level or (nested) module scope; this particular occurrence is outside \
that support — either an OPTIONAL-argument arrow (which has no positional \
spelling to forward) or a `deco` leaf buried inside a compound type"
}
"paren" => {
"0.0.6's paren is `length -> length -> length -> length -> color -> \
(inline-boxes * (length -> length))` — (height, signed depth, axis, \
fontsize, colour); 0.1's is `length -> length -> context -> \
(inline-boxes * (length -> length))`, pulling the last three out of the \
context instead. FORWARD that is a PROJECTION and X3b generates it: \
`size = get-font-size ctx`, `axis = size *' \
get-math-axis-height-ratio ctx`, `colour = get-text-color ctx`. \
REVERSE there is no inverse to generate. The 0.0.6 call site \
(`primitives::make_paren_run`) has only those five scalars and no \
context at all, so a wrapper would have to invent one — and even \
granting `set-font-size`/`set-text-color`, the caller's explicit AXIS \
has no channel: 0.1 recovers the axis from the math font's MATH-table \
height ratio, which no primitive in EITHER generation can set. A \
reverse wrapper would therefore silently draw against the invented \
context's axis rather than the caller's. This occurrence is either \
that direction or outside the forward wrapper's support (an \
OPEN optional row, or a `paren` leaf buried inside a compound type)"
}
"font" => {
"a REPRESENTATION FORK, not a missing feature. 0.1's `font` is an OPAQUE \
HANDLE on one already-loaded face — upstream saphe-split registers \
(\"font\", FontType) in types.cppo.ml's base_type_hash_table, spells it \
tFONTKEY, and its only values are BCFontKey of FontKey.t, minted by a \
font ENVELOPE from a font FILE path (envelopeChecker.ml's \
check_font_envelope). 0.0.6 has NO `font` type at all: no such row in \
its own base_type_hash_table and no `type font` in its bundled \
packages, so the same word in 0.0.6 text is an unrelated opaque user \
nominal. What 0.0.6 calls a font is the bare product `string * float * \
float` (tFONT) whose head is an ABBREV naming a row of \
dist/hash/fonts.satysfi-hash — a different naming universe, and it \
names no forked type, so it already crosses as the string triple it is. \
Neither direction has a total map: forward there is no 0.0.6 value that \
is a face handle, and an untagged `string * float * float` cannot be \
recognized as a font to coerce; reverse a handle is a store index with \
no abbrev to recover from it"
}
"code" => {
"0.0.6 has no `code` type spelling at all (its manual-type decoder knows \
only `list` and `ref`), so `τ code` there is an opaque user nominal — \
but a merged program reads every type declaration under one hard-coded \
V0_1 Checker, where the same text means the real staged type. An \
INFERRED `code` export (a `@stage: 0` binding's `&e`) is unaffected and \
crosses fine; only WRITTEN `code` type text does not"
}
"pre-path" | "path" | "graphics" | "image" => {
"0.0.6 has no such primitive; this name is an opaque user-nominal \
stand-in there, with no shared representation against 0.1's real \
primitive type"
}
_ => {
"no proven-identical Value representation across the version boundary \
(X3a's whitelist is `math` only)"
}
}
}
fn reject_if_forked(
name: &str,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
if name == "math" {
return Ok(());
}
if reject_type_names().contains(name) {
return Err(BoundaryError::ForkedTypeExport {
binding: String::new(),
ty_name: name.to_string(),
from,
to,
note: forked_note(name),
});
}
Ok(())
}
#[allow(dead_code)]
pub fn adapt_export_type(
ty: &PolyType,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<PolyType, BoundaryError> {
check_mono_type(ty.body(), from, to)?;
Ok(ty.clone())
}
#[allow(dead_code)]
fn check_mono_type(
ty: &MonoType,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
match ty {
MonoType::Var(_) | MonoType::Base(_) => Ok(()),
MonoType::Func(row, dom, cod) => {
check_row(row, from, to)?;
check_mono_type(dom, from, to)?;
check_mono_type(cod, from, to)
}
MonoType::Product(items) => {
for t in items {
check_mono_type(t, from, to)?;
}
Ok(())
}
MonoType::List(t) | MonoType::Ref(t) | MonoType::Code(t) => check_mono_type(t, from, to),
MonoType::Record(row) => check_row(row, from, to),
MonoType::Variant(name, args) => {
reject_if_forked(name, from, to)?;
for t in args {
check_mono_type(t, from, to)?;
}
Ok(())
}
MonoType::InlineCmd(items) | MonoType::BlockCmd(items) | MonoType::MathCmd(items) => {
for c in items {
check_cmd_arg(c, from, to)?;
}
Ok(())
}
}
}
#[allow(dead_code)]
fn check_row(row: &Row, from: RustyfiVersion, to: RustyfiVersion) -> Result<(), BoundaryError> {
match row {
Row::Empty | Row::Var(_) => Ok(()),
Row::Cons(_, ty, rest) => {
check_mono_type(ty, from, to)?;
check_row(rest, from, to)
}
}
}
#[allow(dead_code)]
fn check_cmd_arg(
c: &CmdArgType,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
for (_, ty) in &c.opt_labels {
check_mono_type(ty, from, to)?;
}
check_mono_type(&c.ty, from, to)
}
#[allow(dead_code)]
pub fn adapt_export_annotation(
ann: &TypeExpr,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<TypeExpr, BoundaryError> {
let mut out = ann.clone();
relabel_type_expr(&mut out, from, to)?;
Ok(out)
}
fn relabel_type_expr(
te: &mut TypeExpr,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
match te {
TypeExpr::Fun { opts, dom, cod, .. } => {
for o in opts.iter_mut() {
relabel_type_prod(&mut o.ty, from, to)?;
}
relabel_type_prod(dom, from, to)?;
relabel_type_expr(cod, from, to)
}
TypeExpr::Atom(prod) => relabel_type_prod(prod, from, to),
TypeExpr::OptRowFun {
opt_dom, dom, cod, ..
} => {
for e in opt_dom.entries.iter_mut() {
relabel_type_expr(&mut e.ty.0, from, to)?;
}
relabel_type_prod(dom, from, to)?;
relabel_type_expr(cod, from, to)
}
}
}
fn relabel_type_prod(
tp: &mut TypeProd,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
relabel_type_app(&mut tp.first, from, to)?;
for st in tp.rest.iter_mut() {
relabel_type_app(&mut st.ty, from, to)?;
}
Ok(())
}
fn relabel_type_app(
ta: &mut TypeApp,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
relabel_type_atom(&mut ta.head, from, to)?;
for a in &mut ta.rest {
relabel_type_atom(a, from, to)?;
}
Ok(())
}
fn relabel_type_atom(
atom: &mut TypeAtom,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
match atom {
TypeAtom::Cmd { args, .. } => {
for a in args.iter_mut() {
for l in a.opt_labels.iter_mut() {
relabel_type_expr(&mut l.ty.0, from, to)?;
}
relabel_type_expr(&mut a.ty.0, from, to)?;
}
Ok(())
}
TypeAtom::Paren { inner, .. } => relabel_type_expr(&mut inner.0, from, to),
TypeAtom::Record { fields, .. } => {
for f in fields.iter_mut() {
relabel_type_expr(&mut f.ty.0, from, to)?;
}
Ok(())
}
TypeAtom::Var(_) => Ok(()),
TypeAtom::Name(n) => relabel_or_reject_name(&mut n.name, from, to),
TypeAtom::NameMod(_) => Ok(()),
TypeAtom::RecordOpen { inner, .. } => {
for f in inner.fields.iter_mut() {
relabel_type_expr(&mut f.ty.0, from, to)?;
}
Ok(())
}
}
}
fn relabel_or_reject_name(
name: &mut String,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
match (from, to) {
(RustyfiVersion::V0_0, RustyfiVersion::V0_1) if name == "math" => {
*name = "math-text".to_string();
Ok(())
}
(RustyfiVersion::V0_1, RustyfiVersion::V0_0)
if name == "math-text" || name == "math-boxes" =>
{
*name = "math".to_string();
Ok(())
}
_ => reject_if_forked(name, from, to),
}
}
pub(crate) fn relabel_type_decls(
prelude: &[cst::TopBinding],
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<Vec<cst::TopBinding>, BoundaryError> {
prelude
.iter()
.cloned()
.map(|tb| relabel_top_binding_types(tb, from, to))
.collect()
}
fn relabel_top_binding_types(
mut tb: cst::TopBinding,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<cst::TopBinding, BoundaryError> {
match &mut tb {
cst::TopBinding::Type(td) => {
relabel_type_decl_body(&mut td.body, from, to)?;
for a in td.ands.iter_mut() {
relabel_type_decl_body(&mut a.body, from, to)?;
}
}
cst::TopBinding::Module { decls, .. } => {
for d in decls.iter_mut() {
let inner = (*d.0).clone();
*d.0 = relabel_top_binding_types(inner, from, to)?;
}
}
_ => {}
}
Ok(tb)
}
fn relabel_type_decl_body(
body: &mut cst::TypeDeclBody,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
match body {
cst::TypeDeclBody::Variant { first, rest, .. } => {
relabel_variant_def(first, from, to)?;
for bv in rest.iter_mut() {
relabel_variant_def(&mut bv.def, from, to)?;
}
Ok(())
}
cst::TypeDeclBody::Synonym(ty) => relabel_type_expr(ty, from, to),
}
}
fn relabel_variant_def(
vd: &mut cst::VariantDef,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
if let Some(of_ty) = &mut vd.of_ty {
relabel_type_expr(&mut of_ty.ty, from, to)?;
}
Ok(())
}
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
pub(crate) enum DecoKind {
Deco,
DecoSet,
Paren,
Consumer,
}
#[derive(Debug, Clone, PartialEq, Eq)]
pub(crate) enum LeadOpt {
Mandatory,
V006Optional,
V01Labels(Vec<String>),
}
const V01_MAX_OPT_LABELS: usize = 4;
#[derive(Debug, Clone)]
pub(crate) struct DecoExport {
pub name: String,
pub kind: DecoKind,
pub lead_arity: usize,
pub lead_opts: Vec<LeadOpt>,
pub module_path: Vec<String>,
pub arg_downgrades: Vec<Option<DecoKind>>,
pub unit_thunk: bool,
}
impl DecoExport {
fn lead_opt(&self, i: usize) -> &LeadOpt {
const MANDATORY: LeadOpt = LeadOpt::Mandatory;
self.lead_opts.get(i).unwrap_or(&MANDATORY)
}
fn has_optionals(&self) -> bool {
self.lead_opts
.iter()
.any(|o| !matches!(o, LeadOpt::Mandatory))
}
fn opt_src_alias(&self) -> String {
format!("xver-opt-src-{}", self.dash_key())
}
fn qualified_key(&self) -> String {
if self.module_path.is_empty() {
self.name.clone()
} else {
format!("{}.{}", self.module_path.join("."), self.name)
}
}
fn dash_key(&self) -> String {
let mut key: Vec<&str> = self.module_path.iter().map(String::as_str).collect();
key.push(&self.name);
key.join("-")
}
fn orig_capture_name(&self) -> String {
format!("xver-fwd-orig-{}", self.name)
}
fn orig_capture_key(&self) -> String {
if self.module_path.is_empty() {
self.orig_capture_name()
} else {
format!("{}.{}", self.module_path.join("."), self.orig_capture_name())
}
}
fn view_capture_name(&self) -> String {
format!("xver-fwd-view-{}", self.dash_key())
}
}
pub(crate) fn classify_deco_exports(
prelude: &[cst::TopBinding],
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<Vec<DecoExport>, BoundaryError> {
let mut out = Vec::new();
let skip = std::collections::HashSet::new();
for tb in prelude {
classify_top_binding_deco(tb, &mut out, &[], &skip, from, to)?;
}
Ok(out)
}
fn classify_top_binding_deco(
tb: &cst::TopBinding,
out: &mut Vec<DecoExport>,
module_path: &[String],
skip: &std::collections::HashSet<String>,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
match tb {
cst::TopBinding::LetRec { first, ands, .. } => {
classify_rec_binding_deco(first, out, module_path, skip, from, to)?;
for a in ands {
classify_rec_binding_deco(&a.binding, out, module_path, skip, from, to)?;
}
Ok(())
}
cst::TopBinding::Module {
name, sig, decls, ..
} => {
let mut inner = module_path.to_vec();
inner.push(name.name.clone());
let mut wrapped: std::collections::HashSet<String> = std::collections::HashSet::new();
if let Some(sig) = sig {
for item in &sig.items {
if let Some(ty) = sig_item_value_ty(item) {
match (
sig_item_value_name(item),
deco_tail_of(ty),
deco_consumer_plan(ty),
) {
(Some(n), Some((kind, lead_arity, lead_opts)), _) => {
wrapped.insert(n.to_string());
out.push(DecoExport {
name: n.to_string(),
kind,
lead_arity,
lead_opts,
module_path: inner.clone(),
arg_downgrades: Vec::new(),
unit_thunk: false,
});
}
(Some(n), None, Some((plan, lead_opts))) => {
wrapped.insert(n.to_string());
out.push(DecoExport {
name: n.to_string(),
kind: DecoKind::Consumer,
lead_arity: plan.len(),
lead_opts,
module_path: inner.clone(),
arg_downgrades: plan,
unit_thunk: false,
});
}
_ => reject_if_mentions_deco(ty, from, to)?,
}
}
}
}
for d in decls {
classify_top_binding_deco(&d.0, out, &inner, &wrapped, from, to)?;
}
Ok(())
}
_ => Ok(()),
}
}
fn classify_rec_binding_deco(
rb: &cst::ast::RecBinding,
out: &mut Vec<DecoExport>,
module_path: &[String],
skip: &std::collections::HashSet<String>,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
let Some(asc) = &rb.ascription else {
return Ok(());
};
if skip.contains(&rb.name.name) {
return Ok(());
}
if let Some((kind, lead_arity, lead_opts)) = deco_tail_of(&asc.ty) {
if lead_arity > 0 {
out.push(DecoExport {
name: rb.name.name.clone(),
kind,
lead_arity,
lead_opts,
module_path: module_path.to_vec(),
arg_downgrades: Vec::new(),
unit_thunk: false,
});
return Ok(());
}
}
match type_expr_bare_name(&asc.ty) {
Some("deco") => {
out.push(DecoExport {
name: rb.name.name.clone(),
kind: DecoKind::Deco,
lead_arity: 0,
lead_opts: Vec::new(),
module_path: module_path.to_vec(),
arg_downgrades: Vec::new(),
unit_thunk: false,
});
Ok(())
}
Some("deco-set") if matches!(rb.params.as_slice(), [cst::ast::PatBot::Unit { .. }]) => {
out.push(DecoExport {
name: rb.name.name.clone(),
kind: DecoKind::DecoSet,
lead_arity: 0,
lead_opts: Vec::new(),
module_path: module_path.to_vec(),
arg_downgrades: Vec::new(),
unit_thunk: true,
});
Ok(())
}
_ => reject_if_mentions_deco(&asc.ty, from, to),
}
}
fn sig_item_value_ty(item: &cst::SigItem) -> Option<&TypeExpr> {
use cst::SigItem;
match item {
SigItem::ValHorzCmd { ty, .. }
| SigItem::ValVertCmd { ty, .. }
| SigItem::Val { ty, .. }
| SigItem::DirectHorzCmd { ty, .. }
| SigItem::DirectVertCmd { ty, .. } => Some(ty),
SigItem::Type { .. } => None,
}
}
fn sig_item_value_name(item: &cst::SigItem) -> Option<&str> {
use cst::SigItem;
match item {
SigItem::Val { name, .. } => Some(name.name.as_str()),
_ => None,
}
}
fn deco_tail_of(te: &TypeExpr) -> Option<(DecoKind, usize, Vec<LeadOpt>)> {
let mut lead_opts: Vec<LeadOpt> = Vec::new();
let mut cur = te;
loop {
match cur {
TypeExpr::Fun { opts, cod, .. } => {
for _ in opts {
lead_opts.push(LeadOpt::V006Optional);
}
lead_opts.push(LeadOpt::Mandatory);
cur = cod;
}
TypeExpr::OptRowFun { .. } => return None,
_ => {
let kind = match type_expr_bare_name(cur)? {
"deco" => DecoKind::Deco,
"deco-set" => DecoKind::DecoSet,
"paren" => DecoKind::Paren,
_ => return None,
};
return Some((kind, lead_opts.len(), lead_opts));
}
}
}
}
fn deco_consumer_plan(te: &TypeExpr) -> Option<(Vec<Option<DecoKind>>, Vec<LeadOpt>)> {
let mut plan: Vec<Option<DecoKind>> = Vec::new();
let mut lead_opts: Vec<LeadOpt> = Vec::new();
let mut cur = te;
loop {
match cur {
TypeExpr::Fun { opts, dom, cod, .. } => {
for o in opts {
if type_prod_mentions_deco(&o.ty).is_some() {
return None;
}
plan.push(None);
lead_opts.push(LeadOpt::V006Optional);
}
let dom_te = TypeExpr::Atom(dom.clone());
plan.push(match type_expr_bare_name(&dom_te) {
Some("deco") => Some(DecoKind::Deco),
Some("deco-set") => Some(DecoKind::DecoSet),
_ => {
if type_expr_mentions_deco(&dom_te).is_some() {
return None;
}
None
}
});
lead_opts.push(LeadOpt::Mandatory);
cur = cod;
}
TypeExpr::OptRowFun { .. } => return None,
_ => {
if type_expr_mentions_deco(cur).is_some() {
return None;
}
return if plan.iter().any(Option::is_some) {
Some((plan, lead_opts))
} else {
None
};
}
}
}
}
fn type_expr_bare_name(te: &TypeExpr) -> Option<&str> {
match te {
TypeExpr::Atom(TypeProd {
first:
TypeApp {
head: TypeAtom::Name(n),
rest: app_rest,
},
rest,
}) if rest.is_empty() && app_rest.is_empty() => Some(n.name.as_str()),
_ => None,
}
}
fn reject_if_mentions_deco(
te: &TypeExpr,
from: RustyfiVersion,
to: RustyfiVersion,
) -> Result<(), BoundaryError> {
if let Some(name) = type_expr_mentions_deco(te) {
return Err(BoundaryError::ForkedTypeExport {
binding: String::new(),
ty_name: name.clone(),
from,
to,
note: forked_note(&name),
});
}
Ok(())
}
fn type_expr_mentions_deco(te: &TypeExpr) -> Option<String> {
match te {
TypeExpr::Fun { opts, dom, cod, .. } => opts
.iter()
.find_map(|o| type_prod_mentions_deco(&o.ty))
.or_else(|| type_prod_mentions_deco(dom))
.or_else(|| type_expr_mentions_deco(cod)),
TypeExpr::Atom(prod) => type_prod_mentions_deco(prod),
TypeExpr::OptRowFun {
opt_dom, dom, cod, ..
} => opt_dom
.entries
.iter()
.find_map(|e| type_expr_mentions_deco(&e.ty.0))
.or_else(|| type_prod_mentions_deco(dom))
.or_else(|| type_expr_mentions_deco(cod)),
}
}
fn type_prod_mentions_deco(tp: &TypeProd) -> Option<String> {
type_app_mentions_deco(&tp.first)
.or_else(|| tp.rest.iter().find_map(|st| type_app_mentions_deco(&st.ty)))
}
fn type_app_mentions_deco(ta: &TypeApp) -> Option<String> {
std::iter::once(&ta.head)
.chain(ta.rest.iter())
.find_map(type_atom_mentions_deco)
}
fn type_atom_mentions_deco(atom: &TypeAtom) -> Option<String> {
match atom {
TypeAtom::Cmd { args, .. } => args.iter().find_map(|a| {
a.opt_labels
.iter()
.find_map(|l| type_expr_mentions_deco(&l.ty.0))
.or_else(|| type_expr_mentions_deco(&a.ty.0))
}),
TypeAtom::Paren { inner, .. } => type_expr_mentions_deco(&inner.0),
TypeAtom::Record { fields, .. } => {
fields.iter().find_map(|f| type_expr_mentions_deco(&f.ty.0))
}
TypeAtom::Var(_) => None,
TypeAtom::Name(n) => deco_leaf_name(&n.name),
TypeAtom::NameMod(_) => None,
TypeAtom::RecordOpen { inner, .. } => inner
.fields
.iter()
.find_map(|f| type_expr_mentions_deco(&f.ty.0)),
}
}
fn deco_leaf_name(name: &str) -> Option<String> {
if name == "deco" || name == "deco-set" || name == "paren" {
Some(name.to_string())
} else {
None
}
}
pub(crate) const XVER_UNITE_HELPER: &str = "xver-unite-graphics";
pub(crate) const XVER_AXIS_RATIO_HELPER: &str = "xver-math-axis-height-ratio";
pub(crate) const XVER_DOWN_DECO: &str = "xver-downgrade-deco";
pub(crate) const XVER_DOWN_DECOSET: &str = "xver-downgrade-decoset";
pub(crate) fn unite_helper_prelude() -> Vec<cst::TopBinding> {
let src = format!(
"let {XVER_UNITE_HELPER} xver-gs = unite-graphics xver-gs\n\
let {XVER_AXIS_RATIO_HELPER} xver-c = get-math-axis-height-ratio xver-c\n\
let {XVER_DOWN_DECO} xver-f xver-p xver-w xver-h xver-d =\n\
\x20 [xver-f xver-p xver-w xver-h xver-d]\n\
let {XVER_DOWN_DECOSET} xver-s =\n\
\x20 match xver-s with\n\
\x20 | (xver-s0, xver-s1, xver-s2, xver-s3) ->\n\
\x20 ({XVER_DOWN_DECO} xver-s0, {XVER_DOWN_DECO} xver-s1,\n\
\x20 {XVER_DOWN_DECO} xver-s2, {XVER_DOWN_DECO} xver-s3)\n"
);
rustyfi_syntax::parse_file(&src)
.unwrap_or_else(|e| panic!("xver_adapt::unite_helper_prelude failed to parse: {e}"))
.prelude
}
pub(crate) fn needs_unite_helper(exports: &[DecoExport]) -> bool {
exports
.iter()
.any(|e| !e.module_path.is_empty() || e.kind == DecoKind::Consumer)
}
fn deco_wrapper_src(exp: &DecoExport) -> String {
let unite = if exp.module_path.is_empty() {
"unite-graphics"
} else {
XVER_UNITE_HELPER
};
let lead: Vec<String> = (0..exp.lead_arity).map(|i| format!("xver-a{i}")).collect();
let lead_args = if lead.is_empty() {
String::new()
} else {
format!("{} ", lead.join(" "))
};
let lead_params = if lead.is_empty() {
String::new()
} else {
let marked: Vec<String> = (0..exp.lead_arity)
.map(|i| match exp.lead_opt(i) {
LeadOpt::V006Optional => format!("?:xver-a{i}"),
_ => format!("xver-a{i}"),
})
.collect();
format!("{} ", marked.join(" "))
};
let alias = exp.opt_src_alias();
let (orig, alias_binding) = if exp.has_optionals() {
(
alias.as_str(),
format!("let {alias} = ({})\n", exp.name),
)
} else {
(exp.name.as_str(), String::new())
};
let axis_ratio = if exp.module_path.is_empty() {
"get-math-axis-height-ratio"
} else {
XVER_AXIS_RATIO_HELPER
};
match exp.kind {
DecoKind::Consumer => {
let args: Vec<String> = exp
.arg_downgrades
.iter()
.enumerate()
.map(|(i, down)| match down {
Some(DecoKind::DecoSet) => format!("({XVER_DOWN_DECOSET} xver-a{i})"),
Some(_) => format!("({XVER_DOWN_DECO} xver-a{i})"),
None => format!("xver-a{i}"),
})
.collect();
let params: Vec<String> = (0..exp.arg_downgrades.len())
.map(|i| match exp.lead_opt(i) {
LeadOpt::V006Optional => format!("?:xver-a{i}"),
_ => format!("xver-a{i}"),
})
.collect();
format!(
"{alias_binding}let {name} {} =\n\x20 {orig} {}\n",
params.join(" "),
args.join(" "),
name = exp.name
)
}
DecoKind::Paren => format!(
"{alias_binding}let {name} {lead_params}xver-h xver-d xver-ctx =\n\
\x20 {orig} {lead_args}xver-h xver-d\n\
\x20 ((get-font-size xver-ctx) *' ({axis_ratio} xver-ctx))\n\
\x20 (get-font-size xver-ctx)\n\
\x20 (get-text-color xver-ctx)\n",
name = exp.name
),
DecoKind::Deco => format!(
"{alias_binding}let {name} {lead_params}xver-p xver-w xver-h xver-d =\n\
\x20 {unite} ({orig} {lead_args}xver-p xver-w xver-h xver-d)\n",
name = exp.name
),
DecoKind::DecoSet => {
let scrutinee = if exp.unit_thunk {
format!("{orig} ()")
} else if lead.is_empty() {
orig.to_string()
} else {
format!("{orig} {}", lead.join(" "))
};
let mut out = format!(
"{alias_binding}let {name} {lead_params}=\n\
\x20 match {scrutinee} with\n\
\x20 | (xver-d0, xver-d1, xver-d2, xver-d3) ->\n",
name = exp.name
);
let wrap = |i: usize| {
format!(
"(fun xver-p xver-w xver-h xver-d -> \
{unite} (xver-d{i} xver-p xver-w xver-h xver-d))"
)
};
out.push_str(&format!(
" ({}, {}, {}, {})\n",
wrap(0),
wrap(1),
wrap(2),
wrap(3)
));
out
}
}
}
pub(crate) fn inject_module_deco_wrappers(prelude: &mut [cst::TopBinding], exports: &[DecoExport]) {
for tb in prelude.iter_mut() {
inject_into_top_binding(tb, &[], exports);
}
}
fn inject_into_top_binding(tb: &mut cst::TopBinding, path: &[String], exports: &[DecoExport]) {
let cst::TopBinding::Module { name, decls, .. } = tb else {
return;
};
let mut here = path.to_vec();
here.push(name.name.clone());
let mine: Vec<&DecoExport> = exports.iter().filter(|e| e.module_path == here).collect();
if !mine.is_empty() {
let mut src = String::from("module XverWrap = struct\n");
for exp in &mine {
src.push_str(&format!(
"let {} = {}\n",
exp.orig_capture_name(),
exp.name
));
src.push_str(&deco_wrapper_src(exp));
}
src.push_str("end\n");
let file = rustyfi_syntax::parse_file(&src).unwrap_or_else(|e| {
panic!(
"xver_adapt::inject_module_deco_wrappers: internally-generated X3b \
wrapper source failed to parse (a bug in xver_adapt.rs, not user \
input): {e}\n--- generated source ---\n{src}"
)
});
if let Some(cst::TopBinding::Module { decls: gen, .. }) = file.prelude.into_iter().next() {
decls.extend(gen);
}
}
for d in decls.iter_mut() {
inject_into_top_binding(&mut d.0, &here, exports);
}
}
pub(crate) fn deco_coercion_prelude(exports: &[DecoExport]) -> Vec<cst::TopBinding> {
if exports.is_empty() {
return Vec::new();
}
let mut src = String::new();
for exp in exports {
if !exp.module_path.is_empty() {
continue;
}
src.push_str(&format!(
"let {} = {}\n",
exp.orig_capture_name(),
exp.name
));
src.push_str(&deco_wrapper_src(exp));
}
if src.is_empty() {
return Vec::new();
}
let file = rustyfi_syntax::parse_file(&src).unwrap_or_else(|e| {
panic!(
"xver_adapt::deco_coercion_prelude: internally-generated X3b wrapper \
source failed to parse (a bug in xver_adapt.rs, not user input): {e}\n\
--- generated source ---\n{src}"
)
});
file.prelude
}
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
pub(crate) enum UpgradeStep {
Capture,
Restore,
Install,
}
pub(crate) fn deco_upgrade_prelude(
exports: &[DecoExport],
step: UpgradeStep,
) -> Vec<cst::TopBinding> {
if exports.is_empty() {
return Vec::new();
}
let mut src = String::new();
let mut shadow_names: Vec<(String, String)> = Vec::new();
for exp in exports {
let qualified = exp.qualified_key();
let view = exp.view_capture_name();
match step {
UpgradeStep::Capture => {
src.push_str(&format!("let {view} = {qualified}\n"));
}
UpgradeStep::Restore => {
let shadow = format!("xver-fwd-shadow-{}", exp.dash_key());
src.push_str(&format!("let {shadow} = {}\n", exp.orig_capture_key()));
shadow_names.push((shadow, qualified));
}
UpgradeStep::Install => {
let shadow = format!("xver-fwd-shadow-{}", exp.dash_key());
src.push_str(&format!("let {shadow} = {view}\n"));
shadow_names.push((shadow, qualified));
}
}
}
let file = rustyfi_syntax::parse_file(&src).unwrap_or_else(|e| {
panic!(
"xver_adapt::deco_upgrade_prelude: internally-generated X3c placement \
source failed to parse (a bug in xver_adapt.rs, not user input): {e}\n\
--- generated source ---\n{src}"
)
});
let mut prelude = file.prelude;
rebind_shadows_to_qualified(&mut prelude, &shadow_names, "deco_upgrade_prelude");
prelude
}
fn rebind_shadows_to_qualified(
prelude: &mut [cst::TopBinding],
shadow_names: &[(String, String)],
who: &str,
) {
for (shadow, qualified) in shadow_names {
let mut found = false;
for tb in prelude.iter_mut() {
if let cst::TopBinding::Let(tl) = tb {
if tl.name.name == *shadow {
tl.name = cst::BindName::from(rustyfi_syntax::leaf::VarTok {
name: qualified.clone(),
span: tl.name.span,
});
found = true;
break;
}
}
}
assert!(
found,
"xver_adapt::{who}: generated shadow `{shadow}` vanished from its own \
parse (a bug in xver_adapt.rs)"
);
}
}
pub(crate) fn classify_deco_exports_v01_sig<'a>(
file: &'a cst_v1::FileV1,
surfaces: &SurfaceEnv<'a>,
) -> Result<Vec<DecoExport>, BoundaryError> {
let cst_v1::FileV1::Library {
name,
sig_annot: Some(sig_annot),
..
} = file
else {
return Ok(Vec::new());
};
let module_path = vec![name.name.clone()];
let mut out = Vec::new();
let mut visited: Vec<String> = Vec::new();
classify_v01_sig_expr(
&sig_annot.sig_.0,
&module_path,
surfaces,
&mut visited,
&V01Syns::default(),
&[],
&mut out,
)?;
Ok(out)
}
fn classify_v01_sig_expr<'a>(
se: &'a cst_v1::ast::SigExpr,
module_path: &[String],
surfaces: &SurfaceEnv<'a>,
visited: &mut Vec<String>,
syns: &V01Syns<'a>,
inherited_refines: &[surface::Refine<'a>],
out: &mut Vec<DecoExport>,
) -> Result<(), BoundaryError> {
let Some(mut resolved) = v01_resolve_sig_decls(se, module_path, surfaces) else {
return v1_reject_if_mentions_deco(se, syns);
};
resolved.refines.extend(inherited_refines.iter().cloned());
let inner = syns.extended(resolved.decls, &resolved.refines, module_path, surfaces);
let Some(k) = resolved.key else {
return classify_v01_sig_decls(
resolved.decls,
module_path,
surfaces,
visited,
&inner,
&resolved.refines,
out,
);
};
if visited.contains(&k) {
return Ok(());
}
visited.push(k);
let r = classify_v01_sig_decls(
resolved.decls,
module_path,
surfaces,
visited,
&inner,
&resolved.refines,
out,
);
visited.pop();
r
}
fn classify_v01_sig_decls<'a>(
decls: &'a [cst_v1::StructDeclV1],
module_path: &[String],
surfaces: &SurfaceEnv<'a>,
visited: &mut Vec<String>,
syns: &V01Syns<'a>,
refines: &[surface::Refine<'a>],
out: &mut Vec<DecoExport>,
) -> Result<(), BoundaryError> {
for d in decls {
match &*d.0 {
cst_v1::ast::Decl::Val { name, ty, .. } => match v1_deco_tail_of(ty, syns) {
Some((kind, lead_arity, lead_opts)) if kind != DecoKind::Paren => {
out.push(DecoExport {
name: name.name.clone(),
kind,
lead_arity,
lead_opts,
module_path: module_path.to_vec(),
arg_downgrades: Vec::new(),
unit_thunk: false,
})
}
_ => v1_reject_if_mentions_deco_ty(ty, syns)?,
},
cst_v1::ast::Decl::Module { name, sig_, .. } => {
let mut inner = module_path.to_vec();
inner.push(name.name.clone());
let child_refines: Vec<surface::Refine<'a>> = refines
.iter()
.filter(|r| r.path.first() == Some(&name.name))
.map(|r| {
let mut r = r.clone();
r.path.remove(0);
r
})
.collect();
classify_v01_sig_expr(
sig_,
&inner,
surfaces,
visited,
syns,
&child_refines,
out,
)?;
}
cst_v1::ast::Decl::Include { sig_, .. } => {
classify_v01_sig_expr(sig_, module_path, surfaces, visited, syns, refines, out)?;
}
cst_v1::ast::Decl::Signature { .. } => {}
other => {
if let Some(n) = v1_decl_mentions_deco(other, syns) {
return Err(v1_boundary_error(&n));
}
}
}
}
Ok(())
}
struct V01ResolvedSig<'a> {
decls: &'a [cst_v1::StructDeclV1],
key: Option<String>,
refines: Vec<surface::Refine<'a>>,
}
fn v01_resolve_sig_decls<'a>(
se: &'a cst_v1::ast::SigExpr,
site_path: &[String],
surfaces: &SurfaceEnv<'a>,
) -> Option<V01ResolvedSig<'a>> {
use cst_v1::ast::SigExpr;
match se {
SigExpr::Bot(bot) => v01_resolve_sig_bot(bot, site_path, surfaces),
SigExpr::WithType {
base, path, binds, ..
} => {
let mut resolved = v01_resolve_sig_bot(base, site_path, surfaces)?;
resolved
.refines
.extend(surface::collect_refines(binds, mod_chain_segments(path)));
Some(resolved)
}
SigExpr::Functor { .. } => None,
}
}
fn v01_resolve_sig_bot<'a>(
bot: &'a cst_v1::ast::SigBotV1,
site_path: &[String],
surfaces: &SurfaceEnv<'a>,
) -> Option<V01ResolvedSig<'a>> {
use cst_v1::ast::SigBotV1;
match bot {
SigBotV1::Sig { decls, .. } => Some(V01ResolvedSig {
decls: decls.as_slice(),
key: None,
refines: Vec::new(),
}),
SigBotV1::Var(t) => {
surface::find_sig_keyed(surfaces, site_path, &t.name).map(|(key, def)| V01ResolvedSig {
decls: def.decls,
key: Some(key),
refines: def.refines.clone(),
})
}
SigBotV1::Path(t) => {
let suffix = surface::sig_path_suffix(&t.mods, &t.name);
surface::find_sig_keyed(surfaces, site_path, &suffix).map(|(key, def)| V01ResolvedSig {
decls: def.decls,
key: Some(key),
refines: def.refines.clone(),
})
}
}
}
#[derive(Default, Clone)]
struct V01Syns<'a> {
map: std::collections::HashMap<String, Option<&'a cst_v1::ast::TypeExpr>>,
}
enum V01SynLookup<'a> {
Body(&'a cst_v1::ast::TypeExpr),
Opaque,
Undeclared,
}
impl<'a> V01Syns<'a> {
fn lookup(&self, name: &str) -> V01SynLookup<'a> {
match self.map.get(name) {
Some(Some(body)) => V01SynLookup::Body(body),
Some(None) => V01SynLookup::Opaque,
None => V01SynLookup::Undeclared,
}
}
fn extended(
&self,
decls: &'a [cst_v1::StructDeclV1],
refines: &[surface::Refine<'a>],
site_path: &[String],
surfaces: &SurfaceEnv<'a>,
) -> V01Syns<'a> {
let mut out = self.clone();
let mut visited: Vec<String> = Vec::new();
out.absorb_decls(decls, site_path, surfaces, &mut visited);
out.absorb_refines(refines);
out
}
fn absorb_decls(
&mut self,
decls: &'a [cst_v1::StructDeclV1],
site_path: &[String],
surfaces: &SurfaceEnv<'a>,
visited: &mut Vec<String>,
) {
for d in decls {
match &*d.0 {
cst_v1::ast::Decl::Type { binds, .. } => {
for single in v01_flatten_type_binds(binds) {
self.map
.insert(single.name.name.clone(), v01_synonym_body(single));
}
}
cst_v1::ast::Decl::TypeOpaque { name, .. } => {
self.map.insert(name.name.clone(), None);
}
cst_v1::ast::Decl::Include { sig_, .. } => {
let Some(resolved) = v01_resolve_sig_decls(sig_, site_path, surfaces) else {
continue;
};
if let Some(k) = &resolved.key {
if visited.contains(k) {
continue;
}
visited.push(k.clone());
self.absorb_decls(resolved.decls, site_path, surfaces, visited);
self.absorb_refines(&resolved.refines);
visited.pop();
} else {
self.absorb_decls(resolved.decls, site_path, surfaces, visited);
self.absorb_refines(&resolved.refines);
}
}
_ => {}
}
}
}
fn absorb_refines(&mut self, refines: &[surface::Refine<'a>]) {
for r in refines {
if !r.path.is_empty() {
continue;
}
let body = match (r.tyvars.is_empty(), r.body) {
(true, cst_v1::TypeBodyV1::Synonym(ty)) => Some(ty),
_ => None,
};
self.map.insert(r.name.clone(), body);
}
}
}
fn v01_synonym_body(single: &cst_v1::TypeBindSingleV1) -> Option<&cst_v1::ast::TypeExpr> {
match (single.tyvars.is_empty(), &single.body) {
(true, cst_v1::TypeBodyV1::Synonym(ty)) => Some(ty),
_ => None,
}
}
fn v01_flatten_type_binds(binds: &cst_v1::TypeBindsErasedV1) -> Vec<&cst_v1::TypeBindSingleV1> {
let mut out = vec![&binds.0.first];
for a in &binds.0.ands {
out.push(&a.bind);
}
out
}
fn mod_chain_segments(path: &Option<cst_v1::ast::ModChainV1>) -> Vec<String> {
match path {
None => Vec::new(),
Some(cst_v1::ast::ModChainV1::Single(t)) => vec![t.name.clone()],
Some(cst_v1::ast::ModChainV1::Long(t)) => {
let mut segs = t.mods.clone();
segs.push(t.name.clone());
segs
}
}
}
fn v1_boundary_error(name: &str) -> BoundaryError {
BoundaryError::ForkedTypeExport {
binding: String::new(),
ty_name: name.to_string(),
from: RustyfiVersion::V0_1,
to: RustyfiVersion::V0_0,
note: forked_note(name),
}
}
fn v1_reject_if_mentions_deco(
se: &cst_v1::ast::SigExpr,
syns: &V01Syns<'_>,
) -> Result<(), BoundaryError> {
match v1_sigexpr_mentions_deco(se, syns) {
Some(n) => Err(v1_boundary_error(&n)),
None => Ok(()),
}
}
fn v1_reject_if_mentions_deco_ty(
ty: &cst_v1::ast::TypeExpr,
syns: &V01Syns<'_>,
) -> Result<(), BoundaryError> {
match v1_type_expr_mentions_deco(ty, syns) {
Some(n) => Err(v1_boundary_error(&n)),
None => Ok(()),
}
}
fn v1_deco_tail_of<'a>(
te: &'a cst_v1::ast::TypeExpr,
syns: &V01Syns<'a>,
) -> Option<(DecoKind, usize, Vec<LeadOpt>)> {
use cst_v1::ast::TypeExpr;
let mut lead_opts: Vec<LeadOpt> = Vec::new();
let mut labels = 0usize;
let mut expanded: Vec<&str> = Vec::new();
let mut cur = te;
loop {
match cur {
TypeExpr::OptRowFun { opt_dom, cod, .. } => {
if opt_dom.inner.row_tail.is_some() {
return None;
}
let here: Vec<String> = opt_dom
.inner
.entries
.iter()
.map(|e| e.label.name.clone())
.collect();
labels += here.len();
if labels > V01_MAX_OPT_LABELS {
return None;
}
lead_opts.push(LeadOpt::V01Labels(here));
cur = cod;
}
TypeExpr::Fun { cod, .. } => {
lead_opts.push(LeadOpt::Mandatory);
cur = cod;
}
_ => {
let name = v1_type_expr_bare_name(cur)?;
match syns.lookup(name) {
V01SynLookup::Body(body) => {
if expanded.contains(&name) {
return None;
}
expanded.push(name);
cur = body;
continue;
}
V01SynLookup::Opaque => return None,
V01SynLookup::Undeclared => {}
}
let kind = match name {
"deco" => DecoKind::Deco,
"deco-set" => DecoKind::DecoSet,
"paren" => DecoKind::Paren,
_ => return None,
};
return Some((kind, lead_opts.len(), lead_opts));
}
}
}
}
fn v1_type_expr_bare_name(te: &cst_v1::ast::TypeExpr) -> Option<&str> {
use cst_v1::ast::{TypeApp, TypeAtom, TypeExpr};
let TypeExpr::Atom(prod) = te else {
return None;
};
if !prod.rest.is_empty() {
return None;
}
match &prod.first {
TypeApp::Atom(TypeAtom::Name(n)) => Some(n.name.as_str()),
_ => None,
}
}
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
pub(crate) enum DowngradeStep {
Capture,
Install,
Restore,
}
pub(crate) fn deco_downgrade_prelude(
exports: &[DecoExport],
step: DowngradeStep,
) -> Vec<cst::TopBinding> {
if exports.is_empty() {
return Vec::new();
}
let mut src = String::new();
let mut shadow_names: Vec<(String, String)> = Vec::new();
for exp in exports.iter() {
if matches!(exp.kind, DecoKind::Paren | DecoKind::Consumer) {
continue;
}
let qualified = deco_export_qualified_name(exp);
let mangled = qualified.replace('.', "-");
let orig = format!("xver-rev-orig-{mangled}");
let shadow = format!("xver-rev-shadow-{mangled}");
if step == DowngradeStep::Capture {
src.push_str(&format!("let {orig} = {qualified}\n"));
continue;
}
if step == DowngradeStep::Restore {
src.push_str(&format!("let {shadow} = {orig}\n"));
shadow_names.push((shadow, qualified));
continue;
}
let lead: Vec<String> = (0..exp.lead_arity).map(|k| format!("xver-a{k}")).collect();
let lead_params = if lead.is_empty() {
String::new()
} else {
format!("{} ", lead.join(" "))
};
let lambdas = v01_shadow_lambdas(exp);
let case_split = |tail: &str| {
let slots = v01_opt_slots(exp);
let mut chosen = vec![false; slots.len()];
v01_opt_case_split(&slots, 0, &mut chosen, &|chosen| {
format!("{orig} {}{tail}", v01_shadow_args(exp, &slots, chosen))
})
};
match exp.kind {
DecoKind::Deco if exp.has_optionals() => src.push_str(&format!(
"let {shadow} = {lambdas}fun xver-p xver-w xver-h xver-d ->\n\
\x20 [{}]\n",
case_split("xver-p xver-w xver-h xver-d")
)),
DecoKind::Deco => src.push_str(&format!(
"let {shadow} {lead_params}xver-p xver-w xver-h xver-d =\n\
\x20 [{orig} {lead_params}xver-p xver-w xver-h xver-d]\n",
)),
DecoKind::DecoSet => {
let scrutinee = if exp.has_optionals() {
case_split("")
} else if lead.is_empty() {
orig.clone()
} else {
format!("{orig} {}", lead.join(" "))
};
let binder = if exp.has_optionals() {
format!("let {shadow} = {lambdas}")
} else {
format!("let {shadow} {lead_params}= ")
};
let wrap = |k: usize| {
format!(
"(fun xver-p xver-w xver-h xver-d -> \
[xver-d{k} xver-p xver-w xver-h xver-d])"
)
};
src.push_str(&format!(
"{}\n\
\x20 match {scrutinee} with\n\
\x20 | (xver-d0, xver-d1, xver-d2, xver-d3) ->\n\
\x20 ({}, {}, {}, {})\n",
binder.trim_end(),
wrap(0),
wrap(1),
wrap(2),
wrap(3)
));
}
DecoKind::Paren | DecoKind::Consumer => unreachable!("skipped above"),
}
shadow_names.push((shadow, qualified));
}
if src.is_empty() {
return Vec::new();
}
let file = rustyfi_syntax::parse_file(&src).unwrap_or_else(|e| {
panic!(
"xver_adapt::deco_downgrade_prelude: internally-generated X4b wrapper \
source failed to parse (a bug in xver_adapt.rs, not user input): {e}\n\
--- generated source ---\n{src}"
)
});
let mut prelude = file.prelude;
rebind_shadows_to_qualified(&mut prelude, &shadow_names, "deco_downgrade_prelude");
prelude
}
fn v01_opt_slots(exp: &DecoExport) -> Vec<(usize, usize, String)> {
let mut out = Vec::new();
for i in 0..exp.lead_arity {
if let LeadOpt::V01Labels(labels) = exp.lead_opt(i) {
for (k, l) in labels.iter().enumerate() {
out.push((i, k, l.clone()));
}
}
}
out
}
fn v01_shadow_lambdas(exp: &DecoExport) -> String {
let mut out = String::new();
for i in 0..exp.lead_arity {
match exp.lead_opt(i) {
LeadOpt::V01Labels(labels) => {
let binders: Vec<String> = labels
.iter()
.enumerate()
.map(|(k, l)| format!("{l} = xver-o{i}-{k}"))
.collect();
out.push_str(&format!("fun ?({}) xver-a{i} -> ", binders.join(", ")));
}
_ => out.push_str(&format!("fun xver-a{i} -> ")),
}
}
out
}
fn v01_shadow_args(exp: &DecoExport, slots: &[(usize, usize, String)], chosen: &[bool]) -> String {
let mut out = String::new();
for i in 0..exp.lead_arity {
let here: Vec<String> = slots
.iter()
.zip(chosen)
.filter(|((p, _, _), take)| *p == i && **take)
.map(|((p, k, l), _)| format!("{l} = xver-v{p}-{k}"))
.collect();
if !here.is_empty() {
out.push_str(&format!("?({}) ", here.join(", ")));
}
out.push_str(&format!("xver-a{i} "));
}
out
}
fn v01_opt_case_split(
slots: &[(usize, usize, String)],
idx: usize,
chosen: &mut Vec<bool>,
apply: &dyn Fn(&[bool]) -> String,
) -> String {
if idx == slots.len() {
return apply(chosen);
}
let (p, k, _) = &slots[idx];
chosen[idx] = false;
let absent = v01_opt_case_split(slots, idx + 1, chosen, apply);
chosen[idx] = true;
let present = v01_opt_case_split(slots, idx + 1, chosen, apply);
chosen[idx] = false;
format!(
"(match xver-o{p}-{k} with | None -> {absent} | Some(xver-v{p}-{k}) -> {present})"
)
}
pub(crate) fn deco_export_qualified_name(exp: &DecoExport) -> String {
format!("{}.{}", exp.module_path.join("."), exp.name)
}
fn v1_sigexpr_mentions_deco(se: &cst_v1::ast::SigExpr, syns: &V01Syns<'_>) -> Option<String> {
use cst_v1::ast::SigExpr;
match se {
SigExpr::Functor { dom, cod, .. } => v1_sigexpr_mentions_deco(dom, syns)
.or_else(|| v1_sigexpr_mentions_deco(cod, syns)),
SigExpr::WithType { base, .. } => v1_sigbot_mentions_deco(base, syns),
SigExpr::Bot(bot) => v1_sigbot_mentions_deco(bot, syns),
}
}
fn v1_sigbot_mentions_deco(bot: &cst_v1::ast::SigBotV1, syns: &V01Syns<'_>) -> Option<String> {
use cst_v1::ast::SigBotV1;
match bot {
SigBotV1::Path(_) | SigBotV1::Var(_) => None,
SigBotV1::Sig { decls, .. } => decls
.iter()
.find_map(|d| v1_decl_mentions_deco(&d.0, syns)),
}
}
fn v1_decl_mentions_deco(decl: &cst_v1::ast::Decl, syns: &V01Syns<'_>) -> Option<String> {
use cst_v1::ast::Decl;
match decl {
Decl::Val { ty, .. } | Decl::ValHorzCmd { ty, .. } | Decl::ValVertCmd { ty, .. } => {
v1_type_expr_mentions_deco(ty, syns)
}
Decl::TypeOpaque { .. } | Decl::Type { .. } => None,
Decl::Module { sig_, .. } | Decl::Signature { sig_, .. } | Decl::Include { sig_, .. } => {
v1_sigexpr_mentions_deco(sig_, syns)
}
}
}
fn v1_type_expr_mentions_deco(te: &cst_v1::ast::TypeExpr, syns: &V01Syns<'_>) -> Option<String> {
use cst_v1::ast::TypeExpr;
match te {
TypeExpr::OptRowFun {
opt_dom, dom, cod, ..
} => opt_dom
.inner
.entries
.iter()
.find_map(|e| v1_type_expr_mentions_deco(&e.ty.0, syns))
.or_else(|| v1_type_prod_mentions_deco(dom, syns))
.or_else(|| v1_type_expr_mentions_deco(cod, syns)),
TypeExpr::Fun { dom, cod, .. } => v1_type_prod_mentions_deco(dom, syns)
.or_else(|| v1_type_expr_mentions_deco(cod, syns)),
TypeExpr::Atom(prod) => v1_type_prod_mentions_deco(prod, syns),
}
}
fn v1_type_prod_mentions_deco(tp: &cst_v1::ast::TypeProd, syns: &V01Syns<'_>) -> Option<String> {
v1_type_app_mentions_deco(&tp.first, syns).or_else(|| {
tp.rest
.iter()
.find_map(|st| v1_type_app_mentions_deco(&st.ty, syns))
})
}
fn v1_type_app_mentions_deco(ta: &cst_v1::ast::TypeApp, syns: &V01Syns<'_>) -> Option<String> {
use cst_v1::ast::TypeApp;
match ta {
TypeApp::Applied { ctor, first, rest } => v1_leaf_name_through_syns(&ctor.name, syns)
.or_else(|| v1_type_atom_mentions_deco(first, syns))
.or_else(|| {
rest.iter()
.find_map(|a| v1_type_atom_mentions_deco(a, syns))
}),
TypeApp::AppliedLong { first, rest, .. } => v1_type_atom_mentions_deco(first, syns)
.or_else(|| {
rest.iter()
.find_map(|a| v1_type_atom_mentions_deco(a, syns))
}),
TypeApp::InlineCmdTy { args, .. }
| TypeApp::BlockCmdTy { args, .. }
| TypeApp::MathCmdTy { args, .. } => args
.iter()
.find_map(|a| v1_type_cmd_arg_mentions_deco(a, syns)),
TypeApp::Atom(atom) => v1_type_atom_mentions_deco(atom, syns),
}
}
fn v1_type_cmd_arg_mentions_deco(
item: &cst_v1::ast::TypeCmdArgItemV1,
syns: &V01Syns<'_>,
) -> Option<String> {
item.opts
.as_ref()
.and_then(|o| {
o.entries
.iter()
.find_map(|e| v1_type_expr_mentions_deco(&e.ty.0, syns))
})
.or_else(|| v1_type_expr_mentions_deco(&item.ty.0, syns))
}
fn v1_type_atom_mentions_deco(atom: &cst_v1::ast::TypeAtom, syns: &V01Syns<'_>) -> Option<String> {
use cst_v1::ast::TypeAtom;
match atom {
TypeAtom::Paren { inner, .. } => v1_type_expr_mentions_deco(&inner.0, syns),
TypeAtom::Record { inner, .. } => inner
.fields
.iter()
.find_map(|f| v1_type_expr_mentions_deco(&f.ty.0, syns)),
TypeAtom::Var(_) => None,
TypeAtom::LongName(_) => None,
TypeAtom::Name(n) => v1_leaf_name_through_syns(&n.name, syns),
}
}
fn v1_leaf_name_through_syns(name: &str, syns: &V01Syns<'_>) -> Option<String> {
v1_leaf_name_through_syns_guarded(name, syns, &mut Vec::new())
}
fn v1_leaf_name_through_syns_guarded(
name: &str,
syns: &V01Syns<'_>,
expanded: &mut Vec<String>,
) -> Option<String> {
match syns.lookup(name) {
V01SynLookup::Body(body) => {
if expanded.iter().any(|e| e == name) {
return None;
}
expanded.push(name.to_string());
let out = v1_type_expr_mentions_deco_guarded(body, syns, expanded);
expanded.pop();
out
}
V01SynLookup::Opaque => None,
V01SynLookup::Undeclared => deco_leaf_name(name),
}
}
fn v1_type_expr_mentions_deco_guarded(
te: &cst_v1::ast::TypeExpr,
syns: &V01Syns<'_>,
expanded: &mut Vec<String>,
) -> Option<String> {
let mut hidden = syns.clone();
for name in expanded.iter() {
hidden.map.insert(name.clone(), None);
}
v1_type_expr_mentions_deco(te, &hidden)
}
#[cfg(test)]
mod tests {
use super::*;
use crate::types::BaseType;
fn v006() -> RustyfiVersion {
RustyfiVersion::V0_0
}
fn v01() -> RustyfiVersion {
RustyfiVersion::V0_1
}
#[test]
fn adapt_export_type_accepts_bare_math_text_base() {
let ty = PolyType::mono(MonoType::Base(BaseType::MathText));
let out = adapt_export_type(&ty, v006(), v01()).expect("math (MathText) must be accepted");
assert!(matches!(out.body(), MonoType::Base(BaseType::MathText)));
}
#[test]
fn adapt_export_type_accepts_math_nested_in_function_and_list() {
let ty = PolyType::mono(MonoType::Func(
Box::new(Row::Empty),
Box::new(MonoType::List(Box::new(MonoType::Base(BaseType::MathText)))),
Box::new(MonoType::Base(BaseType::MathText)),
));
assert!(adapt_export_type(&ty, v006(), v01()).is_ok());
}
#[test]
fn adapt_export_type_rejects_page_nominal() {
let ty = PolyType::mono(MonoType::Variant("page".to_string(), vec![]));
let err = adapt_export_type(&ty, v006(), v01()).expect_err("page must reject");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "page"),
}
}
#[test]
fn adapt_export_type_rejects_opaque_nominals() {
for name in ["math-text", "math-boxes", "font"] {
let ty = PolyType::mono(MonoType::Variant(name.to_string(), vec![]));
let err = adapt_export_type(&ty, v006(), v01()).unwrap_err();
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, name),
}
}
}
#[test]
fn graphics_tier_base_types_are_not_forked_and_cross_in_both_directions() {
let forked = crate::typecheck::forked_type_names();
for name in ["pre-path", "path", "graphics", "image"] {
assert!(
!forked.contains(name),
"`{name}` must not be reported as version-forked: upstream 0.0.6 \
registers it as a base type exactly as 0.1 does"
);
assert!(
!reject_type_names().contains(name),
"`{name}` must not be rejected"
);
}
for (from, to) in [(v006(), v01()), (v01(), v006())] {
for name in ["pre-path", "path", "graphics", "image"] {
let ann = parse_ty(name);
adapt_export_annotation(&ann, from, to)
.unwrap_or_else(|e| panic!("`{name}` must cross {from:?}->{to:?}: {e:?}"));
}
}
}
#[test]
fn adapt_export_type_rejects_forked_leaf_nested_in_a_compound() {
let ty = PolyType::mono(MonoType::Product(vec![
MonoType::Base(BaseType::MathText),
MonoType::Variant("page".to_string(), vec![]),
]));
assert!(adapt_export_type(&ty, v006(), v01()).is_err());
}
#[test]
fn adapt_export_type_accepts_ordinary_user_nominal() {
let ty = PolyType::mono(MonoType::Variant(
"option".to_string(),
vec![MonoType::Base(BaseType::Int)],
));
assert!(adapt_export_type(&ty, v006(), v01()).is_ok());
}
fn parse_ty(src: &str) -> TypeExpr {
let file =
rustyfi_syntax::parse_file(&format!("type xver-probe = {src}\n0\n")).expect("parse");
for tb in &file.prelude {
if let cst::TopBinding::Type(td) = tb {
if let cst::TypeDeclBody::Synonym(ty) = &td.body {
return ty.clone();
}
}
}
panic!("expected a type synonym declaration");
}
#[test]
fn adapt_export_annotation_relabels_bare_math() {
let ann = parse_ty("math");
let out = adapt_export_annotation(&ann, v006(), v01()).expect("math must be accepted");
match out {
TypeExpr::Atom(TypeProd {
first:
TypeApp {
head: TypeAtom::Name(n),
..
},
..
}) => assert_eq!(n.name, "math-text"),
other => panic!("expected a bare relabeled Name, got {other:?}"),
}
}
#[test]
fn adapt_export_annotation_relabels_math_nested_in_function_type() {
let ann = parse_ty("math -> math");
let out =
adapt_export_annotation(&ann, v006(), v01()).expect("math -> math must be accepted");
let unparsed = format!("{out:?}");
assert!(
!unparsed.contains("\"math\""),
"no bare `math` should survive: {unparsed}"
);
}
#[test]
fn adapt_export_annotation_rejects_page() {
let ann = parse_ty("page -> document");
let err = adapt_export_annotation(&ann, v006(), v01()).expect_err("page must reject");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "page"),
}
}
#[test]
fn adapt_export_annotation_rejects_deco() {
let ann = parse_ty("deco");
let err = adapt_export_annotation(&ann, v006(), v01()).expect_err("deco must reject");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "deco"),
}
}
#[test]
fn adapt_export_annotation_reverse_relabels_math_text_to_math() {
let ann = parse_ty("math-text");
let out = adapt_export_annotation(&ann, v01(), v006()).expect("math-text must be accepted");
match out {
TypeExpr::Atom(TypeProd {
first:
TypeApp {
head: TypeAtom::Name(n),
..
},
..
}) => assert_eq!(n.name, "math"),
other => panic!("expected a bare relabeled Name, got {other:?}"),
}
}
#[test]
fn adapt_export_annotation_reverse_relabels_math_boxes_to_math() {
let ann = parse_ty("math-boxes");
let out =
adapt_export_annotation(&ann, v01(), v006()).expect("math-boxes must be accepted");
match out {
TypeExpr::Atom(TypeProd {
first:
TypeApp {
head: TypeAtom::Name(n),
..
},
..
}) => assert_eq!(n.name, "math"),
other => panic!("expected a bare relabeled Name, got {other:?}"),
}
}
#[test]
fn adapt_export_annotation_reverse_rejects_page() {
let ann = parse_ty("page -> document");
let err = adapt_export_annotation(&ann, v01(), v006()).expect_err("page must reject");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "page"),
}
}
#[test]
fn adapt_export_annotation_reverse_rejects_a_genuinely_forked_name() {
let ann = parse_ty("font");
let err = adapt_export_annotation(&ann, v01(), v006()).expect_err("font must reject");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "font"),
}
}
#[test]
fn adapt_export_annotation_forward_math_relabel_is_unaffected_by_the_reverse_arm() {
let ann = parse_ty("math");
let out =
adapt_export_annotation(&ann, v006(), v01()).expect("math must still be accepted");
match out {
TypeExpr::Atom(TypeProd {
first:
TypeApp {
head: TypeAtom::Name(n),
..
},
..
}) => assert_eq!(n.name, "math-text"),
other => panic!("expected a bare relabeled Name, got {other:?}"),
}
}
fn prelude_of(src: &str) -> Vec<cst::TopBinding> {
let file = rustyfi_syntax::parse_file(src).expect("parse");
file.prelude
}
#[test]
fn relabel_type_decls_rewrites_variant_ctor_payload() {
let prelude = prelude_of("type xver-wrap = XverWrap of math\n0\n");
let out =
relabel_type_decls(&prelude, v006(), v01()).expect("math-only prelude must relabel");
match &out[0] {
cst::TopBinding::Type(td) => match &td.body {
cst::TypeDeclBody::Variant { first, .. } => {
let ty = &first.of_ty.as_ref().unwrap().ty;
match ty {
TypeExpr::Atom(TypeProd {
first:
TypeApp {
head: TypeAtom::Name(n),
..
},
..
}) => assert_eq!(n.name, "math-text"),
other => panic!("expected relabeled Name, got {other:?}"),
}
}
other => panic!("expected a Variant body, got {other:?}"),
},
other => panic!("expected a Type binding, got {other:?}"),
}
}
#[test]
fn relabel_type_decls_recurses_into_nested_module() {
let prelude =
prelude_of("module M = struct\n type inner-wrap = InnerWrap of math\nend\n0\n");
let out = relabel_type_decls(&prelude, v006(), v01())
.expect("nested math-only prelude must relabel");
match &out[0] {
cst::TopBinding::Module { decls, .. } => match decls[0].0.as_ref() {
cst::TopBinding::Type(td) => match &td.body {
cst::TypeDeclBody::Variant { first, .. } => {
let ty = &first.of_ty.as_ref().unwrap().ty;
match ty {
TypeExpr::Atom(TypeProd {
first:
TypeApp {
head: TypeAtom::Name(n),
..
},
..
}) => assert_eq!(n.name, "math-text"),
other => panic!("expected relabeled Name, got {other:?}"),
}
}
other => panic!("expected a Variant body, got {other:?}"),
},
other => panic!("expected a nested Type binding, got {other:?}"),
},
other => panic!("expected a Module binding, got {other:?}"),
}
}
#[test]
fn relabel_type_decls_leaves_non_math_untouched() {
let prelude = prelude_of("type ordinary = Foo of int\n0\n");
let out = relabel_type_decls(&prelude, v006(), v01()).expect("no forked names present");
assert_eq!(format!("{prelude:?}"), format!("{out:?}"));
}
#[test]
fn classify_deco_exports_accepts_bare_top_level_letrec() {
let prelude = prelude_of("let-rec xver-my-deco : deco | (x, y) w h d = []\n0\n");
let exports =
classify_deco_exports(&prelude, v006(), v01()).expect("bare `: deco` must be accepted");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].name, "xver-my-deco");
assert_eq!(exports[0].kind, DecoKind::Deco);
}
#[test]
fn classify_deco_exports_accepts_bare_decoset() {
let prelude = prelude_of("let-rec xver-my-decoset : deco-set | () = (0, 0, 0, 0)\n0\n");
let exports = classify_deco_exports(&prelude, v006(), v01())
.expect("`| ()` deco-set must be accepted");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].name, "xver-my-decoset");
assert_eq!(exports[0].kind, DecoKind::DecoSet);
}
#[test]
fn classify_deco_exports_rejects_decoset_with_wrong_params() {
let prelude = prelude_of("let-rec xver-my-decoset : deco-set | t = (0, 0, 0, 0)\n0\n");
let err = classify_deco_exports(&prelude, v006(), v01())
.expect_err("a deco-set export with a non-unit param must still be rejected");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "deco-set"),
}
}
#[test]
fn classify_deco_exports_ignores_type_synonym() {
let prelude = prelude_of("type xver-deco-alias = deco\n0\n");
let exports = classify_deco_exports(&prelude, v006(), v01())
.expect("a type synonym must be accepted");
assert!(exports.is_empty());
}
#[test]
fn classify_deco_exports_accepts_curried_prefix() {
let prelude =
prelude_of("let-rec xver-my-deco : length -> deco | t (x, y) w h d = []\n0\n");
let got = classify_deco_exports(&prelude, v006(), v01())
.expect("a curried-prefix deco export is now wrappable");
assert_eq!(got.len(), 1);
assert_eq!(got[0].name, "xver-my-deco");
assert_eq!(got[0].lead_arity, 1);
assert!(got[0].module_path.is_empty());
}
#[test]
fn classify_deco_exports_accepts_module_sig_item() {
let prelude = prelude_of(
"module M : sig\n val simple : length -> deco\n val plain : deco\nend = struct\n \
let simple t (x, y) w h d = []\n let plain (x, y) w h d = []\nend\n0\n",
);
let got = classify_deco_exports(&prelude, v006(), v01())
.expect("a module-scoped deco export is now wrappable");
assert_eq!(got.len(), 2);
assert_eq!(got[0].name, "simple");
assert_eq!(got[0].lead_arity, 1);
assert_eq!(got[0].module_path, vec!["M".to_string()]);
assert_eq!(got[1].name, "plain");
assert_eq!(got[1].lead_arity, 0);
}
#[test]
fn module_deco_wrapper_is_injected_inside_the_module() {
let mut prelude = prelude_of(
"module M : sig\n val simple : length -> deco\nend = struct\n \
let simple t (x, y) w h d = []\nend\n0\n",
);
let exports = classify_deco_exports(&prelude, v006(), v01()).unwrap();
let before = match &prelude[0] {
cst::TopBinding::Module { decls, .. } => decls.len(),
other => panic!("expected a module, got {other:?}"),
};
inject_module_deco_wrappers(&mut prelude, &exports);
match &prelude[0] {
cst::TopBinding::Module { decls, .. } => {
assert_eq!(
decls.len(),
before + 2,
"the X3c capture AND the wrapper must be appended INSIDE the module"
);
match &*decls[decls.len() - 2].0 {
cst::TopBinding::Let(tl) => {
assert_eq!(tl.name.name, "xver-fwd-orig-simple")
}
other => panic!("expected the X3c original capture, got {other:?}"),
}
match &*decls[decls.len() - 1].0 {
cst::TopBinding::Let(tl) => assert_eq!(tl.name.name, "simple"),
other => panic!("expected a shadowing `let simple`, got {other:?}"),
}
}
other => panic!("expected a module, got {other:?}"),
}
assert!(deco_coercion_prelude(&exports).is_empty());
}
#[test]
fn deco_coercion_prelude_generates_parseable_wrap() {
let exports = vec![
DecoExport {
name: "xver-my-deco".to_string(),
kind: DecoKind::Deco,
lead_arity: 0,
lead_opts: Vec::new(),
module_path: Vec::new(),
arg_downgrades: Vec::new(),
unit_thunk: false,
},
DecoExport {
name: "xver-my-decoset".to_string(),
kind: DecoKind::DecoSet,
lead_arity: 0,
lead_opts: Vec::new(),
module_path: Vec::new(),
arg_downgrades: Vec::new(),
unit_thunk: true,
},
];
let out = deco_coercion_prelude(&exports);
assert_eq!(out.len(), 4);
let names: Vec<&str> = out
.iter()
.map(|tb| match tb {
cst::TopBinding::Let(tl) => tl.name.name.as_str(),
other => panic!("expected a Let binding, got {other:?}"),
})
.collect();
assert_eq!(
names,
vec![
"xver-fwd-orig-xver-my-deco",
"xver-my-deco",
"xver-fwd-orig-xver-my-decoset",
"xver-my-decoset",
]
);
}
#[test]
fn deco_coercion_prelude_empty_is_empty() {
assert!(deco_coercion_prelude(&[]).is_empty());
}
fn v1_file(src: &str) -> cst_v1::FileV1 {
cst_v1::parse_file_v1(src).expect("parse v1 fixture")
}
fn classify_v1(file: &cst_v1::FileV1) -> Result<Vec<DecoExport>, BoundaryError> {
let mut surfaces = SurfaceEnv::default();
surface::build_file_surface(file, &mut surfaces);
classify_deco_exports_v01_sig(file, &surfaces)
}
#[test]
fn classify_v01_sig_accepts_bare_sig_val_deco() {
let file = v1_file(
"module M :> sig\n val my-deco : deco\nend = struct\n val my-deco = 0\nend\n",
);
let exports = classify_v1(&file).expect("a bare `: deco` sig item");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].name, "my-deco");
assert_eq!(exports[0].kind, DecoKind::Deco);
assert_eq!(exports[0].lead_arity, 0);
assert_eq!(exports[0].module_path, vec!["M".to_string()]);
assert_eq!(deco_export_qualified_name(&exports[0]), "M.my-deco");
}
#[test]
fn classify_v01_sig_accepts_bare_sig_val_decoset() {
let file = v1_file("module M :> sig\n val my-decoset : deco-set\nend = struct\n val my-decoset = 0\nend\n");
let exports = classify_v1(&file).expect("a bare `: deco-set` sig item");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].kind, DecoKind::DecoSet);
assert!(
!exports[0].unit_thunk,
"a 0.1 sig-declared `deco-set` is bound to the bare 4-tuple — no `()` thunk"
);
}
#[test]
fn classify_v01_sig_accepts_curried_sig_val() {
let file =
v1_file("module M :> sig\n val my-deco : length -> color -> deco\nend = struct\n val my-deco t c p w h d = 0\nend\n");
let exports = classify_v1(&file).expect("an arrow-tailed `deco` export");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].kind, DecoKind::Deco);
assert_eq!(exports[0].lead_arity, 2);
}
#[test]
fn classify_v01_sig_accepts_an_optional_argument_arrow() {
let file = v1_file(
"module M :> sig\n val my-deco : ?(thickness : length) length -> deco\nend \
= struct\n val my-deco = 0\nend\n",
);
let exports = classify_v1(&file).expect("a labelled-optional arrow is forwardable now");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].name, "my-deco");
}
#[test]
fn classify_v01_sig_rejects_paren() {
let file = v1_file(
"module M :> sig\n val my-paren : paren\nend = struct\n val my-paren = 0\nend\n",
);
let err = classify_v1(&file)
.expect_err("a 0.1 `paren` export must still reject in the reverse direction");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "paren"),
}
}
#[test]
fn classify_v01_sig_crosses_nested_module_under_composed_key() {
let file = v1_file(
"module Outer :> sig\n module Inner : sig val my-deco : deco end\nend = struct\n \
module Inner :> sig val my-deco : deco end = struct val my-deco = 0 end\nend\n",
);
let exports =
classify_v1(&file).expect("a NESTED module's sig `val : deco` item must cross");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].kind, DecoKind::Deco);
assert_eq!(
deco_export_qualified_name(&exports[0]),
"Outer.Inner.my-deco"
);
}
#[test]
fn classify_v01_sig_ignores_a_signature_member_that_binds_no_value() {
let file = v1_file(
"module Outer :> sig\n signature S = sig val my-deco : deco end\nend = struct\n \
signature S = sig val my-deco : deco end\nend\n",
);
assert!(classify_v1(&file)
.expect("a signature member binds no value — nothing to coerce")
.is_empty());
}
#[test]
fn classify_v01_sig_crosses_a_nested_module_typed_by_a_named_signature() {
let file = v1_file(
"module Outer :> sig\n signature S = sig val my-deco : deco end\n \
module Inner : S\nend = struct\n \
signature S = sig val my-deco : deco end\n \
module Inner :> S = struct val my-deco = 0 end\nend\n",
);
let exports =
classify_v1(&file).expect("a nested module typed by a NAMED signature must now cross");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].kind, DecoKind::Deco);
assert_eq!(
deco_export_qualified_name(&exports[0]),
"Outer.Inner.my-deco"
);
}
#[test]
fn classify_v01_sig_crosses_through_an_include_at_the_enclosing_path() {
let file = v1_file(
"module Outer :> sig\n signature S = sig val my-deco : deco end\n include S\nend \
= struct\n signature S = sig val my-deco : deco end\n val my-deco = 0\nend\n",
);
let exports = classify_v1(&file).expect("an `include`d `deco` export must cross");
assert_eq!(exports.len(), 1);
assert_eq!(deco_export_qualified_name(&exports[0]), "Outer.my-deco");
}
#[test]
fn classify_v01_sig_crosses_through_a_with_type_refinement() {
let file = v1_file(
"module Outer :> sig\n \
signature S = sig type t :: o val my-deco : deco end\n \
module Inner : S with type t = int\nend = struct\n \
signature S = sig type t :: o val my-deco : deco end\n \
module Inner :> S with type t = int = struct\n \
type t = int\n val my-deco = 0\n end\nend\n",
);
let exports = classify_v1(&file)
.expect("a `with type`-refined nested signature must resolve to its base");
assert_eq!(exports.len(), 1);
assert_eq!(
deco_export_qualified_name(&exports[0]),
"Outer.Inner.my-deco"
);
}
#[test]
fn classify_v01_sig_rejects_a_deco_behind_a_functor_signature_member() {
let file = v1_file(
"module Outer :> sig\n \
module Make : (X : sig val n : int end) -> sig val my-deco : deco end\nend \
= struct\n \
module Make = fun (X : sig val n : int end) -> struct val my-deco = 0 end\nend\n",
);
let err = classify_v1(&file)
.expect_err("a `deco` behind a functor signature member must still reject");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "deco"),
}
}
#[test]
fn classify_v01_sig_unknown_signature_name_neither_crosses_nor_panics() {
let file = v1_file(
"module Outer :> sig\n module Inner : Nope\nend = struct\n \
module Inner = struct val my-deco = 0 end\nend\n",
);
assert!(classify_v1(&file)
.expect("an unresolved name is downstream's error, not this scan's")
.is_empty());
}
#[test]
fn classify_v01_sig_self_including_signature_terminates() {
let file = v1_file(
"module Outer :> sig\n signature S = sig include S end\n module Inner : S\nend \
= struct\n signature S = sig include S end\n \
module Inner = struct val my-deco = 0 end\nend\n",
);
assert!(classify_v1(&file)
.expect("an include cycle is downstream's precise error, not a hang")
.is_empty());
}
#[test]
fn classify_v01_sig_ignores_type_only_mention() {
let file = v1_file(
"module M :> sig\n type xver-deco-alias = deco\nend = struct\n type xver-deco-alias = deco\nend\n",
);
assert!(classify_v1(&file)
.expect("a type-only mention is safe")
.is_empty());
}
#[test]
fn classify_v01_sig_crosses_a_member_declared_at_a_type_synonym() {
let file = v1_file(
"module M :> sig\n type t = deco\n val frame : length -> t\nend = struct\n \
type t = deco\n val frame w p x y z = 0\nend\n",
);
let exports = classify_v1(&file).expect("a synonym OF `deco` is a deco export");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].name, "frame");
assert_eq!(exports[0].kind, DecoKind::Deco);
assert_eq!(exports[0].lead_arity, 1);
assert_eq!(deco_export_qualified_name(&exports[0]), "M.frame");
}
#[test]
fn classify_v01_sig_expands_a_synonym_chain_and_an_arrow_bodied_one() {
let file = v1_file(
"module M :> sig\n type t = deco\n type u = t\n type framer = length -> u\n \
val frame : color -> framer\nend = struct\n val frame c w p x y z = 0\nend\n",
);
let exports = classify_v1(&file).expect("a synonym CHAIN is still a deco export");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].kind, DecoKind::Deco);
assert_eq!(
exports[0].lead_arity, 2,
"one lead position from the `val`'s own arrow, one from the synonym's body"
);
}
#[test]
fn classify_v01_sig_crosses_a_synonym_declared_in_an_included_signature() {
let file = v1_file(
"module Outer :> sig\n signature S = sig type t = deco end\n include S\n \
val frame : t\nend = struct\n signature S = sig type t = deco end\n \
type t = deco\n val frame = 0\nend\n",
);
let exports = classify_v1(&file).expect("an `include`d synonym is in scope");
assert_eq!(exports.len(), 1);
assert_eq!(deco_export_qualified_name(&exports[0]), "Outer.frame");
}
#[test]
fn classify_v01_sig_crosses_a_nested_members_use_of_an_enclosing_synonym() {
let file = v1_file(
"module Outer :> sig\n type t = deco\n module Inner : sig val frame : t end\nend \
= struct\n type t = deco\n module Inner :> sig val frame : t end \
= struct val frame = 0 end\nend\n",
);
let exports = classify_v1(&file).expect("an enclosing layer's synonym is in scope");
assert_eq!(exports.len(), 1);
assert_eq!(deco_export_qualified_name(&exports[0]), "Outer.Inner.frame");
}
#[test]
fn classify_v01_sig_opaque_type_is_not_a_deco_and_does_not_cross() {
let file = v1_file(
"module M :> sig\n type t :: o\n val frame : length -> t\nend = struct\n \
type t = int\n val frame w = 0\nend\n",
);
assert!(classify_v1(&file)
.expect("an opaque type is not a deco")
.is_empty());
let shadowed = v1_file(
"module M :> sig\n type deco :: o\n val frame : deco\nend = struct\n \
type deco = int\n val frame = 0\nend\n",
);
assert!(
classify_v1(&shadowed)
.expect("a locally-declared `deco` is not the builtin one")
.is_empty(),
"map-first lookup: a signature's own `type deco` shadows the builtin, so no \
coercion wrapper may be generated for a value that is not a `deco` at all"
);
}
#[test]
fn classify_v01_sig_rejects_a_synonym_of_deco_buried_in_a_compound() {
let file = v1_file(
"module M :> sig\n type t = deco\n val frames : t list\nend = struct\n \
val frames = 0\nend\n",
);
let err = classify_v1(&file).expect_err("a buried deco must reject, synonym or not");
match err {
BoundaryError::ForkedTypeExport { ty_name, .. } => assert_eq!(ty_name, "deco"),
}
}
#[test]
fn classify_v01_sig_synonym_cycle_terminates() {
let file = v1_file(
"module M :> sig\n type t = u\n type u = t\n val frame : t\nend = struct\n \
val frame = 0\nend\n",
);
assert!(classify_v1(&file)
.expect("a synonym cycle is downstream's error, not a hang")
.is_empty());
}
#[test]
fn classify_v01_sig_crosses_a_with_type_refined_deco() {
let file = v1_file(
"module Outer :> sig\n \
signature S = sig type t :: o val frame : t end\n \
module Inner : S with type t = deco\nend = struct\n \
signature S = sig type t :: o val frame : t end\n \
module Inner :> S with type t = deco = struct\n \
type t = deco\n val frame = 0\n end\nend\n",
);
let exports = classify_v1(&file).expect("a `with type`-refined `deco` member crosses");
assert_eq!(exports.len(), 1);
assert_eq!(deco_export_qualified_name(&exports[0]), "Outer.Inner.frame");
}
#[test]
fn classify_v01_sig_crosses_a_with_submodule_type_refined_deco() {
let file = v1_file(
"module Outer :> sig\n \
module Inner : sig type t :: o val frame : t end\n\
end with Inner type t = deco = struct\n \
module Inner :> sig type t :: o val frame : t end \
= struct type t = deco val frame = 0 end\nend\n",
);
let exports =
classify_v1(&file).expect("a `with M type`-refined `deco` member must cross");
assert_eq!(exports.len(), 1);
assert_eq!(deco_export_qualified_name(&exports[0]), "Outer.Inner.frame");
}
#[test]
fn classify_v01_sig_empty_for_no_sig() {
let file = v1_file("module M = struct\n val my-deco p w h d = 0\nend\n");
assert!(
classify_v1(&file)
.expect("no sig, nothing to see")
.is_empty(),
"an UNSEALED module (no sig_annot at all) has no textual site for this scan to read"
);
}
#[test]
fn classify_v01_sig_empty_for_document() {
let file = v1_file("0\n");
assert!(classify_v1(&file)
.expect("a document is never a dependency")
.is_empty());
}
fn one_deco_export() -> Vec<DecoExport> {
let file = v1_file(
"module M :> sig\n val my-deco : length -> deco\nend = struct\n val my-deco t p w h d = 0\nend\n",
);
classify_v1(&file).expect("classify")
}
fn binding_name(tb: &cst::TopBinding) -> &str {
match tb {
cst::TopBinding::Let(tl) => tl.name.name.as_str(),
other => panic!("expected a Let binding, got {other:?}"),
}
}
#[test]
fn deco_downgrade_capture_binds_only_a_private_name() {
let out = deco_downgrade_prelude(&one_deco_export(), DowngradeStep::Capture);
assert_eq!(out.len(), 1);
assert_eq!(binding_name(&out[0]), "xver-rev-orig-M-my-deco");
}
#[test]
fn deco_downgrade_install_rebinds_the_qualified_key() {
let out = deco_downgrade_prelude(&one_deco_export(), DowngradeStep::Install);
assert_eq!(out.len(), 1);
assert_eq!(binding_name(&out[0]), "M.my-deco");
}
#[test]
fn deco_downgrade_restore_rebinds_the_qualified_key_to_the_capture() {
let out = deco_downgrade_prelude(&one_deco_export(), DowngradeStep::Restore);
assert_eq!(out.len(), 1);
assert_eq!(binding_name(&out[0]), "M.my-deco");
let src = format!("{:?}", out[0]);
assert!(
src.contains("xver-rev-orig-M-my-deco"),
"the restore's body must name the private capture, got: {src}"
);
}
#[test]
fn deco_downgrade_private_name_is_a_function_of_the_qualified_key_alone() {
let exports = one_deco_export();
let capture = deco_downgrade_prelude(&exports, DowngradeStep::Capture);
let restore = deco_downgrade_prelude(&exports, DowngradeStep::Restore);
assert!(format!("{:?}", restore[0]).contains(binding_name(&capture[0])));
}
#[test]
fn deco_downgrade_prelude_empty_is_empty() {
assert!(deco_downgrade_prelude(&[], DowngradeStep::Capture).is_empty());
assert!(deco_downgrade_prelude(&[], DowngradeStep::Install).is_empty());
assert!(deco_downgrade_prelude(&[], DowngradeStep::Restore).is_empty());
}
#[test]
fn classify_v01_sig_does_not_perturb_forward_toplevel_letrec() {
let prelude = prelude_of("let-rec xver-my-deco : deco | (x, y) w h d = []\n0\n");
let exports = classify_deco_exports(&prelude, v006(), v01())
.expect("bare `: deco` must still be accepted forward");
assert_eq!(exports.len(), 1);
}
#[test]
fn classify_deco_in_sigless_module_letrec_ascription() {
let prelude = prelude_of(
"module XverMod = struct\n \
let-rec frame : length -> deco | t (x, y) w h d = []\nend\n0\n",
);
let exports = classify_deco_exports(&prelude, v006(), v01()).expect(
"a `let-rec .. : deco` inside a sig-less module must be classified, not rejected",
);
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].name, "frame");
assert_eq!(exports[0].kind, DecoKind::Deco);
assert_eq!(exports[0].lead_arity, 1);
assert_eq!(exports[0].module_path, vec!["XverMod".to_string()]);
}
#[test]
fn classify_deco_in_doubly_nested_module_sig() {
let prelude = prelude_of(
"module Outer = struct\n \
module Inner : sig\n val frame : length -> deco\n end = struct\n \
let frame t (x, y) w h d = []\n end\nend\n0\n",
);
let exports = classify_deco_exports(&prelude, v006(), v01())
.expect("a doubly-nested module's sig `deco` export must be classified");
assert_eq!(exports.len(), 1);
assert_eq!(
exports[0].module_path,
vec!["Outer".to_string(), "Inner".to_string()]
);
}
#[test]
fn classify_deco_in_module_sig_is_not_double_wrapped_by_its_own_ascription() {
let prelude = prelude_of(
"module XverMod : sig\n val frame : length -> deco\nend = struct\n \
let-rec frame : length -> deco | t (x, y) w h d = []\nend\n0\n",
);
let exports = classify_deco_exports(&prelude, v006(), v01()).expect("classify");
assert_eq!(
exports.len(),
1,
"one wrapper per export, even when sig and ascription both name the type"
);
}
#[test]
fn classify_deco_in_nested_module_accepts_an_optional_argument_arrow() {
let prelude = prelude_of(
"module XverMod = struct\n \
let-rec frame : length ?-> length -> deco | t (x, y) w h d = []\nend\n0\n",
);
let exports = classify_deco_exports(&prelude, v006(), v01())
.expect("an optional-argument arrow is forwardable now");
assert_eq!(exports.len(), 1);
assert_eq!(exports[0].module_path, vec!["XverMod".to_string()]);
assert!(
exports[0].lead_opts.contains(&LeadOpt::V006Optional),
"the optional slot must be recorded, not flattened into a positional one: {:?}",
exports[0].lead_opts
);
}
}