local int
n_ty_precedence(Cell *type)
{
Op *op;
DefType *tcons;
switch (type->c_class) {
case C_VOID:
return PREC_MU;
case C_TCONS:
tcons = type->c_abbr->c_tcons;
if (tcons->dt_arity == 0)
return PREC_ATOMIC;
if (tcons->dt_arity == 2 &&
(op = op_lookup(tcons->dt_name)) != NULL)
return op->op_prec;
return PREC_APPLY;
when C_TVAR:
return PREC_ATOMIC;
otherwise:
NOT_REACHED;
}
}
// collects nibbles and outputs them to the output file
void assemble(FILE* in , FILE* out)
{
char buffer[LINE_BUFFER_SIZE];
char* line;
byte upper_nibble = EMPTY;
byte lower_nibble = EMPTY;
while((line = get_line(in,buffer)) != NULL)
{
byte immu = 0;
byte nibble = op_lookup(line,&immu);
if(upper_nibble == EMPTY)
{
upper_nibble = nibble << 4;
if(nibble == 0)
{
lower_nibble = immu;
nibble = upper_nibble | lower_nibble;
fwrite(&nibble,1,1,out);
upper_nibble = EMPTY;
lower_nibble = EMPTY;
}
}
else
{
lower_nibble = nibble;
nibble = upper_nibble | lower_nibble;
fwrite(&nibble,1,1,out);
if(lower_nibble == 0) upper_nibble = immu << 4;
else upper_nibble = EMPTY;
lower_nibble = EMPTY;
}
}
if(upper_nibble != EMPTY)
{
fwrite(&upper_nibble,1,1,out);
}
}
/*
* Print a type.
* The occurs check for mu-types makes this quadratic, but I can't
* think of anything better (and maybe it's not too bad).
*/
local void
pr_c_ty_value(FILE *f, Cell *type, int context)
{
Op *op;
int prec;
Bool is_mu;
DefType *tcons;
Cell *targ;
type = deref(type);
is_mu = type->c_class == C_VOID || occurs(type, type);
prec = is_mu ? PREC_MU : n_ty_precedence(type);
if (prec < context)
(void)fprintf(f, "(");
if (is_mu) {
var_count++;
type->c_varno = var_count;
(void)fprintf(f, "%s ", n_mu);
tv_print(f, (Natural)(type->c_varno - 1));
(void)fprintf(f, " %s ", n_gives);
}
switch (type->c_class) {
case C_TVAR:
if (type->c_varno == 0) {
var_count++;
type->c_varno = var_count;
}
tv_print(f, (Natural)(type->c_varno - 1));
when C_VOID:
tv_print(f, (Natural)(type->c_varno - 1));
when C_TCONS:
ASSERT( type->c_abbr->c_class == C_TSUB );
tcons = type->c_abbr->c_tcons;
targ = type->c_abbr->c_targ;
ASSERT( tcons->dt_arity == 0 || targ->c_class == C_TLIST );
/* mark it as a VAR in case we encounter it recursively */
type->c_class = C_TVAR;
if (tcons->dt_arity == 2 && tcons->dt_tupled &&
(op = op_lookup(tcons->dt_name)) != NULL) {
/* infix */
pr_c_ty_value(f, targ->c_head, LeftPrec(op));
(void)fprintf(f, " %s ", tcons->dt_name);
pr_c_ty_value(f, targ->c_tail->c_head, RightPrec(op));
} else if (tcons->dt_tupled) {
(void)fprintf(f, "%s (", tcons->dt_name);
pr_c_ty_value(f, targ->c_head, PREC_BODY);
for (targ = targ->c_head;
targ != NOCELL;
targ = targ->c_tail) {
ASSERT( targ->c_class == C_TLIST );
(void)fprintf(f, ", ");
pr_c_ty_value(f, targ->c_head, PREC_BODY);
}
(void)fprintf(f, ")");
} else {
(void)fprintf(f, "%s", tcons->dt_name);
for ( ; targ != NOCELL; targ = targ->c_tail) {
ASSERT( targ->c_class == C_TLIST );
(void)fprintf(f, " ");
pr_c_ty_value(f, targ->c_head, PREC_ARG);
}
}
type->c_class = C_TCONS;
otherwise:
NOT_REACHED;
}
if (prec < context)
(void)fprintf(f, ")");
}
