armfortas Public

Watch 0 Fork 0 Star 0
Rust · 6223 bytes Raw Blame History
1 //! Pure / elemental procedure constraint checks.
2 //!
3 //! Extracted from `core.rs` in Sprint 13: F2018 §15.7 says a PURE
4 //! procedure may only call PURE/ELEMENTAL/intrinsic procedures, may
5 //! not define variables visible by host- or USE-association, and an
6 //! ELEMENTAL procedure's dummy args must be scalar. This module is
7 //! the home for those checks.
8
9 use crate::ast::decl::{Attribute, Decl};
10 use crate::ast::expr::Expr;
11 use crate::ast::unit::DummyArg;
12 use crate::lexer::Span;
13 use crate::sema::symtab::{ScopeId, Symbol, SymbolKind, SymbolTable};
14
15 use super::core::{extract_base_name, Ctx};
16
17 pub(super) fn check_pure_expr_calls(ctx: &mut Ctx, expr: &crate::ast::expr::SpannedExpr) {
18 match &expr.node {
19 Expr::FunctionCall { callee, args } => {
20 validate_pure_call(ctx, callee, expr.span);
21 for arg in args {
22 if let crate::ast::expr::SectionSubscript::Element(e) = &arg.value {
23 check_pure_expr_calls(ctx, e);
24 }
25 }
26 }
27 Expr::BinaryOp { left, right, .. } => {
28 check_pure_expr_calls(ctx, left);
29 check_pure_expr_calls(ctx, right);
30 }
31 Expr::UnaryOp { operand, .. } => check_pure_expr_calls(ctx, operand),
32 Expr::ParenExpr { inner } => check_pure_expr_calls(ctx, inner),
33 _ => {}
34 }
35 }
36
37 pub(super) fn validate_pure_call(
38 ctx: &mut Ctx,
39 callee: &crate::ast::expr::SpannedExpr,
40 span: Span,
41 ) {
42 // F2018 15.7: a PURE procedure may only call PURE, ELEMENTAL,
43 // or intrinsic procedures. If the callee resolves to a known
44 // symbol that is NOT marked pure/elemental/intrinsic, reject.
45 // Unknown callees (external without an interface) are left
46 // alone — the programmer's responsibility per F2018 §15.4.
47 let Some(name) = extract_base_name(callee) else {
48 return;
49 };
50 let Some(sym) = ctx.lookup(&name) else {
51 return;
52 };
53 match sym.kind {
54 SymbolKind::Function | SymbolKind::Subroutine
55 if !sym.attrs.pure && !sym.attrs.elemental && !sym.attrs.intrinsic =>
56 {
57 ctx.error(
58 span,
59 format!(
60 "call to '{}' inside a pure procedure: callee is not pure, elemental, or intrinsic (F2018 15.7)",
61 sym.name
62 ),
63 );
64 }
65 SymbolKind::IntrinsicProc => {} // always OK
66 _ => {} // external / unknown — can't check
67 }
68 }
69
70 /// True if `sym` is declared outside the procedure rooted at
71 /// `procedure_scope` — i.e. it comes from host association, USE
72 /// association, or a COMMON block in an enclosing unit. This is
73 /// the F2018 15.7 "accessed by host or use association, or in
74 /// common" predicate that makes a variable off-limits for
75 /// definition inside a PURE procedure body.
76 pub(super) fn symbol_is_non_local_to_procedure(
77 st: &SymbolTable,
78 sym: &Symbol,
79 procedure_scope: ScopeId,
80 ) -> bool {
81 // Walk from `sym.scope` up the parent chain. If we reach
82 // `procedure_scope` (or a descendant we started from), the
83 // symbol lives inside the current procedure — that's OK.
84 // If we reach the top (Global) without crossing the procedure
85 // boundary, the symbol is in an enclosing scope (module,
86 // parent program, parent subroutine).
87 let mut cur = Some(sym.scope);
88 while let Some(sid) = cur {
89 if sid == procedure_scope {
90 return false;
91 }
92 cur = st.scope(sid).parent;
93 }
94 true
95 }
96
97 /// Reject a PURE-procedure statement that would define a variable
98 /// visible via host/use association or a common block. The
99 /// caller supplies the designator's root name; we look it up in
100 /// the current scope and check whether its home scope lies
101 /// outside the enclosing procedure. F2018 15.7, C1598.
102 pub(super) fn reject_pure_nonlocal_definition(
103 ctx: &mut Ctx,
104 target: &crate::ast::expr::SpannedExpr,
105 span: Span,
106 stmt_label: &str,
107 ) {
108 if !ctx.in_pure {
109 return;
110 }
111 let Some(name) = extract_base_name(target) else {
112 return;
113 };
114 let Some(sym) = ctx.lookup(&name) else {
115 return;
116 };
117 // Only variables and COMMON blocks can be "defined"; function
118 // names get definition semantics too but those are the pure
119 // function's own result variable (always local).
120 if !matches!(
121 sym.kind,
122 SymbolKind::Variable | SymbolKind::Parameter | SymbolKind::CommonBlock
123 ) {
124 return;
125 }
126 if symbol_is_non_local_to_procedure(ctx.st, sym, ctx.scope_id) {
127 let sym_name = sym.name.clone();
128 ctx.error(
129 span,
130 format!(
131 "{} target '{}' is accessed by host or use association and cannot be defined inside a pure procedure (F2018 15.7)",
132 stmt_label, sym_name
133 ),
134 );
135 }
136 }
137
138 /// Validate elemental procedure arguments are scalar.
139 pub(super) fn validate_elemental_args(
140 ctx: &mut Ctx,
141 args: &[DummyArg],
142 decls: &[crate::ast::decl::SpannedDecl],
143 span: Span,
144 ) {
145 for arg in args {
146 if let DummyArg::Name(arg_name) = arg {
147 for decl in decls {
148 if let Decl::TypeDecl {
149 attrs, entities, ..
150 } = &decl.node
151 {
152 for entity in entities {
153 if entity.name.eq_ignore_ascii_case(arg_name) {
154 let has_dimension =
155 attrs.iter().any(|a| matches!(a, Attribute::Dimension(_)));
156 let has_entity_dims = entity.array_spec.is_some();
157 if has_dimension || has_entity_dims {
158 ctx.error(
159 span,
160 format!(
161 "elemental procedure argument '{}' must be scalar",
162 arg_name
163 ),
164 );
165 }
166 }
167 }
168 }
169 }
170 }
171 }
172 }
173