include 'colm.lm' export ColmTree: start export ColmError: str A: str = argv->pop() F: stream = open( A, 'r' ) parse P: start [ F ] alias prod_map map alias unique_prod map_el global PM: prod_map = new prod_map() global NextId: int = 1 global Modified: bool = false prod_list cons_prod( SLA: prod_sublist ) { if match SLA [Left: prod_sublist BAR prod_el_list] return cons prod_list[ cons_prod(Left) ' | [ ' SLA.prod_el_list ' ] ' ] else return cons prod_list[ '[ ' SLA.prod_el_list ' ]' ] } cfl_def rewrite_cfl_def( CflDef: ref ) { NewDef: cfl_def for PE: prod_el in CflDef { if match PE [ OptName: opt_prod_el_name POPEN PS: prod_sublist PCLOSE OptRep: opt_repeat] { PL: prod_list = cons_prod(PS) Name: id = PM->find( PL ) if ( !Name ) { Name = parse id "_sublist_[sprintf("%d", NextId)]" NextId = NextId + 1 PM->insert( PL, Name ) NewDef = cons cfl_def "def [Name] [PL]" } PE = cons prod_el [OptName Name OptRep " "] Modified = true # Currently can return only one item. if ( NewDef ) break } } return NewDef } void rewrite( P: ref ) { Modified = false for RIL: root_item<* in P { require RIL [Head: root_item<* CflDef: cfl_def] NewDef: cfl_def NewDef = rewrite_cfl_def( CflDef ) if NewDef { RIL = cons root_item<* [Head NewDef "\n\n" CflDef] Modified = true } else { RIL = cons root_item<* [Head CflDef] } } return Modified } if P { while ( rewrite( P ) ) {} } ColmTree = P ColmError = error