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

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/compiler/FLINT/plambda/plambdatype.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/FLINT/plambda/plambdatype.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (view) (download)

1 : monnier 16 (* Copyright (c) 1997 YALE FLINT PROJECT *)
2 :     (* plambdatype.sml *)
3 :    
4 :     structure PLambdaType : PLAMBDATYPE =
5 :     struct
6 :    
7 :     open LtyExtern
8 :    
9 :     fun bug msg = ErrorMsg.impossible("PLambdaType: "^msg)
10 :    
11 :     (* lt_merge is used by the translate.sml only *)
12 :     fun lt_merge(t1, t2) =
13 :     let fun h ([], []) = []
14 :     | h (x, []) = x
15 :     | h ([], y) = y
16 :     | h (x as ((i,t)::l), y as ((j,s)::r)) =
17 :     if i < j then ((i,t)::(h(l,y)))
18 :     else if i > j then ((j,s)::(h(x,r)))
19 :     else ((i, lt_merge(t,s))::(h(l,r)))
20 :     in ltw_pst(t1,
21 :     (fn ts1 =>
22 :     ltw_pst(t2, fn ts2 => ltc_pst(h(ts1, ts2)), fn _ => t2)),
23 :     (*
24 :     * if lt_eqv(t1, t2) then t2
25 :     * else bug "incompatible PST and STR types in lt_merge"
26 :     *)
27 :     (fn t1 =>
28 :     ltw_pst(t2, fn _ => t1, fn _ => t1))
29 :     (*
30 :     * if lt_eqv(t1, t2) then t1
31 :     * else bug "incompatible STR and PST types in lt_merge"
32 :     *))
33 :     end (* function lt_merge *)
34 :    
35 :     end (* structure PLambdaType *)
36 :    

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