Commit 23418c16 authored by Taddeüs Kroes's avatar Taddeüs Kroes

Added better error checking

parent f8778da5
...@@ -2,8 +2,22 @@ open Types ...@@ -2,8 +2,22 @@ open Types
type token = LPAREN | RPAREN | ID of string | HASH | EXCLAM | PLUS | MINUS type token = LPAREN | RPAREN | ID of string | HASH | EXCLAM | PLUS | MINUS
let is_alnum c =
let i = int_of_char c in
i >= 48 & i <= 57 || i >= 65 & i <= 90 || i >= 97 & i <= 122
let tokenize next_char emit = let tokenize next_char emit =
let buf = Buffer.create 32 in let buf = Buffer.create 32 in
let lineno = ref 1 in
let colno = ref 1 in
let unexpected c =
ParseError (Printf.sprintf
"unexpected '%c' at line %d, character %d"
c !lineno !colno
)
in
let emit_buf () = let emit_buf () =
match Buffer.length buf with match Buffer.length buf with
| 0 -> () | 0 -> ()
...@@ -11,22 +25,33 @@ let tokenize next_char emit = ...@@ -11,22 +25,33 @@ let tokenize next_char emit =
emit (ID (Buffer.contents buf)); emit (ID (Buffer.contents buf));
Buffer.clear buf Buffer.clear buf
in in
let nobuf () = let nobuf c =
assert (Buffer.length buf = 0) if Buffer.length buf > 0 then raise (unexpected c)
in in
let rec n () =
let rec read_all () =
match next_char () with match next_char () with
| Some '(' -> nobuf (); emit LPAREN; n () | Some c ->
| Some ')' -> emit_buf (); emit RPAREN; n () begin
| Some ';' -> emit_buf (); n () match c with
| Some '#' -> nobuf (); emit HASH; n () | '(' -> nobuf c; emit LPAREN
| Some '!' -> nobuf (); emit EXCLAM; n () | ')' -> emit_buf (); emit RPAREN
| Some '+' -> nobuf (); emit PLUS; n () | ';' -> emit_buf ()
| Some '-' -> nobuf (); emit MINUS; n () | '#' -> nobuf c; emit HASH
| Some (' ' | '\t') -> emit_buf (); n () | '!' -> nobuf c; emit EXCLAM
| Some c -> Buffer.add_char buf c; n () | '+' -> nobuf c; emit PLUS
| None -> emit_buf () | '-' -> nobuf c; emit MINUS
in n () | ' ' | '\t' | '\r' -> emit_buf ()
| '\n' -> emit_buf (); incr lineno; colno := 0
| c when is_alnum c -> Buffer.add_char buf c
| _ -> raise (unexpected c)
end;
incr colno;
read_all ()
| None ->
emit_buf ()
in
read_all ()
let program_of_list = function let program_of_list = function
| [] -> Empty | [] -> Empty
...@@ -35,7 +60,7 @@ let program_of_list = function ...@@ -35,7 +60,7 @@ let program_of_list = function
type exp = E_basic | E_jump | E_ptest | E_ntest type exp = E_basic | E_jump | E_ptest | E_ntest
let parse tokenize = let parse next_char =
let stack = ref [ref []] in let stack = ref [ref []] in
let expect = ref E_basic in let expect = ref E_basic in
let append p = let append p =
...@@ -43,6 +68,15 @@ let parse tokenize = ...@@ -43,6 +68,15 @@ let parse tokenize =
lst := p :: !lst lst := p :: !lst
in in
let handler = function let handler = function
| EXCLAM -> append (Primitive Terminate)
| HASH -> expect := E_jump
| PLUS -> expect := E_ptest
| MINUS -> expect := E_ntest
| LPAREN -> stack := ref [] :: !stack
| RPAREN ->
let body = List.rev !(List.hd !stack) in
stack := List.tl !stack;
append (Repeat (program_of_list body))
| ID s -> | ID s ->
let p = let p =
match !expect with match !expect with
...@@ -53,22 +87,8 @@ let parse tokenize = ...@@ -53,22 +87,8 @@ let parse tokenize =
in in
append (Primitive p); append (Primitive p);
expect := E_basic expect := E_basic
| EXCLAM ->
append (Primitive Terminate)
| HASH ->
expect := E_jump
| PLUS ->
expect := E_ptest
| MINUS ->
expect := E_ntest
| LPAREN ->
stack := ref [] :: !stack
| RPAREN ->
let body = List.rev !(List.hd !stack) in
stack := List.tl !stack;
append (Repeat (program_of_list body))
in in
tokenize handler; tokenize next_char handler;
Concat (List.rev !(List.hd !stack)) Concat (List.rev !(List.hd !stack))
let parse_string s = let parse_string s =
...@@ -78,4 +98,4 @@ let parse_string s = ...@@ -78,4 +98,4 @@ let parse_string s =
then None then None
else (incr i; Some (String.get s (!i - 1))) else (incr i; Some (String.get s (!i - 1)))
in in
parse (tokenize next_char) parse next_char
...@@ -18,6 +18,7 @@ let main () = ...@@ -18,6 +18,7 @@ let main () =
if argc = 1 then usage 1; if argc = 1 then usage 1;
begin begin
try
match Sys.argv.(1) with match Sys.argv.(1) with
| "help" -> | "help" ->
usage 0 usage 0
...@@ -25,6 +26,10 @@ let main () = ...@@ -25,6 +26,10 @@ let main () =
print_endline (string_of_program (parse_string Sys.argv.(2))) print_endline (string_of_program (parse_string Sys.argv.(2)))
| _ -> | _ ->
usage 1 usage 1
with
| ParseError msg ->
prerr_endline ("parsing error: " ^ msg);
exit 1
end; end;
exit 0 exit 0
......
open Types open Types
let omega = "\207\137" let omega = "\xcf\x89"
let pound = "\xc2\xa3"
let string_of_basic ins = ins let string_of_basic ins = ins
......
...@@ -12,3 +12,5 @@ type program = ...@@ -12,3 +12,5 @@ type program =
| Concat of program list | Concat of program list
| Repeat of program | Repeat of program
| Empty | Empty
exception ParseError of string
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment