clean repository

9 files changed, 1 insertions, 707 deletions

diff --git a/.gitignore b/.gitignore
index 1ddca66..5c1028b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,2 @@
-miniyacc
+myacc
 .comfile
diff --git a/miniyacc.c b/myacc.c
index 1e5b772..1e5b772 100644
--- a/miniyacc.c
+++ b/myacc.c
diff --git a/ninja.ml b/ninja.ml
deleted file mode 100644
index c4f306b..0000000
--- a/ninja.ml
+++ /dev/null
@@ -1,303 +0,0 @@
-type token = string and id = string
-type sym = T of token | N of id
-type rule =
-  { id: id; rhs: sym list list
-  ; mutable nullable: bool
-  ; mutable first: id list }
-
-let eof: token = ""
-
-
-(* Tools *)
-
-let rec union l1 l2 =
-  (* union of two sorted lists *)
-  match l1, l2 with
-  | a1 :: l1', a2 :: l2' ->
-    let c = compare a1 a2 in
-    if c = 0 then a1 :: union l1' l2'
-    else if c < 0 then a1 :: union l1' l2
-    else a2 :: union l1 l2'
-  | _, [] -> l1
-  | [], _ -> l2
-
-
-module Gram = struct
-  (* A grammar is a set of rules *)
-  include Map.Make(String)
-
-  let add ({id;_} as rl) gr = add id rl gr
-
-  let find id gr =
-    try find id gr
-    with Not_found ->
-      Printf.eprintf "oops: %s\n" id;
-      raise Not_found
-
-  let rhs id gr = (find id gr).rhs
-  let nullable id gr = (find id gr).nullable
-  let first id gr = (find id gr).first
-
-  let init gr =
-    (* initialize nullable and first fields *)
-    let m = ref true in
-    while !m = true do
-      m := false;
-      iter
-        begin fun _ r ->
-          let rec f = function
-            | N y :: syms ->
-              let r' = find y gr in
-              if r'.nullable then f syms else begin
-                let o = r.first in
-                r.first <- union r.first r'.first;
-                m := !m || r.first <> o
-              end
-            | T tok :: _ ->
-              let o = r.first in
-              r.first <- union r.first [ tok ];
-              m := !m || r.first <> o
-            | [] ->
-              m := !m || r.nullable <> true;
-              r.nullable <- true
-          in List.iter f r.rhs
-        end gr
-    done
-
-end
-
-
-
-
-
-
-(* LR1 terms *)
-
-type term =
-  { rule: id
-  ; prod: int (* index of the production in rhs *)
-  ; dot: int (* position of the dot *)
-  ; look: token (* lookahead token *)
-  }
-
-let rec first stnc gr =
-  match stnc with
-  | N id :: stnc ->
-    if Gram.nullable id gr
-      then union (Gram.first id gr) (first stnc gr)
-      else Gram.first id gr
-  | T tok :: _ -> [ tok ]
-  | [] -> []
-
-let dot t gr =
-  (* get the symbol string right after the term dot *)
-  let rec drop l n = if n = 0 then l else drop (List.tl l) (n-1) in
-  let prod = List.nth (Gram.rhs t.rule gr) t.prod in
-  drop prod t.dot
-
-module LRState = Set.Make(struct
-  (* Module for sets of terms *)
-  type t = term
-  let compare = compare
-end)
-
-let rec closure s gr =
-  (* compute the closure of a set [s] of LR1 terms *)
-  let s' = LRState.fold
-    begin fun t s ->
-      match dot t gr with
-      | N b :: stnc ->
-        let fstl = first (stnc @ [ T t.look ]) gr in
-        let rec prodloop pid s = function
-          | prod :: tl ->
-            let s = List.fold_left
-              (fun s fst -> LRState.add
-                {rule=b; prod=pid; dot=0; look=fst} s)
-              s fstl in
-            prodloop (pid+1) s tl
-          | [] -> s in
-        prodloop 0 s (Gram.rhs b gr)
-      | _ -> s
-    end s s in
-  if LRState.equal s' s (* test for fixpoint *)
-    then s
-    else closure s' gr
-
-let goto s sym gr =
-  (* compute the state after seeing [sym] in state [s] *)
-  let s' = LRState.fold
-    begin fun t s' ->
-      match dot t gr with
-      | sym' :: _ when sym' = sym ->
-        LRState.add {t with dot = t.dot+1} s'
-      | _ -> s'
-    end s LRState.empty in
-  closure s' gr
-
-module C = struct
-  (* Module for set of LRStates *)
-  type nstate = {num: int; state: LRState.t}
-  include Set.Make(struct
-    type t = nstate
-    let compare a b =
-      LRState.compare a.state b.state
-  end)
-  let singleton s = singleton {num=0; state=s}
-  let add s c = add {num=cardinal c; state=s} c
-  let num s c = (find {num=0; state=s} c).num
-end
-
-let items toks gr =
-  (* Generate all states *)
-  let gsyms = (* all possible grammar symbols *)
-    (List.map (fun (id, _) -> N id) (Gram.bindings gr)) @
-    (List.map (fun t -> T t) toks) in
-  let rec fix c =
-    let c' = C.fold
-      begin fun s c ->
-        List.fold_left
-          (fun c sym -> C.add (goto s.C.state sym gr) c)
-          c gsyms
-      end c c in
-    if C.equal c' c
-      then c
-      else fix c' in
-  let start =
-    LRState.singleton {rule="#"; prod=0; dot=0; look=eof} in
-  fix (C.singleton (closure start gr))
-
-
-(* Pretty printing *)
-
-let pp_state oc s gr =
-  let open Printf in
-  LRState.iter begin fun t ->
-    let rec pprhs dot = function
-      | T x :: stnc | N x :: stnc ->
-        if dot = 0 then fprintf oc ". ";
-        fprintf oc "%s " x; pprhs (dot-1) stnc
-      | [] ->
-        if dot = 0 then fprintf oc ". ";
-        fprintf oc "    [lookahead = %S]\n" t.look in
-    fprintf oc "%s -> " t.rule;
-    pprhs t.dot (List.nth (Gram.rhs t.rule gr) t.prod)
-  end s
-
-
-(* Tables generation *)
-
-type action =
-  | Shift of int (* shift in a new state *)
-  | Reduce of (id * int) (* reduce by a rule *)
-  | Accept (* parse success *)
-  | Error (* parse error *)
-
-let mktables toks gr =
-  let c = items toks gr in
-  let ns = C.cardinal c in
-  let nt = List.length toks in
-  let toknum t =
-    let rec f i = function
-      | t' :: _ when t' = t -> i
-      | _ :: tl -> f (i+1) tl
-      | [] -> failwith "toknum" in
-    f 0 toks in
-  let (nn, nmap) = Gram.fold
-    (fun id _ (nn, nmap) -> (nn+1, (id,nn) :: nmap))
-    gr (0, []) in
-  let gtbl = Array.init ns (fun _ -> Array.make nn 0) in
-  let atbl = Array.init ns (fun _ -> Array.make nt Error) in
-  C.iter begin fun {C.num; state} ->
-
-    (* fill the goto table *)
-    List.iter
-      (fun (nid, n) ->
-        gtbl.(num).(n) <- C.num (goto state (N nid) gr) c)
-      nmap;
-
-    (* fill the action table *)
-    let seta nt act =
-      let act' = atbl.(num).(nt) in
-      if act' <> act && act' <> Error && act' <> Accept then begin
-        let ptyp = function
-          | Shift _ -> "shift" | Reduce _ -> "reduce" | _ -> "??" in
-        pp_state stderr state gr;
-        failwith (ptyp atbl.(num).(nt) ^ "/" ^ ptyp act ^ " conflict")
-      end else if act' <> Accept then
-        atbl.(num).(nt) <- act in
-
-    LRState.iter begin fun t ->
-        if t.rule = "#" && t.dot = 1 then (* accept action *)
-          seta (toknum eof) Accept;
-        match dot t gr with
-        | T tok :: _ -> (* shift action *)
-          seta (toknum tok) (Shift (C.num (goto state (T tok) gr) c))
-        | [] -> (* reduce action *)
-          seta (toknum t.look) (Reduce (t.rule, t.prod))
-        | _ -> ()
-    end state;
-  end c;
-  (gtbl, atbl, nmap)
-
-let outtables gtbl atbl nm gr =
-  let open Printf in
-  let ns = Array.length gtbl in
-  let nn = Array.length gtbl.(0) in
-  let nt = Array.length atbl.(0) in
-  printf "let n_states = %d\n" ns;
-  printf "let n_goto =\n[|\n";
-  for i=0 to ns-1 do
-    printf "  [|";
-    for j=0 to nn-1 do
-      printf "%d%s" gtbl.(i).(j) (if j<>nn-1 then ";" else "")
-    done;
-    printf "|]%s\n" (if i<>ns-1 then ";" else "")
-  done;
-  let pact = function
-    | Shift n -> printf "S %d" n
-    | Reduce (id, n) -> printf "R (%S,%d)" id n
-    | Accept -> printf "A"
-    | Error -> printf "E" in
-  printf "|]\nlet n_act = \n[|\n";
-  for i=0 to ns-1 do
-    printf "  [|";
-    for j=0 to nt-1 do
-      pact atbl.(i).(j); if j<>nt-1 then printf ";"
-    done;
-    printf "|]%s\n" (if i<>ns-1 then ";" else "")
-  done;
-  printf "|]\nlet n_nmap = [";
-  let rec p = function
-    | (nid, n) :: tl ->
-      printf "(%S,%d)%s" nid n
-        (if tl = [] then "" else ";");
-      p tl
-    | [] -> () in
-  p nm; printf "]\n"
-
-let _ =
-  let mk (id, rhs) = {id; rhs; nullable=false; first=[]} in
-  let toks = ["Num";"+";"-";"(";")";"*";eof] in
-  let gr =
-    (Gram.add (mk ("A", [[N"M"]; [N"A"; T"+"; N"M"]; [N"A"; T"-"; N"M"]]))
-    (Gram.add (mk ("M", [[N"B"]; [N"M"; T"*"; N"B"]]))
-    (Gram.add (mk ("B", [[T"Num"]; [T"("; N"A"; T")"]]))
-    (Gram.add (mk ("#", [[N"A"]]))
-     Gram.empty)))) in
-
-  Gram.init gr;
-  let start =
-    LRState.singleton {rule="#"; prod=0; dot=0; look=eof} in
-  if true then begin
-    pp_state stdout (closure start gr) gr;
-    print_string "------------\n"
-  end;
-  let fin = (goto (closure start gr) (T"Num") gr) in
-  pp_state stdout fin gr;
-  print_string "------------\n";
-  let c = items toks gr in
-  Printf.printf "%d elements in table (final num = %d)\n" (C.cardinal c) (C.num fin c);
-  print_string "------------\n\n";
-  let _g, _a, _nm =  mktables toks gr in
-  outtables _g _a _nm gr;
-  ()
diff --git a/t.c b/t.c
deleted file mode 100644
index 4df2d89..0000000
--- a/t.c
+++ /dev/null
@@ -1,166 +0,0 @@
-/*% cc -Wall -g -o # %
- */
-short yyntoks = 7;
-short yyr1[] = {
-   1,    3,    3,    1,    3,    1,    3,    2
-};
-short yyr2[] = {
-   0,    0,    0,    1,    1,    2,    2,    3
-};
-short yyadef[] = {
-  -1,   -1,   -1,   -1,   -1,   -1,   -1,    0,    1,    2,
-   3,    4,    5,    6,    7
-};
-short yygdef[] = {
-   4,    7,   10,   -1
-};
-short yyadsp[] = {
-   6,    6,    6,    6,   -2,    3,    6,    4,    4,    4,
-  -7,   -7,   -7,   -7,   -7
-};
-short yygdsp[] = {
-   1,    7,    6,  -15
-};
-short yyact[] = {
-   2,    3,    5,   14,   13,    2,    3,   12,    6,    8,
-   9,    0,   11
-};
-short yychk[] = {
-   2,    3,    7,    0,    6,    2,    3,    1,    4,    8,
-   8,    5,    9
-};
-
-#define YYSTYPE int
-
-YYSTYPE yylval, yyval;
-int lex(void);
-
-int
-yyparse()
-{
-	enum {
-		StackSize = 100,
-		ActSz = sizeof yyact / sizeof yyact[0],
-	};
-	struct {
-		YYSTYPE val;
-		int state;
-	} stk[StackSize], *ps;
-	int r, h, n, s, tk;
-
-	ps = stk;
-	ps->state = s = 1; /* to parameterize */
-	tk = -1;
-loop:
-	if (tk <= 0) {
-		tk = lex();
-		yyval = yylval;
-	}
-	n = yyadsp[s] + tk;
-	if (n < 0 || n >= ActSz || yychk[n] != tk) {
-		r = yyadef[s];
-		if (r < 0)
-			return -1;
-		goto reduce;
-	}
-	n = yyact[n];
-	if (n == -1)
-		return -1;
-	if (n < 0) {
-		r = - (n+2);
-		goto reduce;
-	}
-	tk = -1;
-stack:
-	ps++;
-	if (ps-stk >= StackSize)
-		return -2;
-	s = n;
-	ps->state = s;
-	ps->val = yyval;
-	goto loop;
-reduce:
-	ps -= yyr1[r];
-	h = yyr2[r];
-	s = ps->state;
-	n = yygdsp[h] + s;
-	if (n < 0 || n >= ActSz || yychk[n] != yyntoks+h)
-		n = yygdef[h];
-	else
-		n = yyact[n];
-	switch (r) {
-	case 0: /* A -> M */
-		yyval = ps[1].val;
-		break;
-	case 1: /* A -> A + M */
-		yyval = ps[1].val + ps[3].val;
-		break;
-	case 2: /* A -> A - M */
-		yyval = ps[1].val - ps[3].val;
-		break;
-	case 3: /* M -> B */
-		yyval = ps[1].val;
-		break;
-	case 4: /* M -> M * B */
-		yyval = ps[1].val * ps[3].val;
-		break;
-	case 5: /* B -> Num */
-		yyval = ps[1].val;
-		break;
-	case 6: /* B -> ( A ) */
-		yyval = ps[2].val;
-		break;
-	case 7: /* S -> A */
-		yyval = ps[1].val;
-		return 0;
-	}
-	goto stack;
-}
-
-#include <ctype.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-enum {
-	MaxLine = 1000,
-};
-
-char line[MaxLine], *p;
-
-int
-lex()
-{
-	char c;
-
-	p += strspn(p, "\t ");
-	switch ((c=*p++)) {
-	case '+': return 2;
-	case '-': return 3;
-	case '*': return 4;
-	case '(': return 5;
-	case ')': return 6;
-	case 0:
-	case '\n':
-		p--;
-		return 0;
-	}
-	if (isdigit(c)) {
-		yylval = strtol(p-1, &p, 0);
-		return 1;
-	}
-	puts("lex error!");
-	return 0;
-}
-
-int
-main()
-{
-	while ((p=fgets(line, MaxLine, stdin))) {
-		if (yyparse() < 0)
-			puts("parse error!");
-		else
-			printf("-> %d\n", yyval);
-	}
-	return 0;
-}
diff --git a/t.ml b/t.ml
deleted file mode 100644
index 2a2a749..0000000
--- a/t.ml
+++ /dev/null
@@ -1,237 +0,0 @@
-
-(* ****************** *)
-(* prelude *)
-
-type n_act = S of int | R of string * int | A | E
-
-(* ****************** *)
-(* generated by ninja.ml *)
-
-let n_states = 27
-let n_goto =
-[|
-  [|1;2;3;4|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;9;10;11|];
-  [|1;1;3;20|];
-  [|1;1;3;21|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;15;10;11|];
-  [|1;1;22;1|];
-  [|1;1;1;1|];
-  [|1;1;26;1|];
-  [|1;1;10;24|];
-  [|1;1;10;25|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|];
-  [|1;1;1;1|]
-|]
-let n_act =
-[|
-  [|S 5;E;E;S 6;E;E;E|];
-  [|E;E;E;E;E;E;E|];
-  [|E;S 7;S 8;E;E;E;A|];
-  [|E;R ("M",0);R ("M",0);E;E;R ("M",0);R ("M",0)|];
-  [|E;R ("A",0);R ("A",0);E;E;S 14;R ("A",0)|];
-  [|E;R ("B",0);R ("B",0);E;E;R ("B",0);R ("B",0)|];
-  [|S 12;E;E;S 13;E;E;E|];
-  [|S 5;E;E;S 6;E;E;E|];
-  [|S 5;E;E;S 6;E;E;E|];
-  [|E;S 17;S 18;E;S 19;E;E|];
-  [|E;R ("M",0);R ("M",0);E;R ("M",0);R ("M",0);E|];
-  [|E;R ("A",0);R ("A",0);E;R ("A",0);S 16;E|];
-  [|E;R ("B",0);R ("B",0);E;R ("B",0);R ("B",0);E|];
-  [|S 12;E;E;S 13;E;E;E|];
-  [|S 5;E;E;S 6;E;E;E|];
-  [|E;S 17;S 18;E;S 23;E;E|];
-  [|S 12;E;E;S 13;E;E;E|];
-  [|S 12;E;E;S 13;E;E;E|];
-  [|S 12;E;E;S 13;E;E;E|];
-  [|E;R ("B",1);R ("B",1);E;E;R ("B",1);R ("B",1)|];
-  [|E;R ("A",1);R ("A",1);E;E;S 14;R ("A",1)|];
-  [|E;R ("A",2);R ("A",2);E;E;S 14;R ("A",2)|];
-  [|E;R ("M",1);R ("M",1);E;E;R ("M",1);R ("M",1)|];
-  [|E;R ("B",1);R ("B",1);E;R ("B",1);R ("B",1);E|];
-  [|E;R ("A",1);R ("A",1);E;R ("A",1);S 16;E|];
-  [|E;R ("A",2);R ("A",2);E;R ("A",2);S 16;E|];
-  [|E;R ("M",1);R ("M",1);E;R ("M",1);R ("M",1);E|]
-|]
-let n_nmap = [("M",3);("B",2);("A",1);("#",0)]
-
-
-(* ****************** *)
-(* hand written, but shoud be generated *)
-
-type n_state =
-  { n_sid: int
-  ; n_obj: Obj.t }
-
-let n_nstk = 100
-
-let n_stk =
-  Array.make n_nstk
-    {n_sid=0; n_obj=Obj.repr 0}
-and n_stkp = ref 0
-
-let n_push sid obj =
-  n_stk.(!n_stkp) <- {n_sid=sid; n_obj=obj};
-  incr n_stkp
-
-let n_pop () =
-  decr n_stkp;
-  Obj.magic (n_stk.(!n_stkp).n_obj)
-
-let n_actions =
-
-[ ("A",
-    [ (fun () ->
-        print_string "A -> M\n";
-        (n_pop (): int))
-    ; (fun () ->
-        let i2 = (n_pop (): int) in
-        let _ = n_pop () in
-        let i1 = (n_pop (): int) in
-        print_string "A -> A + M\n";
-        i1 + i2
-      )
-    ; (fun () ->
-        let i2 = (n_pop (): int) in
-        let _ = n_pop () in
-        let i1 = (n_pop (): int) in
-        print_string "A -> A - M\n";
-        i1 - i2
-      )
-    ])
-
-; ("M",
-    [ (fun () ->
-        print_string "M -> B\n";
-        (n_pop (): int))
-    ; (fun () ->
-        let i2 = (n_pop (): int) in
-        let _ = n_pop () in
-        let i1 = (n_pop (): int) in
-        print_string "M -> M * B\n";
-        i1 * i2
-      )
-    ])
-
-; ("B",
-    [ (fun () ->
-        let i = n_pop () in
-        print_string "B -> Num\n";
-        i
-      )
-    ; (fun () ->
-        let _ = n_pop () in
-        let i = (n_pop (): int) in
-        let _ = n_pop () in
-        print_string "B -> ( A )\n";
-        i
-      )
-    ])
-
-]
-
-type toks =
-  | TNum of int
-  | TPlus
-  | TMinus
-  | TLParen
-  | TRParen
-  | TMult
-  | TEof
-
-let n_toknum = function
-  | TNum _ -> 0
-  | TPlus -> 1
-  | TMinus -> 2
-  | TLParen -> 3
-  | TRParen -> 4
-  | TMult -> 5
-  | TEof -> 6
-
-
-exception ParseError
-
-let n_parse lex =
-
-  let open Printf in
-
-  (* main parsing loop *)
-  let rec loop st a =
-    match n_act.(st).(n_toknum a) with
-    | E -> raise ParseError
-    | A -> n_pop ()
-    | S st' ->
-      let tobj = Obj.repr a in
-      if Obj.is_block tobj then
-        n_push st' (Obj.field tobj 0)
-      else
-        n_push st' (Obj.repr 0);
-      (* printf "shift in %d\n" st'; *)
-      loop st' (lex ())
-    | R (rule,n) ->
-      let act =
-        List.nth
-          (List.assoc rule n_actions)
-          n in
-      let res = act () in
-      let st' = n_stk.(!n_stkp-1).n_sid in
-      (* printf "reduce from %d back to %d\n" st st'; *)
-      let st'' = n_goto.(st').(List.assoc rule n_nmap) in
-      (* printf "goto %d\n" st''; *)
-      n_push st'' (Obj.repr res);
-      loop st'' a
-
-  in n_push 0 (Obj.repr 0); loop 0 (lex ())
-
-
-(* ****************** *)
-(* hand written for good, or generated using lex *)
-
-let next, refeed =
-  (* buffered input *)
-  let buf = ref None in
-  (fun () ->
-    match !buf with
-    | None -> (try input_char stdin with End_of_file -> '\x00')
-    | Some c -> buf := None; c),
-  (fun c -> buf := Some c)
-
-let rec lex () =
-
-  let digit c = Char.code c - Char.code '0' in
-  let rec pnum n =
-    match next () with
-    | '0'..'9' as c -> pnum (digit c + 10*n)
-    | c -> refeed c; n in
-
-  match next () with
-  | '0'..'9' as c -> TNum (pnum (digit c))
-  | '+' -> TPlus
-  | '-' -> TMinus
-  | '(' -> TLParen
-  | ')' -> TRParen
-  | '*' -> TMult
-  | '\x00' -> TEof
-  | ' ' | '\t' | '\n' -> lex ()
-  | _ -> failwith "lex error"
-
-
-(* main program *)
-let _ =
-  let n = n_parse lex in
-  Printf.printf "result: %d\n" n
diff --git a/act.y b/test/act.y
index e7d7dc6..e7d7dc6 100644
--- a/act.y
+++ b/test/act.y
diff --git a/c89.y b/test/c89.y
index f936022..f936022 100644
--- a/c89.y
+++ b/test/c89.y
diff --git a/ocaml.y b/test/ocaml.y
index 5806be6..5806be6 100644
--- a/ocaml.y
+++ b/test/ocaml.y
diff --git a/t.y b/test/t.y
index b8a184e..b8a184e 100644
--- a/t.y
+++ b/test/t.y