PreviousUpNext

15.4.603  src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax-junk.pkg

## 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.pkg
herein

    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


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext