MP2/MP2-generator.rig

-- MP_generator.rig   Phoenix -> C++ code generator  
-- V 2.0 
-- Mikhail Auguston, 03/05/15
-- last modified 04/05/15
-- use: MP_generator intermediate_file 
--
-----------------------------------
#AG
-- Globals:
--	$roots			-- retain the original MP code,
--	$composites		-- these are used for comment generation
--  $atoms			-- for event name generation
--  $new_root_table
--  $new_composites
--  $composite_order -- for harvest() calls ordering

--  $class_counter
--  $generated_containers: <* work_name: T *>
----------------------------------------------

  $Parm:= #PARM(T);
  $input_file:= #IMPLODE( $Parm [1]);
  LOAD $model $input_file;
	$roots:=			$model.roots;
	$composites:=		$model.composites;
	$atoms:=			$model.atomic_events;
	$new_root_table:=	$model.new_root_table;
	$new_composites:=	$model.new_composites;
	$composite_order:=	$model.composite_order;
	$coordinate_ops:=	$model.coordinate_ops;
	$share_all_ops:=	$model.share_all_ops;
		
  OPEN GEN #IMPLODE( $model.schema '.cpp' ); -- for C++ code
  OPEN MSG ' ';								 --for error messages
  --MSG<< 'Phoenix/C++ generator v.2.0 input from '  $input_file;
  
  GEN<< '/* Monterey Phoenix-> C++ generator, v.2.0, March 2015';
  GEN<< '   Mikhail Auguston, NPS, CS Dept, Monterey, CA, USA';GEN<<;
  GEN<< '   traces derived for scope' $model.scope;
  GEN<< '----------------------------------------------------';
  GEN<< 'SCHEMA' $model.schema;
  -- print comments with the original MP code
  #print_rule_list(root $roots);
  #print_rule_list(composite $composites);
     
  GEN<<;
  GEN<< '*****************************************************************'; 
  GEN<< '***' generated constants are visible in the 'mp2_print_etc.h';
  GEN<< '*****************************************************************/';
  GEN<< '#include "mp2.h" // the permanent part';GEN<<;
     
	#generate_event_names();
	#generate_event_strings();

	GEN<< '#include "mp2_print_etc.h" // print methods';
	GEN<< '//***************************';
	GEN<< '//==== generated classes ====';
	GEN<< '//***************************';
	GEN<<;
	
	$class_counter:= 0;
	#generate_composite_producers($new_composites);
	#generate_composite_producers($new_root_table);
	#generate_event_class($new_composites);
	#generate_event_class($new_root_table);
	#generate_coordination_class($coordinate_ops);
	#generate_share_all_class($share_all_ops);
	#generate_schema_class($model.elt_list);
    
	GEN<< '//******************************************';
	GEN<< '//'	main;
	GEN<< '//******************************************';
	GEN<< 'int main(){';
	GEN<< '   gen_start = clock();';
	GEN<<  @ '   JSON.open("' $model.schema '.json");';
	GEN<<    '   cout<< "generating traces for scope' $model.scope '"<<endl;';
	GEN<< '//----------------------------';
	#generate_harvest_calls($composite_order);
	#harvest_roots($new_root_table);
	#harvest_main_schema();

	-- generate statistics show
	GEN<< '//----------------------------';
	GEN<< '   show_statistics();';
	GEN<< 'return 0;';
	GEN<< '} // end main()';
##
--------------------------------------------------
--  print subroutines ----------------------------
--------------------------------------------------
#print_rule_list
-- Global: $buffer_len  -- should be <= 80
	( root /$type:= ROOT/ ! $x)
	<* $rule_name: 
			/GEN<<  $type @ $rule_name ': ';
			 $buffer_len:= #LEN($rule_name) + 10/
			<. pattern_list: #print_element .>
			/ GEN<] ';'/
	*>
##

#print_element
	<.	type: plain,
		name: $event_name 
			/IF LAST #print_rule_list $buffer_len + #LEN($event_name) > 68 ->
				GEN<< '       '; 
				LAST #print_rule_list $buffer_len:= 10
			 FI;
			 GEN<] $event_name; 
			 LAST #print_rule_list $buffer_len +:= #LEN($event_name) +1/
	.>;;

	<.	type:	sequence,
		body:	(. (*   #print_element  *) .)
	.>;;
	
	<.	type:	alternative,
		body:	/GEN<] '('/
			(. (* /GEN<] $bar; $bar:= '|'/  #print_element  *) .)
			/GEN<] ')'/
	.>;;

	<.	type:	iterator,
		body:	/GEN<] '(*'/  #print_element /GEN<] '*)'/
	.>;;

	<.	type:	iterator_plus,
		body: /GEN<] '(+'/  #print_element /GEN<] '+)'/
	.>;;
	
	<.	type:		set,
		body: /GEN<] '{'/
			(. (* /GEN<] $bar; $bar:= ','/  #print_element  *) .)
			/GEN<] '}'/
	.>;;

	<.	type:		set_iterator,
		body: /GEN<] '{*'/ #print_element /GEN<] '*}'/
	.>;;

	<.	type:		set_iterator_plus,
		body: /GEN<] '{+'/ #print_element /GEN<] '+}'/
	.>;;
	
	<.	type:		optional,
		body: /GEN<] '['/  #print_element /GEN<] ']'/
	.>;;
		
	<. type: empty .> ;; -- EMPTY

	$x /GEN<< '**' $x.type print not implemented yet '**'/
##

------------------------------------------------------------------
-------- generate event names enum and strings
------------------------------------------------------------------

-- GenericContainer is used for all Alt (OR), Seq (AND), Set producers
#generate_event_names
	/GEN<< 'enum Event_name {Dummy_event, GenericContainer';
	 GEN<< '       // atomic events'; 
	 #print_event_name(LAST #AG $atoms);
	 GEN<< '       // composite events'; 
	 #print_event_name(LAST #AG $composites);
	 GEN<< '       // coordination operations'; 
	 #print_event_name(LAST #AG $coordinate_ops);
	 GEN<< '       // share all operations'; 
	 #print_event_name(LAST #AG $share_all_ops);	 	 
	 GEN<< '       // ROOT events';
	 #print_event_name(LAST #AG $roots);
	 GEN<< '       // main schema event'; 
	 GEN<< @ '    , Event_' LAST #AG $model.schema;
	 GEN<] ' };'; GEN<<;/ 
##

#print_event_name
	<* $event_name: $x 
		/GEN<< @ '    , Event_' $event_name /
	*>
##

#generate_event_strings
	/GEN<< 'string event_name_string[] = {"Dummy", "GenericContainer"';
	 #print_event_string(LAST #AG $atoms);
	 #print_event_string(LAST #AG $composites);
	 #print_event_string(LAST #AG $coordinate_ops);
	 #print_event_string(LAST #AG $share_all_ops);
	 #print_event_string(LAST #AG $roots);
	 GEN<< @ '     , "' LAST #AG $model.schema '"';
	 GEN<] ' };'; GEN<<;/ 
##

#print_event_string
	<* $event_name: $x 
		/GEN<< @ '     , "' $event_name '"' /
	*>
##

--********************************************************************
--------------------------- EVENT CLASSES ----------------------------
--********************************************************************
#generate_composite_producers
	<* $event_name:	<. pattern_list:	#generate_container,
					   [build_block:	$comp_op_list
							-- here comes composition op class generator <<<<<<<<<< 
						]
					.>
	*>		
##

#generate_container
	<. type: ( plain ! composite ! empty ) .> ;;
	
	-- for event grammar patterns
	<. name: $work_name
				/IF LAST#AG $generated_containers.$work_name -> 
					RETURN T 
				 FI/, -- to prevent duplication
					
	   type: (	sequence	/$base:= AND_node_producer_container/ ! 
				alternative /$base:= OR_node_producer_container/  ! 
				set			/$base:= SET_node_producer_container/ ),
				
	   body: (. (* #generate_container *) .), -- for nested ALT, SEQ, SET

	   body: 
			/GEN<< '//----' #class_counter() '----';
			 GEN<< class $work_name ': public' $base '{';
			 GEN<< 'public:' '//' constructor;
			 GEN<< '   ' $work_name '():' $base '(GenericContainer){';
			 GEN<< '      element =	new Event_producer_ref[ element_count =' 
					#LEN($.body) + #LEN(LAST #generate_composite_producers $comp_op_list) 
					'];'; 
			 $element_count:= 0 /
			(. (* /GEN<< '      element[' $element_count ']= '/
					#generate_element 
				  /GEN<] ';';
				   $element_count +:= 1 /
				*) .)
	.> 
				
		/GEN<< '    }';
		 GEN<< '};//' end class $work_name;
		 GEN<<;
		 LAST#AG $generated_containers ++:= <. $work_name: T .> / 
##

#generate_element

	<.	type: plain,
		name: $Id    .>
	/GEN<] @ 'new Atomic_producer(Event_' $Id ')'/;;

	<. type: composite,
	   name: $Id		.>
	/GEN<] @ 'new Composite_secondary_producer(Event_' $Id ')'/;;
	
	<. type: (sequence ! alternative ! set),
	   name: $work_name		.>
	/GEN<] new $work_name/;;
	
	<.	type: empty .> 
	/GEN<] '&Dummy'/;;
	
	-- here come composition op elements <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	
	$x /PRINT (. '***' Unrecognized element $x .)/
	
##

#generate_event_class

	<* $event_name:  
		<. rule_type: ( composite /$target_event:= Composite_event_instance_node/ ! 
						ROOT	  /$target_event:= ROOT_node/ ),
							
		   work_name:	$work_name
					/GEN<< '//----' #class_counter() '----';
					GEN<< class $work_name ': public Composite_producer {';
					GEN<< 'public:' '//' constructor;
					GEN<< '   ' $work_name @ '(): Composite_producer(Event_' $event_name '){';
					GEN<< '      target_event =' $target_event ';';
					GEN<< '      element =	new Event_producer_ref[ element_count =' 
					1 + #LEN($.$event_name.build_block) '];'; 
					$element_count:= 0 /,
	 
		   pattern_list: -- on the top level in composite always just single pattern
							/GEN<< '      element[' $element_count ']= '/
							#generate_element 
							/GEN<] ';';
							 $element_count +:= 1 /,  

		   [build_block:	$comp_op_list ]
		.>
		/GEN<< '    }';
		GEN<< '};//' end class $work_name;
		GEN<< /
	 *> 
##

#generate_coordination_class
-- global:
-- $nesting_depth for avoiding redundant create_matrices() calls
-------------------------
	<* $work_name: 
		/GEN<< '//----' #class_counter() '----';
		GEN<< class @ $work_name '_ob: public Coordinate {';
		GEN<< 'public:' '//' constructor;
		GEN<< '   ' @ $work_name '_ob(int n): Coordinate(n){ }';
				GEN<<;


		GEN<< '    Traversal_result traverse(){';
		GEN<< ' try{';
		$nesting_depth:= 0/
		
		#generate_operation
		
		/GEN<< ' }';
		 GEN<< ' catch(Traversal_result t){';
		 GEN<< '   delete_matrices();';
		 GEN<< '   return failed;';
		 GEN<< ' }';
		 GEN<< ' delete_matrices();';
		 GEN<< ' return success_and_completed;';
		 GEN<< '    } // end traverse()';
		 GEN<< '}; // end' @ $work_name '_ob class';
		 GEN<</
	*>
##

#generate_share_all_class
	<* $work_name: 
		/GEN<< '//----' #class_counter() '----';
		GEN<< class @ $work_name '_ob: public Coordinate {';
		GEN<< 'public:' '//' constructor;
		GEN<< '   ' @ $work_name '_ob(int n): Coordinate(n){type = ShareAll_op;}';
		GEN<<;
		GEN<< '    Traversal_result traverse(){';
		GEN<< ' try{';/
		
		#generate_operation
		
		/GEN<< ' }';
		 GEN<< ' catch(Traversal_result t){';
		 GEN<< '   delete_matrices();';
		 GEN<< '   return failed;';
		 GEN<< ' }';
		 GEN<< ' delete_matrices();';
		 GEN<< ' return success_and_completed;';
		 GEN<< '    } // end traverse()';
		 GEN<< '}; // end' @ $work_name '_ob class';
		 GEN<</
	*>
##

#generate_operation
	/LAST #generate_coordination_class $nesting_depth +:= 1/
	<.	synchronization: $synchronization,

		operation:	 COORDINATE 
					/GEN<< '  //' $synchronization COORDINATE operation;
					 GEN<< '  create_matrices();'/,
							 
		source_list: <*  $variable: 
							/GEN<<;
							GEN<< '  int' $variable '; // variable';
							GEN<< @ '  vector<int> ' $variable 
									'_list; // list of coordinated events' / 
								<. from: 
									( <. comp: $source .>  
										/$source_name:= #IMPLODE($source '_source');
										IF NOT $source_defined.$source ->
											GEN<< '  int ' $source_name 
												'; // source of coordination';
											$source_defined++:= <. $source: T .>
										FI;
										GEN<<;
										GEN<< '   // find source event' $source;
										GEN<< '   for(int i = 0; i < Stack.size(); i++){';
										GEN<< @'     if( Stack[i]->name == Event_' $source '){';
										GEN<< '        ' $source_name '= i; break; }';
										GEN<< '   }'/							!
									  <. var: $v .>	
										/$source_name:= $v/					
									)
									/$source_list!.:= (. $variable  $source_name .);
									 $source_tree++:= <. $variable: $source_name .>/
								.>
					*>,
					
					-- second pass
		source_list: /GEN<<;
					  GEN<< '  // create lists of coordinated events';
					  GEN<< '  for(int i = 0; i < len; i++){'/
					  
					 <*  $variable:
							/GEN<< '    if(in_matrix[i * len + ' $source_tree.$variable ']){';
							 GEN<< @'      if(';
							 $or_op:= ' '/
							<. selection_pattern: (. (*  
										/GEN<] @ $or_op '(Stack[i]->name == Event_' /
												$event_name
										/GEN<] @ $event_name ')';
										 $or_op:= '||'/
													  *) .) 
							.>
							/GEN<] @ ' ){'; 
							 GEN<<  '	   //' make sure this is fresh event not yet shared;
							 GEN<<  '       int found = 0;';
							 GEN<< @'       for(vector<int>::  iterator s = ' 
									$variable  '_list.begin(); s != ' $variable '_list.end(); s++){';
							 GEN<<  '         if((found = eq_matrix[i * len + *s])) break;';
							 GEN<<  '       }';
							 GEN<< @'       if(!found) ' $variable '_list.push_back(i);';
							 GEN<<  '      }';
							 GEN<< '     }'/		
					 *>					 
					 
					 /GEN<< '  }';
					  IF #LEN($source_list) > 1 ->
						GEN<< '  //' check that selected lists are of the same length;
						GEN<< @ '  if(';
						$first_arg:= #IMPLODE($source_list[1][1] '_list.size() != ');
						$i:= 2;
						$or_op:= ' ';
						LOOP
							IF $i > #LEN($source_list) -> BREAK FI;
							GEN<] $or_op @ $first_arg $source_list[$i][1] '_list.size() ';
							$i +:= 1;
							$or_op:= '||';
						END;
						GEN<] ') throw failed;'
					  FI/,
					  
		synchronization:	( Synchronous
								/GEN<<;
								 GEN<< '  //' for syncronized COORDINATE sort the list 
											and check for total order;
								 FORALL $var IN $source_list DO
									GEN<< @ '  sort_and_check_coordinated_events(' $var[1] '_list);'
								 OD /		!
							  $a ),
							  
		body:	/GEN<<;
				 GEN<< '  //' do the COORDINATE;
				 GEN<< '  for(int i = 0; i <' #IMPLODE($source_list[1][1] '_list.size()') '; i++){';
				 FORALL $var IN $source_list DO
					GEN<< @ '    ' $var[1] '= ' $var[1] '_list[i];'
				 OD/
				 (. (+ 
					 (	<.  operation:'ADD',
							relation_list:	(. (+ 
								<.first:	$var1, 
								  second:	$var2, 
								  relation: ( PRECEDES
											  /GEN<< @'    Follows.insert(pair<int, int>(' $var2 ',' $var1 '));'/ !
											  FOLLOWS
											  /GEN<< @'    Follows.insert(pair<int, int>(' $var1 ',' $var2 '));'/ !
											  'IN'
											  /GEN<< @'    Inside.insert(pair<int, int>(' $var1 ',' $var2 '));'/ !
											  CONTAINS
											  /GEN<< @'    Inside.insert(pair<int, int>(' $var2 ',' $var1 '));'/ 
											)
								.> 
											    +) .)
						.>			!
						
						#generate_operation !
						
						<.  operation: $op .> 
							/MSG<< '*****' operation $op is not yet implemented/ 
					 )
				    +) 
				.)
				 /GEN<< '  }';
				  IF LAST #generate_coordination_class $nesting_depth < 2 ->
					GEN<< '  create_matrices(); //' to check for axiom violation;
					GEN<< '  //print_matrices(); //<<<<<<<<<<<<'
				  FI;
				  GEN<< '  //' end of COORDINATE;
				  LAST #generate_coordination_class $nesting_depth +:= -1/
	.>;;
	
----------------------------------------------------------------------------------	
	<.	operation:	 SHARE_ALL 
					/GEN<<;
					 GEN<< '  //' SHARE ALL operation;
					 GEN<< '  create_matrices();'/,
					 
		shared_events: $shared_events,
			
		host_list: (. (*  (. (<. comp: $host_name .> /$source_name:= #IMPLODE($host_name '_source')/ ! 
							  <. var: $host_name .> /$source_name:= $host_name/)
								-- single host
							/$hosts ++:= <. $host_name: T .>;
							 GEN<<;
							 IF $source_name <> $host_name ->
								GEN<<  '  int' $source_name ';// shareholder';
								GEN<<  '  // find host event' $host_name;
								GEN<<  '  for(int i = 0; i < Stack.size(); i++){';
								GEN<< @'   if( Stack[i]->name == Event_' $host_name '){';
								GEN<<  '     ' $source_name '= i; break; } }';
							 FI;
							 GEN<<  '   // lists of shared events for ' $host_name;
							 FORALL $e IN $shared_events DO
							   GEN<< @'  vector<int> ' $host_name '_' $e '_list;'
							 OD;/
						  .)
						*)
					.),
					
		host_list: /GEN<<;
					GEN<< '  //' create lists of shared events;
					GEN<< '  for(int i = 0; i < len; i++){'/
					
					(. (*  (. (<. comp: $host_name .> /$source_name:= #IMPLODE($host_name '_source')/ ! 
							   <. var: $host_name .> /$source_name:= $host_name/)
								-- single host
							/GEN<<  '   if(in_matrix[i * len +'  $source_name ']){';
							 FORALL $e IN $shared_events DO
								GEN<< @'     if( Stack[i]->name == Event_' $e ' ){';
								GEN<<  '	   //' make sure this is fresh event not yet shared;
								GEN<<  '       int found = 0;';
								GEN<<  '       for(vector<int>::  iterator s = ' 
									@$host_name '_' $e '_list.begin();';
								GEN<< @ '          s != ' $host_name '_' $e 
									'_list.end(); s++){';
								GEN<<  '         if((found = eq_matrix[i * len + *s])) break;';
								GEN<<  '       }';
								GEN<< @'       if(!found) ' $host_name '_' $e '_list.push_back(i);';
								GEN<<  '     }'
							 OD;
							 GEN<< '    };'/
						   .)
						*)
					.)
					/GEN<< '  } //' end for create lists of shared events;
					 $single_host:= $host_name/,
					 
		shared_events: /GEN<<;
						GEN<< '  //' check that selected lists are of the same length;
						GEN<< '  int len_to_compare;'/
					
					<* $event_name: $x
							/GEN<<  @'   len_to_compare = ' $single_host '_' $event_name '_list.size();';
							 FORALL $h IN $hosts DO
								IF $h <> $single_host ->
								GEN<< @'     if(' $h '_' $event_name '_list.size() != len_to_compare) '
										@ throw failed ';'
								FI
							 OD/
					*>,
					
		host_list: /GEN<<;
					GEN<< '  //' sort the lists/
					
					(. (*  (. (<. comp: $host_name .> /$source_name:= #IMPLODE($host_name '_source')/ ! 
							   <. var: $host_name .> /$source_name:= $host_name/)
								-- single host
							/FORALL $e IN $shared_events DO
								GEN<< @'     sort_events(' $host_name '_' $e '_list);';
							 OD/
						   .)
						*)
					.),
					
		shared_events: /GEN<<;
						GEN<< '  //' do the SHARE ALL/
					
					<* $event_name: $x
							/GEN<<  @'   len_to_compare = ' $single_host '_' $event_name '_list.size();';
							 GEN<<   '   for(int i = 0; i < len_to_compare; i++){';
							 FORALL $h IN $hosts DO
								IF $h <> $single_host ->
								  GEN<< @'     make_equality_complete(' $single_host '_' $event_name '_list[i], '
											$h '_' $event_name '_list[i]);'
								FI
							 OD;
							 GEN<< '   }'/
					*>			
		
	.>	  							  
		/GEN<< ;
		 IF LAST #generate_coordination_class $nesting_depth < 2 ->
			GEN<< '  create_matrices(); //' to check for axiom violation;
			GEN<< '  //print_matrices(); //<<<<<<<<<<<<'
		 FI;
		 GEN<< '  //' end of SHARE ALL;
		 LAST #generate_coordination_class $nesting_depth +:= -1/
	;;

	$a /PRINT (. generation for $a not yet implemented .)/
##

#generate_schema_class
-- from $model.elt_list

	/GEN<< '//----' #class_counter() '----';
	 GEN<< class @ 'SCHEMA_' LAST #AG $model.schema ': public Composite_producer {';
	 GEN<< 'public:' '//' constructor;
	 GEN<< '   ' @ 'SCHEMA_' LAST #AG $model.schema '(): Composite_producer(Event_' 
			LAST #AG $model.schema '){';
	 GEN<< '      target_event = Schema_node;';
	 GEN<< '      element =	new Event_producer_ref[ element_count =' 
					#LEN(LAST #AG $model.elt_list) '];'; 
	 $element_count:= 0 /
	 (. (*  (	<. ROOT: $root_name .>
				/GEN<< '      element[' $element_count 
						@ ']= new Composite_secondary_producer(Event_' $root_name ');';
				 $element_count +:= 1 /			!
				 
				 ( <. COORDINATE: $work .> ! <. SHARE_ALL: $work .> )
				/GEN<< '      element[' $element_count 
						@ ']= new ' $work '_ob(Event_' $work ');';
				 $element_count +:= 1 /			!
				  
				 $any	-- other composition ops here
			) 
		*)
	 .)
	 /GEN<< '    }';
	  GEN<< '};//' end class @ 'SCHEMA_' LAST #AG $model.schema;
	  GEN<< /
##

#generate_harvest_calls
	
	(. /GEN<< '   //' harvesting traces for composite events/
		(*	$comp_name 
			/$t:= #class_counter();
			 GEN<< '   ' LAST #AG $new_composites.$comp_name.work_name @ 'temp_' $t 
					'; temp_' $t '.harvest();'/
		*)
	.)
##

#harvest_roots
-- works on $new_root_table

	/GEN<< '   //' harvesting traces for ROOT events/
	<* $event_name:  
		<.	work_name:	$work_name,
			rule_type: ( composite  ! 
						 ROOT	  
						 /$t:= #class_counter();
						  GEN<< '   ' $work_name 
							@ 'temp_' $t '; temp_' $t '.harvest();'/ )
		.>
	*>
##

#harvest_main_schema
	/GEN<< '   //' harvesting traces for main schema;
	 $t:= #class_counter();
	 GEN<< '   ' @ 'SCHEMA_' LAST #AG $model.schema 
			' temp_' $t '; temp_' $t '.harvest();';
			
	-- generate text file with event traces
	 GEN<< @ '   temp_' $t '.output_JSON();';
	 GEN<<   '   gen_end = clock();';
	 GEN<< @ '   temp_' $t '.show_traces();'/
##

--------------------------------------------------
#class_counter
	/LAST #AG $class_counter +:=1;
	RETURN COPY(LAST #AG $class_counter)/
##