PreviousUpNext

15.4.303  src/lib/compiler/back/low/main/nextcode/nextcode-function-stack-g.pkg

## nextcode-function-stack-g.pkg --- code and data fragments that need to be compiled.
#
# Decompose a compilation unit into clusters:
#
# This package is used (only) in:
#
#     src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg

# Compiled by:
#     src/lib/compiler/core.sublib



###                 "I remember one occasion when I tried to add a little
###                  seasoning to a review, but I wasn't allowed to.
###                  The paper was by Dorothy Maharam, and it was a
###                  perfectly sound contribution to abstract measure theory.
###                  The domains of the underlying measures were not sets but
###                  elements of more general Boolean algebras, and their range
###                  consisted not of positive numbers but of certain abstract
###                  equivalence classes. My proposed first sentence was:
###
###                    "The author discusses valueless measures in pointless spaces."
###
###                     In: I want to be a Mathematician, Washington: MAA Spectrum, 1985, p. 120.




stipulate
    package ncf =  nextcode_form;                                               # nextcode_form                 is from   src/lib/compiler/back/top/nextcode/nextcode-form.pkg
    package lbl =  codelabel;                                                   # codelabel                     is from   src/lib/compiler/back/low/code/codelabel.pkg
herein

    # This generic is invoked (only) from:
    #
    #     src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg
    #
    generic package   nextcode_function_stack_g   (
        #             =========================
        #
        tcf:    Treecode_Form                                                   # Treecode_Form                 is from   src/lib/compiler/back/low/treecode/treecode-form.api
    )
    : (weak)  Nextcode_Function_Stack                                           # Nextcode_Function_Stack       is from   src/lib/compiler/back/low/main/nextcode/nextcode-function-stack.api
    {
        # Export to client packages:
        #
        package tcf =  tcf;                                                     # "tcf" == "treecode_form".

        # This is state used in
        #
        #     src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg
        #
        # to distinguish between functions still in nextcode form
        # and functions which have been converted to treecode form:
        #
        Function_Form
          #
          = FN_PARAMETERS_IN_TREECODE_FORM  List( tcf::Expression )
          #
          | FN_IN_NEXTCODE_FORM
              ( ncf::Codetemp,                                                  # Function id.
                List( ncf::Codetemp ),                                          # Function formal args.
                List( ncf::Type ),                                              # Types of function formal args.
                ncf::Instruction                                                # Function body.
              )
          ;

        Callers_Info
          #
          = PRIVATE_FN                              Ref( Function_Form )
          | PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK  Ref( Function_Form )
          #
          | PUBLIC_FN { fn:                 Ref(  Null_Or(  ncf::Function ) ), 
                        parameter_types:    List( ncf::Type )                   # 
                      }
          ;

        fun error msg
            =
            error_message::impossible ("Function." + msg);

        functions = REF ([]: List( (lbl::Codelabel, Callers_Info) ) );          # XXX BUGGO FIXME Icky thread-hostile mutable global variable.

        fun pop_function ()
            = 
            case *functions
                #
                function ! rest =>  THE function then (functions := rest);
                []              =>  NULL;
            esac;

        fun push_function  lf
            =
            functions :=  lf ! *functions;

        # Make compilation functions for this cluster.
        # Note the icky side-effects:
        #
        fun push_nextcode_function (arg as (callers_info, fun_id, fun_parameters, parameter_types, fun_body), codelabel)
            =
            function
            where
                function = case callers_info
                               #        
                              (ncf::PUBLIC_FN | ncf::FATE_FN)               =>  PUBLIC_FN { fn=>REF (THE arg), parameter_types };
                               #        
                               ncf::PRIVATE_FN                              =>  PRIVATE_FN                             (REF (FN_IN_NEXTCODE_FORM (fun_id, fun_parameters, parameter_types, fun_body)));
                               ncf::PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK  =>  PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK (REF (FN_IN_NEXTCODE_FORM (fun_id, fun_parameters, parameter_types, fun_body)));
                               #        
                               _                                            =>  error "make_fragments";
                           esac;

                functions :=  (codelabel, function) ! *functions;
            end;

    };                  # nextcode_function_stack_g 
end;


## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext