## deep-syntax-junk.pkg
# Compiled by:
# src/lib/compiler/front/typer-stuff/typecheckdata.sublib# More stuff from typer_junk should be moved here eventually.
stipulate
package ds = deep_syntax; # deep_syntax is from src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg package im = int_red_black_map; # int_red_black_map is from src/lib/src/int-red-black-map.pkg package tup = tuples; # tuples is from src/lib/compiler/front/typer-stuff/types/tuples.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package vac = variables_and_constructors; # variables_and_constructors is from src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkgherein
package deep_syntax_junk
: (weak) api {
void_expression: ds::Deep_Expression;
tupleexp: List( ds::Deep_Expression ) -> ds::Deep_Expression;
tuplepat: List( ds::Case_Pattern ) -> ds::Case_Pattern;
# These three fns support type_core_language_declaration () in
# src/lib/compiler/front/typer/types/type-core-language-declaration-g.pkg # Keeping them here reduces clutter there. See Note[1] for additional overview.
#
# clone_core_declaration: ds::Declaration -> ds::Declaration;
core_declaration_contains_overloaded_variable: ds::Declaration -> Bool;
replace_overloaded_variables_in_core_declaration: ds::Declaration -> List(vac::Variable) -> ds::Declaration; # The List() holds one replacement PLAIN_VARIABLE for each OVERLOADED_VARIABLE in the first arg.
}
{
void_expression = ds::RECORD_IN_EXPRESSION [];
fun tupleexp l
=
ds::RECORD_IN_EXPRESSION (build (1, l))
where
fun build (i, e ! es)
=>
( ds::NUMBERED_LABEL { number => i - 1,
name => tup::number_to_label i
},
e
)
!
build (i+1, es);
build (_, []) => [];
end;
end;
fun tuplepat l
=
ds::RECORD_PATTERN { fields => build (1, l),
is_incomplete => FALSE,
type_ref => REF tdt::UNDEFINED_TYPOID
}
where
fun build (_, []) => [];
build (i, e ! es) => (tup::number_to_label i, e) ! build (i+1, es);
end;
end;
# fun clone_core_declaration (d: ds::Declaration)
# =
# do_declaration d
# where
# ref_typevars_sharing_map = REF (im::empty: im::Map( tdt::Typevar_Ref )); # To preserve sharing of REF cells in Typevar_Ref records.
#
# vartypoid_ref_sharing_list = REF ([]: List( (Ref(tdt::Typoid), Ref(tdt::Typoid)) ) );
#
# fun do_vartypoid_ref (vartypoid_ref as REF typoid)
# =
# do' *vartypoid_ref_sharing_list
# where
# fun do' []
# =>
# { r2 = REF (do_typoid typoid); # This is a refcell we haven't seen before, so create, remember and return a clone of it.
# vartypoid_ref_sharing_list := (vartypoid_ref, r2) ! *vartypoid_ref_sharing_list;
# r2;
# };
#
# do' ((r1, r2) ! rest)
# =>
# if (r1 == vartypoid_ref) r2; # This is a refcell we've seen before, so return our existing clone of it.
# else do' rest;
# fi;
# end;
# end
#
# also
# fun do_declaration d
# =
# case d
# #
# ds::EXCEPTION_DECLARATIONS named_exceptions => ds::EXCEPTION_DECLARATIONS (map do_named_exception named_exceptions );
# ds::RECURSIVE_VALUE_DECLARATIONS named_values => ds::RECURSIVE_VALUE_DECLARATIONS (map do_recursive_value_declaration named_values );
# ds::VALUE_DECLARATIONS named_values => ds::VALUE_DECLARATIONS (map do_named_value named_values );
# ds::TYPE_DECLARATIONS types => ds::TYPE_DECLARATIONS (map do_type types );
# ds::SEQUENTIAL_DECLARATIONS declarations => ds::SEQUENTIAL_DECLARATIONS (map do_declaration declarations );
# ds::PACKAGE_DECLARATIONS _ => d;
# ds::GENERIC_DECLARATIONS _ => d;
# ds::API_DECLARATIONS _ => d;
# ds::GENERIC_API_DECLARATIONS _ => d;
# ds::INCLUDE_DECLARATIONS _ => d;
# ds::FIXITY_DECLARATION _ => d;
# ds::LOCAL_DECLARATIONS (d1, d2) => ds::LOCAL_DECLARATIONS (do_declaration d1, do_declaration d2);
# ds::OVERLOADED_VARIABLE_DECLARATION variable => ds::OVERLOADED_VARIABLE_DECLARATION (do_variable variable);
# ds::SUMTYPE_DECLARATIONS { sumtypes, with_types } => ds::SUMTYPE_DECLARATIONS { sumtypes => map do_type sumtypes, with_types => map do_type with_types };
#
# ds::SOURCE_CODE_REGION_FOR_DECLARATION (declaration, source_code_region)
# =>
# ds::SOURCE_CODE_REGION_FOR_DECLARATION (do_declaration declaration, source_code_region);
# esac
#
#
# also
# fun do_deep_expression e
# =
# case e
# #
# ds::VARIABLE_IN_EXPRESSION { var => REF v, typescheme_args => r } => ds::VARIABLE_IN_EXPRESSION { var => REF (do_variable v), typescheme_args => (map do_typoid r) };
# ds::VALCON_IN_EXPRESSION { valcon, typescheme_args } => ds::VALCON_IN_EXPRESSION { valcon => do_valcon valcon, typescheme_args => (map do_typoid typescheme_args) };
# ds::INT_CONSTANT_IN_EXPRESSION (i, typoid) => ds::INT_CONSTANT_IN_EXPRESSION (i, do_typoid typoid);
# ds::UNT_CONSTANT_IN_EXPRESSION (u, typoid) => ds::UNT_CONSTANT_IN_EXPRESSION (u, do_typoid typoid);
# ds::FLOAT_CONSTANT_IN_EXPRESSION _ => e;
# ds::STRING_CONSTANT_IN_EXPRESSION _ => e;
# ds::CHAR_CONSTANT_IN_EXPRESSION _ => e;
# ds::RECORD_IN_EXPRESSION fields => ds::RECORD_IN_EXPRESSION (map (\\ (numbered_label, deep_expression) = (numbered_label, do_deep_expression deep_expression)) fields);
# ds::RECORD_SELECTOR_EXPRESSION (numbered_label, deep_expression) => ds::RECORD_SELECTOR_EXPRESSION (numbered_label, do_deep_expression deep_expression);
# ds::VECTOR_IN_EXPRESSION (deep_expressions, typoid) => ds::VECTOR_IN_EXPRESSION (map do_deep_expression deep_expressions, do_typoid typoid);
# ds::ABSTRACTION_PACKING_EXPRESSION (deep_expression, typoid, types) => ds::ABSTRACTION_PACKING_EXPRESSION (do_deep_expression deep_expression, do_typoid typoid, map do_type types);
# ds::APPLY_EXPRESSION { operator, operand } => ds::APPLY_EXPRESSION { operator => do_deep_expression operator, operand => do_deep_expression operand };
# ds::EXCEPT_EXPRESSION (deep_expression, fnrules) => ds::EXCEPT_EXPRESSION (do_deep_expression deep_expression, do_fnrules fnrules);
# ds::RAISE_EXPRESSION (deep_expression, typoid) => ds::RAISE_EXPRESSION (do_deep_expression deep_expression, do_typoid typoid);
# ds::CASE_EXPRESSION (deep_expression, case_rules, b) => ds::CASE_EXPRESSION (do_deep_expression deep_expression, map do_case_rule case_rules, b);
# ds::OR_EXPRESSION (deep_expression, deep_expression2) => ds::OR_EXPRESSION (do_deep_expression deep_expression, do_deep_expression deep_expression2);
# ds::AND_EXPRESSION (deep_expression, deep_expression2) => ds::AND_EXPRESSION (do_deep_expression deep_expression, do_deep_expression deep_expression2);
# ds::FN_EXPRESSION fnrules => ds::FN_EXPRESSION (do_fnrules fnrules);
# ds::SEQUENTIAL_EXPRESSIONS deep_expressions => ds::SEQUENTIAL_EXPRESSIONS (map do_deep_expression deep_expressions);
# ds::LET_EXPRESSION (declaration, deep_expression) => ds::LET_EXPRESSION (do_declaration declaration, do_deep_expression deep_expression);
# ds::TYPE_CONSTRAINT_EXPRESSION (deep_expression, typoid) => ds::TYPE_CONSTRAINT_EXPRESSION (do_deep_expression deep_expression, do_typoid typoid);
# ds::WHILE_EXPRESSION { test, expression } => ds::WHILE_EXPRESSION { test => do_deep_expression test, expression => do_deep_expression expression };
# ds::IF_EXPRESSION { test_case, then_case, else_case } => ds::IF_EXPRESSION { test_case => do_deep_expression test_case, then_case => do_deep_expression then_case, else_case => do_deep_expression else_case };
# ds::SOURCE_CODE_REGION_FOR_EXPRESSION (deep_expression,source_code_region) => ds::SOURCE_CODE_REGION_FOR_EXPRESSION (do_deep_expression deep_expression, source_code_region);
# esac
#
#
# also
# fun do_named_exception e
# =
# case e
# ds::NAMED_EXCEPTION { exception_constructor, exception_typoid, name_string }
# =>
# ds::NAMED_EXCEPTION { exception_constructor => do_valcon exception_constructor,
# exception_typoid => case exception_typoid NULL => NULL; THE typoid => THE (do_typoid typoid); esac,
# name_string => do_deep_expression name_string
# };
#
# ds::DUPLICATE_NAMED_EXCEPTION { exception_constructor, equal_to }
# =>
# ds::DUPLICATE_NAMED_EXCEPTION { exception_constructor => do_valcon exception_constructor,
# equal_to => do_valcon equal_to
# };
# esac
#
# also
# fun do_recursive_value_declaration
# (ds::NAMED_RECURSIVE_VALUE
# { variable,
# expression,
# raw_typevars => REF typevar_refs,
# generalized_typevars,
# null_or_type
# })
# =
# ds::NAMED_RECURSIVE_VALUE
# { variable => do_variable variable,
# expression => do_deep_expression expression,
# raw_typevars => REF (map do_typevar_ref typevar_refs),
# generalized_typevars=> (map do_typevar_ref generalized_typevars),
# null_or_type => case null_or_type NULL => NULL; THE typoid => THE (do_typoid typoid); esac
# }
#
# also
# fun do_named_value
# (ds::VALUE_NAMING
# {
# pattern,
# expression,
# raw_typevars => REF typevar_refs,
# generalized_typevars
# })
# =
# ds::VALUE_NAMING
# {
# pattern => do_case_pattern pattern,
# expression => do_deep_expression expression,
# raw_typevars => REF (map do_typevar_ref typevar_refs),
# generalized_typevars=> (map do_typevar_ref generalized_typevars)
# }
#
# also
# fun do_type t
# =
# case t
# tdt::SUM_TYPE { stamp, arity, is_eqtype => REF is_eqtype, kind, namepath, stub }
# => tdt::SUM_TYPE { stamp, arity, is_eqtype => REF is_eqtype, kind, namepath, stub };
#
# tdt::NAMED_TYPE { stamp, typescheme, strict, namepath }
# => tdt::NAMED_TYPE { stamp, typescheme => do_typescheme typescheme, strict, namepath };
#
# tdt::TYPE_BY_STAMPPATH _ => t;
# tdt::RECORD_TYPE _ => t;
# tdt::RECURSIVE_TYPE _ => t;
# tdt::FREE_TYPE _ => t;
# tdt::ERRONEOUS_TYPE => t;
# esac
#
# also
# fun do_typescheme (tdt::TYPESCHEME { arity, body })
# = tdt::TYPESCHEME { arity, body => do_typoid body }
#
# also
# fun do_typoid t
# =
# case t
# #
# tdt::TYPEVAR_REF typevar_ref => tdt::TYPEVAR_REF (do_typevar_ref typevar_ref);
# tdt::TYPESCHEME_ARG _ => t;
# tdt::WILDCARD_TYPOID => t;
# tdt::UNDEFINED_TYPOID => t;
# tdt::TYPCON_TYPOID (type, typoids) => tdt::TYPCON_TYPOID (do_type type, map do_typoid typoids);
# tdt::TYPESCHEME_TYPOID { typescheme,
# typescheme_eqflags } => tdt::TYPESCHEME_TYPOID { typescheme => do_typescheme typescheme, typescheme_eqflags };
# esac
#
# also
# fun do_typevar_ref { id, ref_typevar => REF typevar }
# =
# case (im::get (*ref_typevars_sharing_map, id)) # Preserve sharing of REF cells in Typevar_Ref records.
# #
# THE r => r; # We already created a tdt::Typevar_Ref with this ID, so just re-use it.
# #
# NULL => { r = { id, ref_typevar => REF (do_typevar typevar) }; # We haven't seen this ID before, create fresh tdt::Typevar_Ref for it.
# #
# ref_typevars_sharing_map := im::set (*ref_typevars_sharing_map, id, r); # Remember tdt::Typevar_Ref for possible later re-use.
#
# r; # Return tdt::Typevar_Ref.
# };
# esac
#
# also
# fun do_typevar typevar
# =
# case typevar
# #
# tdt::INCOMPLETE_RECORD_TYPEVAR { eq, fn_nesting, known_fields }
# =>
# tdt::INCOMPLETE_RECORD_TYPEVAR { eq, fn_nesting, known_fields => map (\\ (label, typoid) = (label, do_typoid typoid)) known_fields };
#
# tdt::RESOLVED_TYPEVAR typoid => tdt::RESOLVED_TYPEVAR (do_typoid typoid);
#
# tdt::USER_TYPEVAR _ => typevar;
# tdt::META_TYPEVAR _ => typevar;
# tdt::LITERAL_TYPEVAR _ => typevar;
# tdt::OVERLOADED_TYPEVAR _ => typevar;
# tdt::TYPEVAR_MARK _ => typevar;
# esac
#
# also
# fun do_valcon (tdt::VALCON { typoid, name, form, is_constant, signature, is_lazy })
# =
# tdt::VALCON { typoid => do_typoid typoid, name, form, is_constant, signature, is_lazy }
#
# also
# fun do_fnrules (case_rules, typoid)
# =
# (map do_case_rule case_rules, do_typoid typoid)
#
## I think case_pattern can be dropped, but lets get this working first
## and then verify that experimentally before dropping it.
# also
# fun do_case_pattern p
# =
# case p
# ds::WILDCARD_PATTERN => p;
# ds::NO_PATTERN => p;
# ds::TYPE_CONSTRAINT_PATTERN (case_pattern, typoid) => ds::TYPE_CONSTRAINT_PATTERN (do_case_pattern case_pattern, do_typoid typoid);
# ds::AS_PATTERN (case_pattern1, case_pattern2) => ds::AS_PATTERN (do_case_pattern case_pattern1, do_case_pattern case_pattern2);
# ds::OR_PATTERN (case_pattern1, case_pattern2) => ds::OR_PATTERN (do_case_pattern case_pattern1, do_case_pattern case_pattern2);
# ds::VARIABLE_IN_PATTERN variable => ds::VARIABLE_IN_PATTERN (do_variable variable);
# ds::INT_CONSTANT_IN_PATTERN (int, typoid) => ds::INT_CONSTANT_IN_PATTERN (int, do_typoid typoid);
# ds::UNT_CONSTANT_IN_PATTERN (int, typoid) => ds::UNT_CONSTANT_IN_PATTERN (int, do_typoid typoid);
# ds::FLOAT_CONSTANT_IN_PATTERN _ => p;
# ds::STRING_CONSTANT_IN_PATTERN _ => p;
# ds::CHAR_CONSTANT_IN_PATTERN _ => p;
# ds::CONSTRUCTOR_PATTERN (valcon, typoids ) => ds::CONSTRUCTOR_PATTERN (do_valcon valcon, map do_typoid typoids);
# ds::APPLY_PATTERN (valcon, typoids, case_pattern) => ds::APPLY_PATTERN (do_valcon valcon, map do_typoid typoids, do_case_pattern case_pattern);
# ds::VECTOR_PATTERN (case_patterns, typoid) => ds::VECTOR_PATTERN (map do_case_pattern case_patterns, do_typoid typoid);
# ds::RECORD_PATTERN { is_incomplete,
# type_ref => REF typoid,
# fields
# } => ds::RECORD_PATTERN { is_incomplete, type_ref => REF (do_typoid typoid), fields => map (\\ (label, case_pattern) = (label, do_case_pattern case_pattern)) fields };
# esac
#
# also
# fun do_case_rule (ds::CASE_RULE (case_pattern, deep_expression))
# =
# ds::CASE_RULE (do_case_pattern case_pattern, do_deep_expression deep_expression)
#
# also
# fun do_variable v
# =
# case v
# vac::PLAIN_VARIABLE { path, varhome, inlining_data, vartypoid_ref }
# =>
# vac::PLAIN_VARIABLE { path, varhome, inlining_data, vartypoid_ref => do_vartypoid_ref vartypoid_ref };
#
# vac::OVERLOADED_VARIABLE { name, typescheme, alternatives => REF alternatives }
# =>
# vac::OVERLOADED_VARIABLE { name, typescheme => do_typescheme typescheme, alternatives => REF (map (\\ { indicator, variant } = { indicator => do_typoid indicator, variant => do_variable variant }) alternatives) };
#
# vac::ERROR_VARIABLE => v;
# esac;
#
# end;
fun core_declaration_contains_overloaded_variable (d: ds::Declaration)
=
do_declaration d
where
fun or_fold (do_x: X -> Bool) (xs: List(X))
=
or_fold' xs
where
fun or_fold' [] => FALSE;
or_fold' (x ! xs) => if (do_x x) TRUE;
else or_fold' xs;
fi;
end;
end;
fun do_declaration d
=
case d
#
ds::EXCEPTION_DECLARATIONS named_exceptions => FALSE;
ds::RECURSIVE_VALUE_DECLARATIONS named_values => (or_fold do_recursive_value_declaration named_values );
ds::VALUE_DECLARATIONS named_values => (or_fold do_named_value named_values );
ds::TYPE_DECLARATIONS types => FALSE;
ds::SEQUENTIAL_DECLARATIONS declarations => (or_fold do_declaration declarations );
ds::PACKAGE_DECLARATIONS _ => FALSE;
ds::GENERIC_DECLARATIONS _ => FALSE;
ds::API_DECLARATIONS _ => FALSE;
ds::GENERIC_API_DECLARATIONS _ => FALSE;
ds::INCLUDE_DECLARATIONS _ => FALSE;
ds::FIXITY_DECLARATION _ => FALSE;
ds::LOCAL_DECLARATIONS (d1, d2) => { do_declaration d1 or do_declaration d2; };
ds::OVERLOADED_VARIABLE_DECLARATION variable => FALSE;
ds::SUMTYPE_DECLARATIONS { sumtypes, with_types } => FALSE;
ds::SOURCE_CODE_REGION_FOR_DECLARATION (declaration, _) => do_declaration declaration;
esac
also
fun do_deep_expression e
=
case e
#
ds::VARIABLE_IN_EXPRESSION { var => REF v, ... } => do_variable v;
ds::VALCON_IN_EXPRESSION _ => FALSE;
ds::INT_CONSTANT_IN_EXPRESSION _ => FALSE;
ds::UNT_CONSTANT_IN_EXPRESSION _ => FALSE;
ds::FLOAT_CONSTANT_IN_EXPRESSION _ => FALSE;
ds::STRING_CONSTANT_IN_EXPRESSION _ => FALSE;
ds::CHAR_CONSTANT_IN_EXPRESSION _ => FALSE;
ds::RECORD_IN_EXPRESSION fields => or_fold (\\ (numbered_label, deep_expression) = do_deep_expression deep_expression) fields;
ds::RECORD_SELECTOR_EXPRESSION (_, deep_expression) => do_deep_expression deep_expression;
ds::VECTOR_IN_EXPRESSION (deep_expressions, _) => or_fold do_deep_expression deep_expressions;
ds::ABSTRACTION_PACKING_EXPRESSION (deep_expression, _, _) => do_deep_expression deep_expression;
ds::APPLY_EXPRESSION { operator, operand } => do_deep_expression operator or do_deep_expression operand;
ds::EXCEPT_EXPRESSION (deep_expression, fnrules) => do_deep_expression deep_expression or do_fnrules fnrules;
ds::RAISE_EXPRESSION (deep_expression, _) => do_deep_expression deep_expression;
ds::CASE_EXPRESSION (deep_expression, case_rules, _) => do_deep_expression deep_expression or or_fold do_case_rule case_rules;
ds::OR_EXPRESSION (deep_expression, deep_expression2) => do_deep_expression deep_expression or do_deep_expression deep_expression2;
ds::AND_EXPRESSION (deep_expression, deep_expression2) => do_deep_expression deep_expression or do_deep_expression deep_expression2;
ds::FN_EXPRESSION fnrules => do_fnrules fnrules;
ds::SEQUENTIAL_EXPRESSIONS deep_expressions => or_fold do_deep_expression deep_expressions;
ds::LET_EXPRESSION (declaration, deep_expression) => do_declaration declaration or do_deep_expression deep_expression;
ds::TYPE_CONSTRAINT_EXPRESSION (deep_expression, _) => do_deep_expression deep_expression;
ds::WHILE_EXPRESSION { test, expression } => do_deep_expression test or do_deep_expression expression;
ds::IF_EXPRESSION { test_case, then_case, else_case } => do_deep_expression test_case or do_deep_expression then_case or do_deep_expression else_case;
ds::SOURCE_CODE_REGION_FOR_EXPRESSION (deep_expression,_) => do_deep_expression deep_expression;
esac
also
fun do_recursive_value_declaration
(ds::NAMED_RECURSIVE_VALUE { variable, expression, ... })
=
do_variable variable or do_deep_expression expression
also
fun do_named_value
(ds::VALUE_NAMING { expression, ... })
=
do_deep_expression expression
also
fun do_fnrules (case_rules, _)
=
(or_fold do_case_rule case_rules)
also
fun do_case_rule (ds::CASE_RULE (_, deep_expression))
=
do_deep_expression deep_expression
also
fun do_variable v
=
case v
vac::OVERLOADED_VARIABLE _ => TRUE;
_ => FALSE;
esac;
end;
fun replace_overloaded_variables_in_core_declaration (d: ds::Declaration) (variables: List(vac::Variable)) # The List() holds one replacement PLAIN_VARIABLE for each OVERLOADED_VARIABLE in the first arg.
=
do_declaration d
where
stipulate
vars = REF variables;
herein
fun nextvar ()
=
case *vars
#
(v ! vs) => { vars := vs;
v;
};
[] => raise exception DIE "Not enough variables! -- replace_overloaded_variables_in_core_declaration in deep-syntax-junk.pkg";
esac;
fun checkvars ()
=
case *vars
#
(v ! vs) => raise exception DIE "Too many variables! -- replace_overloaded_variables_in_core_declaration in deep-syntax-junk.pkg";
[] => ();
esac;
end;
fun do_declaration d
=
case d
#
ds::EXCEPTION_DECLARATIONS named_exceptions => ds::EXCEPTION_DECLARATIONS (map do_named_exception named_exceptions );
ds::RECURSIVE_VALUE_DECLARATIONS named_values => ds::RECURSIVE_VALUE_DECLARATIONS (map do_recursive_value_declaration named_values );
ds::VALUE_DECLARATIONS named_values => ds::VALUE_DECLARATIONS (map do_named_value named_values );
ds::TYPE_DECLARATIONS _ => d;
ds::SEQUENTIAL_DECLARATIONS declarations => ds::SEQUENTIAL_DECLARATIONS (map do_declaration declarations );
ds::PACKAGE_DECLARATIONS _ => d;
ds::GENERIC_DECLARATIONS _ => d;
ds::API_DECLARATIONS _ => d;
ds::GENERIC_API_DECLARATIONS _ => d;
ds::INCLUDE_DECLARATIONS _ => d;
ds::FIXITY_DECLARATION _ => d;
ds::LOCAL_DECLARATIONS (d1, d2) => ds::LOCAL_DECLARATIONS (do_declaration d1, do_declaration d2);
ds::OVERLOADED_VARIABLE_DECLARATION _ => d;
ds::SUMTYPE_DECLARATIONS _ => d;
ds::SOURCE_CODE_REGION_FOR_DECLARATION (declaration, source_code_region)
=>
ds::SOURCE_CODE_REGION_FOR_DECLARATION (do_declaration declaration, source_code_region);
esac
also
fun do_deep_expression e
=
case e
#
ds::VARIABLE_IN_EXPRESSION { var => REF v, typescheme_args } => ds::VARIABLE_IN_EXPRESSION { var => REF (do_variable v), typescheme_args };
ds::VALCON_IN_EXPRESSION { valcon, typescheme_args } => e;
ds::INT_CONSTANT_IN_EXPRESSION (i, typoid) => e;
ds::UNT_CONSTANT_IN_EXPRESSION (u, typoid) => e;
ds::FLOAT_CONSTANT_IN_EXPRESSION _ => e;
ds::STRING_CONSTANT_IN_EXPRESSION _ => e;
ds::CHAR_CONSTANT_IN_EXPRESSION _ => e;
ds::RECORD_IN_EXPRESSION fields => ds::RECORD_IN_EXPRESSION (map (\\ (numbered_label, deep_expression) = (numbered_label, do_deep_expression deep_expression)) fields);
ds::RECORD_SELECTOR_EXPRESSION (numbered_label, deep_expression) => ds::RECORD_SELECTOR_EXPRESSION (numbered_label, do_deep_expression deep_expression);
ds::VECTOR_IN_EXPRESSION (deep_expressions, typoid) => ds::VECTOR_IN_EXPRESSION (map do_deep_expression deep_expressions, typoid);
ds::ABSTRACTION_PACKING_EXPRESSION (deep_expression, typoid, types) => ds::ABSTRACTION_PACKING_EXPRESSION (do_deep_expression deep_expression, typoid, types);
ds::APPLY_EXPRESSION { operator, operand } => ds::APPLY_EXPRESSION { operator => do_deep_expression operator, operand => do_deep_expression operand };
ds::EXCEPT_EXPRESSION (deep_expression, fnrules) => ds::EXCEPT_EXPRESSION (do_deep_expression deep_expression, do_fnrules fnrules);
ds::RAISE_EXPRESSION (deep_expression, typoid) => ds::RAISE_EXPRESSION (do_deep_expression deep_expression, typoid);
ds::CASE_EXPRESSION (deep_expression, case_rules, b) => ds::CASE_EXPRESSION (do_deep_expression deep_expression, map do_case_rule case_rules, b);
ds::OR_EXPRESSION (deep_expression, deep_expression2) => ds::OR_EXPRESSION (do_deep_expression deep_expression, do_deep_expression deep_expression2);
ds::AND_EXPRESSION (deep_expression, deep_expression2) => ds::AND_EXPRESSION (do_deep_expression deep_expression, do_deep_expression deep_expression2);
ds::FN_EXPRESSION fnrules => ds::FN_EXPRESSION (do_fnrules fnrules);
ds::SEQUENTIAL_EXPRESSIONS deep_expressions => ds::SEQUENTIAL_EXPRESSIONS (map do_deep_expression deep_expressions);
ds::LET_EXPRESSION (declaration, deep_expression) => ds::LET_EXPRESSION (do_declaration declaration, do_deep_expression deep_expression);
ds::TYPE_CONSTRAINT_EXPRESSION (deep_expression, typoid) => ds::TYPE_CONSTRAINT_EXPRESSION (do_deep_expression deep_expression, typoid);
ds::WHILE_EXPRESSION { test, expression } => ds::WHILE_EXPRESSION { test => do_deep_expression test, expression => do_deep_expression expression };
ds::IF_EXPRESSION { test_case, then_case, else_case } => ds::IF_EXPRESSION { test_case => do_deep_expression test_case, then_case => do_deep_expression then_case, else_case => do_deep_expression else_case };
ds::SOURCE_CODE_REGION_FOR_EXPRESSION (deep_expression,source_code_region) => ds::SOURCE_CODE_REGION_FOR_EXPRESSION (do_deep_expression deep_expression, source_code_region);
esac
also
fun do_named_exception e
=
case e
ds::NAMED_EXCEPTION { exception_constructor, exception_typoid, name_string }
=>
ds::NAMED_EXCEPTION { exception_constructor,
exception_typoid,
name_string => do_deep_expression name_string
};
ds::DUPLICATE_NAMED_EXCEPTION { exception_constructor, equal_to }
=>
e;
esac
also
fun do_recursive_value_declaration
(ds::NAMED_RECURSIVE_VALUE
{ variable,
expression,
raw_typevars,
generalized_typevars,
null_or_type
})
=
ds::NAMED_RECURSIVE_VALUE
{ variable => do_variable variable,
expression => do_deep_expression expression,
raw_typevars,
generalized_typevars,
null_or_type
}
also
fun do_named_value
(ds::VALUE_NAMING
{
pattern,
expression,
raw_typevars,
generalized_typevars
})
=
ds::VALUE_NAMING
{
pattern,
expression => do_deep_expression expression,
raw_typevars,
generalized_typevars
}
also
fun do_fnrules (case_rules, typoid)
=
(map do_case_rule case_rules, typoid)
also
fun do_case_rule (ds::CASE_RULE (case_pattern, deep_expression))
=
ds::CASE_RULE (case_pattern, do_deep_expression deep_expression)
also
fun do_variable v
=
case v
vac::OVERLOADED_VARIABLE _ => nextvar();
vac::PLAIN_VARIABLE _ => v;
vac::ERROR_VARIABLE => v;
esac;
end;
};
end;
##########################################################################
# Note[1]
#
# The idea is to implement variable overloading via multiple passes:
#
# 1) Propagate types so as to be able to select
# the right variant of each overloaded variable.
#
# 2) Replace each overloaded variable the selected variant.
#
# 3) Do a complete fresh type propagation pass so as
# to get the precise same effect as though each
# overloaded variable had never been there.
#
# This strategy was arrived at by wasting a lot of time
# trying to make the original simple one-pass/backpatching
# approach work. There seem to be just too many odd side-effects
# of type substitution and too much need to propagate type
# information resulting from overloaded-variable-substitution
# for a simpler, naive approach to work.
#
# In a clean-slate redesign I think I would factor out the mutable
# state from the rest of the deep syntax tree so as to make it
# trivial to revert changes.
# That is, mutable elements in the tree would be replaced by
# small ints which would be looked up in a red-black tree. (The
# red-black tree probably needs to return different types to
# different callers; the existing symbol table logic shows how to
# handle this.)
# All mutations would then be updates to the red-black tree;
# reversion to a given state of the syntax tree would require only saving
# the value of the redblack tree at that point, along with the deep syntax
# tree proper if it gets rewritten.
# This would, for example, clean up the kludgey soft_unify stuff
# in src/lib/compiler/front/typer/types/resolve-overloaded-variables.pkg# by eliminating the need to undo tree changes one by one, and thus
# eliminate the need for soft_unify() to duplicate the logic in regular
# unify().
# Similarly
# clone_core_declaration
# core_declaration_contains_overloaded_variable
# replace_overloaded_variables_in_core_declaration
# in this file could all be discarded.
# -- CrT 2013-01-05