Rewrite most of P_XXX instance generation using visitor; other fixes.

libraries/openehr/src/am/archetype/assertion/assertion.e

@@ -12,11 +12,6 @@ class ASSERTION
 inherit
 	BASIC_DEFINITIONS
 
-	OPERATOR_TYPES
-		export
-			{NONE} all
-		end
-
 	RULE_STATEMENT
 
 create
@@ -29,7 +24,7 @@ feature -- Initialisation
    		do
 			expression := an_expr
 			an_expr.set_parent (Current)
-			type := op_type_boolean
+			type := {OPERATOR_TYPES}.op_type_boolean
 		end
 
 	make_with_tag (an_expr: EXPRESSION; a_tag: STRING)
@@ -40,7 +35,7 @@ feature -- Initialisation
 			tag := a_tag
 			expression := an_expr
 			an_expr.set_parent (Current)
-			type := op_type_boolean
+			type := {OPERATOR_TYPES}.op_type_boolean
 		end
 
 feature -- Access

libraries/openehr/src/am/archetype/assertion/expr_archetype_id_constraint.e

@@ -23,8 +23,7 @@ feature -- Initialisation
 	make (an_item: C_STRING)
 			-- node is a constraint on a primitive type; can only be used with "matches" function
    		do
-			item := an_item
-			type := an_item.generator
+			precursor (an_item)
 		end
 
 end

libraries/openehr/src/am/archetype/assertion/expr_operator.e

@@ -23,10 +23,10 @@ feature -- Initialisation
    		do
 			operator := an_op
 
-			-- this should be replaced by code that infers typs properly from operands
-			if boolean_operator (an_op.value) or relational_operator (an_op.value) or set_operator (an_op.value) then
+			-- this should be replaced by code that infers types properly from operands
+			if is_boolean_operator (an_op.value) or is_relational_operator (an_op.value) or is_set_operator (an_op.value) then
 				type := op_type_boolean
-			elseif arithmetic_operator (an_op.value) then
+			elseif is_arithmetic_operator (an_op.value) then
 				type := op_type_arithmetic
 			end
 		end
@@ -54,6 +54,11 @@ feature -- Modification
 			precedence_overridden
 		end
 
+	set_operator (an_op: OPERATOR_KIND)
+   		do
+			operator := an_op
+		end
+
 end
 
 

libraries/openehr/src/am/archetype/assertion/operator_types.e

@@ -92,63 +92,63 @@ feature -- Status Report
 			Result := operator_values.has (an_op_name)
 		end
 
-	boolean_operator (an_op: INTEGER): BOOLEAN
+	is_boolean_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op can operate on boolean operands
 		require
 			valid_operator (an_op)
 		do
-			Result := unary_boolean_operator(an_op) or binary_boolean_operator (an_op)
+			Result := is_unary_boolean_operator(an_op) or is_binary_boolean_operator (an_op)
 		end
 
-	unary_boolean_operator (an_op: INTEGER): BOOLEAN
+	is_unary_boolean_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op is a unary boolean operator
 		require
 			valid_operator (an_op)
 		do
 			Result := an_op = op_not
 		end
 
-	binary_boolean_operator (an_op: INTEGER): BOOLEAN
+	is_binary_boolean_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op is a binary boolean operator
 		require
 			valid_operator(an_op)
 		do
 			Result := an_op >= op_and and an_op <= op_implies
 		end
 
-	relational_operator (an_op: INTEGER): BOOLEAN
+	is_relational_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op is a binary operator with COMPARABLE arguments returning a boolean
 		require
 			valid_operator(an_op)
 		do
 			Result := an_op >= op_eq and an_op <= op_gt
 		end
 
-	unary_arithmetic_operator (an_op: INTEGER): BOOLEAN
+	is_unary_arithmetic_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op is a unary arithmetic operator
 		require
 			valid_operator (an_op)
 		do
 			Result := an_op = op_minus
 		end
 
-	arithmetic_operator (an_op: INTEGER): BOOLEAN
+	is_arithmetic_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op is a binary operator with numeric arguments returning a numeric
 		require
 			valid_operator (an_op)
 		do
-			Result := binary_arithmetic_operator(an_op)
+			Result := is_binary_arithmetic_operator(an_op)
 		end
 
-	binary_arithmetic_operator (an_op: INTEGER): BOOLEAN
+	is_binary_arithmetic_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op is a binary operator with numeric arguments returning a numeric
 		require
 			valid_operator(an_op)
 		do
 			Result := an_op >= op_plus and an_op <= op_exp
 		end
 
-	set_operator (an_op: INTEGER): BOOLEAN
+	is_set_operator (an_op: INTEGER): BOOLEAN
 			-- True if an_op is a unary set operator
 		require
 			valid_operator(an_op)

libraries/openehr/src/am/persistence/c_p_factory.e

@@ -0,0 +1,166 @@
+note
+	component:   "openEHR ADL Tools"
+	description: "visitor class to generate P_C_XXX obects from corresponding C_XXX objects"
+	keywords:    "visitor, constraint model"
+	author:      "Thomas Beale <[email protected]>"
+	support:     "http://www.openehr.org/issues/browse/AWB"
+	copyright:   "Copyright (c) 2025- The openEHR Foundation <http://www.openEHR.org>"
+	license:     "Apache 2.0 License <http://www.apache.org/licenses/LICENSE-2.0.html>"
+
+class C_P_FACTORY
+
+inherit
+	C_VISITOR
+		redefine
+			end_c_complex_object, end_c_archetype_root, end_c_attribute,
+			start_c_terminology_code, start_c_boolean, start_c_integer, start_c_real, start_c_date, start_c_time, start_c_date_time, start_c_duration, start_c_string
+		end
+
+create
+	make
+
+feature -- Initialisation
+
+	make (an_archetype: ARCHETYPE)
+		do
+			create p_c_obj_node_stack.make (0)
+			create p_c_attr_node_stack.make (0)
+			initialise (an_archetype)
+		end
+
+feature -- Access
+
+	p_c_object: detachable P_C_COMPLEX_OBJECT
+
+feature -- Visitor
+
+	start_c_complex_object (a_node: C_COMPLEX_OBJECT; depth: INTEGER)
+		local
+			p_co: P_C_COMPLEX_OBJECT
+		do
+			create p_co.make (a_node)
+			p_c_obj_node_stack.extend (p_co)
+			if a_node.is_root then
+				p_c_object := p_co
+			else
+				p_c_attr_node_stack.item.add_child (p_co)
+			end
+		end
+
+	end_c_complex_object (a_node: C_COMPLEX_OBJECT; depth: INTEGER)
+		do
+			-- deal with attribute tuples
+			if not a_node.is_prohibited and not a_node.any_allowed then
+				if attached a_node.attribute_tuples as att_tuples then
+					across att_tuples as att_tuples_csr loop
+						p_c_obj_node_stack.item.add_attribute_tuple (create {P_C_ATTRIBUTE_TUPLE}.make (att_tuples_csr.item))
+					end
+				end
+			end
+			p_c_obj_node_stack.remove
+		end
+
+	start_archetype_slot (a_node: ARCHETYPE_SLOT; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_ARCHETYPE_SLOT}.make(a_node))
+		end
+
+	start_c_attribute (a_node: C_ATTRIBUTE; depth: INTEGER)
+		local
+			p_c_attr: P_C_ATTRIBUTE
+		do
+			create p_c_attr.make (a_node)
+			p_c_attr_node_stack.extend (p_c_attr)
+			p_c_obj_node_stack.item.add_attribute (p_c_attr)
+		end
+
+	end_c_attribute (a_node: C_ATTRIBUTE; depth: INTEGER)
+		do
+			p_c_attr_node_stack.remove
+		end
+
+	start_c_leaf_object (a_node: C_LEAF_OBJECT; depth: INTEGER)
+		do
+		end
+
+	start_c_archetype_root (a_node: C_ARCHETYPE_ROOT; depth: INTEGER)
+		local
+			p_as:P_C_ARCHETYPE_ROOT
+		do
+			create p_as.make(a_node)
+			p_c_attr_node_stack.item.add_child (p_as)
+			if a_node.has_attributes then
+				p_c_obj_node_stack.extend (p_as)
+			end
+		end
+
+	end_c_archetype_root (a_node: C_ARCHETYPE_ROOT; depth: INTEGER)
+		do
+			if a_node.has_attributes then
+				p_c_obj_node_stack.remove
+			end
+		end
+
+	start_c_complex_object_proxy (a_node: C_COMPLEX_OBJECT_PROXY; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_COMPLEX_OBJECT_PROXY}.make(a_node))
+		end
+
+	start_c_primitive_object (a_node: C_PRIMITIVE_OBJECT; depth: INTEGER)
+		do
+		end
+
+	start_c_boolean (a_node: C_BOOLEAN; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_BOOLEAN}.make(a_node))
+		end
+
+	start_c_integer (a_node: C_INTEGER; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_INTEGER}.make(a_node))
+		end
+
+	start_c_real (a_node: C_REAL; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_REAL}.make(a_node))
+		end
+
+	start_c_date (a_node: C_DATE; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_DATE}.make(a_node))
+		end
+
+	start_c_date_time (a_node: C_DATE_TIME; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_DATE_TIME}.make(a_node))
+		end
+
+	start_c_time (a_node: C_TIME; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_TIME}.make(a_node))
+		end
+
+	start_c_duration (a_node: C_DURATION; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_DURATION}.make(a_node))
+		end
+
+	start_c_string (a_node: C_STRING; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_STRING}.make(a_node))
+		end
+
+	start_c_terminology_code (a_node: C_TERMINOLOGY_CODE; depth: INTEGER)
+		do
+			p_c_attr_node_stack.item.add_child (create {P_C_TERMINOLOGY_CODE}.make(a_node))
+		end
+
+feature {NONE} -- Implementation
+
+	p_c_obj_node_stack: ARRAYED_STACK [P_C_COMPLEX_OBJECT]
+
+	p_c_attr_node_stack: ARRAYED_STACK [P_C_ATTRIBUTE]
+
+end
+
+

libraries/openehr/src/am/persistence/p_archetype.e

@@ -24,12 +24,26 @@ feature -- Initialisation
 
 	make (an_archetype: like artefact_class_type)
 			-- basic make routine to guarantee validity on creation
+		local
+			a_c_iterator: OG_CONTENT_ITERATOR
+			c_p_factory: C_P_FACTORY
 		do
 			artefact_type := an_archetype.artefact_type
 			create archetype_id.make (an_archetype.archetype_id)
 			parent_archetype_id := an_archetype.parent_archetype_id
-			create definition.make (an_archetype.definition)
-			rules := an_archetype.rules
+
+			create c_p_factory.make (an_archetype)
+			create a_c_iterator.make (an_archetype.definition.representation, c_p_factory)
+			a_c_iterator.do_all
+			definition := c_p_factory.p_c_object
+
+			if attached an_archetype.rules as arch_rules then
+				create rules.make (0)
+				across arch_rules as arch_rules_csr loop
+					rules.extend (create {P_ASSERTION}.make (arch_rules_csr.item))
+				end
+			end
+
 			create terminology.make (an_archetype.terminology)
 			is_generated := an_archetype.is_generated
 			is_differential := an_archetype.is_differential
@@ -52,7 +66,7 @@ feature -- Access
 
 	definition: detachable P_C_COMPLEX_OBJECT
 
-	rules: detachable ARRAYED_LIST [ASSERTION]
+	rules: detachable ARRAYED_LIST [P_ASSERTION]
 
 	terminology: detachable P_ARCHETYPE_TERMINOLOGY
 
@@ -69,23 +83,31 @@ feature -- Factory
 
 	create_archetype: detachable like artefact_class_type
 		local
-			o_archetype_id: detachable ARCHETYPE_HRID
+			o_archetype_id: ARCHETYPE_HRID
 			arch_terminology: ARCHETYPE_TERMINOLOGY
+			o_rules: ARRAYED_LIST [ASSERTION]
 		do
 			if attached archetype_id as att_aid
 				and attached definition as o_definition
 				and attached terminology as p_terminology
 			then
-				create o_archetype_id.make_from_string (att_aid.physical_id)
+				o_archetype_id := att_aid.create_archetype_hrid
 				create arch_terminology.make_differential ((create {TERMINOLOGY_CODE}.default_create).code_string, o_definition.node_id)
 				p_terminology.populate_terminology (arch_terminology)
 				arch_terminology.finalise_dt
 
+				if attached rules as att_rules then
+					create o_rules.make (0)
+					across att_rules as p_rules_csr loop
+						o_rules.extend (p_rules_csr.item.create_assertion)
+					end
+				end
+
 				create Result.make_all (
 					o_archetype_id,
 					parent_archetype_id,
 					o_definition.create_c_complex_object,
-					rules,
+					o_rules,
 					arch_terminology
 				)