PreviousUpNext

15.4.639  src/lib/compiler/front/typer/main/oop-collect-methods-and-fields.pkg

## 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 fast_symbol;                                        # fast_symbol                           is from   src/lib/compiler/front/basics/map/fast-symbol.pkg
    include raw_syntax;                                         # raw_syntax                            is from   src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg
    include raw_syntax_junk;                                    # raw_syntax_junk                       is from   src/lib/compiler/front/parser/raw-syntax/raw-syntax-junk.pkg
herein

    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_info as
                {
                  error_fn,
                  ...
                }:                      typer_junk::Per_Compile_Info
            )
            =
            {   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_typ (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_info, *syntax_errors); };
                                            (METHOD_FUN,  NULL    ) =>  { methods_and_messages :=   f ! *methods_and_messages; };
                                            (PLAIN_FUN,   NULL    ) =>  ();
                                            (MESSAGE_FUN, NULL    ) =>   raise exception FAIL "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 FAIL "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 FAIL "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, type_variables)                        => ();
                        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,   type_variables)    => ();
                        RECURSIVE_VALUE_DECLARATIONS (named_recursive_values, type_variables)    => ();
                        ENUM_DECLARATIONS { datatyps, with_typs }      => ();
                        ABSTRACT_TYPE_DECLARATIONS  { abstract_typs,
                                                      with_typs,
                                                      body
                                                    }                                            => ();

                        FIELD_DECLARATIONS (named_fields, type_variables)   =>  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,
                              type_variables                            # 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-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext