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/bug619.sml
ViewVC logotype

Annotation of /tests/trunk/bugs/tests.obsolete/bug619.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2460 - (view) (download)

1 : dbm 548 (* bug619.sml *)
2 :    
3 :     signature SIG =
4 :     sig
5 :     exception Error of string
6 :     end
7 :    
8 :     functor F (X : SIG) =
9 :     struct
10 :     open X
11 :    
12 :     datatype Exp = APP of Exp * (Exp list)
13 :     datatype Val = FUNC of Val list -> (Val -> unit) -> unit
14 :    
15 :     fun extend_one (i,v,r) j = if i = j then v else (r j)
16 :     fun extend_env([],[],r) = r
17 :     | extend_env(i::is,v::vs,r) = extend_env(is,vs,extend_one(i,v,r))
18 :     | extend_env _ = raise Error "mismatching environment extension"
19 :    
20 :     fun meaning (APP(e,es)) r k =
21 :     meaning e r (fn (FUNC f) => meaninglis es r (fn vs => f vs k))
22 :    
23 :     and meaninglis [] r k = k []
24 :     | meaninglis (e :: es) r k =
25 :     meaning e r (fn v => meaninglis es r (fn vs => k (v :: vs)))
26 :     end
27 :    
28 :     structure A : SIG =
29 :     struct
30 :     exception Error of string
31 :     end
32 :    
33 :     structure B = F(A) (* necessary *)
34 :    

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