PreviousUpNext

15.4.47  src/app/makelib/compilable/raw-syntax-to-module-dependencies-summary.pkg

## Convert RAW_SYNTAX_TREEs to makelib's trimmed version thereof ("module_dependencies_summarys").

# Compiled by:
#     src/app/makelib/makelib.sublib

#   The ideas here are based on those found in the original SC and
#   also in an older version of makelib (before 1999).  However, nearly
#   all aspects have been changed radically, and the code has been
#   re-written from scratch.
#
#   The module_dependencies_summarys generated by this module are typically smaller
#   than the "decl"s in SC or old versions of makelib.  This should
#   make dependency analysis somewhat faster (but is probably not
#   very noticeable).

stipulate
    package err =  error_message;                                                                       # error_message                                 is from   src/lib/compiler/front/basics/errormsg/error-message.pkg
    package raw =  raw_syntax;                                                                          # raw_syntax                                    is from   src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg
    package sy  =  symbol;                                                                              # symbol                                        is from   src/lib/compiler/front/basics/map/symbol.pkg
    package syp =  symbol_path;                                                                         # symbol_path                                   is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
    package sys =  symbol_set;                                                                          # symbol_set                                    is from   src/app/makelib/stuff/symbol-set.pkg
herein

    package   raw_syntax_to_module_dependencies_summary
    :         Raw_Syntax_To_Module_Dependencies_Summary                                                 # Raw_Syntax_To_Module_Dependencies_Summary     is from   src/app/makelib/compilable/raw-syntax-to-module-dependencies-summary.api
    {
#       include package   raw_syntax;
        include package   module_dependencies_summary;


        Symbol =  sy::Symbol;
        Path   =  List( Symbol );

        # The main idea is to collect lists of decl ("dl"s).
        # Normally, a dl will eventually become an argument to seq or par.
        # As an important optimization, we always try to keep any "Ref s"
        # at the front (but we don't try too hard and only do it where
        # it is reasonably convenient).

        # Function composition suitable for fold[lr]-arguments 
        #
        infix my  o' ;
        #
        fun (f o' g) (x, y)
            =
            f (g x, y);

        #  Add the head of a symbol path to a given set: 
        #
        fun s_add_p ([], set)
                =>
                set;

            s_add_p (head ! _, set)
                =>
                sys::add (set, head);
        end;

        # Same as s_addP except we ignore paths of length 1
        # because they do not involve module access:
        #
        fun s_add_mp ([],       set) =>   set;                  #  Can this happen at all?  XXX BUGGO FIXME
            s_add_mp ([only],   set) =>   set;                  #  no module name here 
            s_add_mp (head ! _, set) =>   sys::add (set, head);
        end;

        #  Add a reference to a symbol to a dl: 
        #
        fun dl_add_sym (symbol, [])         =>   [REF (sys::singleton symbol)];
            dl_add_sym (symbol, REF s ! dl) =>    REF (sys::add   (s, symbol)) ! dl;
            dl_add_sym (symbol, dl)         =>    REF (sys::singleton symbol)  ! dl;
        end;

        #  Add the first element of a path to a dl: 
        #
        fun dl_add_p ([], d)
                =>
                d;

            dl_add_p (head ! _, d)
                =>
                dl_add_sym (head, d);
        end;

        # Add the first element of a path to a dl
        # -- except if that element is the only
        # one on the path:

        fun dl_add_mp ([],       dl) =>  dl;
            dl_add_mp ([only],   dl) =>  dl;
            dl_add_mp (head ! _, dl) =>  dl_add_sym (head, dl);
        end;

        # Given a set of module references, add it to a decl list: 
        #
        fun dl_add_s (s, dl)
            =
            if (sys::is_empty s)
                #
                dl;
            else
                case dl
                    #
                    []           =>  [REF s];
                    REF s' ! dl' =>   REF (sys::union (s, s')) ! dl';
                    _            =>   REF s ! dl;
                esac;
            fi;

        #  Make a SEQ node when necessary: 
        #
        fun seq []     =>   REF sys::empty;
            seq [only] =>   only;
            seq l      =>   SEQ l;
        end;

        #  Make a PAR node when necessary and stick it in front of a given dl: 

        fun parcons ([], d)     =>   d;
            parcons ([only], d) =>   only ! d;
            parcons (l, d)      =>   PAR l ! d;
        end;

        # Given a "bind list", stick a parallel BIND in front of a given dl.
        # While doing so, if a REF occured at the front of the dl, move it
        # past the bind list (shrinking it appropriately).

        fun parbindcons (bl, REF s ! d)
                =>
                {   bs =   sys::add_list (sys::empty, map #1 bl);

                    dl_add_s (sys::difference (s, bs), parcons (map BIND bl, d));
                };

           parbindcons (bl, d)
               =>
               parcons (map BIND bl, d);
        end;

        #  Split initial ref set from a decl list: 

        fun split_dl []          =>   (sys::empty, []);
            split_dl (REF s ! d) =>   (s, d);
            split_dl d           =>   (sys::empty, d);
        end;

        #  Join two definition sequences: 

        fun join_dl ([],      d) =>   d;
            join_dl ([REF s], d) =>   dl_add_s (s, d);
            join_dl (h ! t, d) =>   h ! join_dl (t, d);
        end;

        #  Local definitions: 

        fun local_dl ([],        b, d) =>   join_dl (b, d);
            local_dl (REF s ! t, b, d) =>   dl_add_s (s, local_dl (t, b, d));
            local_dl (l,         b, d) =>   LOCAL (seq l, seq b) ! d;
        end;

        #  Build a 'let' expression: 

        fun letexp (dl, (s, e))
            =
            case (split_dl dl)
                #
                (s', [])
                    =>
                    (sys::union (s', s), e);
                #
                (s', dl')
                    =>
                    {   dl'' =   if (sys::is_empty s)   dl';
                                 else                   reverse (dl_add_s (s, reverse dl'));
                                 fi;

                       (s', LET (dl'', e));
                    };
            esac;

        # Make an IGN1 if necessary:
        #
        fun ign (      p1,         NULL) =>   p1;
            ign ((s1, e1), THE (s2, e2)) =>   (sys::union (s1, s2), IGN1 (e1, e2));
        end;

        # Open cancels Decl: 
        #
        fun use (DECL dl, dl') =>  join_dl (dl, dl');
            use (e, dl)        =>  OPEN e ! dl;
        end;

        # Generate a set of "parallel" namings 
        #
        fun parbind f l d
            =
            {   my (s, bl) =   fold_forward f (sys::empty, []) l;

                dl_add_s (s, parbindcons (bl, d));
            };

        # Get the ref set from a type: 
        #
        fun ty_s (raw::TYPEVAR_TYPE _, set)                 =>   set;
            ty_s (raw::TYPE_TYPE (cn, l), set)                    =>   s_add_mp (cn, fold_forward ty_s set l);
            #
            ty_s (raw::RECORD_TYPE l, set)                        =>   fold_forward (ty_s o' #2) set l;
            ty_s (raw::TUPLE_TYPE  l, set)                        =>   fold_forward ty_s set l;
            #
            ty_s (raw::SOURCE_CODE_REGION_FOR_TYPE (arg, _), set) =>   ty_s (arg, set);
        end;

        # Get the ref set from a type option:
        #
        fun tyopt_s (NULL,  set) =>   set;
            tyopt_s (THE t, set) =>   ty_s (t, set);
        end;

        # Get the ref set from a pattern:
        #
        fun pat_s (raw::VARIABLE_IN_PATTERN p, set)
                =>
                s_add_mp (p, set);

            pat_s (raw::RECORD_PATTERN { definition, ... }, set)
                =>
                fold_forward (pat_s o' #2) set definition;

            pat_s (   ( raw::LIST_PATTERN   l
                      | raw::TUPLE_PATTERN  l
                      | raw::VECTOR_PATTERN l
                      | raw::OR_PATTERN     l
                      ),

                      set
                  )
                =>
                fold_forward pat_s set l;

            pat_s (raw::PRE_FIXITY_PATTERN l, set)
                =>
                fold_forward (pat_s o' .item) set l;

            pat_s (raw::APPLY_PATTERN { constructor, argument }, set)
                =>
                pat_s (constructor, pat_s (argument, set));

            pat_s (raw::TYPE_CONSTRAINT_PATTERN { pattern, type_constraint }, set)
                =>
                pat_s (pattern, ty_s (type_constraint, set));

            pat_s (raw::AS_PATTERN { variable_pattern, expression_pattern }, set)
                =>
                pat_s (variable_pattern, pat_s (expression_pattern, set));

            pat_s (raw::SOURCE_CODE_REGION_FOR_PATTERN (arg, _), set)
                =>
                pat_s (arg, set);

            pat_s ((               raw::WILDCARD_PATTERN
                    |       raw::INT_CONSTANT_IN_PATTERN _
                    |       raw::UNT_CONSTANT_IN_PATTERN _
                    |    raw::STRING_CONSTANT_IN_PATTERN _
                    | raw::CHAR_CONSTANT_IN_PATTERN _
                    ), set)
                =>
                set;
        end;

        # Get the ref set from an exception naming: 

        fun eb_s (raw::NAMED_EXCEPTION           { exception_symbol=>exn, exception_type=>etype }, set) =>   tyopt_s (etype, set);
            eb_s (raw::DUPLICATE_NAMED_EXCEPTION { exception_symbol=>exn, equal_to=>edef  },       set) =>   s_add_mp (edef, set);
            eb_s (raw::SOURCE_CODE_REGION_FOR_NAMED_EXCEPTION (arg, _),                            set) =>   eb_s (arg, set);
        end;

        #  ... 
        fun dbrhs_s (raw::VALCONS l, set)
                =>
                fold_forward (tyopt_s o' #2) set l;

            dbrhs_s (raw::REPLICAS cn, set)
                =>
                s_add_mp (cn, set);
        end;

        fun db_s (raw::SUM_TYPE { right_hand_side, ... }, set)
                =>
                dbrhs_s (right_hand_side, set);

            db_s (raw::SOURCE_CODE_REGION_FOR_UNION_TYPE (arg, _), set)
                =>
                db_s (arg, set);
        end;

        fun tb_s (raw::NAMED_TYPE { definition, ... }, set)
                =>
                ty_s (definition, set);

            tb_s (raw::SOURCE_CODE_REGION_FOR_NAMED_TYPE (arg, _), set)
                =>
                tb_s (arg, set);
        end;

        # Get a dl from an expression: 
        #
        fun exp_dl (raw::VARIABLE_IN_EXPRESSION p, d)
                =>
                dl_add_mp (p, d);

            exp_dl (raw::IMPLICIT_THUNK_PARAMETER p, d)         # These should have been expanded to VARIABLE_IN_EXPRESSION by now.
                =>
                raise exception DIE "Are you using #foo outside of {. ... } ?";

            exp_dl (raw::FN_EXPRESSION rl, d)
                =>
                fold_backward rule_dl d rl;

            exp_dl (raw::PRE_FIXITY_EXPRESSION l, d)
                =>
                fold_backward (exp_dl o' .item) d l;

            exp_dl (raw::APPLY_EXPRESSION { function, argument }, d)
                =>
                exp_dl (function, exp_dl (argument, d));

            exp_dl (raw::OBJECT_FIELD_EXPRESSION { object, field }, d)
                =>
                exp_dl (object, d);

            exp_dl (raw::CASE_EXPRESSION { expression, rules }, d)
                =>
                exp_dl (expression, fold_backward rule_dl d rules);

            exp_dl (raw::LET_EXPRESSION { declaration, expression }, d)
                =>
                local_dl (dec_dl (declaration, []), exp_dl (expression, []), d);

            exp_dl ( ( raw::SEQUENCE_EXPRESSION   l
                     | raw::LIST_EXPRESSION       l
                     | raw::TUPLE_EXPRESSION      l
                     | raw::VECTOR_IN_EXPRESSION  l
                     ),

                     d
                   )
                =>
                fold_forward exp_dl d l;

            exp_dl (raw::RECORD_IN_EXPRESSION l, d)
                =>
                fold_forward (exp_dl o' #2) d l;

            exp_dl (raw::RECORD_SELECTOR_EXPRESSION _, d)
                =>
                d;

            exp_dl (raw::TYPE_CONSTRAINT_EXPRESSION { expression, constraint }, d)
                =>
                dl_add_s (ty_s (constraint, sys::empty), exp_dl (expression, d));

            exp_dl (raw::EXCEPT_EXPRESSION { expression, rules }, d)
                =>
                exp_dl (expression, fold_forward rule_dl d rules);

            exp_dl (raw::RAISE_EXPRESSION e, d)
                =>
                exp_dl (e, d);

            exp_dl (raw::IF_EXPRESSION { test_case, then_case, else_case }, d)
                =>
                exp_dl (test_case, exp_dl (then_case, exp_dl (else_case, d)));

            exp_dl ( ( raw::AND_EXPRESSION (e1, e2)
                     | raw::OR_EXPRESSION  (e1, e2)
                     ),

                     d
                   )
                =>
                exp_dl (e1, exp_dl (e2, d));

            exp_dl (raw::WHILE_EXPRESSION { test, expression }, d)
                =>
                exp_dl (test, exp_dl (expression, d));

            exp_dl (raw::SOURCE_CODE_REGION_FOR_EXPRESSION (arg, _), d)
                =>
                exp_dl (arg, d);

            exp_dl ( (    raw::INT_CONSTANT_IN_EXPRESSION _
                     |    raw::UNT_CONSTANT_IN_EXPRESSION _
                     |  raw::FLOAT_CONSTANT_IN_EXPRESSION _
                     | raw::STRING_CONSTANT_IN_EXPRESSION _
                     |   raw::CHAR_CONSTANT_IN_EXPRESSION _
                     ),

                     d
                   )
                =>
                d;
        end 

        also
        fun rule_dl (raw::CASE_RULE { pattern, expression }, d)
            =
            dl_add_s (pat_s (pattern, sys::empty), exp_dl (expression, d))

        also
        fun pattern_clause_dl (raw::PATTERN_CLAUSE { patterns => p, result_type => t, expression => e }, d)
            =
            dl_add_s (fold_forward (pat_s o' .item) (tyopt_s (t, sys::empty)) p,
                    exp_dl (e, d))

        also
        fun named_function_dl (raw::NAMED_FUNCTION { pattern_clauses, is_lazy, kind, null_or_type }, d)
                =>
                case null_or_type
                    #   
                    THE type => dl_add_s (ty_s (type, sys::empty), fold_backward pattern_clause_dl d pattern_clauses);
                    NULL     =>                                    fold_backward pattern_clause_dl d pattern_clauses ; 
                esac; 

            named_function_dl (raw::SOURCE_CODE_REGION_FOR_NAMED_FUNCTION (arg, _), d)
                =>
                named_function_dl (arg, d);
        end 

        also
        fun lib7_pattern_clause_dl (raw::NADA_PATTERN_CLAUSE { pattern => p, result_type => t, expression => e }, d)
            =
            dl_add_s (   fold_forward
                            pat_s (tyopt_s (t, sys::empty)) [p],  #  XXX BUGGO FIXME Since [p] is (obviously!) always a length-1 list, the logic can probably be simplified here. 
                            exp_dl (e, d)
                    )

        also
        fun lib7_named_function_dl (raw::NADA_NAMED_FUNCTION (l, _), d)
                =>
                fold_backward lib7_pattern_clause_dl d l;

            lib7_named_function_dl (raw::SOURCE_CODE_REGION_FOR_NADA_NAMED_FUNCTION (arg, _), d)
                =>
                lib7_named_function_dl (arg, d);
        end 

        also
        fun vb_dl (raw::NAMED_VALUE { pattern, expression, is_lazy }, d)
                =>
                dl_add_s (pat_s (pattern, sys::empty), exp_dl (expression, d));

            vb_dl (raw::SOURCE_CODE_REGION_FOR_NAMED_VALUE (arg, _), d)
                =>
                vb_dl (arg, d);
        end 

        also
        fun field_dl (raw::NAMED_FIELD symbol, d)
                =>
                d;      # 2009-02-23 CrT: Quick hack so it will compile.  Might even be correct.

            field_dl (raw::SOURCE_CODE_REGION_FOR_NAMED_FIELD (arg, _), d)
                =>
                field_dl (arg, d);
        end 

        also
        fun rvb_dl (raw::NAMED_RECURSIVE_VALUE { variable_symbol, expression, null_or_type, ... }, d)
                =>
                dl_add_s (tyopt_s (null_or_type, sys::empty), exp_dl (expression, d));

            rvb_dl (raw::SOURCE_CODE_REGION_FOR_RECURSIVELY_NAMED_VALUE (arg, _), d)
                =>
                rvb_dl (arg, d);
        end 

        also
        fun spec_dl (raw::SOURCE_CODE_REGION_FOR_API_ELEMENT (arg, _), d)
                =>
                spec_dl (arg, d);

            spec_dl (raw::PACKAGES_IN_API l, d)
                =>
                {   #  strange case - optional: package, mandatory: api 
                    fun one ((n, g, c), (s, bl))
                        =
                        {   my (s', e) =   sigexp_p g;

                            s'' =   sys::union (s, s');

                            case c  NULL  =>  (s'', (n, e) ! bl);
                                    THE p =>  (s'', (n, IGN1 (VARIABLE (syp::SYMBOL_PATH p), e)) ! bl);
                            esac;
                        };

                    my (s, bl)
                        =
                        fold_backward one (sys::empty, []) l;

                    dl_add_s (s, parbindcons (bl, d));
                };

            spec_dl (raw::TYPES_IN_API (l, _), d)
                =>
                dl_add_s (fold_forward one_s sys::empty l, d)
                where
                    fun one_s ((_, _, THE t), s)  =>   ty_s (t, s);
                        one_s (_,             s)  =>            s;
                    end;
                end;

            spec_dl (raw::GENERICS_IN_API l, d)
                =>
                {   fun one ((n, g), (s, bl))
                        =
                        {   my (s', e) =   generic_api_expression_p g;

                            (sys::union (s, s'), (n, e) ! bl);
                        };

                    my (s, bl) =   fold_backward one (sys::empty, []) l;

                    dl_add_s (s, parbindcons (bl, d));
                };

            spec_dl (raw::VALUES_IN_API l, d)
                =>
                dl_add_s (fold_forward (ty_s o' #2) sys::empty l, d);

            spec_dl (raw::VALCONS_IN_API { sumtypes, with_types }, d)
                =>
                dl_add_s (fold_forward db_s (fold_forward tb_s sys::empty with_types) sumtypes, d);

            spec_dl (raw::EXCEPTIONS_IN_API      l, d)
                =>
                dl_add_s (fold_forward (tyopt_s o' #2) sys::empty l, d);

            spec_dl (raw::PACKAGE_SHARING_IN_API l, d)
                =>
                fold_forward dl_add_p d l;

            spec_dl (raw::TYPE_SHARING_IN_API    l, d)
                =>
                dl_add_s (fold_forward s_add_mp sys::empty l, d);

            spec_dl (raw::IMPORT_IN_API g, d)
                =>
                {   my (s, e) =   sigexp_p g;
                    #
                    dl_add_s (s, use (e, d));
                };
        end 

        also
        fun sigexp_p (raw::API_BY_NAME s)
                =>
                (sys::empty, VARIABLE (syp::SYMBOL_PATH [s]));

            sigexp_p (raw::API_WITH_WHERE_SPECS (g, whspecs))
                =>
                {   fun one_s (raw::WHERE_TYPE (_, _, type), s)  =>  ty_s (type, s);
                        one_s (raw::WHERE_PACKAGE (_, p), s)       =>  s_add_p (p, s);
                    end;

                    (sigexp_p  g) ->   (s, e);

                    (fold_forward one_s s whspecs, e);
                };

            sigexp_p (raw::API_DEFINITION  l)
                =>
                {   (split_dl (fold_backward spec_dl [] l))
                        ->
                        (s, d);

                    (s, DECL d);
                };

            sigexp_p (raw::SOURCE_CODE_REGION_FOR_API (arg, _))
                =>
                sigexp_p arg;
       end 

       also
       fun generic_api_expression_p (raw::GENERIC_API_BY_NAME s)
                =>
                (sys::empty, VARIABLE (syp::SYMBOL_PATH [s]));

            generic_api_expression_p (raw::GENERIC_API_DEFINITION { parameter, result } )
                =>
                letexp (fold_backward fparam_d [] parameter, sigexp_p result);

            generic_api_expression_p (raw::SOURCE_CODE_REGION_FOR_GENERIC_API (arg, _))
                =>
                generic_api_expression_p arg;
        end 

        also
        fun fparam_d ((nopt, g), d)
            =
            {   my (s, e) =   sigexp_p g;

                case nopt
                    #
                    NULL  =>  dl_add_s (s, use (e, d));
                    THE n =>  dl_add_s (s, BIND (n, e) ! d);
                esac;
            }

        also
        fun sigexpc_p  raw::NO_PACKAGE_CAST
                =>
                NULL;

            sigexpc_p (    raw::WEAK_PACKAGE_CAST g
                      | raw::PARTIAL_PACKAGE_CAST g
                      |  raw::STRONG_PACKAGE_CAST g
                      )
                =>
                THE (sigexp_p g);
        end 

        also
        fun generic_api_expressionc_p  raw::NO_PACKAGE_CAST
                =>
                NULL;

            generic_api_expressionc_p (     raw::WEAK_PACKAGE_CAST fg
                                      |  raw::PARTIAL_PACKAGE_CAST fg
                                      |   raw::STRONG_PACKAGE_CAST fg
                                      )
                =>
                THE (generic_api_expression_p fg);
        end 

        also
        fun fctexp_p (raw::GENERIC_BY_NAME (p, c))
                =>
                ign ((sys::empty, VARIABLE (syp::SYMBOL_PATH p)), generic_api_expressionc_p c);

            fctexp_p (raw::GENERIC_DEFINITION { parameters, body, constraint } )
                =>
                letexp (fold_backward fparam_d [] parameters,
                        ign (pkgexp_p body, sigexpc_p constraint));

            fctexp_p (raw::CONSTRAINED_CALL_OF_GENERIC (p, l, c))
                =>
                {   fun one ((str, _), (s, el))
                        =
                        {   my (s', e) =   pkgexp_p str;
                            #
                            (sys::union (s, s'), e ! el);
                        };

                    my  (s, el)
                        =
                        fold_forward one (sys::empty, []) l;

                    my  (s', e)
                        =
                        ign ((sys::empty, VARIABLE (syp::SYMBOL_PATH p)), generic_api_expressionc_p c);

                    (sys::union (s, s'), fold_forward IGN1 e el);
                };

            fctexp_p (raw::LET_IN_GENERIC  (bdg, b))
                =>
                letexp (dec_dl (bdg, []), fctexp_p b);

            fctexp_p (raw::SOURCE_CODE_REGION_FOR_GENERIC (arg, _))
                =>
                fctexp_p arg;
        end 

        also
        fun pkgexp_p (raw::PACKAGE_BY_NAME p)
                =>
                (sys::empty, VARIABLE (syp::SYMBOL_PATH p));

            pkgexp_p (raw::PACKAGE_DEFINITION declaration)
                =>
                {   my  (s, dl)
                        =
                        split_dl (dec_dl (declaration, []));

                    (s, DECL dl);
                };

            pkgexp_p (raw::PACKAGE_CAST (s, c))
                =>
                ign (pkgexp_p s, sigexpc_p c);

            pkgexp_p ( raw::CALL_OF_GENERIC (p, l)
                     | raw::INTERNAL_CALL_OF_GENERIC (p, l)
                     )
                =>
                {   fun one ((str, _), (s, el))
                        =
                        {   my (s', e) =   pkgexp_p str;
                            #
                            (sys::union (s, s'),   e ! el);
                        };

                    my (s, el)   =   fold_forward one (sys::empty, []) l;

                    (s, fold_forward IGN1 (VARIABLE (syp::SYMBOL_PATH p)) el);
                };

            pkgexp_p (raw::LET_IN_PACKAGE (bdg, b))
                =>
                letexp (dec_dl (bdg, []), pkgexp_p b);

            pkgexp_p (raw::SOURCE_CODE_REGION_FOR_PACKAGE (s, _))
                =>
                pkgexp_p s;
        end 

        also
        fun dec_dl (raw::VALUE_DECLARATIONS             (l, _), d) =>  fold_forward  vb_dl                    d l;
            dec_dl (raw::FIELD_DECLARATIONS             (l, _), d) =>  fold_forward  field_dl                 d l;
            dec_dl (raw::RECURSIVE_VALUE_DECLARATIONS   (l, _), d) =>  fold_forward  rvb_dl                   d l;
            dec_dl (raw::FUNCTION_DECLARATIONS          (l, _), d) =>  fold_forward  named_function_dl        d l;
            dec_dl (raw::NADA_FUNCTION_DECLARATIONS     (l, _), d) =>  fold_forward  lib7_named_function_dl   d l;
            dec_dl (raw::TYPE_DECLARATIONS               l,     d) =>  dl_add_s  (fold_forward tb_s sys::empty l, d);

            dec_dl (raw::SUMTYPE_DECLARATIONS { sumtypes, with_types }, d)
                =>
                dl_add_s (fold_forward db_s (fold_forward tb_s sys::empty with_types) sumtypes, d);

            dec_dl (raw::EXCEPTION_DECLARATIONS l, d)
                =>
                dl_add_s (fold_forward eb_s sys::empty l, d);

            dec_dl (raw::PACKAGE_DECLARATIONS l, d)
                =>
                parbind one l d
                where
                    fun one (raw::SOURCE_CODE_REGION_FOR_NAMED_PACKAGE (arg, _), x)
                            =>
                            one (arg, x);

                        one (raw::NAMED_PACKAGE { name_symbol=>name, definition=>def, constraint, kind }, (s, bl))
                            =>
                            {   my (s', e) =   ign (pkgexp_p def, sigexpc_p constraint);

                                (sys::union (s, s'), (name, e) ! bl);
                            };
                    end;
                end;

            dec_dl (raw::GENERIC_DECLARATIONS l, d)
                =>
                {   fun one (raw::SOURCE_CODE_REGION_FOR_NAMED_GENERIC (arg, _), x)
                            =>
                            one (arg, x);

                        one (raw::NAMED_GENERIC { name_symbol=>name, definition=>def }, (s, bl))
                            =>
                            {   (fctexp_p  def)
                                    ->
                                    (s', e);

                                (sys::union (s, s'), (name, e) ! bl);
                            };
                    end;

                    parbind one l d;
                };

            dec_dl (raw::API_DECLARATIONS l, d)
                =>
                {   fun one (raw::SOURCE_CODE_REGION_FOR_NAMED_API (arg, _), x)
                            =>
                            one (arg, x);

                        one (raw::NAMED_API { name_symbol=>name, definition=>def }, (s, bl))
                            =>
                            {   (sigexp_p  def)
                                    ->
                                    (s', e);

                                (sys::union (s, s'), (name, e) ! bl);
                            };
                    end;

                    parbind one l d;
                };

            dec_dl (raw::GENERIC_API_DECLARATIONS l, d)
                =>
                {   fun one (raw::SOURCE_REGION_FOR_NAMED_GENERIC_API (arg, _), x)
                            =>
                            one (arg, x);

                        one (raw::NAMED_GENERIC_API { name_symbol=>name, definition=>def }, (s, bl))
                            =>
                            {   (generic_api_expression_p  def)
                                    ->
                                    (s', e);

                                (sys::union (s, s'), (name, e) ! bl);
                            };
                    end;

                    parbind one l d;
                };

            dec_dl (raw::LOCAL_DECLARATIONS (bdg, body), d)
                =>
                local_dl (dec_dl (bdg, []), dec_dl (body, []), d);

            dec_dl (raw::SEQUENTIAL_DECLARATIONS l, d)
                =>
                fold_backward dec_dl d l;

            dec_dl (raw::INCLUDE_DECLARATIONS l, d)
                =>
                parcons (map (OPEN o VARIABLE o syp::SYMBOL_PATH) l, d);

            dec_dl (raw::OVERLOADED_VARIABLE_DECLARATION (_, t, l, x), d)
                =>
                dl_add_s (ty_s (t, sys::empty), fold_forward exp_dl d l);

            dec_dl (raw::FIXITY_DECLARATIONS _, d)
                =>
                d;

            dec_dl (raw::SOURCE_CODE_REGION_FOR_DECLARATION (arg, _), d)
                =>
                dec_dl (arg, d);

            dec_dl (raw::PRE_COMPILE_CODE string, d)
                =>
                d;
        end;

        fun c_dec d
            =
            seq (dec_dl (d, []));

        fun convert { tree, err }
            =
            {   # Build a function that will complain (once you call it)
                # about any existing restriction violations
                #
                fun complain_cm region
                    =
                    {   fun same_reg (raw::LOCAL_DECLARATIONS (_, body), k)
                                =>
                                same_reg (body, k);

                            same_reg (raw::SEQUENTIAL_DECLARATIONS l, k)
                                =>
                                fold_forward same_reg k l;

                            same_reg (raw::INCLUDE_DECLARATIONS _, k)
                                =>
                                (\\ ()
                                    =
                                    {   k ();
                                        err err::ERROR region "toplevel use";
                                    }
                                );

                            same_reg (raw::SOURCE_CODE_REGION_FOR_DECLARATION (arg, region), k)
                                =>
                                complain_cm  region  (arg, k);

                            same_reg ( ( raw::PACKAGE_DECLARATIONS _
                                       | raw::GENERIC_DECLARATIONS _
                                       | raw::API_DECLARATIONS _
                                       | raw::GENERIC_API_DECLARATIONS _
                                       | raw::PRE_COMPILE_CODE _
                                       ),

                                       k
                                     )
                                =>
                                k;

                            same_reg (_, k)
                                =>
                                (\\ ()
                                    =
                                    {   k ();
                                        err err::WARNING region "definition not tracked by makelib";
                                    }
                                );
                        end;

                        same_reg;
                    };

                fun warn0 ()
                    =
                    ();

                complain =   complain_cm (0, 0) (tree, warn0);

                { complain,
                  module_dependencies_summary => c_dec tree
                };
            };
    };
end;

## author: Matthias Blume (blume@cs.princeton.edu)
## The copyright notices of the earlier versions are:
##   Copyright (c) 1995 by AT&T Bell Laboratories
##   Copyright (c) 1993 by Carnegie Mellon University,
##                         School of Computer Science
##                         contact: Gene Rollins (rollins+@cs.cmu.edu)
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext