src/Pure/Syntax/parser.ML
changeset 80957 8aff3182ef82
parent 80950 b4a6bee4621a
child 80958 0de153a15095
equal deleted inserted replaced
80956:12994047862f 80957:8aff3182ef82
   424     prods = Vector.fromList [nt_gram_empty]};
   424     prods = Vector.fromList [nt_gram_empty]};
   425 
   425 
   426 fun extend_gram xprods (Gram {nt_count, prod_count, tags, chains, lambdas, prods}) =
   426 fun extend_gram xprods (Gram {nt_count, prod_count, tags, chains, lambdas, prods}) =
   427   let
   427   let
   428     (*Get tag for existing nonterminal or create a new one*)
   428     (*Get tag for existing nonterminal or create a new one*)
   429     fun get_tag nt_count tags nt =
   429     fun get_tag (context as (nt_count, tags)) nt =
   430       (case tags_lookup tags nt of
   430       (case tags_lookup tags nt of
   431         SOME tag => (nt_count, tags, tag)
   431         SOME tag => (context, tag)
   432       | NONE => (nt_count + 1, tags_insert (nt, nt_count) tags, nt_count));
   432       | NONE => ((nt_count + 1, tags_insert (nt, nt_count) tags), nt_count));
   433 
   433 
   434     (*Convert symbols to the form used by the parser;
   434     (*Convert symbols to the form used by the parser;
   435       delimiters and predefined terms are stored as terminals,
   435       delimiters and predefined terms are stored as terminals,
   436       nonterminals are converted to integer tags*)
   436       nonterminals are converted to integer tags*)
   437     fun symb_of [] nt_count tags result = (nt_count, tags, rev result)
   437     fun make_symbs [] context result = (context, rev result)
   438       | symb_of (Syntax_Ext.Delim s :: ss) nt_count tags result =
   438       | make_symbs (Syntax_Ext.Delim s :: ss) context result =
   439           symb_of ss nt_count tags (Terminal (Lexicon.literal s) :: result)
   439           make_symbs ss context (Terminal (Lexicon.literal s) :: result)
   440       | symb_of (Syntax_Ext.Argument (s, p) :: ss) nt_count tags result =
   440       | make_symbs (Syntax_Ext.Argument (s, p) :: ss) context result =
   441           let
   441           let
   442             val (nt_count', tags', new_symb) =
   442             val (context', new_symb) =
   443               (case Lexicon.get_terminal s of
   443               (case Lexicon.get_terminal s of
   444                 NONE =>
   444                 NONE =>
   445                   let val (nt_count', tags', s_tag) = get_tag nt_count tags s;
   445                   let val (context', tag) = get_tag context s;
   446                   in (nt_count', tags', Nonterminal (s_tag, p)) end
   446                   in (context', Nonterminal (tag, p)) end
   447               | SOME tk => (nt_count, tags, Terminal tk));
   447               | SOME tk => (context, Terminal tk));
   448           in symb_of ss nt_count' tags' (new_symb :: result) end
   448           in make_symbs ss context' (new_symb :: result) end
   449       | symb_of (_ :: ss) nt_count tags result = symb_of ss nt_count tags result;
   449       | make_symbs (_ :: ss) context result = make_symbs ss context result;
   450 
   450 
   451     (*Convert list of productions by invoking symb_of for each of them*)
   451     fun make_prods [] context result = (context, result)
   452     fun prod_of [] nt_count prod_count tags result =
   452       | make_prods (Syntax_Ext.XProd (lhs, xsymbs, const, pri) :: ps) context result =
   453           (nt_count, prod_count, tags, result)
       
   454       | prod_of (Syntax_Ext.XProd (lhs, xsymbs, const, pri) :: ps)
       
   455             nt_count prod_count tags result =
       
   456           let
   453           let
   457             val (nt_count', tags', lhs_tag) = get_tag nt_count tags lhs;
   454             val (nt_count, prod_count, tags) = context;
   458             val (nt_count'', tags'', prods) = symb_of xsymbs nt_count' tags' [];
   455             val (context', tag) = get_tag (nt_count, tags) lhs;
   459           in
   456             val ((nt_count'', tags''), symbs) = make_symbs xsymbs context' [];
   460             prod_of ps nt_count'' (prod_count + 1) tags''
   457             val context'' = (nt_count'', prod_count + 1, tags'');
   461               ((lhs_tag, (prods, const, pri)) :: result)
   458           in make_prods ps context'' ((tag, (symbs, const, pri)) :: result) end;
   462           end;
   459 
   463 
   460     val ((nt_count', prod_count', tags'), new_prods) =
   464     val (nt_count', prod_count', tags', xprods') =
   461       make_prods xprods (nt_count, prod_count, tags) [];
   465       prod_of xprods nt_count prod_count tags [];
       
   466 
   462 
   467     val array_prods' =
   463     val array_prods' =
   468       Array.tabulate (nt_count', fn i =>
   464       Array.tabulate (nt_count', fn i =>
   469         if i < nt_count then Vector.nth prods i
   465         if i < nt_count then Vector.nth prods i
   470         else nt_gram_empty);
   466         else nt_gram_empty);
   471 
   467 
   472     val (chains', lambdas') =
   468     val (chains', lambdas') =
   473       (chains, lambdas) |> fold (add_production array_prods') xprods';
   469       (chains, lambdas) |> fold (add_production array_prods') new_prods;
   474   in
   470   in
   475     Gram
   471     Gram
   476      {nt_count = nt_count',
   472      {nt_count = nt_count',
   477       prod_count = prod_count',
   473       prod_count = prod_count',
   478       tags = tags',
   474       tags = tags',