equal
deleted
inserted
replaced
745 let val nt_prods = snd (Vector.sub (prods, nt)); |
745 let val nt_prods = snd (Vector.sub (prods, nt)); |
746 in get_prods nts (token_assoc (nt_prods, tk) @ result) end; |
746 in get_prods nts (token_assoc (nt_prods, tk) @ result) end; |
747 in get_prods (connected_with chains nts nts) [] end; |
747 in get_prods (connected_with chains nts nts) [] end; |
748 |
748 |
749 |
749 |
750 fun PROCESSS ctxt warned prods chains Estate i c states = |
750 fun PROCESSS ctxt prods chains Estate i c states = |
751 let |
751 let |
752 fun all_prods_for nt = prods_for prods chains true c [nt]; |
752 fun all_prods_for nt = prods_for prods chains true c [nt]; |
753 |
753 |
754 fun processS used [] (Si, Sii) = (Si, Sii) |
754 fun processS used [] (Si, Sii) = (Si, Sii) |
755 | processS used (S :: States) (Si, Sii) = |
755 | processS used (S :: States) (Si, Sii) = |
771 | NONE => (*nonterminal is parsed for the first time*) |
771 | NONE => (*nonterminal is parsed for the first time*) |
772 let |
772 let |
773 val tk_prods = all_prods_for nt; |
773 val tk_prods = all_prods_for nt; |
774 val States' = mk_states i min_prec nt (get_RHS min_prec tk_prods); |
774 val States' = mk_states i min_prec nt (get_RHS min_prec tk_prods); |
775 in (Inttab.update (nt, (min_prec, [])) used, States') end); |
775 in (Inttab.update (nt, (min_prec, [])) used, States') end); |
776 |
|
777 val _ = |
|
778 if not (! warned) andalso |
|
779 length new_states + length States > Config.get ctxt branching_level then |
|
780 (Context_Position.if_visible ctxt warning |
|
781 "Currently parsed expression could be extremely ambiguous"; |
|
782 warned := true) |
|
783 else (); |
|
784 in |
776 in |
785 processS used' (new_states @ States) (S :: Si, Sii) |
777 processS used' (new_states @ States) (S :: Si, Sii) |
786 end |
778 end |
787 | (_, _, _, Terminal a :: _, _, _) => (*scanner operation*) |
779 | (_, _, _, Terminal a :: _, _, _) => (*scanner operation*) |
788 processS used States |
780 processS used States |
801 in processS used (map (movedot_nonterm tt) Slist @ States) (S :: Si, Sii) end |
793 in processS used (map (movedot_nonterm tt) Slist @ States) (S :: Si, Sii) end |
802 end) |
794 end) |
803 in processS Inttab.empty states ([], []) end; |
795 in processS Inttab.empty states ([], []) end; |
804 |
796 |
805 |
797 |
806 fun produce ctxt warned prods tags chains stateset i indata prev_token = |
798 fun produce ctxt prods tags chains stateset i indata prev_token = |
807 (case Array.sub (stateset, i) of |
799 (case Array.sub (stateset, i) of |
808 [] => |
800 [] => |
809 let |
801 let |
810 val toks = if Lexicon.is_eof prev_token then indata else prev_token :: indata; |
802 val toks = if Lexicon.is_eof prev_token then indata else prev_token :: indata; |
811 val pos = Position.str_of (Lexicon.pos_of_token prev_token); |
803 val pos = Position.str_of (Lexicon.pos_of_token prev_token); |
819 | s => |
811 | s => |
820 (case indata of |
812 (case indata of |
821 [] => s |
813 [] => s |
822 | c :: cs => |
814 | c :: cs => |
823 let |
815 let |
824 val (si, sii) = PROCESSS ctxt warned prods chains stateset i c s; |
816 val (si, sii) = PROCESSS ctxt prods chains stateset i c s; |
825 val _ = Array.update (stateset, i, si); |
817 val _ = Array.update (stateset, i, si); |
826 val _ = Array.update (stateset, i + 1, sii); |
818 val _ = Array.update (stateset, i + 1, sii); |
827 in produce ctxt warned prods tags chains stateset (i + 1) cs c end)); |
819 in produce ctxt prods tags chains stateset (i + 1) cs c end)); |
828 |
820 |
829 |
821 |
830 fun get_trees states = map_filter (fn (_, _, [pt], _, _, _) => SOME pt | _ => NONE) states; |
822 fun get_trees states = map_filter (fn (_, _, [pt], _, _, _) => SOME pt | _ => NONE) states; |
831 |
823 |
832 fun earley ctxt prods tags chains startsymbol indata = |
824 fun earley ctxt prods tags chains startsymbol indata = |
839 val s = length indata + 1; |
831 val s = length indata + 1; |
840 val Estate = Array.array (s, []); |
832 val Estate = Array.array (s, []); |
841 val _ = Array.update (Estate, 0, S0); |
833 val _ = Array.update (Estate, 0, S0); |
842 in |
834 in |
843 get_trees |
835 get_trees |
844 (produce ctxt (Unsynchronized.ref false) prods tags chains Estate 0 indata Lexicon.eof) |
836 (produce ctxt prods tags chains Estate 0 indata Lexicon.eof) |
845 end; |
837 end; |
846 |
838 |
847 |
839 |
848 fun parse ctxt (Gram {tags, prods, chains, ...}) start toks = |
840 fun parse ctxt (Gram {tags, prods, chains, ...}) start toks = |
849 let |
841 let |