[Tinyos-commits] CVS: tinyos-1.x/tos/lib/VM/languages/motlle/standalone compile.c, 1.4, 1.5 scheme.c, 1.2, 1.3

[David Gay]

Update of /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20996

Modified Files:
	compile.c scheme.c 
Log Message:
some reasonable approximation of define handling


Index: compile.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/compile.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** compile.c	7 Oct 2005 17:15:11 -0000	1.4
--- compile.c	7 Oct 2005 18:01:22 -0000	1.5
***************
*** 986,989 ****
--- 986,990 ----
    lexloc.filename = bstrdup(region, nicename);
  
+   normal_lexing();
    if ((frame->f = parse(frame->parser_block)))
      {

Index: scheme.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** scheme.c	7 Oct 2005 17:15:11 -0000	1.2
--- scheme.c	7 Oct 2005 18:01:22 -0000	1.3
***************
*** 206,209 ****
--- 206,263 ----
  }
  
+ static bool bind_define(location l, value v, fncode fn)
+ {
+   if (TYPE(v, type_pair))
+     {
+       struct list *expr = v;
+ 
+       if (TYPE(expr->car, type_symbol) &&
+ 	  !strcmp("define", symname(expr->car)))
+ 	{
+ 	  if (list_length(expr->cdr) >= 2)
+ 	    {
+ 	      expr = expr->cdr;
+ 	  
+ 	      if (TYPE(expr->car, type_pair))
+ 		expr = expr->car;
+ 	      if (TYPE(expr->car, type_symbol))
+ 		env_declare(sym2vlist(fnmemory(fn), expr->car));
+ 
+ 	    }
+ 	  return TRUE;
+ 	}
+       if (TYPE(expr->car, type_symbol) &&
+ 	  !strcmp("begin", symname(expr->car)))
+ 	{
+ 	  /* the definitions at the start of an embedded begin block
+ 	     should also be declared - this is not quite what the spec
+ 	     says as we allow random non-define stuff after some initial
+ 	     defines */
+ 	  struct list *defines;
+ 
+ 	  for (defines = expr->cdr;
+ 	       TYPE(defines, type_pair) && bind_define(l, defines->car, fn); 
+ 	       defines = defines->cdr)
+ 	    ;
+ 	  if (defines != expr->cdr)
+ 	    return TRUE;
+ 	}
+     }
+   return FALSE;
+ }
+ 
+ void compile_block(location l, struct list *blk, bool discard, fncode fn)
+ {
+   struct list *defines;
+ 
+   for (defines = blk; defines && bind_define(l, defines->car, fn); )
+     defines = defines->cdr;
+ 
+   GCPRO1(blk);
+   for (; blk; blk = blk->cdr)
+     scheme_compile(l, blk->car, blk->cdr || discard, fn);
+   GCPOP(1);
+ }
+ 
  static void sgen_function(location l, struct string *varname, value formals,
  			  value body, bool discard, fncode fn)
***************
*** 266,270 ****
    
    start_block("<return>", FALSE, FALSE, newfn);
!   compile_begin(l, body, FALSE, newfn);
    end_block(newfn);
    ins0(OPmreturn, newfn);
--- 320,324 ----
    
    start_block("<return>", FALSE, FALSE, newfn);
!   compile_block(l, body, FALSE, newfn);
    end_block(newfn);
    ins0(OPmreturn, newfn);
***************
*** 345,356 ****
  }
  
  static void compile_define(location l, struct list *args, bool discard, fncode fn)
  {
    vlist vfn = NULL;
  
    if (TYPE(args->car, type_symbol))
      {
        vfn = sym2vlist(fnmemory(fn), args->car);
!       env_declare(vfn);
        scheme_compile(l, nth(args, 2), FALSE, fn);
      }
--- 399,418 ----
  }
  
+ static void define_of(location l, vlist var, fncode fn)
+ {
+   /* in-block declarations are handled by compile_block */
+   if (fntoplevel(fn))
+     env_declare(var);
+ }
+ 
  static void compile_define(location l, struct list *args, bool discard, fncode fn)
  {
    vlist vfn = NULL;
+   int toplevel = fntoplevel(fn);
  
    if (TYPE(args->car, type_symbol))
      {
        vfn = sym2vlist(fnmemory(fn), args->car);
!       define_of(l, vfn, fn);
        scheme_compile(l, nth(args, 2), FALSE, fn);
      }
***************
*** 364,368 ****
  
  	  vfn = sym2vlist(fnmemory(fn), name);
! 	  env_declare(vfn);
  	  sgen_function(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
  	}
--- 426,430 ----
  
  	  vfn = sym2vlist(fnmemory(fn), name);
! 	  define_of(l, vfn, fn);
  	  sgen_function(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
  	}
***************
*** 406,410 ****
  static void let_body(location l, struct list *body, bool discard, fncode fn)
  {
!   compile_begin(l, body, discard, fn);
    env_block_pop();
  }
--- 468,472 ----
  static void let_body(location l, struct list *body, bool discard, fncode fn)
  {
!   compile_block(l, body, discard, fn);
    env_block_pop();
  }