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 /tests/trunk/bugs/tests.obsolete/bug1308.3.sml
ViewVC logotype

Annotation of /tests/trunk/bugs/tests.obsolete/bug1308.3.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2460 - (view) (download)

1 : dbm 548 (* bug1308.3.sml *)
2 :    
3 :     signature STO =
4 :     sig
5 :     type store
6 :     val update : (store -> 'a) -> 'a
7 :     end;
8 :    
9 :     signature COMP =
10 :     sig
11 :     type 'a lift
12 :     val rap : 'a -> 'a lift
13 :     val uplift : ('b lift) -> 'b lift
14 :     end;
15 :    
16 :     functor F (structure S : STO
17 :     structure C : COMP)
18 :     : sig
19 :     val x : S.store C.lift
20 :     end =
21 :     struct
22 :     val x = C.uplift (S.update (C.rap: S.store -> S.store C.lift))
23 :     end;
24 :    
25 :     structure Sto : STO =
26 :     struct
27 :     type store = string * int list
28 :     fun update f = f ("x",[0])
29 :     end;
30 :    
31 :     structure CPS : COMP =
32 :     struct
33 :     type 'a lift = ('a -> Sto.store) -> Sto.store
34 :     fun rap (v: 'a) (k: 'a -> Sto.store) = k v
35 :     fun uplift (f: 'a lift) (k: 'a -> Sto.store) = f k
36 :     end;
37 :    
38 :     structure R =
39 :     F (structure S = Sto
40 :     structure C = CPS);
41 :    
42 :     val s2' = R.x (fn x => x);
43 :    

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