PreviousUpNext

15.4.477  src/lib/compiler/back/top/highcode/highcode-dictionary.pkg

## highcode-dictionary.pkg 

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


###         "I will not go so far as to say that to construct
###          a history of thought without profound study of
###          the mathematical ideas of successive epochs is
###          like omitting Hamlet from the play which is
###          named after him. 
###
###         "But it is certainly analogous to cutting out
###          the part of Ophelia. This simile is singularly exact.
###          For Ophelia is quite essential to the play,
###          she is very charming -- and a little mad."
###
###                   --  Alfred North Whitehead (1861-1947)
###                       [English philosopher and mathematician]


stipulate
    package hut =  highcode_uniq_types;
herein

    api Highcode_Dictionary {
        #
        Uniqtyp =  hut::Uniqtyp;
        Uniqtype   =  hut::Uniqtype;

        tmemo_fn:  { tcf:  (Uniqtyp -> X)                      ->  (Uniqtyp -> X),
                     ltf:  (Uniqtyp -> X, Uniqtype -> Y)  ->  (Uniqtype   -> Y)
                   } 
                   ->
                   { tc_map: Uniqtyp -> X,
                     lt_map: Uniqtype -> Y
                   };

        wmemo_fn:  { tc_wmap:  (Uniqtyp -> X,  Uniqtyp -> X) ->  (Uniqtyp -> X),
                     tc_umap:  (Uniqtyp -> X,  Uniqtyp -> X) ->  (Uniqtyp -> X),
                     lt_umap:  (Uniqtyp -> X,  Uniqtype   -> Y) ->  (Uniqtype   -> Y)
                   }
                   ->
                   { tc_wmap:  Uniqtyp -> X,
                     tc_umap:  Uniqtyp -> X, 
                     lt_umap:  Uniqtype   -> Y,
                     cleanup:  Void -> Void
                   };

    };
end;


stipulate
    package hut =  highcode_uniq_types;
herein

    package highcode_dictionary: (weak)  Highcode_Dictionary {                                  # Highcode_Dictionary   is from   src/lib/compiler/back/top/highcode/highcode-dictionary.pkg

        fun bug s
            =
            error_message::impossible ("LtyDict: " + s);

        say = global_controls::print::say;

        package tc_dictionary
            =
            red_black_map_g (                                                           # red_black_map_g               is from   src/lib/src/red-black-map-g.pkg
                #
                Key     =   hut::Uniqtyp;
                compare =   hut::compare_uniqtyps;
            );

        package lt_dictionary
            =
            red_black_map_g (
                #
                Key     =  hut::Uniqtype;
                compare =  hut::compare_uniqtypes;
            );

        Uniqtyp =  hut::Uniqtyp;
        Uniqtype   =  hut::Uniqtype;

        fun tmemo_fn { tcf, ltf }
            =
            { tc_map => tc_look,
              lt_map => lt_look
            }
            where
                m1 = REF (tc_dictionary::empty);
                m2 = REF (lt_dictionary::empty);

                fun tc_look t
                    = 
                    case (tc_dictionary::get (*m1, t))
                        #
                        THE t' => t';
                        #
                        NULL   => {   x = (tcf tc_look) t;
                                      m1 := tc_dictionary::set (*m1, t, x);
                                      x;
                                  };
                    esac

                also
                fun lt_look t
                    = 
                    case (lt_dictionary::get (*m2, t))
                        #
                        THE t' => t';
                        #
                        NULL   => {   x = ltf (tc_look, lt_look) t;
                                      m2 := lt_dictionary::set (*m2, t, x);
                                      x;
                                  };
                    esac;
            end;                        # fun tmemo_fn 

        fun wmemo_fn { tc_wmap, tc_umap, lt_umap }
            = 
            { tc_wmap => tcw_look,
              tc_umap => tcu_look,
              lt_umap => ltu_look,
              cleanup
            }
            where
                m1 = REF (tc_dictionary::empty);
                m2 = REF (tc_dictionary::empty);
                m3 = REF (lt_dictionary::empty);

                fun tcw_look t
                    = 
                    case (tc_dictionary::get (*m1, t))
                        #
                        THE t' => t';
                        #
                        NULL   => {   x = (tc_wmap (tcw_look, tcu_look)) t;
                                      m1 := tc_dictionary::set (*m1, t, x);
                                      x;
                                  };
                    esac

                also
                fun tcu_look t
                    = 
                    case (tc_dictionary::get (*m2, t))
                        #
                        THE t' => t';
                        #
                        NULL   => {   x = (tc_umap (tcu_look, tcw_look)) t;
                                      m2 := tc_dictionary::set (*m2, t, x);
                                      x;
                                  };
                    esac

                also
                fun ltu_look t
                    = 
                    case (lt_dictionary::get (*m3, t))
                        #
                        THE t' => t';
                        #
                        NULL   => {   x = lt_umap (tcu_look, ltu_look) t;
                                      m3 := lt_dictionary::set (*m3, t, x);
                                      x;
                                  };
                    esac;

                fun cleanup () = ();
            end;                        # fun wmemo_fn 
    };                                  # package highcode_dictionary 
end;                                    # toplevel stipulate







Comments and suggestions to: bugs@mythryl.org

PreviousUpNext