Merge pull request #1 from neosilky/define

Implement renaming

.gitignore

@@ -1,5 +1,5 @@
 src/lexer.ml
-src/main
+src/mysplinterpreter
 src/parser.ml
 src/parser.mli
 src/parser.output

example/test/test1.asm

@@ -5,4 +5,4 @@ main:
 	ADD r1, r3, 2
 	ADD r5, r3, r3
 	MOV r2, r5
-	JMP main
+	JMP main

example/test/test10.asm

@@ -1,6 +1,6 @@
 	MOV r-1, 21
 	MOV o1, r-1
-	NXT stdout,o
+	NXT stdout, o
 	MOV r1, -1
 	MOV o1, r1
-	NXT stdout,o
+	NXT stdout, o

example/test/test15.asm

@@ -0,0 +1,5 @@
+#DEF register r0
+
+	MOV register, 22
+	MOV o1, register
+	NXT stdout, o

example/test/test16.asm

@@ -0,0 +1,6 @@
+#DEF reg r0
+
+	MOV r22, 64
+	MOV reg, 22
+	MOV o1, r[reg]
+	NXT stdout, o

example/test/test2.asm

@@ -3,4 +3,4 @@
 	ADD r1, r2, r3 ; r1 = 0, r2 = 0, r3 = 0
 	ADD r4, r1, 4 ; r4 = 4, r1 = 0
 	SUB r3, r[r4], 1 ; r3 = 3, r[r4] = r4 = 4
-	MOV r5, r4 ; r5 = 4, r4 = 4 
+	MOV r5, r4 ; r5 = 4, r4 = 4

src/Makefile

@@ -11,9 +11,9 @@
 #                  existing modules.  (The graph is stored in the file
 #                  .depend)
 
-# These are the object files needed to rebuild the main executable file
+# These are the object files needed to rebuild the mysplinterpreter executable file
 #
-OBJS = Streasm.cmo parser.cmo lexer.cmo main.cmo 
+OBJS = Streasm.cmo parser.cmo lexer.cmo mysplinterpreter.cmo 
 
 COMMONOBJS = str.cma
 
@@ -22,15 +22,15 @@ DEPEND += lexer.ml parser.ml
 
 # When "make" is invoked with no arguments, we build an executable 
 # typechecker, after building everything that it depends on
-all: $(DEPEND) $(OBJS) main
+all: $(DEPEND) $(OBJS) mysplinterpreter
 
 # Include an automatically generated list of dependencies between source files
 include .depend
 
 # Build an executable typechecker
-main: $(OBJS) main.cmo 
+mysplinterpreter: $(OBJS) mysplinterpreter.cmo 
 	@echo Linking $@
-	ocamlc -o $@ $(COMMONOBJS) $(OBJS) 
+	ocamlc -o $@ $(COMMONOBJS) $(OBJS)
 
 # Compile an ML module interface
 %.cmi : %.mli
@@ -54,7 +54,7 @@ parser.ml parser.mli: parser.mly
 
 # Clean up the directory
 clean::
-	rm -rf lexer.ml parser.ml parser.mli *.o *.cmo *.cmi parser.output main c TAGS *~ 
+	rm -rf lexer.ml parser.ml parser.mli *.o *.cmo *.cmi parser.output mysplinterpreter c TAGS *~ 
 
 # Rebuild intermodule dependencies
 depend:: $(DEPEND) 

src/Streasm.ml

@@ -4,8 +4,15 @@ let running = ref true;;
 let return_stack : int list ref = ref [];;
 let lines : string array array ref = ref (Array.of_list ((Array.of_list ("" :: [])) :: []));;
 let index = ref 0;;
+let renamings = Hashtbl.create 16;;
 let registers = Hashtbl.create 32;;
 let labels = Hashtbl.create 32;;
+let regex_lit = "\\(-?[0-9]+\\)"
+let regex_char = "\\([a-zA-Z]\\)"
+let regex_str = "\\([a-zA-Z]+\\)"
+let regex_reg = regex_char ^ regex_lit
+let regex_nreg = regex_char ^ "\\[\\([a-zA-Z]-?[0-9]+\\)\\]"
+let regex_nreg2 = regex_char ^ "\\[\\([a-zA-Z]+\\)\\]"
 
 let map_label (label: string) (line: int) = 
     if label <> "" then
@@ -25,35 +32,59 @@ let rec find_label_aux (label: string) (index: int) =
 
 let find_label (label: string) =             
     if Hashtbl.mem labels label then Hashtbl.find labels label 
-    else find_label_aux label !index        
+    else find_label_aux label !index
+
+let get_name_binding (name: string) =
+    if Hashtbl.mem renamings name then Hashtbl.find renamings name
+    else raise (Failure ("The naming " ^ name ^ " is undefined at instruction " ^ (string_of_int !index)))   
 
-let lookup (register: string) = 
-    if Hashtbl.mem registers register then Hashtbl.find registers register
-    else raise (Failure ("The register " ^ register ^ " is unbound on instruction " ^ (string_of_int !index)))
+let rec lookup (register: string) =
+    if Str.string_match (Str.regexp regex_reg) register 0 then
+        if Hashtbl.mem registers register then Hashtbl.find registers register
+        else raise (Failure ("The register " ^ register ^ " is unbound on instruction " ^ (string_of_int !index)))
+    else if Str.string_match (Str.regexp regex_str) register 0 then
+        lookup (get_name_binding register)
+    else raise (Failure ("Unexpected error: Asked to lookup " ^ register))
 
-let value (register: string) =
-    if Str.string_match (Str.regexp "[-]?[0-9]+") register 0 then
+let rec value (register: string) =
+    if Str.string_match (Str.regexp regex_lit) register 0 then
         int_of_string register
-    else if Str.string_match (Str.regexp "[a-zA-Z]+[-]?[0-9]+") register 0 then
+    else if Str.string_match (Str.regexp regex_reg) register 0 then
         lookup register
-    else if Str.string_match (Str.regexp "\\([a-zA-Z]+\\)\\[\\([a-zA-Z]+[-]?[0-9]+\\)\\]") register 0 then  (* match for example r[r1] *)
+    else if Str.string_match (Str.regexp regex_nreg) register 0 || Str.string_match (Str.regexp regex_nreg2) register 0 then  (* match for example r[r1] or r[nicename] *)
         let outer = Str.matched_group 1 register in
             let inner = Str.matched_group 2 register in
-                lookup (outer ^ (string_of_int (lookup inner))) 
+                lookup (outer ^ (string_of_int (lookup inner)))
+    else if Str.string_match (Str.regexp regex_str) register 0 then (* match a naming defined with DEF *)
+        value (get_name_binding register)
     else raise (Failure ("The register " ^ register ^ " is unbound on instruction " ^ (string_of_int !index)))
-        
-let bind_value (register: string) (value: int) = 
-    if Str.string_match (Str.regexp "\\([a-zA-Z]+\\)\\([-]?[0-9]+\\)") register 0 then
+
+let clean_regname (register: string) =
+    if Str.string_match (Str.regexp regex_reg) register 0 then
         let ident = Str.matched_group 1 register in
         let number = Str.matched_group 2 register in
         (* we want to remove many 0's, eg convert 00001 -> 1 *)
-        Hashtbl.replace registers (ident ^ (string_of_int (int_of_string number))) value
-    else if Str.string_match (Str.regexp "\\([a-zA-Z]+\\)\\[\\([a-zA-Z]+[-]?[0-9]+\\)\\]") register 0 then
+        (ident ^ (string_of_int (int_of_string number)))
+    else if Str.string_match (Str.regexp regex_nreg) register 0 then
         let ident = Str.matched_group 1 register in
         let number = Str.matched_group 2 register in
-        Hashtbl.replace registers (ident ^ (string_of_int (lookup number))) value
+        (ident ^ (string_of_int (lookup number)))
+    else
+        raise (Failure ("Expected a register, received '" ^ register ^ "'"))
+
+let bind_value (register: string) (value: int) = 
+    if ((Str.string_match (Str.regexp regex_reg) register 0) || (Str.string_match (Str.regexp regex_nreg) register 0)) then
+        Hashtbl.replace registers (clean_regname register) value
+    else if Str.string_match (Str.regexp regex_str) register 0 then
+        Hashtbl.replace registers (get_name_binding register) value
+    else
+        raise (Failure ("Expected a register, received '" ^ register ^ "'"))
+
+let rename (new_name: string) (register: string) =
+    if Str.string_match (Str.regexp regex_reg) register 0 then
+        Hashtbl.replace renamings new_name (clean_regname register)
     else
-        raise (Failure ("Expected a register, recieved " ^ register))
+        raise (Failure ("Expected a register, received '" ^ register ^ "'"))
 
 let instr_jmp (label: string) = 
     if label = "@END" then running := false
@@ -95,19 +126,19 @@ let rec make_string (ident: string) (target: int) (found: int) (position: int) =
 
 let instr_nxt (iden1: string) (iden2: string) = 
     if iden2 = "stdin" then
-        if Str.string_match (Str.regexp "[a-zA-Z]+") iden1 0 then
+        if Str.string_match (Str.regexp regex_char) iden1 0 then
             get_string iden1
         else
             raise (Failure ("\"" ^ iden1 ^ "\" unexpected for pairing with stdin."))
     else if iden1 = "stdout" then
-        if Str.string_match (Str.regexp "[a-zA-Z]+") iden2 0 then
+        if Str.string_match (Str.regexp regex_char) iden2 0 then
             (if Hashtbl.mem registers (iden2 ^ "0") then
                 (make_string iden2 (lookup (iden2 ^ "0")) 0 1; Hashtbl.remove registers (iden2 ^ "0"))
             else
                 make_string iden2 0 0 1;
             print_newline())
         else raise (Failure ("\"" ^ iden2 ^ "\" unexpected for pairing with stdout."))
-    else raise (Failure "stdin must be used as the second parameter for NXT, or stdout used as the first.")
+    else raise (Failure "stdin must be used as the second parameter for NXT, or stdout used as the first.") 
 
 let interpret (input: string array array) =
     (lines := input;
@@ -148,5 +179,6 @@ let interpret (input: string array array) =
         | "RET" ->      instr_ret ()
         | "BS" ->       instr_bs p1 (value p2) (value p3)
         | "NXT" ->      instr_nxt p1 p2
+        | "DEF" ->      rename p1 p2
         | _ ->          raise ( Failure ("Unknown Instruction: " ^ instruction))) 
     done);;

src/lexer.mll

@@ -9,7 +9,8 @@
 
 let literal = '-'? ['0'-'9']+
 let alpha = ['a'-'z' 'A'-'Z']
-let register = alpha literal | alpha '[' alpha literal ']'
+let str = alpha+
+let register = alpha literal | alpha '[' alpha literal ']' | alpha '[' str ']'
 let comment = ";"([^'\n']+)
 
 rule lexer_main = parse
@@ -53,6 +54,7 @@ rule lexer_main = parse
     | "stdout" as o     { STDOUT (o) }
     | "@END" as a       { LABEL_END(a) }
     | "@NEXT" as a      { LABEL_NEXT(a) }
-    | alpha+ as a       { LABEL (a) }
+    | "#DEF"            { DEF }
+    | str as a          { STRING (a) }
     | _                 { syntax_error lexbuf }
     | eof      	        { EOF }

src/main.ml → src/mysplinterpreter.ml

@@ -16,14 +16,14 @@ let parseProgram c =
 		        let tok = Lexing.lexeme lexbuf in
 		        	begin
 		        		print_string "Line: "; print_int line; print_newline();
-		        		print_string ("Token: <" ^ tok ^ ">\n"); print_newline();
+		        		print_endline ("Token: \"" ^ tok ^ "\"\n");
 				        raise (Error (Parsing.Parse_error, (line,tok)))
 		        	end
 	      	end;;
 
 let arg = ref stdin in
 	let setProg p = arg := open_in p in
-		parse [] setProg "./main <program_file>";
+		parse [] setProg "./main <program_file> < input";
 
 let _ = parseProgram !arg in
 	flush stdout;;

src/parser.mly

@@ -9,9 +9,9 @@
 %token INSTR_AND INSTR_OR INSTR_NOR INSTR_XOR INSTR_NAND INSTR_COM
 %token INSTR_CLR INSTR_JMP INSTR_CALL INSTR_RET
 %token INSTR_TSTZ INSTR_TSTE INSTR_TSTG INSTR_TSTGE INSTR_TSTL INSTR_TSTLE INSTR_TSTB
-%token COMMA COLON EOF EOL TAB 
+%token COMMA COLON EOF EOL TAB DEF
 %token <string> STDIN STDOUT
-%token <string> IDENTIFIER REGISTER LABEL LABEL_NEXT LABEL_END
+%token <string> IDENTIFIER REGISTER STRING LABEL_NEXT LABEL_END
 %token <string> BINARY LITERAL
 
 %start parser_main
@@ -38,6 +38,8 @@ line
     | label eol tab instruction tab { add_line $1 $4 }
     | TAB instruction tab { add_line "" $2 }
     | TAB instruction { add_line "" $2 }
+    | define tab { add_line "" $1 }
+    | define { add_line "" $1 }
     | tab {}
 ;
 
@@ -51,7 +53,10 @@ tab
     | TAB       { }
 ;
 
-register: REGISTER { $1 };
+register
+    : REGISTER { $1 }
+    | STRING   { $1 }
+;
 
 value
     : register { $1 }
@@ -64,12 +69,12 @@ literal
 ;
 
 label_ref
-    : LABEL { $1 }
+    : STRING { $1 }
     | LABEL_NEXT { $1 }
     | LABEL_END { $1 }
 ;
 
-label: LABEL COLON { $1 };
+label: STRING COLON { $1 };
 
 ident1
     : IDENTIFIER { $1 }
@@ -81,6 +86,10 @@ ident2
     | STDIN     { $1 }
 ;
 
+define
+    : DEF STRING register { add_instr "DEF" $2 $3 "" "" }
+;
+
 instruction
     : INSTR_NXT ident1 COMMA ident2 { add_instr "NXT" $2 $4 "" "" }
     | INSTR_MOV register COMMA value { add_instr "MOV" $2 $4 "" "" }
@@ -99,7 +108,7 @@ instruction
     | INSTR_COM register COMMA value { add_instr "COM" $2 $4 "" "" }
     | INSTR_CLR register { add_instr "CLR" $2 "" "" "" }
     | INSTR_JMP label_ref { add_instr "JMP" $2 "" "" "" }
-    | INSTR_CALL LABEL { add_instr "CALL" $2 "" "" "" }
+    | INSTR_CALL STRING { add_instr "CALL" $2 "" "" "" }
     | INSTR_RET { add_instr "RET" "" "" "" "" }
     | INSTR_TSTZ value COMMA label_ref COMMA label_ref { add_instr "TSTZ" $2 $4 $6 "" }
     | INSTR_TSTE value COMMA value COMMA label_ref COMMA label_ref { add_instr "TSTE" $2 $4 $6 $8 }