src/Pure/Syntax/parser.ML
changeset 373 68400ea32f7b
parent 372 40d565e51dea
child 377 ab8917806779
     1.1 --- a/src/Pure/Syntax/parser.ML	Fri May 13 13:56:22 1994 +0200
     1.2 +++ b/src/Pure/Syntax/parser.ML	Tue May 17 14:42:34 1994 +0200
     1.3 @@ -50,8 +50,10 @@
     1.4  
     1.5  (* convert productions to reference grammar with lookaheads and eliminate
     1.6     chain productions *)
     1.7 -fun mk_gram prods = 
     1.8 -  let (*get reference on list of all possible rhss for nonterminal lhs
     1.9 +fun mk_gram prods =
    1.10 +  let val _ = writeln "Building new grammar...";
    1.11 +
    1.12 +      (*get reference on list of all possible rhss for nonterminal lhs
    1.13          (if it doesn't exist a new one is created and added to the nonterminal
    1.14           list)*)
    1.15        fun get_rhss ref_prods lhs =
    1.16 @@ -482,16 +484,36 @@
    1.17  fun produce stateset i indata prev_token =
    1.18                       (*the argument prev_token is only used for error messages*)
    1.19    (case Array.sub (stateset, i) of
    1.20 -    [] => let (*compute a list of allowed starting tokens 
    1.21 -                for a list of nonterminals*)
    1.22 +    [] => let (*similar to token_assoc but does not automatically 
    1.23 +                include 'None' key*)
    1.24 +              fun token_assoc2 (list, key) =
    1.25 +                let fun assoc [] = []
    1.26 +                      | assoc ((keyi, xi) :: pairs) =
    1.27 +                          if is_some keyi andalso
    1.28 +                             matching_tokens (the keyi, key) then 
    1.29 +                            (assoc pairs) @ xi
    1.30 +                          else assoc pairs;
    1.31 +                          in assoc list end;
    1.32 +
    1.33 +              (*test if tk is a lookahead for a given minimum precedence*)
    1.34 +              fun reduction minPrec tk _ (Term _ :: _, _, prec:int) =
    1.35 +                    if prec >= minPrec then true
    1.36 +                    else false
    1.37 +                | reduction minPrec tk checked 
    1.38 +                            (Nonterm (rhss_ref, NTprec)::_,_, prec) =
    1.39 +                    if prec >= minPrec andalso not (rhss_ref mem checked) then
    1.40 +                      exists (reduction NTprec tk (rhss_ref :: checked)) 
    1.41 +                             (token_assoc2 (!rhss_ref, tk))
    1.42 +                    else false;
    1.43 +
    1.44 +              (*compute a list of allowed starting tokens 
    1.45 +                for a list of nonterminals considering precedence*)
    1.46                fun get_starts [] = []
    1.47                  | get_starts ((rhss_ref, minPrec:int) :: refs) =
    1.48                      let fun get [] = []
    1.49 -                          | get ((Some tok, prods) :: rhss) =
    1.50 -                              if exists (fn (Term _ :: _, _, prec) => 
    1.51 -                                              prec >= minPrec
    1.52 -                                          | (_, _, _) => false) prods
    1.53 -                              then tok :: (get rhss)
    1.54 +                          | get ((Some tk, prods) :: rhss) =
    1.55 +                              if exists (reduction minPrec tk [rhss_ref]) prods
    1.56 +                              then tk :: (get rhss)
    1.57                                else get rhss
    1.58                            | get ((None, _) :: rhss) =
    1.59                                get rhss;
    1.60 @@ -505,8 +527,6 @@
    1.61                              (map (fn (_, _, _, Term a :: _, _, _) => a)
    1.62                              (filter (fn (_, _, _, Term _ :: _, _, _) => true
    1.63                                     | _ => false) (Array.sub (stateset, i-1)))));
    1.64 -                                             (*terminals have to be searched for
    1.65 -                                               because of lambda productions*)
    1.66            in syntax_error (if prev_token = EndToken then indata
    1.67                             else prev_token :: indata) allowed
    1.68            end