Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Update ocs to 1.0.3.

  • Loading branch information...
commit f28415851754d8128512bca49aa61dc97bf846fd 1 parent d8e98ee
authored April 05, 2009
11  CHANGES
... ...
@@ -1,3 +1,14 @@
  1
+1.0.3
  2
+
  3
+    - The various let forms now create new frames.  This fixes
  4
+    behavior for situations where the initializers for the bound
  5
+    variables return multiple times due to captured continuations.
  6
+
  7
+    - Change define-syntax to return the unspecified value.
  8
+
  9
+    - Fix (lambda <var> ...) forms where <var> is env-tagged by
  10
+    macro expansion.
  11
+
1 12
 1.0.2
2 13
 
3 14
     - Try to find a smaller invariant precision when converting from
70  src/ocs_compile.ml
@@ -228,7 +228,7 @@ and mklambda e args body =
228 228
 	  let _ = bind_var ne s in
229 229
 	    incr nargs;
230 230
 	    scanargs tl
231  
-      | Ssymbol _ as s ->
  231
+      | (Ssymbol _ | Sesym (_, _)) as s ->
232 232
 	  let _ = bind_var ne s in
233 233
 	    incr nargs;
234 234
 	    has_rest := true;
@@ -259,52 +259,66 @@ and mknamedlet e s args =
259 259
     let av =
260 260
       Array.map (fun (s, v) -> let _ = bind_var ne s in v) argv in
261 261
     let body = mkseq (mkbody ne (Array.sub args 2 (Array.length args - 2))) in
262  
-      let proc =
263  
-	Clambda (make_proc body (Array.length av) false !(ne.env_frame_size))
264  
-      in
265  
-	Cseq2 (gendef ar proc, mkapply (genref ar) av)
  262
+    let proc =
  263
+      Clambda (make_proc body (Array.length av) false !(ne.env_frame_size))
  264
+    in
  265
+      Cseq2 (gendef ar proc, mkapply (genref ar) av)
266 266
 
267 267
 and mklet e args =
268 268
   if Array.length args < 2 then
269 269
     raise (Error "let: too few args");
270 270
   match args.(0) with
271 271
     (Ssymbol _ | Sesym (_, _)) as s -> mknamedlet e s args
272  
-  | (Spair _ | Snull) as al ->
273  
-      let av =
  272
+  | Snull -> mkseq (mkbody e (Array.sub args 1 (Array.length args - 1)))
  273
+  | Spair _ as al ->
  274
+      let argv =
274 275
 	Array.map
275  
-	  (letsplit (fun s v -> s, new_var e, compile e v))
276  
-	  (Array.of_list (list_to_caml al))
  276
+	  (letsplit (fun s v -> s, compile e v))
  277
+	  (Array.of_list (list_to_caml al)) in
  278
+      let ne = new_frame e in
  279
+      let av = Array.map (fun (s, v) -> let _ = bind_var ne s in v) argv in
  280
+      let body = mkseq (mkbody ne (Array.sub args 1 (Array.length args - 1))) in
  281
+      let proc =
  282
+	Clambda (make_proc body (Array.length av) false !(ne.env_frame_size))
277 283
       in
278  
-	let ne = new_scope e in
279  
-	let sets =
280  
-	  Array.map
281  
-	    (fun (s, r, v) -> bind_name ne s r; gendef r v) av in
282  
-	let rest = mkbody ne (Array.sub args 1 (Array.length args - 1)) in
283  
-	  mkseq (Array.append sets rest)
  284
+	mkapply proc av
284 285
   | _ -> raise (Error "let: missing argument list")
285 286
 
286 287
 and mkletstar e args =
287 288
   if Array.length args < 2 then
288 289
     raise (Error "let*: too few args");
289  
-  let ne = new_scope e in
290  
-  let sets = Array.map
291  
-    (letsplit
292  
-      (fun s v -> let ce = compile ne v in gendef (bind_var ne s) ce))
293  
-    (Array.of_list (list_to_caml args.(0))) in
294  
-  let rest = mkbody ne (Array.sub args 1 (Array.length args - 1)) in
295  
-    mkseq (Array.append sets rest)
  290
+  let rec build e =
  291
+    function
  292
+      x::t ->
  293
+	let (s, v) = letsplit (fun s v -> s, compile e v) x in
  294
+	let ne = new_frame e in
  295
+	let _ = bind_var ne s in
  296
+	let body = build ne t in
  297
+	let proc = Clambda (make_proc body 1 false !(ne.env_frame_size)) in
  298
+	  mkapply proc [| v |]
  299
+    | [] -> mkseq (mkbody e (Array.sub args 1 (Array.length args - 1)))
  300
+  in
  301
+    build e (list_to_caml args.(0))
296 302
 
297 303
 and mkletrec e args =
298 304
   if Array.length args < 2 then
299 305
     raise (Error "letrec: too few args");
300  
-  let ne = new_scope e in
301  
-  let t =
  306
+  let ne = new_frame e in
  307
+  let av =
302 308
     Array.map (letsplit (fun s v -> let r = bind_var ne s in (r, v)))
303 309
 	      (Array.of_list (list_to_caml args.(0))) in
304  
-  let sets =
305  
-    Array.map (fun (r, v) -> gendef r (compile ne v)) t in
306  
-  let rest = mkbody ne (Array.sub args 1 (Array.length args - 1)) in
307  
-    mkseq (Array.append sets rest)
  310
+  let avi = Array.map (fun (r, v) -> compile ne v) av in
  311
+  let ne' = new_frame ne in
  312
+  let sets = Array.map (fun (r, v) -> gendef r (genref (new_var ne'))) av in
  313
+  let body = mkseq (Array.append sets
  314
+    (mkbody ne' (Array.sub args 1 (Array.length args - 1)))) in
  315
+  let proc =
  316
+    Clambda (make_proc body (Array.length av) false !(ne'.env_frame_size)) in
  317
+  let proc =
  318
+    Clambda (make_proc (mkapply proc avi)
  319
+		       (Array.length av) false !(ne.env_frame_size))
  320
+  in
  321
+    mkapply proc (Array.map (fun _ -> Cval Sunspec) av)
308 322
 
309 323
 and compileseq e s =
310 324
   mkseq (Array.map (fun x -> compile e x)
2  src/ocs_macro.ml
@@ -397,7 +397,7 @@ let mkdefine_syntax e =
397 397
       let rules = parsetspec (new_scope e) sym tspec in
398 398
 	bind_name e sym (Vmacro (expand (normalize_name sym) e
399 399
 				        { r_rules = rules }));
400  
-	Cval Snull
  400
+	Cval Sunspec
401 401
   | _ -> raise (Error "define-syntax: bad args")
402 402
 ;;
403 403
 

0 notes on commit f284158

Please sign in to comment.
Something went wrong with that request. Please try again.