## template-expansion.pkg
# Compiled by:
# src/lib/compiler/core.sublib#DO set_control "compiler::trap_int_overflow" "TRUE";
stipulate
package ds = deep_syntax; # deep_syntax is from src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package mtt = more_type_types; # more_type_types is from src/lib/compiler/front/typer/types/more-type-types.pkg package vac = variables_and_constructors; # variables_and_constructors is from src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkg package tj = type_junk; # type_junk is from src/lib/compiler/front/typer-stuff/types/type-junk.pkg #
include package translate_deep_syntax_pattern_to_lambdacode_junk;
# include package more_type_types;
#
herein
package template_expansion {
#
exception LOOKUP;
fun lookup
( a as vac::PLAIN_VARIABLE { varhome=>vh::HIGHCODE_VARIABLE a', ... },
(vac::PLAIN_VARIABLE { varhome=>vh::HIGHCODE_VARIABLE b, ... }, c) ! d
)
=>
a' == b ?? c
:: lookup (a, d);
lookup (vac::PLAIN_VARIABLE _, (vac::PLAIN_VARIABLE _, _) ! _)
=>
err::impossible "833 in tempexpn";
lookup _
=>
raise exception LOOKUP;
end;
issue_highcode_codetemp
=
highcode_codetemp::issue_highcode_codetemp;
exception CANNOT_MATCH;
fun foo x = err::impossible "no templates yet";
/*
(case lookup (x, *constructor_env)
of { representation = TEMPLrep (NO_PATTERN, _, _), ... } => raise exception CANNOT_MATCH
| { representation = TEMPLrep x, ... } => x
| _ => raise exception Internal 1)
except Lookup => raise exception (Internal 2)
*/
fun foo' x = err::impossible "no symbolic constants yet";
/*
(case lookup (x, *constructor_env)
of { representation = CONSTrep (NO_PATTERN, _), ... } => raise exception CANNOT_MATCH
| { representation = CONSTrep x, ... } => x
| _ => raise exception Internal 3)
except Lookup => raise exception (Internal 4)
*/
fun and_patterns (ds::WILDCARD_PATTERN, pattern) => pattern;
and_patterns (pattern, ds::WILDCARD_PATTERN) => pattern;
and_patterns (ds::TYPE_CONSTRAINT_PATTERN (pattern, _), pattern') => and_patterns (pattern, pattern');
and_patterns (pattern, ds::TYPE_CONSTRAINT_PATTERN (pattern', _)) => and_patterns (pattern, pattern');
and_patterns (ds::VARIABLE_IN_PATTERN v, pattern) => ds::AS_PATTERN (ds::VARIABLE_IN_PATTERN v, pattern);
and_patterns (pattern, ds::VARIABLE_IN_PATTERN v) => ds::AS_PATTERN (ds::VARIABLE_IN_PATTERN v, pattern);
and_patterns (ds::CONSTRUCTOR_PATTERN (k, t), ds::CONSTRUCTOR_PATTERN (k', t'))
=>
if (con_eq (k, k')) ds::CONSTRUCTOR_PATTERN (k, t);
elif (abstract k ) ds::AS_PATTERN (ds::CONSTRUCTOR_PATTERN (k, t), ds::CONSTRUCTOR_PATTERN (k', t'));
elif (abstract k' ) ds::AS_PATTERN (ds::CONSTRUCTOR_PATTERN (k', t'), ds::CONSTRUCTOR_PATTERN (k, t));
else raise exception CANNOT_MATCH;
fi;
and_patterns (ds::CONSTRUCTOR_PATTERN (k, t), ds::APPLY_PATTERN (k', t', pattern))
=>
if (abstract k ) ds::AS_PATTERN (ds::CONSTRUCTOR_PATTERN (k, t), ds::APPLY_PATTERN (k', t', pattern));
elif (abstract k') ds::AS_PATTERN (ds::APPLY_PATTERN (k', t', pattern), ds::CONSTRUCTOR_PATTERN (k, t));
else raise exception CANNOT_MATCH;
fi;
and_patterns (ds::APPLY_PATTERN (k', t', pattern), ds::CONSTRUCTOR_PATTERN (k, t))
=>
if (abstract k ) ds::AS_PATTERN (ds::CONSTRUCTOR_PATTERN (k, t), ds::APPLY_PATTERN (k', t', pattern));
elif (abstract k') ds::AS_PATTERN (ds::APPLY_PATTERN (k', t', pattern), ds::CONSTRUCTOR_PATTERN (k, t));
else raise exception CANNOT_MATCH;
fi;
and_patterns (ds::APPLY_PATTERN (k, t, pattern), ds::APPLY_PATTERN (k', t', pattern'))
=>
if (con_eq (k, k'))
ds::APPLY_PATTERN (k, t, and_patterns (pattern, pattern'));
elif (abstract k)
ds::AS_PATTERN (ds::APPLY_PATTERN (k, t, pattern), ds::APPLY_PATTERN (k', t', pattern'));
elif (abstract k')
ds::AS_PATTERN (ds::APPLY_PATTERN (k', t', pattern'), ds::APPLY_PATTERN (k, t, pattern));
else
raise exception CANNOT_MATCH;
fi;
and_patterns (ds::CONSTRUCTOR_PATTERN (k, t), pattern)
=>
if (abstract k)
ds::AS_PATTERN (ds::CONSTRUCTOR_PATTERN (k, t), pattern);
else
err::impossible "Non abstract ds::CONSTRUCTOR_PATTERN & non constructor pattern in andPattern";
fi;
and_patterns (pattern, ds::CONSTRUCTOR_PATTERN (k, t))
=>
if (abstract k)
ds::AS_PATTERN (ds::CONSTRUCTOR_PATTERN (k, t), pattern);
else
err::impossible "non constructor pattern & Non abstract ds::CONSTRUCTOR_PATTERN in andPattern";
fi;
and_patterns (ds::APPLY_PATTERN (k, t, pattern), pattern')
=>
if (abstract k)
ds::AS_PATTERN (ds::APPLY_PATTERN (k, t, pattern), pattern');
else
err::impossible "Non abstract ds::APPLY_PATTERN & non constructor pattern in andPattern";
fi;
and_patterns (pattern, ds::APPLY_PATTERN (k, t, pattern'))
=>
if (abstract k)
ds::AS_PATTERN (ds::APPLY_PATTERN (k, t, pattern'), pattern);
else
err::impossible "non constructor pattern & Non abstract ds::APPLY_PATTERN in andPattern";
fi;
and_patterns (ds::AS_PATTERN (ds::TYPE_CONSTRAINT_PATTERN (pattern1, _), pattern2), pattern)
=>
and_patterns (ds::AS_PATTERN (pattern1, pattern2), pattern);
and_patterns (pattern, ds::AS_PATTERN (ds::TYPE_CONSTRAINT_PATTERN (pattern1, _), pattern2))
=>
and_patterns (pattern, ds::AS_PATTERN (pattern1, pattern2));
and_patterns (ds::AS_PATTERN (pattern1, pattern2), pattern)
=>
ds::AS_PATTERN (pattern1, and_patterns (pattern2, pattern));
and_patterns (pattern, ds::AS_PATTERN (pattern1, pattern2))
=>
ds::AS_PATTERN (pattern1, and_patterns (pattern2, pattern));
and_patterns (ds::INT_CONSTANT_IN_PATTERN (p as (s, t)), ds::INT_CONSTANT_IN_PATTERN (s', t'))
=>
if (tj::typoids_are_equal (t, mtt::int_typoid) )
if ((literal_to_num::int s) == (literal_to_num::int s'))
ds::INT_CONSTANT_IN_PATTERN p;
else raise exception CANNOT_MATCH;fi;
elif (tj::typoids_are_equal (t, mtt::int1_typoid) )
if (literal_to_num::one_word_int s == literal_to_num::one_word_int s')
ds::INT_CONSTANT_IN_PATTERN p;
else
raise exception CANNOT_MATCH;
fi;
else
err::impossible "and_patterns/ds::INT_CONSTANT_IN_PATTERN in tempexpn";
fi
except
OVERFLOW = err::impossible "overflow during int or word pattern comparisons";
and_patterns (ds::UNT_CONSTANT_IN_PATTERN (p as (w, t)), ds::UNT_CONSTANT_IN_PATTERN (w', t'))
=>
if (tj::typoids_are_equal (t, mtt::unt_typoid) )
if (literal_to_num::unt w != literal_to_num::unt w') raise exception CANNOT_MATCH; fi;
ds::UNT_CONSTANT_IN_PATTERN p;
elif (tj::typoids_are_equal (t, mtt::unt8_typoid) )
if (literal_to_num::one_byte_unt w != literal_to_num::one_byte_unt w') raise exception CANNOT_MATCH; fi;
ds::UNT_CONSTANT_IN_PATTERN p;
elif (tj::typoids_are_equal (t, mtt::unt1_typoid) )
if (literal_to_num::one_word_unt w != literal_to_num::one_word_unt w') raise exception CANNOT_MATCH; fi;
ds::UNT_CONSTANT_IN_PATTERN p;
else
err::impossible "and_patterns/ds::UNT_CONSTANT_IN_PATTERN in tempexpn";
fi
except
OVERFLOW = err::impossible "overflow during int or word pattern comparisons";
and_patterns (ds::FLOAT_CONSTANT_IN_PATTERN r, ds::FLOAT_CONSTANT_IN_PATTERN r')
=>
if (r == r') ds::FLOAT_CONSTANT_IN_PATTERN r;
else raise exception CANNOT_MATCH;
fi;
and_patterns (ds::STRING_CONSTANT_IN_PATTERN s, ds::STRING_CONSTANT_IN_PATTERN s')
=>
if (s == s') ds::STRING_CONSTANT_IN_PATTERN s;
else raise exception CANNOT_MATCH;
fi;
and_patterns (ds::CHAR_CONSTANT_IN_PATTERN s, ds::CHAR_CONSTANT_IN_PATTERN s')
=>
if (s == s') ds::CHAR_CONSTANT_IN_PATTERN s;
else raise exception CANNOT_MATCH;
fi;
and_patterns (pattern1 as ds::RECORD_PATTERN { fields=>p, ... },
pattern2 as ds::RECORD_PATTERN { fields=>q, ... } )
=>
make_recordpat pattern1 (multi_and (map #2 p, map #2 q));
# ****************** how to and two types ? *************************
and_patterns (ds::VECTOR_PATTERN (p, t), ds::VECTOR_PATTERN (p', t'))
=>
if (length p == length p')
ds::VECTOR_PATTERN (multi_and (p, p'), t);
else
raise exception CANNOT_MATCH;
fi;
and_patterns (p1, p2)
=>
err::impossible "bas andPattern call";
end
also
fun multi_and (NIL, NIL)
=>
NIL;
multi_and (pattern ! rest, pattern' ! rest')
=>
(and_patterns (pattern, pattern')) ! (multi_and (rest, rest'));
multi_and _
=>
err::impossible "bad multi_and call";
end;
fun macro_expand_patexp (ds::VARIABLE_IN_PATTERN v, dictionary)
=>
lookup (v, dictionary);
macro_expand_patexp (ds::AS_PATTERN (pattern1, pattern2), dictionary)
=>
and_patterns (macro_expand_patexp (pattern1, dictionary), macro_expand_patexp (pattern2, dictionary));
macro_expand_patexp (ds::TYPE_CONSTRAINT_PATTERN (pattern, _), dictionary)
=>
macro_expand_patexp (pattern, dictionary);
macro_expand_patexp (ds::APPLY_PATTERN (k, t, pattern), dictionary)
=>
ds::APPLY_PATTERN (k, t, macro_expand_patexp (pattern, dictionary));
macro_expand_patexp (pattern as ds::RECORD_PATTERN { fields, ... }, dictionary)
=>
make_recordpat pattern (multi_macro_expand_patexp (map #2 fields, dictionary));
macro_expand_patexp (ds::VECTOR_PATTERN (pats, t), dictionary)
=>
ds::VECTOR_PATTERN (multi_macro_expand_patexp (pats, dictionary), t);
macro_expand_patexp (pattern, dictionary)
=>
pattern;
end
also
fun multi_macro_expand_patexp (NIL, dictionary)
=>
NIL;
multi_macro_expand_patexp (pattern ! rest, dictionary)
=>
macro_expand_patexp (pattern, dictionary)
!
multi_macro_expand_patexp (rest, dictionary);
end;
fun instance (ds::VARIABLE_IN_PATTERN (vac::PLAIN_VARIABLE { path, vartypoid_ref, inlining_data, ... } ))
=>
VARSIMP (vac::PLAIN_VARIABLE { varhome=>vh::HIGHCODE_VARIABLE (issue_highcode_codetemp()), path, vartypoid_ref, inlining_data } );
instance (ds::VARIABLE_IN_PATTERN _)
=>
err::impossible "bad variable in match";
instance (ds::RECORD_PATTERN { fields, ... } )
=>
RECORDSIMP (map (\\ (lab, pattern)=>(lab, instance pattern); end ) fields);
instance (ds::TYPE_CONSTRAINT_PATTERN (pattern, _))
=>
instance pattern;
instance pattern
=>
err::impossible "bad instance call";
end;
fun simp_to_pattern (VARSIMP v)
=>
ds::VARIABLE_IN_PATTERN v;
simp_to_pattern (RECORDSIMP labsimps)
=>
ds::RECORD_PATTERN {
fields => map (\\ (lab, simp)= (lab, simp_to_pattern simp)) labsimps,
is_incomplete => FALSE,
type_ref => REF tdt::UNDEFINED_TYPOID
};
end;
fun trivpat_triv_dictionary (ds::VARIABLE_IN_PATTERN v, VARSIMP x)
=>
[(v, ds::VARIABLE_IN_PATTERN x)];
trivpat_triv_dictionary (ds::TYPE_CONSTRAINT_PATTERN (tpat, _), simp)
=>
trivpat_triv_dictionary (tpat, simp);
trivpat_triv_dictionary (ds::RECORD_PATTERN { fields, ... }, RECORDSIMP labsimps)
=>
multi_trivpat_triv_dictionary (map #2 fields, map #2 labsimps);
trivpat_triv_dictionary _
=>
err::impossible "trivpat_triv_dictionary";
end
also
fun multi_trivpat_triv_dictionary (NIL, NIL)
=>
NIL;
multi_trivpat_triv_dictionary (tpat ! trest, simp ! srest)
=>
(trivpat_triv_dictionary (tpat, simp))@(multi_trivpat_triv_dictionary (trest, srest));
multi_trivpat_triv_dictionary _
=>
err::impossible "multiTrivpatTrivDict";
end;
fun wild_dictionary (ds::VARIABLE_IN_PATTERN v) => [(v, ds::WILDCARD_PATTERN)];
wild_dictionary (ds::TYPE_CONSTRAINT_PATTERN (tpat, _)) => wild_dictionary tpat;
wild_dictionary (ds::RECORD_PATTERN { fields, ... } ) => list::cat (map (wild_dictionary o #2) fields);
wild_dictionary _ => err::impossible "wild_dictionary called on non-trivpat";
end;
fun match_trivial_pattern (ds::VARIABLE_IN_PATTERN v, pattern)
=>
([(v, pattern)], NIL, NIL);
match_trivial_pattern (ds::TYPE_CONSTRAINT_PATTERN (tpat, _), pattern)
=>
match_trivial_pattern (tpat, pattern);
match_trivial_pattern (tpat, ds::TYPE_CONSTRAINT_PATTERN (pattern, _))
=>
match_trivial_pattern (tpat, pattern);
match_trivial_pattern (ds::RECORD_PATTERN { fields=>tps, ... }, ds::RECORD_PATTERN { fields=>ps, ... } )
=>
multi_match_trivpat (map #2 tps, map #2 ps);
match_trivial_pattern (tpat, ds::WILDCARD_PATTERN)
=>
(wild_dictionary tpat, NIL, NIL);
match_trivial_pattern (tpat, ds::VARIABLE_IN_PATTERN v)
=>
{ a = instance tpat;
b = trivpat_triv_dictionary (tpat, a);
(b, [(v, a)], NIL);
};
match_trivial_pattern (tpat, ds::CONSTRUCTOR_PATTERN (k, t))
=>
{ a = instance tpat;
b = trivpat_triv_dictionary (tpat, a);
(b, NIL, [(a, ds::CONSTRUCTOR_PATTERN (k, t))]);
};
match_trivial_pattern (tpat, ds::APPLY_PATTERN (k, t, pattern))
=>
{ a = instance tpat;
b = trivpat_triv_dictionary (tpat, a);
(b, NIL, [(a, ds::APPLY_PATTERN (k, t, pattern))]);
};
match_trivial_pattern (tpat, ds::AS_PATTERN (ds::CONSTRUCTOR_PATTERN (k, t), pattern))
=>
{ a = instance tpat;
my (pattern', var_dictionary, constr)
=
match_trivial_pattern (tpat, and_patterns (simp_to_pattern a, pattern));
(pattern', var_dictionary, (a, ds::CONSTRUCTOR_PATTERN (k, t)) ! constr);
};
match_trivial_pattern (tpat, ds::AS_PATTERN (ds::APPLY_PATTERN (k, t, spat), pattern))
=>
{ a = instance tpat;
my (pattern', var_dictionary, constr)
=
match_trivial_pattern (tpat, and_patterns (simp_to_pattern a, pattern));
(pattern', var_dictionary, (a, ds::APPLY_PATTERN (k, t, spat)) ! constr);
};
match_trivial_pattern (tpat, ds::AS_PATTERN (ds::VARIABLE_IN_PATTERN v, pattern))
=>
{ a = instance tpat;
my (pattern', var_dictionary, constr)
=
match_trivial_pattern (tpat, and_patterns (simp_to_pattern a, pattern));
(pattern', (v, a) ! var_dictionary, constr);
};
match_trivial_pattern (tpat, ds::AS_PATTERN (ds::TYPE_CONSTRAINT_PATTERN (pattern1, _), pattern2))
=>
match_trivial_pattern (tpat, ds::AS_PATTERN (pattern1, pattern2));
match_trivial_pattern (tpat, pattern)
=>
err::impossible "bad match_trivial_pattern call";
end
also
fun multi_match_trivpat (NIL, NIL)
=>
(NIL, NIL, NIL);
multi_match_trivpat (tpat ! trest, pattern ! prest)
=>
{ my (patenv, varenv, constr ) = multi_match_trivpat (trest, prest);
my (patenv', varenv', constr') = match_trivial_pattern (tpat, pattern);
(patenv@patenv', varenv@varenv', constr@constr');
};
multi_match_trivpat _
=>
err::impossible "bad multi_match_trivpat call";
end;
fun new_vars (RECORDSIMP labsimps, dictionary)
=>
multi_new_vars (map #2 labsimps, dictionary);
new_vars (VARSIMP (v as vac::PLAIN_VARIABLE { path, vartypoid_ref, inlining_data, ... } ), dictionary)
=>
{ lookup (v, dictionary);
dictionary;
}
except
lookup
=
( v,
vac::PLAIN_VARIABLE {
path,
vartypoid_ref,
varhome => vh::HIGHCODE_VARIABLE (issue_highcode_codetemp()),
inlining_data
}
)
!
dictionary;
new_vars (VARSIMP _, _)
=>
err::impossible "bad instance call to newVars";
end
also
fun multi_new_vars (NIL, dictionary)
=>
dictionary;
multi_new_vars (simp ! rest, dictionary)
=>
multi_new_vars (rest, new_vars (simp, dictionary));
end;
fun macro_expand_local_vars (NIL, dictionary)
=>
dictionary;
macro_expand_local_vars ((path, pattern) ! rest, dictionary)
=>
macro_expand_local_vars (rest, new_vars (path, dictionary));
end;
fun inst_simpexp (VARSIMP v, dictionary)
=>
VARSIMP (lookup (v, dictionary));
inst_simpexp (RECORDSIMP labsimps, dictionary)
=>
RECORDSIMP (multi_inst_simpexp (labsimps, dictionary));
end
also
fun multi_inst_simpexp (NIL, dictionary)
=>
NIL;
multi_inst_simpexp((lab, simpexp) ! rest, dictionary)
=>
( lab,
inst_simpexp (simpexp, dictionary)
)
!
(multi_inst_simpexp (rest, dictionary));
end;
fun macro_expand_constrs (NIL, loc_dictionary, dictionary)
=>
NIL;
macro_expand_constrs((simpexp, pattern) ! rest, loc_dictionary, dictionary)
=>
(inst_simpexp (simpexp, loc_dictionary), macro_expand_patexp (pattern, dictionary))
!
(macro_expand_constrs (rest, loc_dictionary, dictionary));
end;
fun liftenv NIL
=>
NIL;
liftenv ((v, x) ! rest)
=>
( v,
ds::VARIABLE_IN_PATTERN x
)
!
(liftenv rest);
end;
fun templ_expand (k, pattern)
=
{ my (patexp, trivpat, constrs)
=
foo k;
my (dictionary, varnames, newconstrs)
=
match_trivial_pattern (trivpat, pattern);
dictionary' = macro_expand_local_vars (constrs, NIL);
new_dictionary = dictionary @ (liftenv dictionary');
( macro_expand_patexp (patexp, new_dictionary),
newconstrs @ (macro_expand_constrs (constrs, dictionary', new_dictionary)),
varnames
);
};
fun const_expand k
=
{ my (patexp, constrs)
=
foo' k;
new_dictionary
=
macro_expand_local_vars (constrs, NIL);
l_new_dictionary
=
liftenv new_dictionary;
( macro_expand_patexp (patexp, l_new_dictionary),
macro_expand_constrs (constrs, new_dictionary, l_new_dictionary),
NIL
);
};
fun multi_template_expand NIL
=>
(NIL, NIL, NIL);
multi_template_expand (pattern ! rest)
=>
{ my (pats', constr1, varenv1)
=
multi_template_expand rest;
my (pattern', constr2, varenv2)
=
template_expand_pattern pattern;
( pattern' ! pats',
constr1 @ constr2,
varenv1 @ varenv2
);
};
end
also
fun template_expand_pattern (ds::APPLY_PATTERN (k, t, pattern))
=>
{ my (pattern', pat_constraints, pat_varenv)
=
template_expand_pattern pattern;
if (template k)
my (new_pattern, k_constraints, k_varenv)
=
templ_expand (k, pattern');
(new_pattern, pat_constraints@k_constraints, pat_varenv@k_varenv);
else
(ds::APPLY_PATTERN (k, t, pattern'), pat_constraints, pat_varenv);
fi;
};
template_expand_pattern (ds::CONSTRUCTOR_PATTERN (k, t))
=>
if (template k)
my (new_pattern, constraints, varenv)
=
const_expand k;
(new_pattern, constraints, varenv);
else
(ds::CONSTRUCTOR_PATTERN (k, t), NIL, NIL);
fi;
template_expand_pattern (pattern as ds::RECORD_PATTERN { fields, ... } )
=>
{ my (pats', constr, varenv)
=
multi_template_expand (map #2 fields);
( make_recordpat pattern pats',
constr,
varenv
);
};
template_expand_pattern (ds::VECTOR_PATTERN (pats, t))
=>
{ my (pats', constr, varenv)
=
multi_template_expand pats;
( ds::VECTOR_PATTERN (pats, t),
constr,
varenv
);
};
template_expand_pattern (ds::AS_PATTERN (pattern1, pattern2))
=>
{ my (pattern1', constr1, varenv1) = template_expand_pattern pattern1;
my (pattern2', constr2, varenv2) = template_expand_pattern pattern2;
(ds::AS_PATTERN (pattern1', pattern2'), constr1@constr2, varenv1@varenv2);
};
template_expand_pattern (ds::TYPE_CONSTRAINT_PATTERN (pattern, _))
=>
template_expand_pattern pattern;
template_expand_pattern pattern
=>
(pattern, NIL, NIL);
end;
fun fully_expand_naming varenv (VARSIMP v)
=>
fully_expand_naming varenv (lookup (v, varenv))
except
lookup = VARSIMP v;
fully_expand_naming varenv (RECORDSIMP labsimps)
=>
RECORDSIMP
(map (\\ (lab, simp)=>(lab, fully_expand_naming varenv simp); end ) labsimps);
end;
fun fully_expand_naming_trivpat varenv (ds::VARIABLE_IN_PATTERN v)
=>
fully_expand_naming_trivpat varenv (simp_to_pattern (lookup (v, varenv)))
except
lookup = ds::VARIABLE_IN_PATTERN v;
fully_expand_naming_trivpat varenv (pattern as ds::RECORD_PATTERN { fields, ... } )
=>
make_recordpat pattern (map (fully_expand_naming_trivpat varenv o #2) fields);
fully_expand_naming_trivpat varenv (ds::TYPE_CONSTRAINT_PATTERN (pattern, _))
=>
fully_expand_naming_trivpat varenv pattern;
fully_expand_naming_trivpat _ _
=>
err::impossible "fully_expand_naming_trivpat miscalled";
end;
}; # package template_expansion
end; # toplevel stipulate