Added basic PGA parser and printer

.gitignore

+*.swp
+*.cmi
+*.cmx
+*.o
+pga

Makefile

+RESULT := pga
+BASENAMES := types stringify parse pga
+
+OFILES := $(addsuffix .cmx,$(BASENAMES))
+
+OCAMLCFLAGS := -g
+OCAMLLDFLAGS :=
+
+.PHONY: all clean
+.PRECIOUS: $(addsuffix .cmi,$(BASENAMES))
+
+all: $(RESULT)
+
+%.cmx: %.ml
+	ocamlopt -c -o $@ $(<:.cmi=.ml)
+
+$(RESULT): $(OFILES)
+	ocamlopt -o $@ $^
+
+clean:
+	rm -f *.cmi *.cmx *.o $(RESULT)

parse.ml

+open Types
+
+type token = LPAREN | RPAREN | ID of string | HASH | EXCLAM | PLUS | MINUS
+
+let tokenize next_char emit =
+  let buf = Buffer.create 32 in
+  let emit_buf () =
+    match Buffer.length buf with
+    | 0 -> ()
+    | _ ->
+      emit (ID (Buffer.contents buf));
+      Buffer.clear buf
+  in
+  let nobuf () =
+    assert (Buffer.length buf = 0)
+  in
+  let rec n () =
+    match next_char () with
+    | Some '(' -> nobuf (); emit LPAREN; n ()
+    | Some ')' -> emit_buf (); emit RPAREN; n ()
+    | Some ';' -> emit_buf (); n ()
+    | Some '#' -> nobuf (); emit HASH; n ()
+    | Some '!' -> nobuf (); emit EXCLAM; n ()
+    | Some '+' -> nobuf (); emit PLUS; n ()
+    | Some '-' -> nobuf (); emit MINUS; n ()
+    | Some (' ' | '\t') -> emit_buf (); n ()
+    | Some c   -> Buffer.add_char buf c; n ()
+    | None     -> emit_buf ()
+  in n ()
+
+let program_of_list = function
+  | []  -> Empty
+  | [p] -> p
+  | p   -> Concat p
+
+type exp = E_basic | E_jump  | E_ptest | E_ntest
+
+let parse tokenize =
+  let stack = ref [ref []] in
+  let expect = ref E_basic in
+  let append p =
+    let lst = List.hd !stack in
+    lst := p :: !lst
+  in
+  let handler = function
+    | ID s ->
+      let p =
+        match !expect with
+        | E_basic -> Basic s
+        | E_jump  -> Jump (int_of_string s)
+        | E_ptest -> Ptest s
+        | E_ntest -> Ntest s
+      in
+      append (Primitive p);
+      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
+  tokenize handler;
+  Concat (List.rev !(List.hd !stack))
+
+let parse_string s =
+  let i = ref 0 in
+  let next_char () =
+    if !i = String.length s
+      then None
+      else (incr i; Some (String.get s (!i - 1)))
+  in
+  parse (tokenize next_char)

pga.ml

+open Printf
+open Types
+open Stringify
+open Parse
+
+let main () =
+  let argc = Array.length Sys.argv in
+  let usage status =
+    printf "usage: %s command [args]\n" Sys.argv.(0);
+    printf "command:\n";
+    printf "  help\n";
+    printf "  echo PROGRAM\n";
+    status
+  in
+  if argc = 1 then begin
+    usage 1
+  end else
+    match Sys.argv.(1) with
+    | "help" ->
+      usage 0
+    | "echo" when argc > 2 ->
+      printf "%s\n" (string_of_program (parse_string Sys.argv.(2)));
+      0
+    | _ ->
+      usage 1
+
+let () = exit (main ())

stringify.ml

+open Types
+
+let string_of_basic ins = ins
+
+let string_of_primitive = function
+  | Basic ins -> string_of_basic ins
+  | Terminate -> "!"
+  | Ptest ins -> "+" ^ string_of_basic ins
+  | Ntest ins -> "-" ^ string_of_basic ins
+  | Jump len  -> "#" ^ string_of_int len
+
+let rec string_of_program = function
+  | Primitive p -> string_of_primitive p
+  | Concat l    -> String.concat ";" (List.map string_of_program l)
+  | Repeat p    -> "(" ^ string_of_program p ^ ")\207\137"
+  | Empty       -> ""

types.ml

+type basic_instr = string
+
+type primitive =
+  | Basic of basic_instr
+  | Terminate
+  | Ptest of basic_instr
+  | Ntest of basic_instr
+  | Jump of int
+
+type program =
+  | Primitive of primitive
+  | Concat of program list
+  | Repeat of program
+  | Empty