## oop-collect-methods-and-fields.pkg
# Compiled by:
# src/lib/compiler/front/typer/typer.sublib# Mythryl classes are lightly modified packages.
# To expand oop constructs into the vanilla non-OOP
# underlying language we must traverse the class
# (package) syntax tree converting everything oop
# into vanilla non-oop form.
#
# In this package we implement the package syntax
# tree dagwalk subtask. This involves a set of
# mutually recursive functions mirroring the
# mutually recursive grammar rules defining package
# syntax:
stipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package eos = expand_oop_syntax_junk; # expand_oop_syntax_junk is from src/lib/compiler/front/typer/main/expand-oop-syntax-junk.pkg package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package raw = raw_syntax; # raw_syntax is from src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg include package fast_symbol; # fast_symbol is from src/lib/compiler/front/basics/map/fast-symbol.pkg include package raw_syntax; # raw_syntax is from src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg include package raw_syntax_junk; # raw_syntax_junk is from src/lib/compiler/front/parser/raw-syntax/raw-syntax-junk.pkgherein
package oop_collect_methods_and_fields
: Oop_Collect_Methods_And_Fields # Oop_Collect_Methods_And_Fields is from src/lib/compiler/front/typer/main/oop-collect-methods-and-fields.api {
validate_message_type
=
validate_message_type::validate_message_type;
# We get called from
# src/lib/compiler/front/typer/main/expand-oop-syntax.pkg # to gather all the oop-related
# statements in a class declaration
# prior to starting code synthesis.
#
# The relevant statements are:
# class super = ... ;
# field my ... ;
# message fun ... ;
# method fun ... ;
#
# This is a read-only pass; the input
# syntax tree is not modified.
#
fun collect_methods_and_fields
( declaration: raw_syntax::Declaration,
symbolmapstack: symbolmapstack::Symbolmapstack,
source_code_region: line_number_db::Source_Code_Region,
per_compile_stuff as
{
error_fn,
...
}: typer_junk::Per_Compile_Stuff
)
=
{ methods_and_messages = REF []: Ref (List( Named_Function )); # Declarations of a new method.
fields = REF []: Ref (List( Named_Field )); #
null_or_superclass = REF NULL: Ref (Null_Or( Named_Package )); # First "class super = ..." declaration found, else NULL.
syntax_errors = REF 0;
fun do_package_expression_bool ((package_expression, bool), source_code_region)
=
do_package_expression (package_expression, source_code_region)
also
fun do_package_expression_bools (pb ! more, source_code_region)
=>
{ do_package_expression_bool (pb, source_code_region);
do_package_expression_bools (more, source_code_region);
};
do_package_expression_bools ([], _)
=>
();
end
also
fun do_package_expression (package_expression, source_code_region)
=
case package_expression
PACKAGE_DEFINITION declaration
=>
do_declaration (declaration, source_code_region);
CALL_OF_GENERIC (path, package_expression_bool_list)
=>
do_package_expression_bools (package_expression_bool_list, source_code_region);
INTERNAL_CALL_OF_GENERIC (path, package_expression_bool_list)
=>
do_package_expression_bools (package_expression_bool_list, source_code_region);
LET_IN_PACKAGE (declaration, package_expression)
=>
{ do_declaration (declaration, source_code_region);
do_package_expression (package_expression, source_code_region);
};
PACKAGE_CAST ( package_expression, api_expression)
=>
do_package_expression (package_expression, source_code_region);
SOURCE_CODE_REGION_FOR_PACKAGE( package_expression, region)
=>
do_package_expression (package_expression, source_code_region);
PACKAGE_BY_NAME path
=>
();
esac
also
fun do_package_expressions ([], _)
=>
();
do_package_expressions (package_expression ! package_expressions, source_code_region)
=>
{ do_package_expression (package_expression, source_code_region);
do_package_expressions (package_expressions, source_code_region);
};
end
also
fun do_named_package (me as NAMED_PACKAGE { name_symbol, definition, constraint, kind }, source_code_region)
=>
{
# Special processing for 'class super = ... ' statments:
#
if (symbol::name name_symbol == "super")
# If this is the first 'super' declaration, note it,
# otherwise issue a duplicate-superclasses error:
#
if (*null_or_superclass == NULL)
# Require that the superclass be specified by name.
# (We may be able to relax this requirement;
# there is no fundamental reason for it.)
#
check_definition (definition, source_code_region)
where
fun check_definition (raw::SOURCE_CODE_REGION_FOR_PACKAGE( definition, source_code_region), _)
=>
check_definition (definition, source_code_region);
check_definition (raw::PACKAGE_BY_NAME path, source_code_region)
=>
{
# Require that the superclass exist.
# Checking this here allows the
# expand-oop-syntax.pkg logic to plow
# ahead without worrying about it:
#
case (eos::path_to_package (symbolmapstack, path))
#
THE pkg
=>
# Require that the superclass export
# type 'Myself' as a quick, approximate
# test for it being a valid class:
#
if (eos::package_defines_type (path, symbol::make_type_symbol "Myself", symbolmapstack))
#
null_or_superclass := THE me;
else
error_fn
source_code_region
err::ERROR
(sprintf "Not a valid superclass: ``%s''. (Does not define 'Myself'.)" (eos::path_to_string path))
err::null_error_body;
fi;
NULL => error_fn
source_code_region
err::ERROR
(sprintf "Cannot find superclass ``%s''" (eos::path_to_string path))
err::null_error_body;
esac;
};
check_definition _
=>
{ error_fn
source_code_region
err::ERROR
"Superclass must be specified by name in ``class super = ... ;'' statement."
err::null_error_body;
syntax_errors := *syntax_errors + 1;
};
end; # fun check_definition
end; # where
else
error_fn
source_code_region
err::ERROR
"Only one superclass definition (``class super = ... ;'') per class supported."
err::null_error_body;
syntax_errors := *syntax_errors + 1;
fi;
fi;
do_package_expression (definition, source_code_region);
};
do_named_package (SOURCE_CODE_REGION_FOR_NAMED_PACKAGE (named_package, source_code_region), _)
=>
do_named_package (named_package, source_code_region);
end
also
fun do_named_packages ([], _)
=>
();
do_named_packages (named_package ! named_packages, source_code_region)
=>
{ do_named_package (named_package, source_code_region);
do_named_packages (named_packages, source_code_region);
};
end
also
fun do_generic_expression (generic_expression as GENERIC_BY_NAME _, source_code_region)
=>
();
do_generic_expression (LET_IN_GENERIC (declaration, generic_expression), source_code_region)
=>
{ do_declaration (declaration, source_code_region);
do_generic_expression (generic_expression, source_code_region);
};
do_generic_expression (GENERIC_DEFINITION { parameters, body => package_expression, constraint }, source_code_region)
=>
do_package_expression (package_expression, source_code_region);
do_generic_expression (CONSTRAINED_CALL_OF_GENERIC ( path, package_expression_bools, api_constraint ), source_code_region)
=>
do_package_expression_bools (package_expression_bools, source_code_region);
do_generic_expression (SOURCE_CODE_REGION_FOR_GENERIC (generic_expression, source_code_region), _)
=>
do_generic_expression (generic_expression, source_code_region);
end
also
fun do_named_generics ([], _)
=>
();
do_named_generics (named_generic ! named_generics, source_code_region)
=>
{ do_named_generic (named_generic, source_code_region);
do_named_generics (named_generics, source_code_region);
}
where
fun do_named_generic (NAMED_GENERIC { name_symbol, definition => generic_expression }, source_code_region)
=>
do_generic_expression (generic_expression, source_code_region);
do_named_generic (SOURCE_CODE_REGION_FOR_NAMED_GENERIC (named_generic, source_code_region), _)
=>
do_named_generic (named_generic, source_code_region);
end;
end;
end
also
fun do_named_functions ([], _)
=>
();
do_named_functions (named_function ! rest, source_code_region)
=>
{ do_named_function (named_function, source_code_region);
do_named_functions (rest, source_code_region);
}
where
fun do_named_function (f as (NAMED_FUNCTION { pattern_clauses, is_lazy, kind, null_or_type }), source_code_region)
=>
{
# We return NULL to tell caller to remove function from syntax tree,
# THE f to tell it to leave it in place:
#
case (kind, null_or_type)
#
(MESSAGE_FUN, THE type) => { methods_and_messages := f ! *methods_and_messages; syntax_errors := validate_message_type (type, symbolmapstack, source_code_region, per_compile_stuff, *syntax_errors); };
(METHOD_FUN, NULL ) => { methods_and_messages := f ! *methods_and_messages; };
(PLAIN_FUN, NULL ) => ();
(MESSAGE_FUN, NULL ) => raise exception DIE "expand-oop-syntax.pkg: unexpected MESSAGE_FUN,NULL combination -- -- src/lib/compiler/front/typer/main/oop-collect-methods-and-fields.pkg\n";
(METHOD_FUN, THE type) => raise exception DIE "expand-oop-syntax.pkg: unexpected METHOD_FUN, THE type combination -- -- src/lib/compiler/front/typer/main/oop-collect-methods-and-fields.pkg\n";
(PLAIN_FUN, THE type) => raise exception DIE "expand-oop-syntax.pkg: unexpected PLAIN_FUN, THE type combination -- -- src/lib/compiler/front/typer/main/oop-collect-methods-and-fields.pkg\n";
esac;
};
do_named_function (SOURCE_CODE_REGION_FOR_NAMED_FUNCTION (named_function, source_code_region), _)
=>
do_named_function (named_function, source_code_region);
end;
end;
end
also
fun do_named_fields ([], _)
=>
();
do_named_fields (named_field ! named_fields, source_code_region)
=>
{ do_named_field (named_field, source_code_region);
do_named_fields (named_fields, source_code_region);
}
where
fun do_named_field (f as NAMED_FIELD { name, type, init }, _)
=>
fields := (f ! *fields);
do_named_field (SOURCE_CODE_REGION_FOR_NAMED_FIELD (named_field, source_code_region), _)
=>
do_named_field (named_field, source_code_region); # Yes, region arg never gets used here. Just being consistent.
end;
end;
end
also
fun do_declaration (declaration, source_code_region)
=
case declaration
#
VALUE_DECLARATIONS (named_values, typevars) => ();
EXCEPTION_DECLARATIONS named_exceptions => ();
TYPE_DECLARATIONS named_types => ();
API_DECLARATIONS named_apis => ();
GENERIC_API_DECLARATIONS named_generic_apis => ();
INCLUDE_DECLARATIONS paths => ();
OVERLOADED_VARIABLE_DECLARATION _ => ();
FIXITY_DECLARATIONS { fixity, ops } => ();
NADA_FUNCTION_DECLARATIONS (nada_named_functions, typevars) => ();
RECURSIVE_VALUE_DECLARATIONS (named_recursive_values, typevars) => ();
SUMTYPE_DECLARATIONS { sumtypes, with_types } => ();
FIELD_DECLARATIONS (named_fields, typevars) => do_named_fields (named_fields, source_code_region);
PACKAGE_DECLARATIONS named_packages => do_named_packages (named_packages, source_code_region);
GENERIC_DECLARATIONS named_generics => do_named_generics (named_generics, source_code_region);
SEQUENTIAL_DECLARATIONS declarations => do_declarations (declarations, source_code_region);
LOCAL_DECLARATIONS (declaration, declaration')
=>
{
do_declaration (declaration, source_code_region);
do_declaration (declaration', source_code_region);
};
FUNCTION_DECLARATIONS
( named_functions,
typevars # This will nowadays always be NIL; used to be support for start-of-declaration type variables.
)
=>
do_named_functions (named_functions, source_code_region);
SOURCE_CODE_REGION_FOR_DECLARATION (declaration', source_code_region)
=>
do_declaration (declaration', source_code_region);
PRE_COMPILE_CODE string
=>
error_fn
source_code_region
err::ERROR
"Bug (PRE_COMPILE_CODE) -- src/lib/compiler/front/typer/main/oop-collect-methods-and-fields.pkg"
err::null_error_body;
esac
also
fun do_declarations ([], _)
=>
();
do_declarations (declaration ! rest, source_code_region)
=>
{ do_declaration (declaration, source_code_region);
do_declarations (rest, source_code_region);
};
end;
do_declaration (declaration, source_code_region);
{ fields => reverse *fields,
methods_and_messages => reverse *methods_and_messages,
null_or_superclass => *null_or_superclass,
syntax_errors => *syntax_errors
};
};
};
end;
## Code by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.