Commits

Pierre Surply committed ff3d777

r8

Comments (0)

Files changed (23)

+R8 2013-04-29
+  - Improved error messages
+  - Added term mode (including umara compiler and VM)
+  - AVR-GCC is now executed properly by marac
+  - Improved string parsing
+  - Improved standard library (EEPROM, string, ...)
+  - Fixed many bugs...
 R5 2013-04-15
   - Added Finite-State Machine
   - Improved compound assignment

compiler/backend/gen.ml

 **    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
 **
 ** Started on  Thu Dec 27 19:13:52 2012 Pierre Surply
-** Last update Fri Mar 22 18:19:48 2013 Pierre Surply
+** Last update Fri Mar 29 18:03:30 2013 Pierre Surply
 *)
 
 open Ast
   let dstatic = ref false in
   let p_cldef = function
     | Static -> dstatic := true; []
-    | Vdef (_, v) -> Mem.add mem v; []
-    | Fdef (id, al, b) ->
+    | Vdef (_, v, _) -> Mem.add mem v; []
+    | Fdef (id, al, b, _) ->
       let ty = Hashtbl.find ty (idc ^ "_" ^ id) in
       let mem = Mem.create (Some ty) in
       let _ = Hashtbl.iter

compiler/error.ml

+(*
+** error.ml for Mara
+** 
+** Copyright (C) 2013 Pierre Surply
+** <pierre.surply@gmail.com>
+**
+** This file is part of Mara.
+**
+**    Mara is free software: you can redistribute it and/or modify
+**    it under the terms of the GNU General Public License as published by
+**    the Free Software Foundation, either version 3 of the License, or
+**    (at your option) any later version.
+**
+**    Mara is distributed in the hope that it will be useful,
+**    but WITHOUT ANY WARRANTY; without even the implied warranty of
+**    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+**    GNU General Public License for more details.
+**
+**    You should have received a copy of the GNU General Public License
+**    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
+**
+** Started on  Wed Dec 26 11:47:42 2012 Pierre Surply
+** Last update Fri Mar 29 18:11:31 2013 Pierre Surply
+*)
+
+open Conf
+
+let print_success success =
+  if success then
+    Printf.printf "\t\x1B[32msuccess\x1B[0m\n%!"
+  else
+    Printf.printf "\t\x1B[31mfailure\x1B[0m\n%!"
+
+let print_sample file line (b, e) =
+  let cin = File.load file in
+  for i = 0 to line - 2 do
+    let _ = input_line cin in ()
+  done;
+  let l = input_line cin in
+  let ul = String.create e in
+  Printf.fprintf stderr
+    "\x1B[34m%s\x1B[0m\n" l;
+  for i = 0 to b - 1 do
+    ul.[i] <- ' '
+  done;
+  for i = b to e - 1 do
+    ul.[i] <- '~'
+  done;
+  Printf.fprintf stderr
+    "\x1B[33m%s\x1B[0m\n" ul
+
+let print_error (sp, ep) msg =
+  let line = sp.Lexing.pos_lnum in
+  let b = sp.Lexing.pos_cnum - sp.Lexing.pos_bol in
+  let e = ep.Lexing.pos_cnum - ep.Lexing.pos_bol in
+  print_success false;
+  Printf.fprintf stderr
+    "\x1B[34m**\x1B[0m In file \x1B[34m%s\x1B[0m, line \x1B[34m%d\x1B[0m, characters \x1B[34m%d\x1B[0m-\x1B[34m%d\x1B[0m
+\x1B[34m**\x1B[0m %s"
+    conf.cur_file line b e msg;
+  print_sample conf.cur_file line (b, e);
+  exit 2
+
+let print_simple_error msg =
+  Printf.fprintf stderr
+    "\x1B[31m**\x1B[0m %s" msg;
+  exit 2

compiler/fsm/fsm.ml

         fsm.states
     with
       | Trans_unknown_dest (dest, loc) ->
-	Error.print_error loc;
-	Printf.fprintf stderr
-	  "** Cannot find state %s\n"
-	  dest;
-	exit 3
+	Error.print_error loc
+          (Printf.sprintf
+	     "Cannot find state %s\n"
+	     dest)
       | Trans_unknown_input (input, loc) ->  
-	Error.print_error loc;
-	Printf.fprintf stderr
-	  "** Cannot find input %s\n"
-	  input;
-	exit 3
+	Error.print_error loc
+	  (Printf.sprintf
+	     "Cannot find input %s\n"
+	     input)
   end;
   try
     let _ = Hashtbl.find fsm.states "start" in
 				       Int (1, loc), loc)],
 			      loc);
 		      Return (Field (Var ("self", loc),
-				     "state", ref "", loc), loc)]))::
+				     "state", ref "", loc), loc)], loc))::
 	       !classdef;
   let set_trans (cond, dst) elseb =
     [IfElse ((match cond with
   let set_state_func id (state, _) =
     classdef := (Fdef (id ^ "_action",
 		       [],
-		       state.State.action))::
+		       state.State.action, loc))::
 		(Fdef (id ^ "_trans",
 		       [],
 		       List.fold_right set_trans state.State.trans
-			[Return (Int (-1, loc), loc)]))::
+			[Return (Int (-1, loc), loc)], loc))::
 		(Fdef ("is_" ^ id,
 		       [],
 		       [Return (BinOp("==",
 				      Field (Var ("self", loc),
 				                  "state", ref "", loc),
 				      Int (Hashtbl.find fsm.states_id id, loc),
-				      loc), loc)]))::
+				      loc), loc)], loc))::
 		!classdef
   in
   Hashtbl.iter set_state_func fsm.states;
 				     "waiting", ref "", loc),
 			      Int (0, loc), loc);
 		      Return (Var ("self", loc), loc)
-		     ]))::
+		     ], loc))::
 	      !classdef;
   List.iter
     (fun (ty, id) ->
-       classdef := (Vdef (ty, id))::!classdef)
+       classdef := (Vdef (ty, id, loc))::!classdef)
     fsm.def;
-  classdef := (Vdef ("integer", "state"))::
-  	      (Vdef ("integer", "waiting"))::
+  classdef := (Vdef ("integer", "state", loc))::
+  	      (Vdef ("integer", "waiting", loc))::
 	      !classdef;
   !classdef
 **    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
 **
 ** Started on  Fri Nov  9 15:58:29 2012 Pierre Surply
-** Last update Fri Mar 22 18:01:26 2013 Pierre Surply
+** Last update Fri Mar 29 17:52:22 2013 Pierre Surply
 *)
 
 open Conf
 
-let cmd s = 
-  if conf.v then
-    Printf.printf "%s\n" s;
-  Sys.command s = 0
+let exec name arg =
+  let print_cmd arg =
+    List.iter
+      (fun x -> Printf.printf "%s " x)
+      (Array.to_list arg);
+    Printf.printf "\n%!"
+  in
+  let read, write = Unix.pipe() in
+  if (Unix.fork () == 0) then
+    begin
+      Unix.close read;
+      Unix.dup2 write Unix.stderr;
+      Unix.execvp arg.(0) arg
+    end
+  else
+    begin
+      Unix.close write;
+      Unix.dup2 read Unix.stdin;
+      Printf.printf "%s...%!" name;
+      let _, status = Unix.wait () in
+      match status with
+      | Unix.WEXITED ret when ret = 0 ->
+        Error.print_success true;
+        Unix.close read
+      | _ ->
+        Error.print_success false;
+        print_cmd arg;
+        Printf.printf "\x1B[31m%!";
+        let buff = String.create 512 in
+        let i = Unix.read Unix.stdin buff 0 512 in
+        let _ = Unix.write Unix.stderr buff 0 i in
+        Printf.printf "\x1B[0m%!";
+        Unix.close read;
+        exit 2
+    end
 
 let header () =
   if conf.v then
   Gen.gen globl_env dst
 
 let build_hex f dst =
-  cmd ("avr-gcc -mmcu=" ^ conf.mmcu ^ 
-	  " -x assembler-with-cpp -o _mbuild/" ^
-	  f ^ ".elf " ^ dst) &&
-    cmd ("avr-objcopy -O ihex _mbuild/"
-	 ^ f ^ ".elf " ^ f ^ ".hex")
+  exec "Assembling"
+    [| "avr-gcc";
+       "-mmcu=" ^ conf.mmcu;
+       "-x"; "assembler-with-cpp";
+       "-o"; "_mbuild/" ^ f ^ ".elf";
+       dst
+    |];
+  exec "Linking"
+    [| "avr-objcopy";
+        "-O"; "ihex";
+       "_mbuild/" ^ f ^ ".elf";
+       f ^ ".hex"
+    |]
 
 let show_time () =
   let t = Unix.gmtime (Unix.times ()).Unix.tms_utime in
-  Printf.printf "Finished (%02d:%02d:%02d)\n"
+  Printf.printf "\x1B[32mFinished (%02d:%02d:%02d)\x1B[0m\n"
     t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec
 
 let loop () =
   conf.cur_file <- file;
   let cin = File.load file in
   let lexbuf = Lexing.from_channel cin in
-  if conf.v then
-    Printf.printf "Compiling \'%s\'...\n" file;
+  Printf.printf "Compiling...%!";
   let ast = (Parser.main Lexer.token lexbuf) in
   gen_asm ast dst;
-  if build_hex f dst then
-    show_time ()
-  else
-    exit 1
+  Error.print_success true;
+  build_hex f dst;
+  show_time ()
 
 let main () =
   arg ();
         loop ()
       done
     with File.Cannot_find f ->
-      (Printf.fprintf stderr "** Cannot find \"%s\"\n" f;
-       exit 1)
+      Error.print_simple_error
+        (Printf.sprintf "Cannot find \"%s\"\n" f)
   end;
   exit 0
 

compiler/parser/ast.mli

 **    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
 **
 ** Started on  Fri Nov  9 19:40:14 2012 Pierre Surply
-** Last update Sun Jan 20 12:09:15 2013 Pierre Surply
+** Last update Fri Mar 29 18:00:23 2013 Pierre Surply
 *)
 
 type 'loc expr =
 | Using         of string * 'loc
 
 type 'loc classdef =
-| Vdef		of string * string
+| Vdef		of string * string * 'loc
 | Fdef		of string *
-    string list * ('loc instr) list
+    string list * ('loc instr) list * 'loc
 | Static
 
 type 'loc statedef =

compiler/parser/error.ml

-(*
-** error.ml for Mara
-** 
-** Copyright (C) 2013 Pierre Surply
-** <pierre.surply@gmail.com>
-**
-** This file is part of Mara.
-**
-**    Mara is free software: you can redistribute it and/or modify
-**    it under the terms of the GNU General Public License as published by
-**    the Free Software Foundation, either version 3 of the License, or
-**    (at your option) any later version.
-**
-**    Mara is distributed in the hope that it will be useful,
-**    but WITHOUT ANY WARRANTY; without even the implied warranty of
-**    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-**    GNU General Public License for more details.
-**
-**    You should have received a copy of the GNU General Public License
-**    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
-**
-** Started on  Wed Dec 26 11:47:42 2012 Pierre Surply
-** Last update Sun Jan 20 12:08:59 2013 Pierre Surply
-*)
-
-open Conf
-
-let print_error (sp, ep) =
-  Printf.fprintf stderr
-    "** File \'%s\', line %d, characters %d-%d\n"
-    conf.cur_file
-    sp.Lexing.pos_lnum (sp.Lexing.pos_cnum - sp.Lexing.pos_bol)
-    (ep.Lexing.pos_cnum - ep.Lexing.pos_bol)

compiler/parser/lexer.mll

 **    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
 **
 ** Started on  Fri Nov  9 15:58:41 2012 Pierre Surply
-** Last update Sat Mar 16 22:36:26 2013 Pierre Surply
+** Last update Fri Mar 29 18:57:53 2013 Pierre Surply
 *)
 
 {
   open Parser
 
-  let update_lexbuf lexbuf =
+  let nl lexbuf =
     let p = lexbuf.Lexing.lex_curr_p in
       lexbuf.Lexing.lex_curr_p <- {
 	p with
 	  Lexing.pos_bol  = p.Lexing.pos_cnum;
       }
 
-  let update_nlexbuf n lexbuf =
+  let nnl n lexbuf =
     for i = 1 to n do
-      update_lexbuf lexbuf
+      nl lexbuf
     done
 
+  let strbuf = Buffer.create 128
+  let asmon = ref false
+
   let ht_kwd = Hashtbl.create 13
   let kwd =
     [("setup",		SETUP);
      ("fsm", 		FSM);
      ("begin",		BEGIN);
      ("end",		END);
-     ("asm",		ASM);
      ("new",		NEW);
      ("del",		DEL);
      ("return",		RETURN);
 
 }
 
-let white = [' ' '\t'] | ("\\" [' ' '\t']* "\n")
+let white = [' ' '\t']
 
 let ident = ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '0'-'9' '_']*
 
 let int1 = "true"
 
 let symba = "+" | "++" | "-" | "--" | "*" | "**" | "/" | "//" | "%" | "%" | "(" | ")" | "{" | "}" | 
-    "<<" | "bitls" | "<<<<" | ">>" | "bitrs" | ">>>>" | "|" | "bitor" | "||" | "&" | "bitand" | "&&" | "or" | "and" | "<-" | "->" | "," |
+    "<<" | "bitls" | "<<<<" | ">>" | "bitrs" | ">>>>" | "|" | "bitor" | "||" | 
+        "&" | "bitand" | "&&" | "or" | "and" | "<-" | "->" | "," |
 	"<" | ">" | "<=" | ">=" | "<>" | "=" | "[" | "]" | "." | ":" |
 	    "not" | "~" | "compl" | "_" | "?" | "::" | ";"
 
 let integer = ['0'-'9']+ | ("0b" ['0' '1']+) | ("0x" ['0'-'9' 'A'-'F' 'a'-'f']+)
 
 rule token = parse
-    | white			{ token lexbuf }
-    | ['\n']+ as lxm		{ update_nlexbuf (String.length lxm) lexbuf; EOL }
+    | white                     { token lexbuf }
+    | "\\" [' ' '\t']* "\n"     { nl lexbuf; token lexbuf }
+    | ['\n']+ as lxm		{ nnl (String.length lxm) lexbuf; EOL }
     | "#"			{ comment lexbuf }
     | integer as lxm		{ INT(int_of_string lxm) }
     | int0			{ INT(0) }
     | int1			{ INT(1) }
     | '\''([^'\''] as c)'\''	{ CHAR(c) }
-    | '"'([^'"']* as s)'"'	{ STR(s) }
+    | "asm"                     { asmon := true; ASM }
+    | '"'
+        {
+          Buffer.reset strbuf;
+          if !asmon then
+            begin
+              asmstr strbuf lexbuf;
+              asmon := false;
+            end
+          else
+            str strbuf lexbuf;
+          STR (Buffer.contents strbuf)
+        }
     | symba as s		{ Hashtbl.find ht_sym s }
     | ident as i		{ try
 				    Hashtbl.find ht_kwd i
     | eof			{ EOF }
 
 and comment = parse
-    | "\n"		{ update_lexbuf lexbuf; EOL }
+    | '\n'		{ nl lexbuf; EOL }
     | eof		{ EOF }
     | _			{ comment lexbuf }
+
+and str s = parse
+    | '"'               { () }
+    | '\n'              { nl lexbuf;
+                          Buffer.add_string s "\\n";
+                          str s lexbuf}
+    | _ as c            { Buffer.add_char s c;
+                          str s lexbuf}
+and asmstr s = parse
+    | '"'               { () }
+    | '\n' [' ' '\t']*  { Buffer.add_string s "\n\t";
+                          asmstr s lexbuf}
+    | _ as c            { Buffer.add_char s c;
+                          asmstr s lexbuf}

compiler/parser/parser.mly

 **    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
 **
 ** Started on  Fri Nov  9 15:58:54 2012 Pierre Surply
-** Last update Mon Mar 18 08:18:31 2013 Pierre Surply
+** Last update Fri Mar 29 18:00:57 2013 Pierre Surply
 *)
 
   open Parsing
   open Lexing
 
   let print_error pos =
-    Error.print_error pos;
-    Printf.fprintf stderr "** Syntax error\n";
-    exit 2
+    Error.print_error pos
+      (Printf.sprintf "Syntax error\n")
 %}
 
 %token <int> INT
 classdef:
   | STATIC                                      { Ast.Static }
   | FUN id=ID LPAREN vl=varlist RPAREN EOL b=body END
-                                                { Ast.Fdef(id, vl, b)}
-  | ty=ID id=ID                                 { Ast.Vdef(ty, id) }
+                                                { Ast.Fdef(id, vl, b, ($startpos, $endpos))}
+  | ty=ID id=ID                                 { Ast.Vdef(ty, id, ($startpos, $endpos)) }
   | error                                       { print_error ($startpos, $endpos) }
 ;
 

compiler/semantic/opt.ml

 **    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
 ** 
 ** Started on  Thu Jan  3 11:35:06 2013 Pierre Surply
-** Last update Sun Jan 20 12:08:28 2013 Pierre Surply
+** Last update Fri Mar 29 18:15:12 2013 Pierre Surply
 *)
 
 open Ast
 	globl_env.Env.ast
     with
       | Cannot_find_class (cl, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** Cannot find class %s\n"
-	    cl;
-	  exit 3
-      | Undeclared_var (v, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** Unbound variable %s\n"
-	    v;
-	  exit 3
-      | Unknown_field (f, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** This expression has not \'%s\' field\n"
-	    f;
-	  exit 3
-      | Unknown_method (m, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** This expression has not \'%s\' method\n"
-	    m;
-	  exit 3
-      | Unknown_function (m, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** \'%s\' function is not defined\n"
-	    m;
-	  exit 3
-      | Not_an_object (loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** This expression is not an object\n";
-	  exit 3
-      | Given_arg (m, g, e, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** \'%s\' expected %d argument(s) (%d given)\n"
-	    m e g;
-	  exit 3
-      | No_init (c, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** \'%s\' has not constructor\n" c;
-	  exit 3
-      | Ret_nometh loc ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr
-	    "** Return statement must be used in a method\n";
-	  exit 3
-      | Bad_type (e, g, loc) ->
-	  Error.print_error loc;
-	  Printf.fprintf stderr 
-	    "** This expression has type \'%s\'\n   but an expression was expected of type \'%s\'\n"
-	    (type2str g) (type2str e);
-	  exit 3
+	  Error.print_error loc
+	    (Printf.sprintf
+                "Cannot find class %s\n"
+                cl)
+       | Undeclared_var (v, loc) ->
+           Error.print_error loc
+             (Printf.sprintf
+                "Unbound variable %s\n"
+                v)
+       | Unknown_field (f, loc) ->
+           Error.print_error loc
+             (Printf.sprintf
+                "This expression has not \'%s\' field\n"
+                f)
+       | Unknown_method (m, loc) ->
+	  Error.print_error loc
+	    (Printf.sprintf
+	       "This expression has not \'%s\' method\n"
+	       m)
+       | Unknown_function (m, loc) ->
+	 Error.print_error loc
+	   (Printf.sprintf
+	      "\'%s\' function is not defined\n"
+	      m)
+       | Not_an_object (loc) ->
+	 Error.print_error loc "This expression is not an object\n"
+       | Given_arg (m, g, e, loc) ->
+	 Error.print_error loc
+	   (Printf.sprintf
+	      "\'%s\' expected %d argument(s) (%d given)\n"
+	      m e g)
+       | No_init (c, loc) ->
+	 Error.print_error loc
+	   (Printf.sprintf "\'%s\' has not constructor\n" c)
+       | Ret_nometh loc ->
+	 Error.print_error loc
+	   (Printf.sprintf
+	      "Return statement must be used in a function/method\n")
+       | Bad_type (e, g, loc) ->
+	 Error.print_error loc
+	   (Printf.sprintf
+	      "This expression has type \'%s\'\nbut an expression was expected of type \'%s\'\n"
+	      (type2str g) (type2str e))
   end

compiler/semantic/sem.ml

 **    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
 **
 ** Started on  Tue Dec 25 12:49:26 2012 Pierre Surply
-** Last update Fri Jan 25 19:18:34 2013 Pierre Surply
+** Last update Fri Mar 29 18:04:37 2013 Pierre Surply
 *)
 
 open Ast
 	begin
 	  try
 	    let _ = Hashtbl.find globl.Env.cl cl in ()
-	  with Not_found -> load_class globl cl
+	  with Not_found -> load_class loc globl cl
 	end;
 	let cla = Hashtbl.find globl.Env.cl cl in
 	  begin
         if rt = Tnone then
           let _ = get_type_expr ~fty:lt cl fix_ty globl local re in ()
         else
-          let _ = cmp_type loc (rt, lt) in ()
+          let _ = cmp_type loc (lt, rt) in ()
       end;
       Affect (opt_expr local le, opt_expr local re, loc)
     | Return (e, loc) ->
     | Static ->
       cl.Class.static <- true;
       Static
-    | Vdef (ty, id) ->
+    | Vdef (ty, id, loc) ->
       let t = str2type ty in
       begin
         match t with
 	  begin
 	    try
 	      let _ = Hashtbl.find globl.Env.cl cl in ()
-	    with Not_found -> load_class globl cl
+	    with Not_found -> load_class loc globl cl
 	  end
         | _ -> ()
       end;
       Hashtbl.add cl.Class.prop id t;
-      Vdef (ty, id)
-    | Fdef (id, al, il) ->
+      Vdef (ty, id, loc)
+    | Fdef (id, al, il, loc) ->
       let m, oil, env = add_method cl idcl id globl al il in
       Hashtbl.add globl.Env.local (idcl ^ "_" ^ id) env;
-      Fdef (id, al, oil)
+      Fdef (id, al, oil, loc)
   in
     List.map build def
 
-and load_class globl id =
-  if conf.v then
-    Printf.printf "Loading class : \'%s\'...\n" id;
+and load_class loc globl id =
   let old_file = conf.cur_file in
-  conf.cur_file <- (id ^ ".mr");
   let cl = Class.create () in
-  let lexbuf = Lexing.from_channel (File.load (id ^ ".mr")) in
+  let cin =
+    try
+      File.load (id ^ ".mr")
+    with File.Cannot_find _ ->
+      raise (Cannot_find_class (id, loc))
+  in
+  conf.cur_file <- (id ^ ".mr");
+  let lexbuf = Lexing.from_channel cin in
   let ast = (Parser.main Lexer.token lexbuf) in
   begin
     let rec r_load = function
     in
     r_load ast
   end;
-    if conf.v then
-      begin
-	Hashtbl.iter 
-	  (fun id ty -> Printf.printf "# %s %s\n"
-	     (Typing.type2str ty) id)
-	  cl.Class.prop;
-	Hashtbl.iter 
-	  (fun id m ->
-             Printf.printf "# %s: " id;
-             List.iter
-               (fun (id, ty) ->
-		  Printf.printf "(%s:%s) -> " id
-		    (Typing.type2str ty))
-               m.Class.arg;
-             Printf.printf "%s\n" (Typing.type2str m.Class.ret))
-	  cl.Class.m;
-	Printf.printf "\'%s\' loaded\n" id;
-      end;
-    conf.cur_file <- old_file
+  conf.cur_file <- old_file
 
 and eval_header globl =
   let rec eval = function
-    | Using (s, _) ->
+    | Using (s, loc) ->
       if not
         (List.exists
            (fun x -> x = s)
            globl.Env.st_cl)
       then
         begin
-          load_class globl s;
+          load_class loc globl s;
           globl.Env.st_cl <- s::globl.Env.st_cl
         end
   in

samples/fsm/Makefile

 ## Started on  Wed Oct 24 18:38:55 2012
 ##
 
-MCU		= 8515
+MCU		= 644
 
 MARAC		= marac
 MFLAGS		= -mmcu atmega$(MCU) -v
+# Atoi
+
+using cstring
+
+begin lib
+  func is_nbr(s)
+    var i <- 0
+    var c <- 0
+    var b <- 10
+    if str_get(s, 0) = '0' then
+      if str_get(s, 1) = 'x' then
+        b <- 16
+        i <- 2
+      elif str_get(s, 1) = 'b' then
+        b <- 2
+        i <- 2
+      endif
+    endif
+    c <- str_get(s, i)
+    while c do
+      if not ((b = 10 and '0' <= c  and c <= '9') or \
+              (b = 2 and ('0' = c  or c = '1')) or \
+              (b = 16 and (('0' <= c  and c <= '9') or \
+                          ('a' <= c  and c <= 'f') or \
+                          ('A' <= c  and c <= 'F')))) then
+        return false
+      endif
+      i ++ 1
+      c <- str_get(s, i)
+    done
+    return true
+  end
+
+  func atoi(s)
+    var i <- 0
+    var a <- 0
+    var c <- 0
+    if str_get(s, 0) = '0' and  \
+       str_get(s, 1) = 'x' then
+      i <- 2
+      c <- str_get(s, i)
+      while c do
+        a <<<< 4
+        if 'A' <= c and c <= 'F' then
+          c <- c - 'A' + 0xA
+        elif 'a' <= c and c <= 'f' then
+          c <- c - 'a' + 0xA
+        else
+          c <- c - '0'
+        endif
+        a || c
+        i ++ 1
+        c <- str_get(s, i)
+      done
+    elif str_get(s, 0) = '0' and  \
+         str_get(s, 1) = 'b' then
+      i <- 2
+      c <- str_get(s, i)
+      while c do
+        a <<<< 1
+        a || c - '0'
+        i ++ 1
+        c <- str_get(s, i)
+      done
+    else
+      while str_get(s, i) do
+        a ** 10
+        a ++ str_get(s, i) - '0'
+        i ++ 1
+      done
+    endif
+    return a
+  end
+end

stdlib/cstring.mr

+##
+## cstring.mr for Mara
+##  
+## Copyright (C) 2013 Pierre Surply
+## <pierre.surply@gmail.com>
+##
+## This file is part of Mara.
+##
+##    Mara is free software: you can redistribute it and/or modify
+##    it under the terms of the GNU General Public License as published by
+##    the Free Software Foundation, either version 3 of the License, or
+##    (at your option) any later version.
+##
+##    Mara is distributed in the hope that it will be useful,
+##    but WITHOUT ANY WARRANTY; without even the implied warranty of
+##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##    GNU General Public License for more details.
+##
+##    You should have received a copy of the GNU General Public License
+##    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
+##
+
+begin lib
+  func str_get(s, i)
+    asm{{cstring : s}} "movw r30, r24"
+    asm{i}             "add  r30, r24
+                        adc  r31, r25"
+    return asm         "ld   r24, Z
+                        ldi  r25, 0"
+  end
+
+  func str_set(s, i, x)
+    asm{{cstring : s}} "movw r30, r24"
+    asm{i}             "add  r30, r24
+                        adc  r31, r25"
+    asm{x}             "st   Z, r24"
+  end
+
+  func str_cmp(s, d)
+    var i <- 0
+    var cs <- str_get(s, 0)
+    var cd <- str_get(d, 0)
+    while cd and cs and cd = cs do
+      i ++ 1
+      cs <- str_get(s, i)
+      cd <- str_get(d, i)
+    done
+    return (cs - cd)
+  end
+end
+##
+## string.mr for Mara
+##  
+## Copyright (C) 2013 Pierre Surply
+## <pierre.surply@gmail.com>
+##
+## This file is part of Mara.
+##
+##    Mara is free software: you can redistribute it and/or modify
+##    it under the terms of the GNU General Public License as published by
+##    the Free Software Foundation, either version 3 of the License, or
+##    (at your option) any later version.
+##
+##    Mara is distributed in the hope that it will be useful,
+##    but WITHOUT ANY WARRANTY; without even the implied warranty of
+##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##    GNU General Public License for more details.
+##
+##    You should have received a copy of the GNU General Public License
+##    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
+##
+
+using cstring
+using list
+
+begin class
+  integer         size
+  cstring         s
+
+  func init(size)
+    self.size <- size
+    self.s <- asm{size} "call malloc"
+    str_set(self.s, 0, 0)
+    return self
+  end
+
+  func destr()
+    asm{self.s} "call free"
+    return self
+  end
+
+  func set(i, x)
+    str_set(self.s, i, x)
+  end
+
+  func get(i)
+    return str_get(self.s, i)
+  end
+
+  func length()
+    var i <- 0
+    while self[i] do
+      i ++ 1
+    done
+    return i
+  end
+
+  func write_from(s, n)
+    var i <- 0
+    var c <- str_get(s, i)
+    while c and (i + n) < (self.size - 1) do
+      c <- str_get(s, i)
+      str_set(self.s, i + n, c)
+      i ++ 1
+    done
+    str_set(self.s, i + n, 0)
+  end
+
+  func write(s)
+    self.write_from(s, 0)
+  end
+
+  func cat(s)
+    var i <- 0
+    while str_get(self.s, i) do
+      i ++ 1
+    done
+    self.write_from(s, i)
+  end
+
+  func append_char(c)
+    var i <- 0
+    while str_get(self.s, i) do
+      i ++ 1
+    done
+    if i + 1 < self.size then
+      str_set(self.s, i, c)
+      str_set(self.s, i + 1, 0)
+      return true
+    else
+      return false
+    endif
+  end
+
+  func delete_char()
+    var i <- 0
+    while str_get(self.s, i) do
+      i ++ 1
+    done
+    if i > 0 then
+      str_set(self.s, i-1, 0)
+      return true
+    endif
+    return false
+  end
+
+  func print_digit(i, shift)
+    var c <- 0
+    i <- (i bitrs shift) bitand 0xF
+    if i < 0xA then
+      c <- i + '0'
+    else
+      c <- i - 0xA + 'A'
+    endif
+    self.append_char(c)
+  end
+
+  func itoa_rec(i)
+    var c <- i % 10
+    if i > 0 then
+      self.itoa_rec(i / 10)
+      self.append_char(c + '0')
+    endif
+  end
+
+  func itoa(i)
+    self.set(0, 0)
+    if i = 0 then
+      self.append_char('0')
+    else
+      if i < 0 then
+        self.append_char('-')
+        i <- -i
+      endif
+      self.itoa_rec(i)
+    endif
+  end
+
+  func itoa_hex(i, digit)
+    self.set(0, 0)
+    for j <- 0 to digit - 1 do
+      self.print_digit(i, \
+                       (digit - j - 1) * 4)
+    done
+  end
+
+  func split(sep)
+    var l <- []
+    var i <- self.length() - 1
+    while i and (self[i] = sep) do
+      self.set(i, 0)
+      i -- 1
+    done
+    while i do
+      if self[i] = sep then
+        l.push({integer : self.s} + i + 1)
+        while self[i] = sep do
+          self.set(i, 0)
+          i -- 1
+        done
+      endif
+      i -- 1
+    done
+    l.push(self.s)
+    return l
+  end
+end
+# UART
+
+using cstring
+
+begin class
+  integer rate
+
+  func init(rate)
+    self.rate <- rate
+    asm{rate} "sts UBRR0L, r24
+               sts UBRR0H, r25
+               ldi r24, (1 << TXEN0) | (1 << RXEN0)
+               sts UCSR0B, r24
+               ldi r24, (3 << UCSZ00)
+               sts UCSR0C, r24"
+    return self
+  end
+
+  func destr()
+    return self
+  end
+
+  func send(x)
+    waitfor not \
+      (((asm "lds   r24, UCSR0A
+              clr  r25") >> 5) & 1)
+    asm{x} "sts UDR0, r24"
+  end
+
+  func available()
+    return (((asm "lds   r24, UCSR0A
+                   clr  r25") >> 7) & 1)
+  end
+
+  func recv()
+    return asm "lds  r24, UDR0
+                clr r25"
+  end
+
+  func write(s)
+    var i <- 0
+    var c <- str_get(s, 0)
+
+    while c do
+      self.send(c)
+      i ++ 1
+      c <- str_get(s, i)
+    done
+  end
+
+  func newline()
+    self.write("\n\r")
+  end
+end
+##
+## vect.mr for Mara
+##  
+## Copyright (C) 2013 Pierre Surply
+## <pierre.surply@gmail.com>
+##
+## This file is part of Mara.
+##
+##    Mara is free software: you can redistribute it and/or modify
+##    it under the terms of the GNU General Public License as published by
+##    the Free Software Foundation, either version 3 of the License, or
+##    (at your option) any later version.
+##
+##    Mara is distributed in the hope that it will be useful,
+##    but WITHOUT ANY WARRANTY; without even the implied warranty of
+##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##    GNU General Public License for more details.
+##
+##    You should have received a copy of the GNU General Public License
+##    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
+##
+
+begin class
+  integer         length
+  undef           vect
+
+  func init(length)
+    self.length <- length
+    self.vect <- asm{length * 2} "call malloc"
+    return self
+  end
+
+  func destr()
+    asm{self.vect} "call free"
+    return self
+  end
+
+  func set(i, x)
+    asm{self.vect} "movw r30, r24"
+    asm{i << 1}    "add  r30, r24
+                    adc  r31, r25"
+    asm{x}         "st   Z, r24
+                    std  Z+1, r25"
+  end
+
+  func get(i)
+    asm{self.vect} "movw r30, r24"
+    asm{i << 1}    "add  r30, r24
+                    adc  r31, r25"
+    return asm     "ld   r24, Z
+                    ldd  r25, Z+1"
+  end
+
+  func fill(x)
+    for i <- 0 to self.length - 1 do
+      self.set(i, x)
+    done
+  end
+end

term/atoi.mr

-# Atoi
-
-using cstring
-
-begin lib
-  func is_nbr(s)
-    var i <- 0
-    var c <- 0
-    var b <- 10
-    if str_get(s, 0) = '0' then
-      if str_get(s, 1) = 'x' then
-        b <- 16
-        i <- 2
-      elif str_get(s, 1) = 'b' then
-        b <- 2
-        i <- 2
-      endif
-    endif
-    c <- str_get(s, i)
-    while c do
-      if not ((b = 10 and '0' <= c  and c <= '9') or \
-              (b = 2 and ('0' = c  or c = '1')) or \
-              (b = 16 and (('0' <= c  and c <= '9') or \
-                          ('a' <= c  and c <= 'f') or \
-                          ('A' <= c  and c <= 'F')))) then
-        return false
-      endif
-      i ++ 1
-      c <- str_get(s, i)
-    done
-    return true
-  end
-
-  func atoi(s)
-    var i <- 0
-    var a <- 0
-    var c <- 0
-    if str_get(s, 0) = '0' and  \
-       str_get(s, 1) = 'x' then
-      i <- 2
-      c <- str_get(s, i)
-      while c do
-        a <<<< 4
-        if 'A' <= c and c <= 'F' then
-          c <- c - 'A' + 0xA
-        elif 'a' <= c and c <= 'f' then
-          c <- c - 'a' + 0xA
-        else
-          c <- c - '0'
-        endif
-        a || c
-        i ++ 1
-        c <- str_get(s, i)
-      done
-    elif str_get(s, 0) = '0' and  \
-         str_get(s, 1) = 'b' then
-      i <- 2
-      c <- str_get(s, i)
-      while c do
-        a <<<< 1
-        a || c - '0'
-        i ++ 1
-        c <- str_get(s, i)
-      done
-    else
-      while str_get(s, i) do
-        a ** 10
-        a ++ str_get(s, i) - '0'
-        i ++ 1
-      done
-    endif
-    return a
-  end
-end

term/cstring.mr

-##
-## cstring.mr for Mara
-##  
-## Copyright (C) 2013 Pierre Surply
-## <pierre.surply@gmail.com>
-##
-## This file is part of Mara.
-##
-##    Mara is free software: you can redistribute it and/or modify
-##    it under the terms of the GNU General Public License as published by
-##    the Free Software Foundation, either version 3 of the License, or
-##    (at your option) any later version.
-##
-##    Mara is distributed in the hope that it will be useful,
-##    but WITHOUT ANY WARRANTY; without even the implied warranty of
-##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-##    GNU General Public License for more details.
-##
-##    You should have received a copy of the GNU General Public License
-##    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
-##
-
-begin lib
-  func str_get(s, i)
-    asm{{cstring : s}} "movw r30, r24"
-    asm{i}             "add  r30, r24
-                        adc  r31, r25"
-    return asm         "ld   r24, Z
-                        ldi  r25, 0"
-  end
-
-  func str_set(s, i, x)
-    asm{{cstring : s}} "movw r30, r24"
-    asm{i}             "add  r30, r24
-                        adc  r31, r25"
-    asm{x}             "st   Z, r24"
-  end
-
-  func str_cmp(s, d)
-    var i <- 0
-    var cs <- str_get(s, 0)
-    var cd <- str_get(d, 0)
-    while cd and cs and cd = cs do
-      i ++ 1
-      cs <- str_get(s, i)
-      cd <- str_get(d, i)
-    done
-    return (cs - cd)
-  end
-end

term/string.mr

-##
-## string.mr for Mara
-##  
-## Copyright (C) 2013 Pierre Surply
-## <pierre.surply@gmail.com>
-##
-## This file is part of Mara.
-##
-##    Mara is free software: you can redistribute it and/or modify
-##    it under the terms of the GNU General Public License as published by
-##    the Free Software Foundation, either version 3 of the License, or
-##    (at your option) any later version.
-##
-##    Mara is distributed in the hope that it will be useful,
-##    but WITHOUT ANY WARRANTY; without even the implied warranty of
-##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-##    GNU General Public License for more details.
-##
-##    You should have received a copy of the GNU General Public License
-##    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
-##
-
-using cstring
-using list
-
-begin class
-  integer         size
-  cstring         s
-
-  func init(size)
-    self.size <- size
-    self.s <- asm{size} "call malloc"
-    str_set(self.s, 0, 0)
-    return self
-  end
-
-  func destr()
-    asm{self.s} "call free"
-    return self
-  end
-
-  func set(i, x)
-    str_set(self.s, i, x)
-  end
-
-  func get(i)
-    return str_get(self.s, i)
-  end
-
-  func length()
-    var i <- 0
-    while self[i] do
-      i ++ 1
-    done
-    return i
-  end
-
-  func write_from(s, n)
-    var i <- 0
-    var c <- str_get(s, i)
-    while c and (i + n) < (self.size - 1) do
-      c <- str_get(s, i)
-      str_set(self.s, i + n, c)
-      i ++ 1
-    done
-    str_set(self.s, i + n, 0)
-  end
-
-  func write(s)
-    self.write_from(s, 0)
-  end
-
-  func cat(s)
-    var i <- 0
-    while str_get(self.s, i) do
-      i ++ 1
-    done
-    self.write_from(s, i)
-  end
-
-  func append_char(c)
-    var i <- 0
-    while str_get(self.s, i) do
-      i ++ 1
-    done
-    if i + 1 < self.size then
-      str_set(self.s, i, c)
-      str_set(self.s, i + 1, 0)
-      return true
-    else
-      return false
-    endif
-  end
-
-  func delete_char()
-    var i <- 0
-    while str_get(self.s, i) do
-      i ++ 1
-    done
-    if i > 0 then
-      str_set(self.s, i-1, 0)
-      return true
-    endif
-    return false
-  end
-
-  func print_digit(i, shift)
-    var c <- 0
-    i <- (i bitrs shift) bitand 0xF
-    if i < 0xA then
-      c <- i + '0'
-    else
-      c <- i - 0xA + 'A'
-    endif
-    self.append_char(c)
-  end
-
-  func itoa_rec(i)
-    var c <- i % 10
-    if i > 0 then
-      self.itoa_rec(i / 10)
-      self.append_char(c + '0')
-    endif
-  end
-
-  func itoa(i)
-    self.set(0, 0)
-    if i = 0 then
-      self.append_char('0')
-    else
-      if i < 0 then
-        self.append_char('-')
-        i <- -i
-      endif
-      self.itoa_rec(i)
-    endif
-  end
-
-  func itoa_hex(i, digit)
-    self.set(0, 0)
-    for j <- 0 to digit - 1 do
-      self.print_digit(i, \
-                       (digit - j - 1) * 4)
-    done
-  end
-
-  func split(sep)
-    var l <- []
-    var i <- self.length() - 1
-    while i and (self[i] = sep) do
-      self.set(i, 0)
-      i -- 1
-    done
-    while i do
-      if self[i] = sep then
-        l.push({integer : self.s} + i + 1)
-        while self[i] = sep do
-          self.set(i, 0)
-          i -- 1
-        done
-      endif
-      i -- 1
-    done
-    l.push(self.s)
-    return l
-  end
-end

term/uart.mr

-# UART
-
-using cstring
-
-begin class
-  integer rate
-
-  func init(rate)
-    self.rate <- rate
-    asm{rate} "sts UBRR0L, r24
-               sts UBRR0H, r25
-               ldi r24, (1 << TXEN0) | (1 << RXEN0)
-               sts UCSR0B, r24
-               ldi r24, (3 << UCSZ00)
-               sts UCSR0C, r24"
-    return self
-  end
-
-  func destr()
-    return self
-  end
-
-  func send(x)
-    waitfor not \
-      (((asm "lds   r24, UCSR0A
-              clr  r25") >> 5) & 1)
-    asm{x} "sts UDR0, r24"
-  end
-
-  func available()
-    return (((asm "lds   r24, UCSR0A
-                   clr  r25") >> 7) & 1)
-  end
-
-  func recv()
-    return asm "lds  r24, UDR0
-                clr r25"
-  end
-
-  func write(s)
-    var i <- 0
-    var c <- str_get(s, 0)
-
-    while c do
-      self.send(c)
-      i ++ 1
-      c <- str_get(s, i)
-    done
-  end
-
-  func newline()
-    self.write("\n\r")
-  end
-end

term/vect.mr

-##
-## vect.mr for Mara
-##  
-## Copyright (C) 2013 Pierre Surply
-## <pierre.surply@gmail.com>
-##
-## This file is part of Mara.
-##
-##    Mara is free software: you can redistribute it and/or modify
-##    it under the terms of the GNU General Public License as published by
-##    the Free Software Foundation, either version 3 of the License, or
-##    (at your option) any later version.
-##
-##    Mara is distributed in the hope that it will be useful,
-##    but WITHOUT ANY WARRANTY; without even the implied warranty of
-##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-##    GNU General Public License for more details.
-##
-##    You should have received a copy of the GNU General Public License
-##    along with Mara.  If not, see <http://www.gnu.org/licenses/>.
-##
-
-begin class
-  integer         length
-  undef           vect
-
-  func init(length)
-    self.length <- length
-    self.vect <- asm{length * 2} "call malloc"
-    return self
-  end
-
-  func destr()
-    asm{self.vect} "call free"
-    return self
-  end
-
-  func set(i, x)
-    asm{self.vect} "movw r30, r24"
-    asm{i << 1}    "add  r30, r24
-                    adc  r31, r25"
-    asm{x}         "st   Z, r24
-                    std  Z+1, r25"
-  end
-
-  func get(i)
-    asm{self.vect} "movw r30, r24"
-    asm{i << 1}    "add  r30, r24
-                    adc  r31, r25"
-    return asm     "ld   r24, Z
-                    ldd  r25, Z+1"
-  end
-
-  func fill(x)
-    for i <- 0 to self.length - 1 do
-      self.set(i, x)
-    done
-  end
-end

website/templates/base.html

           </ul>
           <div class='fl'>Download</div>
           <ul>
-            <li><a href="http://git.psurply.com/mara/get/5.tar.bz2">Source code</a></li>
+            <li><a href="http://git.psurply.com/mara/get/8.tar.bz2">Source code</a></li>
             <li><a href="http://git.psurply.com/mara/">Git repository</a></li>
           </ul>
           <div class='fl'>Links</div>
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.