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

SCM Repository

[smlnj] View of /sml/trunk/src/compiler/FLINT/plambda/plambdatype.sml
ViewVC logotype

View of /sml/trunk/src/compiler/FLINT/plambda/plambdatype.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 94 - (download) (annotate)
Tue May 12 21:56:22 1998 UTC (22 years, 5 months ago) by monnier
File size: 1202 byte(s)
This commit was generated by cvs2svn to compensate for changes in r93,
which included commits to RCS files with non-trunk default branches.
(* Copyright (c) 1997 YALE FLINT PROJECT *)
(* plambdatype.sml *)

structure PLambdaType : PLAMBDATYPE = 
struct

open LtyExtern

fun bug msg = ErrorMsg.impossible("PLambdaType: "^msg)

(* lt_merge is used by the translate.sml only *)
fun lt_merge(t1, t2) = 
  let fun h ([], []) = []
        | h (x, []) = x
        | h ([], y) = y
        | h (x as ((i,t)::l), y as ((j,s)::r)) = 
             if i < j then ((i,t)::(h(l,y)))
             else if i > j then ((j,s)::(h(x,r)))
                  else ((i, lt_merge(t,s))::(h(l,r)))
   in ltw_pst(t1, 
              (fn ts1 => 
                ltw_pst(t2, fn ts2 => ltc_pst(h(ts1, ts2)), fn _ => t2)), 
              (* 
               * if lt_eqv(t1, t2) then t2 
               * else bug "incompatible PST and STR types in lt_merge"
               *)
              (fn t1 => 
                ltw_pst(t2, fn _ => t1, fn _ => t1))
              (*
               * if lt_eqv(t1, t2) then t1 
               * else bug "incompatible STR and PST types in lt_merge"
               *))
  end (* function lt_merge *)

end (* structure PLambdaType *)


(*
 * $Log: plambdatype.sml,v $
 * Revision 1.1.1.1  1998/04/08 18:39:38  george
 * Version 110.5
 *
 *)

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