# Mythryl-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi
# Compiled by:
# src/app/yacc/src/mythryl-yacc.lib### "An individual relates himself in action
### to his society through the use of tools
### that he actively masters, or by which
### he is passively acted upon.
###
### "To the degree that he masters his tools,
### he can invest the world with his meaning;
### to the degree that he is mastered by his tools,
### the shape of the tool determines his own self-image."
###
### -- ivan d. illich (Tools for Conviviality)
package deep_syntax: (weak) Deep_Syntax # Deep_Syntax is from src/app/yacc/src/deep-syntax.api=
package {
Expression
= CODE String
| EAPP (Expression, Expression)
| EINT Int
| ETUPLE List( Expression )
| EVAR String
| FN (Pattern, Expression)
| LET (List( Decl ), Expression)
| SEQ (Expression, Expression)
| UNIT
also Pattern
= PVAR String
| PAPP (String, Pattern)
| PINT Int
| PLIST (List( Pattern ), Null_Or( Pattern ))
| PTUPLE List( Pattern )
| WILD
| AS (String, Pattern)
also Decl = NAMED_VALUE (Pattern, Expression)
also Rule = RULE (Pattern, Expression);
# Define the ASCII characters legal within an identifier.
# This is essentially [A-Za-z0-9_']:
fun id_char '\'' => TRUE;
id_char '_' => TRUE;
id_char c => char::is_alpha c or char::is_digit c;
end;
# Given a string, find all the lexically valid
# identifiers in it and return them as a list
# of strings. We define an identifier to consist
# of an initial alphabetic followed by any mixture
# of alphabetics, decimal digits, underlines and
# single quotes:
fun code_to_ids s
=
scan_list (explode s, NIL)
where
fun scan_list (NIL, r)
=>
r;
scan_list (h ! t, r)
=>
if (char::is_alpha h)
scan_id (t,[h], r);
else
scan_list (t, r);
fi;
end
also
fun scan_id (NIL, accum, r)
=>
implode (reverse accum) ! r;
scan_id (a as (h ! t), accum, r)
=>
if (id_char h)
scan_id (t, h ! accum, r);
else
scan_list (a, implode (reverse accum) ! r);
fi;
end;
end;
my simplify_rule: Rule -> Rule
=
\\ (RULE (pattern, expression))
=>
RULE ( simplify_pattern pattern,
simplify_expression expression
)
where
# fun 'used' returns TRUE for any string
# naming an variable used in 'expression':
stipulate
identifiers
=
f expression
where
fun f (CODE s) => code_to_ids s;
f (EAPP (a, b)) => f a @ f b;
f (ETUPLE l) => list::cat (map f l);
f (EVAR s) => [s];
f (FN(_, e)) => f e;
f (LET (dl, e)) =>
(list::cat (map (\\ NAMED_VALUE(_, e) => f e; end ) dl)) @ f e;
f (SEQ (a, b)) => f a @ f b;
f _ => NIL;
end;
end;
herein
my used: (String -> Bool)
=
( \\ s
=>
list::exists
(\\ a => a == s; end )
identifiers; end
);
end;
my simplify_pattern: Pattern -> Pattern
=
f where
fun f a
=
case a
PVAR s
=>
if (used s)
a;
else WILD;fi;
PAPP (s, pattern)
=>
case (f pattern)
WILD => WILD;
pattern' => PAPP (s, pattern');
esac;
PLIST (l, topt)
=>
{ l' = map f l;
topt' = null_or::map f topt;
fun not_wild WILD => FALSE;
not_wild _ => TRUE; end;
case topt'
THE WILD => if (list::exists not_wild l')
PLIST (l', topt');
else WILD; fi;
_ => PLIST (l', topt');
esac;
};
PTUPLE l
=>
{ l' = map f l;
if (list::exists (\\ WILD=>FALSE; _ => TRUE; end ) l')
PTUPLE l';
else WILD;fi;
};
AS (a, b)
=>
if (used a )
case (f b)
WILD => PVAR a;
b' => AS (a, b');
esac;
else f b;fi;
_ => a;
esac;
end;
my simplify_expression: Expression -> Expression
=
f where
fun f (EAPP (a, b)) => EAPP (f a, f b);
f (ETUPLE l) => ETUPLE (map f l);
f (FN (p, e)) => FN (simplify_pattern p, f e);
f (SEQ (a, b)) => SEQ (f a, f b);
f (LET (dl, e))
=>
LET (
map (\\ NAMED_VALUE (p, e)
=>
NAMED_VALUE (simplify_pattern p, f e); end
)
dl,
f e
);
f a => a; end;
end;
end; end ;
fun print_rule ( say: String -> Void,
sayln: String -> Void
)
r
=
case (simplify_rule r)
#
RULE (pattern, expression)
=>
apply
out
(prettyprint (pattern, " =>" ! print_expression (expression, ["\n"])))
where
fun flatten (a, []) => reverse a;
flatten (a, SEQ (e1, e2) ! el) => flatten (a, e1 ! e2 ! el);
flatten (a, e ! el) => flatten (e ! a, el);
end;
fun print_list (lb, rb, c, f, [], result_so_far)
=>
" " ! lb ! rb ! result_so_far;
print_list (lb, rb, c, f, h ! t, result_so_far)
=>
" " ! lb ! f (h, fold_backward (\\ (x, result_so_far) => c ! f (x, result_so_far); end )
(rb ! result_so_far)
t);
end;
fun print_expression (CODE c, result_so_far)
=>
" (" ! c ! ")" ! result_so_far;
print_expression (EAPP (x, y as (EAPP _)), result_so_far)
=>
print_expression (x, " (" ! print_expression (y, ")" ! result_so_far));
print_expression (EAPP (x, y), result_so_far)
=>
print_expression (x, print_expression (y, result_so_far));
print_expression (EINT i, result_so_far)
=>
" " ! int::to_string i ! result_so_far;
print_expression (ETUPLE l, result_so_far)
=>
print_list ("(", ")", ", ", print_expression, l, result_so_far);
print_expression (EVAR v, result_so_far)
=>
" " ! v ! result_so_far;
print_expression (FN (p, b), result_so_far)
=>
" (\\\\ " ! prettyprint (p, " = " ! print_expression (b, ")" ! result_so_far));
print_expression (LET ([], b), result_so_far)
=>
print_expression (b, result_so_far);
print_expression (LET (declarations, expression), result_so_far)
=>
( " { "
!
fold_backward
printrule
(print_expression (expression, ";\n } " ! result_so_far))
declarations
)
where
fun printrule (NAMED_VALUE (pattern, expression), result_so_far)
=
" my " ! prettyprint (pattern, " =" ! print_expression (expression, ";\n" ! result_so_far));
end;
print_expression (SEQ (expr1, expr2), result_so_far)
=>
print_list ("(", ")", ";", print_expression, flatten ([], [expr1, expr2]), result_so_far);
print_expression (UNIT, result_so_far)
=>
" ()" ! result_so_far;
end
also
fun prettyprint (PVAR v, result_so_far)
=>
" " ! v ! result_so_far;
prettyprint (PAPP (x, y as PAPP _), result_so_far)
=>
" " ! x ! " (" ! prettyprint (y, ")" ! result_so_far);
prettyprint (PAPP (x, y), result_so_far)
=>
" " ! x ! prettyprint (y, result_so_far);
prettyprint (PINT i, result_so_far)
=>
" " ! int::to_string i ! result_so_far;
prettyprint (PLIST (l, NULL), result_so_far)
=>
print_list ("[", "]", ", ", prettyprint, l, result_so_far);
prettyprint (PLIST (l, THE t), result_so_far)
=>
" (" ! fold_backward (\\ (x, result_so_far) => prettyprint (x, " ! " ! result_so_far); end )
(prettyprint (t, ")" ! result_so_far))
l;
prettyprint (PTUPLE l, result_so_far)
=>
print_list ("(", ")", ", ", prettyprint, l, result_so_far);
prettyprint (WILD, result_so_far)
=>
" _" ! result_so_far;
prettyprint (AS (v, PVAR v'), result_so_far)
=>
" (" ! v ! " as " ! v' ! ")" ! result_so_far;
prettyprint (AS (v, p), result_so_far)
=>
" (" ! v ! " as (" ! prettyprint (p, "))" ! result_so_far);
end;
fun out "\n" => sayln "";
out s => say s;
end;
end;
esac; # fun print_rule
};