Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/kernel/ltyextern.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/kernel/ltyextern.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 422, Sun Sep 5 22:49:38 1999 UTC revision 423, Mon Sep 6 02:32:11 1999 UTC
# Line 534  Line 534 
534  (************************************************************************  (************************************************************************
535   *            SUBSTITION OF NAMED VARS IN A TYC/LTY                     *   *            SUBSTITION OF NAMED VARS IN A TYC/LTY                     *
536   ************************************************************************)   ************************************************************************)
537  structure LtDict = BinaryDict  structure LtDict = BinaryMapFn
538                         (struct                         (struct
539                             type ord_key = lty                             type ord_key = lty
540                             val cmpKey = LtyKernel.lt_cmp                             val compare = LtyKernel.lt_cmp
541                         end)                         end)
542    
543  fun tc_nvar_elim_gen() = let  fun tc_nvar_elim_gen() = let
544      val dict = ref (TcDict.mkDict())      val dict = ref (TcDict.empty)
545    
546      fun tc_nvar_elim s d tyc =      fun tc_nvar_elim s d tyc =
547          case LK.tc_nvars tyc of          case LK.tc_nvars tyc of
# Line 552  Line 552 
552           * using tcc_proj *)           * using tcc_proj *)
553          val tycdepth = tcc_proj (tyc, d)          val tycdepth = tcc_proj (tyc, d)
554      in      in
555          case TcDict.peek(!dict, tycdepth) of          case TcDict.find(!dict, tycdepth) of
556              SOME t => t                 (* hit! *)              SOME t => t                 (* hit! *)
557            | NONE => let                 (* must recompute *)            | NONE => let                 (* must recompute *)
558                  val r = tc_nvar_elim s d (* default recursive invoc. *)                  val r = tc_nvar_elim s d (* default recursive invoc. *)
# Line 605  Line 605 
605  end  end
606    
607  fun lt_nvar_elim_gen() = let  fun lt_nvar_elim_gen() = let
608      val dict = ref (LtDict.mkDict())      val dict = ref (LtDict.empty)
609      val tc_nvar_elim = tc_nvar_elim_gen()      val tc_nvar_elim = tc_nvar_elim_gen()
610    
611      fun lt_nvar_elim s d lty =      fun lt_nvar_elim s d lty =
# Line 617  Line 617 
617           * (only first 2 args are useful) *)           * (only first 2 args are useful) *)
618          val ltydepth = lt_inj (LK.LT_ENV (lty, d, 0, LK.initTycEnv))          val ltydepth = lt_inj (LK.LT_ENV (lty, d, 0, LK.initTycEnv))
619      in      in
620          case LtDict.peek(!dict, ltydepth) of          case LtDict.find(!dict, ltydepth) of
621              SOME t => t                 (* hit! *)              SOME t => t                 (* hit! *)
622            | NONE => let                 (* must recompute *)            | NONE => let                 (* must recompute *)
623                  val r = lt_nvar_elim s d (* default recursive invoc. *)                  val r = lt_nvar_elim s d (* default recursive invoc. *)
# Line 672  Line 672 
672      end      end
673    
674  fun tc_nvar_subst_gen() = let  fun tc_nvar_subst_gen() = let
675      val dict = ref (TcDict.mkDict())      val dict = ref (TcDict.empty)
676    
677      fun tc_nvar_subst subst = let      fun tc_nvar_subst subst = let
678          fun loop tyc =          fun loop tyc =
# Line 681  Line 681 
681               false => tyc               (* nothing to subst *)               false => tyc               (* nothing to subst *)
682             | true =>             | true =>
683               (* next check the memoization table *)               (* next check the memoization table *)
684               (case TcDict.peek(!dict, tyc) of               (case TcDict.find(!dict, tyc) of
685                    SOME t => t           (* hit! *)                    SOME t => t           (* hit! *)
686                  | NONE =>                  | NONE =>
687                let                       (* must recompute *)                let                       (* must recompute *)
# Line 736  Line 736 
736  end (* tc_nvar_subst_gen *)  end (* tc_nvar_subst_gen *)
737    
738  fun lt_nvar_subst_gen() = let  fun lt_nvar_subst_gen() = let
739      val dict = ref (LtDict.mkDict())      val dict = ref (LtDict.empty)
740      val tc_nvar_subst' = tc_nvar_subst_gen()      val tc_nvar_subst' = tc_nvar_subst_gen()
741    
742      fun lt_nvar_subst subst = let      fun lt_nvar_subst subst = let
# Line 748  Line 748 
748               false => lty                  (* nothing to subst *)               false => lty                  (* nothing to subst *)
749             | true =>             | true =>
750               (* next check the memoization table *)               (* next check the memoization table *)
751               (case LtDict.peek(!dict, lty) of               (case LtDict.find(!dict, lty) of
752                    SOME t => t           (* hit! *)                    SOME t => t           (* hit! *)
753                  | NONE =>                  | NONE =>
754                let                       (* must recompute *)                let                       (* must recompute *)
# Line 802  Line 802 
802  (* val s_nvars = Stats.makeStat "Cvt free nvars length" *)  (* val s_nvars = Stats.makeStat "Cvt free nvars length" *)
803    
804  fun tc_nvar_cvt_gen() = let  fun tc_nvar_cvt_gen() = let
805      val dict = ref (TcDict.mkDict())      val dict = ref (TcDict.empty)
806    
807      fun tc_nvar_cvt (tvoffs:tvoffs) d tyc =      fun tc_nvar_cvt (tvoffs:tvoffs) d tyc =
808          ((* Stats.addStat s_iter 1; *)          ((* Stats.addStat s_iter 1; *)
# Line 819  Line 819 
819           * using tcc_proj *)           * using tcc_proj *)
820          val tycdepth = tcc_proj (tyc, d)          val tycdepth = tcc_proj (tyc, d)
821      in      in
822          case TcDict.peek(!dict, tycdepth) of          case TcDict.find(!dict, tycdepth) of
823              SOME t => ((* Stats.addStat s_hits 1; *)              SOME t => ((* Stats.addStat s_hits 1; *)
824                         t                 (* hit! *)                         t                 (* hit! *)
825                         )                         )
# Line 876  Line 876 
876    
877    
878  fun lt_nvar_cvt_gen() = let  fun lt_nvar_cvt_gen() = let
879      val dict = ref (LtDict.mkDict())      val dict = ref (LtDict.empty)
880      val tc_nvar_cvt = tc_nvar_cvt_gen()      val tc_nvar_cvt = tc_nvar_cvt_gen()
881    
882      fun lt_nvar_cvt tvoffs d lty =      fun lt_nvar_cvt tvoffs d lty =
# Line 889  Line 889 
889           * (only first 2 args are useful) *)           * (only first 2 args are useful) *)
890          val ltydepth = lt_inj (LK.LT_ENV (lty, d, 0, LK.initTycEnv))          val ltydepth = lt_inj (LK.LT_ENV (lty, d, 0, LK.initTycEnv))
891      in      in
892          case LtDict.peek(!dict, ltydepth) of          case LtDict.find(!dict, ltydepth) of
893              SOME t => t                 (* hit! *)              SOME t => t                 (* hit! *)
894            | NONE => let                 (* must recompute *)            | NONE => let                 (* must recompute *)
895                  val r = lt_nvar_cvt tvoffs d (* default recursive invoc. *)                  val r = lt_nvar_cvt tvoffs d (* default recursive invoc. *)
# Line 930  Line 930 
930    
931          val (ks, tvoffs) = frob (tvks, 0, [], [])          val (ks, tvoffs) = frob (tvks, 0, [], [])
932          fun cmp ((tvar1,_), (tvar2,_)) = tvar1 > tvar2          fun cmp ((tvar1,_), (tvar2,_)) = tvar1 > tvar2
933          val tvoffs = Sort.sort cmp tvoffs          val tvoffs = ListMergeSort.sort cmp tvoffs
934    
935          (* temporarily gen() *)          (* temporarily gen() *)
936          val ltSubst = lt_nvar_cvt_gen() tvoffs (DI.next DI.top)          val ltSubst = lt_nvar_cvt_gen() tvoffs (DI.next DI.top)

Legend:
Removed from v.422  
changed lines
  Added in v.423

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0