src/Pure/Syntax/earley0A.ML
author nipkow
Mon, 06 Dec 1993 17:05:10 +0100
changeset 189 831a9a7ab9f3
parent 18 c9ec452ff08f
child 237 a7d3e712767a
permissions -rw-r--r--
added rep_tsig
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
     1
(*  Title:      Pure/Syntax/earley0A.ML
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     2
    ID:         $Id$
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     3
    Author:     Tobias Nipkow
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
     5
WARNING: This file is about to disappear.
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     7
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     8
signature PARSER =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     9
sig
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    10
  structure XGram: XGRAM
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    11
  structure ParseTree: PARSE_TREE
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    12
  local open XGram ParseTree ParseTree.Lexicon in
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    13
    type gram
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    14
    val mk_gram: string list -> string prod list -> gram
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    15
    val parse: gram -> string -> token list -> parsetree
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    16
  end
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    17
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    18
(*  exception SYNTAX_ERROR of token list *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    19
(*  val compile_xgram: string list * token prod list -> Gram *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    20
(*  val parsable: Gram * string -> bool *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    21
(*  val print_gram: Gram * lexicon -> unit *)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    22
end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    23
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    24
functor EarleyFun(structure Symtab: SYMTAB and XGram: XGRAM
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    25
  and ParseTree: PARSE_TREE): PARSER =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    26
struct
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    27
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    28
structure ParseTree = ParseTree;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    29
structure Lexicon = ParseTree.Lexicon;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    30
structure XGram = XGram;
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    31
open ParseTree Lexicon;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    32
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    33
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    34
(** mk_pt (from parse_tree.ML) **)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    35
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    36
fun mk_pt ("", [pt]) = pt
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    37
  | mk_pt ("", _) = error "mk_pt: funny copy op in parse tree"
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    38
  | mk_pt (s, ptl) = Node (s, ptl);
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    39
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    40
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    41
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    42
(** token maps (from lexicon.ML) **)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    43
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    44
type 'b TokenMap = (token * 'b list) list * 'b list;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    45
val first_token = 0;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    46
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    47
fun int_of_token(Token(tk)) = first_token |
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    48
    int_of_token(IdentSy _) = first_token - 1 |
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    49
    int_of_token(VarSy _) = first_token - 2 |
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    50
    int_of_token(TFreeSy _) = first_token - 3 |
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    51
    int_of_token(TVarSy _) = first_token - 4 |
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    52
    int_of_token(EndToken) = first_token - 5;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    53
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    54
fun lesstk(s, t) = int_of_token(s) < int_of_token(t) orelse
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    55
                  (case (s, t) of (Token(a), Token(b)) => a<b | _ => false);
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    56
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    57
fun mkTokenMap(atll) =
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    58
    let val aill = atll;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    59
        val dom = sort lesstk (distinct(flat(map snd aill)));
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    60
        val mt = map fst (filter (null o snd) atll);
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    61
        fun mktm(i) =
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    62
            let fun add(l, (a, il)) = if i mem il then a::l else l
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    63
            in (i, foldl add ([], aill)) end;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    64
    in (map mktm dom, mt) end;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    65
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    66
fun find_al (i) =
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    67
    let fun find((j, al)::l) = if lesstk(i, j) then [] else
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    68
                              if matching_tokens(i, j) then al else find l |
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    69
            find [] = [];
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    70
    in find end;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    71
fun applyTokenMap((l, mt), tk:token) = mt@(find_al tk l);
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    72
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
    73
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    74
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    75
(* Linked lists: *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    76
infix 5 &;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    77
datatype 'a LList = nilL | op & of 'a * ('a LListR)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    78
withtype 'a LListR = 'a LList ref;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    79
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    80
(* Apply proc to all elements in a linked list *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    81
fun seqll (proc: '_a -> unit) : ('_a LListR -> unit) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    82
    let fun seq (ref nilL) = () |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    83
            seq (ref((a:'_a)&l)) = (proc a; seq l)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    84
    in seq end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    85
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    86
fun llist_to_list (ref nilL) = [] |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    87
    llist_to_list (ref(a&ll)) = a::(llist_to_list ll);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    88
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    89
val len = length;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    90
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    91
local open Array XGram ParseTree ParseTree.Lexicon in
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    92
nonfix sub;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    93
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    94
fun forA(p: int -> unit, a: 'a array) : unit =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    95
    let val ub = length a
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    96
        fun step(i) = if i=ub then () else (p(i); step(i+1));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    97
    in step 0 end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    98
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    99
fun itA(a0:'a, b: 'b array)(f:'a * 'b -> 'a) : 'a =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   100
    let val ub = length b
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   101
        fun acc(a,i) = if i=ub then a else acc(f(a,sub(b,i)),i+1)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   102
    in acc(a0,0) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   103
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   104
(*
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   105
gram: name of nt -> number, nt number -> productions array,
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   106
      nt number -> list of nt's reachable via copy ops
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   107
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   108
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   109
datatype Symbol = T of token | NT of int * int
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   110
     and Op = Op of OpSyn * string * int
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   111
withtype OpSyn = Symbol array
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   112
     and OpListA = Op array * int TokenMap
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   113
     and FastAcc = int TokenMap;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   114
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   115
type gram = int Symtab.table * OpListA array * int list array;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   116
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   117
fun non_term(Nonterminal(s,_)) = if predef_term(s)=EndToken then [s] else []
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   118
  | non_term(_) = [];
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   119
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   120
fun non_terms(Prod(_,symbs,_,_)) = flat(map non_term symbs);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   121
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   122
(* mk_pre_grammar converts a list of productions in external format into an
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   123
internal gram object. *)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   124
val dummyTM:FastAcc = mkTokenMap[];
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   125
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   126
fun mk_pre_grammar(prods): gram =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   127
let fun same_res(Prod(t1,_,_,_), Prod(t2,_,_,_)) = t1=t2;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   128
    val partitioned0 = partition_eq same_res prods;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   129
    val nts0 = map (fn Prod(ty,_,_,_)::_ => ty) partitioned0;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   130
    val nts' = distinct(flat(map non_terms prods)) \\ nts0;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   131
    val nts = nts' @ nts0;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   132
    val partitioned = (replicate (len nts') []) @ partitioned0;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   133
    val ntis = nts ~~ (0 upto (len(nts)-1));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   134
    val tab = foldr Symtab.update (ntis,Symtab.null);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   135
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   136
    fun nt_or_vt(s,p) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   137
        (case predef_term(s) of
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   138
           EndToken => let val Some(i) = Symtab.lookup(tab,s) in NT(i,p) end
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   139
         | tk => T(tk));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   140
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   141
    fun mksyn(Terminal(t)) = [T(t)]
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   142
      | mksyn(Nonterminal(t)) = [nt_or_vt t]
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   143
      | mksyn(_) = [];
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   144
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   145
    fun prod2op(Prod(nt,sy,opn,p)) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   146
        let val syA = arrayoflist(flat(map mksyn sy)) in Op(syA,opn,p) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   147
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   148
    fun mkops prods = (arrayoflist(map prod2op prods),dummyTM);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   149
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   150
    val opLA = arrayoflist(map mkops partitioned);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   151
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   152
    val subs = array(length opLA,[]) : int list array;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   153
    fun newcp v (a,Op(syA,_,p)) =
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   154
        if p=chain_pri
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   155
        then let val NT(k,_) = sub(syA,0)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   156
             in if k mem v then a else k ins a end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   157
        else a;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   158
    fun reach v i =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   159
        let val new = itA ([],#1(sub(opLA,i))) (newcp v)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   160
            val v' = new union v
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   161
        in flat(map (reach v') new) union v' end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   162
    fun rch(i) = update(subs,i,reach[i]i);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   163
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   164
in forA(rch,subs); (tab,opLA,subs) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   165
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   166
val RootPref = "__";
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   167
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   168
(* Lookahead tables for speeding up parsing. Lkhd is a mapping from
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   169
nonterminals (in the form of OpList) to sets (lists) of token strings *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   170
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   171
type Lkhd = token list list list;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   172
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   173
(* subst_syn(s,k) syn = [ pref k ts | ts is a token string derivable from sy
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   174
                                      under substitution s ] *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   175
(* This is the general version.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   176
fun cross l1 l2 = flat(map (fn e2 => (map (fn e1 => e1@e2) l1)) l2);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   177
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   178
(* pref k [x1,...,xn] is [x1,...,xk] if 0<=k<=n and [x1,...,xn] otherwise *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   179
fun pref 0 l = []
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   180
  | pref _ [] = []
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   181
  | pref k (e::l) = e::(pref (k-1) l);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   182
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   183
fun subst_syn(s:Lkhd,k) =
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   184
    let fun subst(ref(symb & syn)):token list list =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   185
              let val l1 = case symb of T t => [[t]] |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   186
                         NT(oplr,_) => let val Some l = assoc(s,!oplr) in l end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   187
              in distinct(map (pref k) (cross l1 (subst syn))) end |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   188
            subst _ = [[]]
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   189
    in subst end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   190
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   191
(* This one is specialized to lookahead 1 and a bit too generous *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   192
fun subst_syn(s:Lkhd,1) syA =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   193
    let fun subst i = if i = length(syA) then [[]] else
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   194
              case sub(syA,i) of
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   195
                NT(j,_) => let val pre = nth_elem(j,s)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   196
                         in if [] mem pre then (pre \ []) union subst(i+1)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   197
                            else pre end |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   198
               T(tk) => [[tk]];
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   199
    in subst 0 end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   200
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   201
(* mk_lkhd(G,k) returns a table which associates with every nonterminal N in
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   202
G the list of pref k s for all token strings s with N -G->* s *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   203
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   204
fun mk_lkhd(opLA:OpListA array,k:int):Lkhd =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   205
    let fun step(s:Lkhd):Lkhd =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   206
            let fun subst_op(l,Op(sy,_,_)) = subst_syn(s,k)sy union l;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   207
                fun step2(l,(opA,_)) = l@[itA([],opA)subst_op];
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   208
            in writeln"."; itA([],opLA)step2 end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   209
        fun iterate(s:Lkhd):Lkhd = let val s' = step s
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   210
              in if map len s = map len s' then s
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   211
                 else iterate s' end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   212
    in writeln"Computing lookahead tables ...";
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   213
       iterate (replicate (length opLA) []) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   214
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   215
(* create look ahead tables *)
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   216
fun mk_earley_gram(g as (tab,opLA,_):gram):gram =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   217
    let val lkhd = mk_lkhd(opLA,1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   218
        fun mk_fa(i):FastAcc =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   219
            let val opA = #1(sub(opLA,i));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   220
                fun start(j) = let val Op(sy,_,_) = sub(opA,j);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   221
                                   val pre = subst_syn(lkhd,1) sy
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   222
                        in (j,if [] mem pre then [] else map hd pre) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   223
            in mkTokenMap(map start (0 upto(length(opA)-1))) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   224
        fun updt(i) = update(opLA,i,(#1(sub(opLA,i)),mk_fa(i)));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   225
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   226
    in forA(updt,opLA); g end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   227
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   228
fun compile_xgram(roots,prods) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   229
      let fun mk_root nt = Prod(RootPref^nt,
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   230
                [Nonterminal(nt,0),Terminal(EndToken)],"",0);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   231
          val prods' = (map mk_root roots) @ prods
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   232
      in mk_earley_gram(mk_pre_grammar(prods')) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   233
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   234
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   235
(* translate (from xgram.ML) *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   236
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   237
fun translate trfn =
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   238
  map
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   239
    (fn Terminal t => Terminal (trfn t)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   240
      | Nonterminal s => Nonterminal s
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   241
      | Space s => Space s
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   242
      | Bg i => Bg i
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   243
      | Brk i => Brk i
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   244
      | En => En);
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   245
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   246
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   247
(* mk_gram (from syntax.ML) *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   248
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   249
fun str_to_tok (opl: string prod list): token prod list =
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   250
  map
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   251
    (fn Prod (t, syn, s, pa) => Prod (t, translate Token syn, s, pa))
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   252
    opl;
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   253
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   254
fun mk_gram roots prods = compile_xgram (roots, str_to_tok prods);
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   255
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   256
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   257
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   258
(* State: nonterminal#, production#, index in production,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   259
          index of originating state set,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   260
          parse trees generated so far,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   261
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   262
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   263
datatype State = St of int * int * int * int * parsetree list
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   264
withtype StateSet  = State LListR * (State -> unit) LListR;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   265
type Compl = State -> unit;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   266
type StateSetList = StateSet array;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   267
(* Debugging:
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   268
val print_SL = seqll(fn St(nti,pi,ip,fs,ptl)=>
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   269
(print_int nti; prs" "; print_int pi; prs" "; print_int ip; prs" ";
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   270
print_int fs; prs" "; print_int(len ptl); prs"\n"));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   271
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   272
fun print_SS(s1,delr) = (writeln"================="; print_SL s1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   273
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   274
fun count_ss(ref nilL) = 0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   275
  | count_ss(ref(_ & ss)) = count_ss(ss)+1;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   276
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   277
fun print_stat(state_sets) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   278
    let fun pr i = let val(s1,_)=sub(state_sets,i)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   279
                in prs" "; print_int(count_ss s1) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   280
    in prs"["; forA(pr,state_sets); prs"]\n" end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   281
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   282
fun mt_stateS():StateSet = (ref nilL, ref nilL);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   283
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   284
fun mt_states(n):StateSetList = array(n,mt_stateS());
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   285
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   286
fun ismt_stateS((ref nilL,_):StateSet) = true | ismt_stateS _ = false;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   287
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   288
fun fst_state((ref(st & _),_): StateSet) = st;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   289
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   290
fun apply_all_states(f,(slr,_):StateSet) = seqll f slr;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   291
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   292
fun add_state(nti,pi,ip,from,ptl,(sllr,delr):StateSet) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   293
      let fun add(ref(St(nti',pi',ip',from',_) & rest)) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   294
                if nti=nti' andalso pi=pi' andalso ip=ip' andalso from=from'
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   295
                then ()
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   296
                else add rest |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   297
              add(last as ref nilL) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   298
                let val newst = St(nti,pi,ip,from,ptl)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   299
                in last := newst & ref nilL;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   300
                   seqll (fn compl => compl newst) delr
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   301
                end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   302
      in add sllr end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   303
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   304
fun complete(nti,syA,opn,p,ptl,ss,si as (_,delr):StateSet,opLA,rchA) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   305
      let val pt = mk_pt(opn,ptl)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   306
          fun compl(St(ntj,pj,jp,from,ptl)) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   307
                let val Op(syj,_,_) = sub(fst(sub(opLA,ntj)),pj) in
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   308
                if jp=length(syj) then () else
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   309
                case sub(syj,jp) of
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   310
                  NT(nt,p') => if p >= p' andalso nti mem sub(rchA,nt)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   311
                        then add_state(ntj,pj,jp+1,from,ptl@[pt], si)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   312
                        else ()
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   313
                | _ => ()
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   314
                end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   315
      in apply_all_states(compl,ss);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   316
         if length(syA)=0 (* delayed completion in case of empty production: *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   317
         then delr := compl & ref(!delr) else ()
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   318
      end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   319
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   320
fun predict(tk,isi,si,p',opLA) = fn nti =>
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   321
    let val (opA,tm) = sub(opLA,nti);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   322
        fun add(pi) = let val opr as Op(syA,_,p) = sub(opA,pi)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   323
                in if p < p' then () else add_state(nti,pi,0,isi,[],si) end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   324
    in seq add (applyTokenMap(tm,tk)) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   325
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   326
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   327
(*(* FIXME *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   328
fun parsable((tab,_,_):gram, root:string) =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   329
        not(Symtab.lookup(tab,RootPref^root) = None);
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   330
*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   331
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   332
(* exception SYNTAX_ERROR of token list; *) (* FIXME *)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   333
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   334
fun unknown c = error ("Unparsable category: " ^ c);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   335
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   336
fun syn_err toks = error ("Syntax error at: " ^ space_implode " " (map str_of_token toks));
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   337
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   338
fun parse ((tab,opLA,rchA):gram) (root:string) (tl: token list): parsetree =
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   339
    let val tl' = tl;   (* FIXME was ..@[EndToken] *)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   340
        val state_sets = mt_states(len tl' +1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   341
        val s0 = mt_stateS();
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   342
        val rooti = case Symtab.lookup(tab,RootPref^root) of
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   343
                Some(ri) => ri | None => unknown root;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   344
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   345
        fun lr (tl,isi,si,t) =
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   346
(*            if ismt_stateS(si) then raise SYNTAX_ERROR(t::tl) else  *)  (* FIXME *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   347
            if ismt_stateS(si) then syn_err (t::tl) else
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   348
            case tl of
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   349
              [] => () |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   350
              t::tl =>
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   351
                let val si1 = mt_stateS();
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   352
                    fun process(St(nti,pi,ip,from,ptl)) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   353
                          let val opA = #1(sub(opLA,nti))
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   354
                              val Op(syA,opn,p) = sub(opA,pi) in
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   355
                        if ip = length(syA)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   356
                        then complete(nti,syA,opn,p,ptl,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   357
                                        sub(state_sets,from),si,opLA,rchA)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   358
                        else case sub(syA,ip) of
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   359
                          NT(ntj,p) =>
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   360
                                seq (predict(t,isi,si,p,opLA)) (sub(rchA,ntj))
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   361
                        | T(t') =>
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   362
                            if matching_tokens(t,t')
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   363
                            then add_state(nti,pi,ip+1,from,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   364
                                           if valued_token(t)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   365
                                           then ptl@[Tip(t)] else ptl,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   366
                                           si1)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   367
                            else () end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   368
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   369
            in apply_all_states(process,si);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   370
               update(state_sets,isi+1,si1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   371
               lr(tl,isi+1,si1,t) end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   372
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   373
    in update(state_sets,0,s0);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   374
       add_state(rooti,0,0,0,[],s0);
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   375
       lr(tl',0,s0,EndToken(*dummy*));
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   376
       (*print_stat state_sets;*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   377
       let val St(_,_,_,_,[pt]) = fst_state(sub(state_sets,len tl'))
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   378
       in pt end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   379
    end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   380
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   381
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   382
(*(* FIXME *)
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   383
fun print_gram ((st,opAA,rchA):gram,lex) =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   384
    let val tts = Lexicon.name_of_token;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   385
        val al = map (fn (x,y)=>(y,x)) (Symtab.alist_of st);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   386
        fun nt i = let val Some(s) = assoc(al,i) in s end;
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   387
        fun print_sy(T(EndToken)) = prs". " |
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   388
            print_sy(T(tk)) = (prs(tts tk); prs" ") |
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   389
            print_sy(NT(i,p)) = (prs((nt i)^"[");print_int p;prs"] ");
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   390
        fun print_opA(i) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   391
                let val lhs = nt i;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   392
                    val (opA,_)=sub(opAA,i);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   393
                    fun print_op(j) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   394
                        let val Op(sy,n,p) = sub(opA,j)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   395
                        in prs(lhs^" = "); forA(fn i=>print_sy(sub(sy,i)),sy);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   396
                           if n="" then () else prs(" => \""^n^"\"");
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   397
                           prs" (";print_int p;prs")\n"
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   398
                        end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   399
                in forA(print_op,opA) end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   400
        fun print_rch(i) = (print_int i; prs" -> ";
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   401
                            print_list("[","]\n",print_int) (sub(rchA,i)))
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   402
    in forA(print_opA,opAA) (*; forA(print_rch,rchA) *) end;
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   403
*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   404
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   405
end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   406
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   407
end;
18
c9ec452ff08f lots of internal cleaning and tuning;
wenzelm
parents: 0
diff changeset
   408