[Tinyos-commits] CVS: tinyos-1.x/tos/lib/VM/languages/motlle/standalone compile.c, 1.3, 1.4 env.c, 1.2, 1.3 env.h, 1.2, 1.3 lexer.h, 1.2, 1.3 lexer.l, 1.3, 1.4 mparser.c, 1.3, 1.4 parser.y, 1.3, 1.4 scheme.c, 1.1, 1.2

David Gay idgay at users.sourceforge.net
Fri Oct 7 10:15:14 PDT 2005 

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

Modified Files:
	compile.c env.c env.h lexer.h lexer.l mparser.c parser.y 
	scheme.c 
Log Message:
more scheme-like lexing (change lexing rules for scheme code)
let&co


Index: compile.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/compile.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** compile.c	6 Oct 2005 23:38:00 -0000	1.3
--- compile.c	7 Oct 2005 17:15:11 -0000	1.4
***************
*** 457,461 ****
    struct whiledata wdata;
  
!   env_block_push(NULL, in_loop(fn)); /* init may have local declarations */
    if (init)
      generate_component(init, NULL, TRUE, fn);
--- 457,461 ----
    struct whiledata wdata;
  
!   env_block_push(NULL); /* init may have local declarations */
    if (init)
      generate_component(init, NULL, TRUE, fn);
***************
*** 528,532 ****
  void generate_block(block b, bool discard, fncode fn)
  {
!   env_block_push(b->locals, in_loop(fn));
    generate_decls(b->locals, fn);
    generate_clist(b->sequence, discard, fn);
--- 528,532 ----
  void generate_block(block b, bool discard, fncode fn)
  {
!   env_block_push(b->locals);
    generate_decls(b->locals, fn);
    generate_clist(b->sequence, discard, fn);
***************
*** 624,628 ****
  	    decl->next = NULL;
  
! 	    env_declare(decl, fntoplevel(fn), in_loop(fn));
  	    generate_decls(decl, fn);
  	  }
--- 624,628 ----
  	    decl->next = NULL;
  
! 	    env_declare(decl);
  	    generate_decls(decl, fn);
  	  }

Index: env.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/env.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** env.c	30 Nov 2004 18:52:44 -0000	1.2
--- env.c	7 Oct 2005 17:15:11 -0000	1.3
***************
*** 199,203 ****
  }
  
! static void env_push_locals(vlist locals, bool implicit, bool inloop)
  {
    u16 osize = env_stack->size, i;
--- 199,203 ----
  }
  
! static void env_push_locals(vlist locals, bool implicit)
  {
    u16 osize = env_stack->size, i;
***************
*** 205,221 ****
    declare_locals(locals, implicit, FALSE);
    /* TODO: only clear if no init */
!   if (inloop)
      for (i = osize; i < env_stack->size; i++)
        ins1(OPmclearl, i, env_stack->fn);
  }
  
! void env_block_push(vlist locals, bool inloop)
  {
!   env_push_locals(locals, FALSE, inloop);
  }
  
! void env_declare(vlist locals, bool toplevel, bool inloop)
  {
!   if (toplevel && !env_inblock())
      for (;locals; locals = locals->next)
        {
--- 205,221 ----
    declare_locals(locals, implicit, FALSE);
    /* TODO: only clear if no init */
!   if (in_loop(env_stack->fn))
      for (i = osize; i < env_stack->size; i++)
        ins1(OPmclearl, i, env_stack->fn);
  }
  
! void env_block_push(vlist locals)
  {
!   env_push_locals(locals, FALSE);
  }
  
! void env_declare(vlist locals)
  {
!   if (fntoplevel(env_stack->fn) && !env_inblock())
      for (;locals; locals = locals->next)
        {
***************
*** 232,236 ****
        }
    else
!     env_push_locals(locals, TRUE, inloop);
  }
  
--- 232,236 ----
        }
    else
!     env_push_locals(locals, TRUE);
  }
  

Index: env.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/env.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** env.h	30 Nov 2004 18:52:44 -0000	1.2
--- env.h	7 Oct 2005 17:15:11 -0000	1.3
***************
*** 46,50 ****
  */
  
! void env_block_push(vlist locals, bool inloop);
  /* Effects: We have entered a local scope of the environment at the top
       of the stack. Add locals to the list of variables for this scope,
--- 46,50 ----
  */
  
! void env_block_push(vlist locals);
  /* Effects: We have entered a local scope of the environment at the top
       of the stack. Add locals to the list of variables for this scope,
***************
*** 52,56 ****
  */
  
! void env_declare(vlist locals, bool toplevel, bool inloop);
  /* Effects: declare variables in locals. toplevel is TRUE if this
       declaration is at the toplevel (note that the declarations may
--- 52,56 ----
  */
  
! void env_declare(vlist locals);
  /* Effects: declare variables in locals. toplevel is TRUE if this
       declaration is at the toplevel (note that the declarations may

Index: lexer.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/lexer.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** lexer.h	30 Nov 2004 18:52:44 -0000	1.2
--- lexer.h	7 Oct 2005 17:15:11 -0000	1.3
***************
*** 34,36 ****
--- 34,39 ----
  void read_from_file(FILE *f);
  
+ void scheme_lexing(void);
+ void normal_lexing(void);
+ 
  #endif

Index: lexer.l
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/lexer.l,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** lexer.l	6 Oct 2005 23:38:00 -0000	1.3
--- lexer.l	7 Oct 2005 17:15:11 -0000	1.4
***************
*** 89,97 ****
  HEXDIGIT	[0-9a-fA-F]
  SYMBOL_NAME     [_a-zA-Z][a-zA-Z0-9$_?!]*
  
  %%
  
! \n { lexloc.lineno++; }
! [ \t\r]+  { }
  \/\/.*\n  { lexloc.lineno++; }
  ^\#!.*\n  { lexloc.lineno++; }
--- 89,102 ----
  HEXDIGIT	[0-9a-fA-F]
  SYMBOL_NAME     [_a-zA-Z][a-zA-Z0-9$_?!]*
+ SCHEME_SYMBOL   [!$%&*/:<=>?~_^a-zA-Z][!$%&*/:<=>?~_^a-zA-Z0-9.+-]*
+ 
+ %x schemelex
  
  %%
  
! <INITIAL,schemelex>\n { lexloc.lineno++; }
! <INITIAL,schemelex>[ \t\r]+  { }
! 
! <schemelex>;.*\n { lexloc.lineno++; }
  \/\/.*\n  { lexloc.lineno++; }
  ^\#!.*\n  { lexloc.lineno++; }
***************
*** 112,121 ****
  	     }
           }
  "&&"	{ return SC_AND; }
  "||"	{ return SC_OR; }
  "^^"    { return XOR; }
  "!"	{ return NOT; }
- "["	{ return '['; }
- "]"	{ return ']'; }
  "|"	{ return '|'; }
  ":"	{ return ':'; }
--- 117,135 ----
  	     }
           }
+ <INITIAL,schemelex>"("	{ return '('; }
+ <INITIAL,schemelex>")"	{ return ')'; }
+ <INITIAL,schemelex>"["	{ return '['; }
+ <INITIAL,schemelex>"]"	{ return ']'; }
+ <INITIAL,schemelex>"{"	{ return '{'; }
+ <INITIAL,schemelex>"}"	{ return '}'; }
+ <INITIAL,schemelex>"."	{ return '.'; }
+ <INITIAL,schemelex>"'"	{ return QUOTE; }
+ <INITIAL,schemelex>"="	{ return ASSIGN; }
+ 
+ 
  "&&"	{ return SC_AND; }
  "||"	{ return SC_OR; }
  "^^"    { return XOR; }
  "!"	{ return NOT; }
  "|"	{ return '|'; }
  ":"	{ return ':'; }
***************
*** 126,138 ****
  "/"	{ return '/'; }
  "%"	{ return '%'; }
- "("	{ return '('; }
- ")"	{ return ')'; }
- "{"	{ return '{'; }
- "}"	{ return '}'; }
  "&"	{ return '&'; }
  "~"	{ return '~'; }
  "^"	{ return '^'; }
  ","     { return ','; }
- "."	{ return '.'; }
  "+="	{ yylval.operator = b_add; return OP_ASSIGN; }
  "-="	{ yylval.operator = b_subtract; return OP_ASSIGN; }
--- 140,147 ----
***************
*** 148,152 ****
  ">>="	{ yylval.operator = b_shift_right; return OP_ASSIGN; }
  "<<="	{ yylval.operator = b_shift_left; return OP_ASSIGN; }
- "="	{ return ASSIGN; }
  "=="	{ return EQ; }
  "!="	{ return NE; }
--- 157,160 ----
***************
*** 159,168 ****
  "++"    { yylval.operator = b_add; return INCREMENTER; }
  "--"    { yylval.operator = b_subtract; return INCREMENTER; }
- "'"	{ return QUOTE; }
  "@"	{ return '@'; }
  "_"     { return SINK; }
  "..."   { return ELLIPSIS; }
  
! '\\.'	{
  	  switch (yytext[2])
  	    {
--- 167,175 ----
  "++"    { yylval.operator = b_add; return INCREMENTER; }
  "--"    { yylval.operator = b_subtract; return INCREMENTER; }
  "@"	{ return '@'; }
  "_"     { return SINK; }
  "..."   { return ELLIPSIS; }
  
! <INITIAL,schemelex>'\\.'	{
  	  switch (yytext[2])
  	    {
***************
*** 175,181 ****
  	  return INTEGER;
  	}
! '[^\\]'	{ yylval.integer = (unsigned char) yytext[1]; return INTEGER; }
  
! -?({DIGIT}+|0[xX]{HEXDIGIT}+) {
  	  if (!mudlle_strtoint(yytext, &yylval.integer))
  	    log_error(lexloc, "Integer constant out of bounds.");
--- 182,188 ----
  	  return INTEGER;
  	}
! <INITIAL,schemelex>'[^\\]'	{ yylval.integer = (unsigned char) yytext[1]; return INTEGER; }
  
! <INITIAL,schemelex>-?({DIGIT}+|0[xX]{HEXDIGIT}+) {
  	  if (!mudlle_strtoint(yytext, &yylval.integer))
  	    log_error(lexloc, "Integer constant out of bounds.");
***************
*** 184,188 ****
  	}
  
! -?{DIGIT}+(({DECIM}{EXP}?)|{EXP}) {
            if (!mudlle_strtofloat(yytext, &yylval.mudlle_float))
  	    log_error(lexloc, "illegal floating point number");
--- 191,195 ----
  	}
  
! <INITIAL,schemelex>-?{DIGIT}+(({DECIM}{EXP}?)|{EXP}) {
            if (!mudlle_strtofloat(yytext, &yylval.mudlle_float))
  	    log_error(lexloc, "illegal floating point number");
***************
*** 191,195 ****
  	}
  
! \"([^\n\\"]*(\\(.|\n))?)+\" {char *str = yylval.string =
  				allocate(parser_memory, strlen(yytext));
  			      const char *text = yytext + 1;
--- 198,202 ----
  	}
  
! <INITIAL,schemelex>\"([^\n\\"]*(\\(.|\n))?)+\" {char *str = yylval.string =
  				allocate(parser_memory, strlen(yytext));
  			      const char *text = yytext + 1;
***************
*** 228,231 ****
--- 235,245 ----
  .	{ log_error(lexloc, "Bad character %s(%02x)", yytext, (unsigned char)yytext[0]); }
  
+ <schemelex>({SCHEME_SYMBOL}|[+]|[-]) {
+ 		yylval.symbol = allocate(parser_memory,strlen(yytext) + 1);
+ 		strlwr(strcpy(yylval.symbol, yytext));
+ 
+ 		return SYMBOL;
+ 	      }
+ 
  %%
  
***************
*** 268,269 ****
--- 282,295 ----
    lexloc.lineno = 0;
  }
+ 
+ void scheme_lexing(void)
+ {
+   BEGIN(schemelex);
+ }
+ 
+ void normal_lexing(void)
+ {
+   BEGIN(INITIAL);
+ }
+ 
+ 

Index: mparser.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/mparser.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** mparser.c	6 Oct 2005 23:38:00 -0000	1.3
--- mparser.c	7 Oct 2005 17:15:11 -0000	1.4
***************
*** 467,480 ****
  #define YYFINAL  3
  /* YYLAST -- Last index in YYTABLE.  */
! #define YYLAST   1003
  
  /* YYNTOKENS -- Number of terminals. */
  #define YYNTOKENS  68
  /* YYNNTS -- Number of nonterminals. */
! #define YYNNTS  82
  /* YYNRULES -- Number of rules. */
! #define YYNRULES  200
[...2636 lines suppressed...]
  #line 759 "../standalone/parser.y"
      { (*yyvalp).tvlist = new_vlist(parser_memory, yyvsp[0].yystate.yysemantics.yysval.symbol, stype_any, NULL, NULL); ;}
      break;
  
!   case 201:
  #line 760 "../standalone/parser.y"
      { (*yyvalp).tvlist = new_vlist(parser_memory, yyvsp[-2].yystate.yysemantics.yysval.symbol, stype_any, yyvsp[0].yystate.yysemantics.yysval.tcomponent, NULL); ;}
***************
*** 2422,2426 ****
  # undef YYRECOVERING
  /* Line 671 of glr.c.  */
! #line 2424 "parser.tab.c"
  }
  
--- 2421,2425 ----
  # undef YYRECOVERING
  /* Line 671 of glr.c.  */
! #line 2423 "parser.tab.c"
  }
  

Index: parser.y
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/parser.y,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** parser.y	6 Oct 2005 23:38:01 -0000	1.3
--- parser.y	7 Oct 2005 17:15:11 -0000	1.4
***************
*** 393,397 ****
  expression : 
    control_expression |
!   SCHEME constant { $$ = new_component(parser_memory, c_scheme, $2); } |
    e0 ;
  
--- 393,397 ----
  expression : 
    control_expression |
!   SCHEME { scheme_lexing(); } constant { normal_lexing(); $$ = new_component(parser_memory, c_scheme, $3); } |
    e0 ;
  

Index: scheme.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** scheme.c	6 Oct 2005 23:38:01 -0000	1.1
--- scheme.c	7 Oct 2005 17:15:11 -0000	1.2
***************
*** 37,45 ****
  }
  
! static const char *sym2str(block_t region, value sym)
  {
    struct symbol *s = sym;
  
!   return bstrdup(region, s->name->str);
  }
  
--- 37,50 ----
  }
  
! static const char *symname(value sym)
  {
    struct symbol *s = sym;
  
!   return s->name->str;
! }
! 
! static const char *sym2str(block_t region, value sym)
! {
!   return bstrdup(region, symname(sym));
  }
  
***************
*** 79,83 ****
  	  struct symbol *called = call->car;
  
! 	  return lookup_builtin(called->name->str, list_length(call->cdr));
  	}
      }
--- 84,88 ----
  	  struct symbol *called = call->car;
  
! 	  return lookup_builtin(symname(called), list_length(call->cdr));
  	}
      }
***************
*** 347,351 ****
      {
        vfn = sym2vlist(fnmemory(fn), args->car);
!       env_declare(vfn, fntoplevel(fn), in_loop(fn));
        scheme_compile(l, nth(args, 2), FALSE, fn);
      }
--- 352,356 ----
      {
        vfn = sym2vlist(fnmemory(fn), args->car);
!       env_declare(vfn);
        scheme_compile(l, nth(args, 2), FALSE, fn);
      }
***************
*** 359,363 ****
  
  	  vfn = sym2vlist(fnmemory(fn), name);
! 	  env_declare(vfn, fntoplevel(fn), in_loop(fn));
  	  sgen_function(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
  	}
--- 364,368 ----
  
  	  vfn = sym2vlist(fnmemory(fn), name);
! 	  env_declare(vfn);
  	  sgen_function(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
  	}
***************
*** 369,392 ****
  }
  
  static void compile_let(location l, struct list *args, bool discard, fncode fn)
  {
!   struct list *bindings;
!   int error = FALSE;
  
!   /* Recast as recursive functioin. currently broken. */
!   for (bindings = args->car; TYPE(bindings, type_pair); bindings = bindings->cdr)
!     if (check_binding(l, bindings, &error))
!       sgen_binding_init(l, bindings);
  
    if (bindings)
      log_error(l, "invalid bindings");
!   
!   if (!error)
!   for (bindings = args->car; TYPE(bindings, type_pair); bindings = bindings->cdr)
      {
!       sgen_binding_decl(l, bindings);
!       sgen_binding_assign(l, bindings);
      }
  
  }
  
--- 374,495 ----
  }
  
+ static int check_binding(location l, value binding)
+ {
+   if (list_length(binding) != 2)
+     {
+       log_error(l, "invalid let binding");
+       return FALSE;
+     }
+   if (!TYPE(((struct list *)binding)->car, type_symbol))
+     {
+       log_error(l, "first element of binding list must be a symbol");
+       return FALSE;
+     }
+   return TRUE;
+ }
+ 
+ static void sgen_binding_init(location l, struct list *binding, fncode fn)
+ {
+   scheme_compile(l, nth(binding, 2), FALSE, fn);
+ }
+ 
+ static void sgen_binding_decl(location l, struct list *binding, fncode fn)
+ {
+   env_declare(sym2vlist(fnmemory(fn), binding->car));
+ }
+ 
+ static void sgen_binding_assign(location l, struct list *binding, fncode fn)
+ {
+   sgen_assign(l, symname(binding->car), TRUE, fn);
+ }
+ 
+ static void let_body(location l, struct list *body, bool discard, fncode fn)
+ {
+   compile_begin(l, body, discard, fn);
+   env_block_pop();
+ }
+ 
+ static void let_bindings(location l, struct list *bindings, fncode fn)
+ {
+   if (TYPE(bindings, type_pair))
+     {
+       int ok = check_binding(l, bindings->car);
+ 
+       GCPRO1(bindings);
+       if (ok)
+ 	sgen_binding_init(l, bindings->car, fn);
+ 
+       let_bindings(l, bindings->cdr, fn);
+ 
+       if (ok)
+ 	{
+ 	  sgen_binding_decl(l, bindings->car, fn);
+ 	  sgen_binding_assign(l, bindings->car, fn);
+ 	}
+       GCPOP(1);
+     }
+   else if (bindings)
+     log_error(l, "invalid bindings");
+ }
+ 
  static void compile_let(location l, struct list *args, bool discard, fncode fn)
  {
!   env_block_push(NULL);
!   let_bindings(l, args->car, fn);
!   let_body(l, args->cdr, discard, fn);
! }
  
! static void letstar_bindings(location l, struct list *bindings, fncode fn)
! {
!   for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
!     {
!       value binding = bindings->car;
  
+       if (check_binding(l, binding))
+ 	{
+ 	  sgen_binding_init(l, binding, fn);
+ 	  sgen_binding_decl(l, binding, fn);
+ 	  sgen_binding_assign(l, binding, fn);
+ 	}
+     }
    if (bindings)
      log_error(l, "invalid bindings");
! }
! 
! static void compile_letstar(location l, struct list *args, bool discard, fncode fn)
! {
!   env_block_push(NULL);
!   letstar_bindings(l, args->car, fn);
!   let_body(l, args->cdr, discard, fn);
! }
! 
! static void letrec_bindings(location l, struct list *bindings, fncode fn)
! {
!   if (TYPE(bindings, type_pair))
      {
!       int ok = check_binding(l, bindings->car);
! 
!       GCPRO1(bindings);
!       if (ok)
! 	sgen_binding_decl(l, bindings->car, fn);
! 
!       letrec_bindings(l, bindings->cdr, fn);
! 
!       if (ok)
! 	{
! 	  sgen_binding_init(l, bindings->car, fn);
! 	  sgen_binding_assign(l, bindings->car, fn);
! 	}
!       GCPOP(1);
      }
+   else if (bindings)
+     log_error(l, "invalid bindings");
+ }
  
+ static void compile_letrec(location l, struct list *args, bool discard, fncode fn)
+ {
+   env_block_push(NULL);
+   letrec_bindings(l, args->car, fn);
+   let_body(l, args->cdr, discard, fn);
  }
  
***************
*** 404,407 ****
--- 507,512 ----
    { "define", -1, compile_define },
    { "let", -2, compile_let },
+   { "let*", -2, compile_letstar },
+   { "letrec", -2, compile_letrec },
  };
  
***************
*** 418,426 ****
    if (TYPE(list->car, type_symbol))
      {
!       struct string *symname = ((struct symbol *)list->car)->name;
        int i;
  
        for (i = 0; i < sizeof syntax / sizeof *syntax; i++)
! 	if (!strcmp(symname->str, syntax[i].keyword))
  	  {
  	    if (syntax[i].nargs > 0)
--- 523,531 ----
    if (TYPE(list->car, type_symbol))
      {
!       struct string *name = ((struct symbol *)list->car)->name;
        int i;
  
        for (i = 0; i < sizeof syntax / sizeof *syntax; i++)
! 	if (!strcmp(name->str, syntax[i].keyword))
  	  {
  	    if (syntax[i].nargs > 0)

More information about the Tinyos-commits mailing list