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', |