| 1 | //! Built-in intrinsic modules (iso_c_binding, iso_fortran_env). |
| 2 | //! |
| 3 | //! These modules are constructed programmatically rather than parsed |
| 4 | //! from source. When `USE iso_c_binding` is encountered, the symbol |
| 5 | //! table is populated with the appropriate constants and procedures. |
| 6 | |
| 7 | use super::symtab::*; |
| 8 | use crate::lexer::Span; |
| 9 | |
| 10 | /// Register all intrinsic module scopes in the symbol table. |
| 11 | /// Called once during semantic analysis initialization. |
| 12 | pub fn register_intrinsic_modules(st: &mut SymbolTable) { |
| 13 | register_iso_c_binding(st); |
| 14 | register_iso_fortran_env(st); |
| 15 | register_ieee_stubs(st); |
| 16 | } |
| 17 | |
| 18 | fn builtin_span() -> Span { |
| 19 | let pos = crate::lexer::Position { line: 0, col: 0 }; |
| 20 | Span { |
| 21 | start: pos, |
| 22 | end: pos, |
| 23 | file_id: 0, |
| 24 | } |
| 25 | } |
| 26 | |
| 27 | fn insert_param(st: &mut SymbolTable, mod_id: ScopeId, name: &str, ti: TypeInfo) { |
| 28 | insert_param_val(st, mod_id, name, ti, None); |
| 29 | } |
| 30 | |
| 31 | fn insert_param_val( |
| 32 | st: &mut SymbolTable, |
| 33 | mod_id: ScopeId, |
| 34 | name: &str, |
| 35 | ti: TypeInfo, |
| 36 | val: Option<i64>, |
| 37 | ) { |
| 38 | let span = builtin_span(); |
| 39 | st.scope_mut(mod_id).symbols.insert( |
| 40 | name.to_lowercase(), |
| 41 | Symbol { |
| 42 | name: name.to_string(), |
| 43 | kind: SymbolKind::Parameter, |
| 44 | type_info: Some(ti), |
| 45 | attrs: SymbolAttrs { |
| 46 | parameter: true, |
| 47 | ..Default::default() |
| 48 | }, |
| 49 | defined_at: span, |
| 50 | scope: mod_id, |
| 51 | arg_names: vec![], |
| 52 | const_value: val, |
| 53 | }, |
| 54 | ); |
| 55 | } |
| 56 | |
| 57 | fn insert_type(st: &mut SymbolTable, mod_id: ScopeId, name: &str) { |
| 58 | let span = builtin_span(); |
| 59 | st.scope_mut(mod_id).symbols.insert( |
| 60 | name.to_lowercase(), |
| 61 | Symbol { |
| 62 | name: name.to_string(), |
| 63 | kind: SymbolKind::DerivedType, |
| 64 | type_info: Some(TypeInfo::Derived(name.to_string())), |
| 65 | attrs: Default::default(), |
| 66 | defined_at: span, |
| 67 | scope: mod_id, |
| 68 | arg_names: vec![], |
| 69 | const_value: None, |
| 70 | }, |
| 71 | ); |
| 72 | } |
| 73 | |
| 74 | fn insert_proc(st: &mut SymbolTable, mod_id: ScopeId, name: &str) { |
| 75 | let span = builtin_span(); |
| 76 | st.scope_mut(mod_id).symbols.insert( |
| 77 | name.to_lowercase(), |
| 78 | Symbol { |
| 79 | name: name.to_string(), |
| 80 | kind: SymbolKind::IntrinsicProc, |
| 81 | type_info: None, |
| 82 | attrs: SymbolAttrs { |
| 83 | intrinsic: true, |
| 84 | ..Default::default() |
| 85 | }, |
| 86 | defined_at: span, |
| 87 | scope: mod_id, |
| 88 | arg_names: vec![], |
| 89 | const_value: None, |
| 90 | }, |
| 91 | ); |
| 92 | } |
| 93 | |
| 94 | /// Populate the iso_c_binding module scope. |
| 95 | fn register_iso_c_binding(st: &mut SymbolTable) { |
| 96 | let m = st.push_scope(ScopeKind::Module("iso_c_binding".into())); |
| 97 | |
| 98 | // ---- Integer kind parameters (ARM64 macOS LP64) ---- |
| 99 | // Each constant's VALUE is the kind number (e.g., c_int = 4 means kind=4 = 4 bytes). |
| 100 | let ik = |k: u8| TypeInfo::Integer { kind: Some(k) }; |
| 101 | for (name, kind) in [ |
| 102 | ("c_int", 4u8), |
| 103 | ("c_short", 2), |
| 104 | ("c_long", 8), |
| 105 | ("c_long_long", 8), |
| 106 | ("c_signed_char", 1), |
| 107 | ("c_int8_t", 1), |
| 108 | ("c_int16_t", 2), |
| 109 | ("c_int32_t", 4), |
| 110 | ("c_int64_t", 8), |
| 111 | ("c_size_t", 8), |
| 112 | ("c_intptr_t", 8), |
| 113 | ("c_ptrdiff_t", 8), |
| 114 | ] { |
| 115 | insert_param_val(st, m, name, ik(4), Some(kind as i64)); |
| 116 | } |
| 117 | |
| 118 | // ---- Real kind parameters ---- |
| 119 | for (name, kind) in [("c_float", 4u8), ("c_double", 8), ("c_long_double", 8)] { |
| 120 | insert_param_val( |
| 121 | st, |
| 122 | m, |
| 123 | name, |
| 124 | TypeInfo::Integer { kind: Some(4) }, |
| 125 | Some(kind as i64), |
| 126 | ); |
| 127 | } |
| 128 | |
| 129 | // ---- Complex kind parameters ---- |
| 130 | for (name, kind) in [ |
| 131 | ("c_float_complex", 4u8), |
| 132 | ("c_double_complex", 8), |
| 133 | ("c_long_double_complex", 8), |
| 134 | ] { |
| 135 | insert_param_val( |
| 136 | st, |
| 137 | m, |
| 138 | name, |
| 139 | TypeInfo::Integer { kind: Some(4) }, |
| 140 | Some(kind as i64), |
| 141 | ); |
| 142 | } |
| 143 | |
| 144 | // ---- Character and logical kinds ---- |
| 145 | // c_char is an integer kind parameter (value = 1), not a character type. |
| 146 | insert_param_val(st, m, "c_char", ik(4), Some(1)); |
| 147 | insert_param_val( |
| 148 | st, |
| 149 | m, |
| 150 | "c_bool", |
| 151 | TypeInfo::Integer { kind: Some(4) }, |
| 152 | Some(1), |
| 153 | ); |
| 154 | |
| 155 | // ---- Character constants (c_null_char, etc.) ---- |
| 156 | // Each constant's value is its ASCII byte code. |
| 157 | let ck = TypeInfo::Character { |
| 158 | len: Some(1), |
| 159 | kind: Some(1), |
| 160 | }; |
| 161 | for (name, ascii) in [ |
| 162 | ("c_null_char", 0i64), |
| 163 | ("c_alert", 7), |
| 164 | ("c_backspace", 8), |
| 165 | ("c_horizontal_tab", 9), |
| 166 | ("c_new_line", 10), |
| 167 | ("c_vertical_tab", 11), |
| 168 | ("c_form_feed", 12), |
| 169 | ("c_carriage_return", 13), |
| 170 | ] { |
| 171 | insert_param_val(st, m, name, ck.clone(), Some(ascii)); |
| 172 | } |
| 173 | |
| 174 | // ---- Pointer types ---- |
| 175 | insert_type(st, m, "c_ptr"); |
| 176 | insert_type(st, m, "c_funptr"); |
| 177 | |
| 178 | // ---- Null pointer constants ---- |
| 179 | insert_param(st, m, "c_null_ptr", ik(8)); |
| 180 | insert_param(st, m, "c_null_funptr", ik(8)); |
| 181 | |
| 182 | // ---- Procedures ---- |
| 183 | for name in [ |
| 184 | "c_loc", |
| 185 | "c_funloc", |
| 186 | "c_f_pointer", |
| 187 | "c_f_procpointer", |
| 188 | "c_associated", |
| 189 | "c_sizeof", |
| 190 | ] { |
| 191 | insert_proc(st, m, name); |
| 192 | } |
| 193 | |
| 194 | st.pop_scope(); |
| 195 | } |
| 196 | |
| 197 | /// Populate the iso_fortran_env module scope. |
| 198 | fn register_iso_fortran_env(st: &mut SymbolTable) { |
| 199 | let m = st.push_scope(ScopeKind::Module("iso_fortran_env".into())); |
| 200 | |
| 201 | let ik4 = TypeInfo::Integer { kind: Some(4) }; |
| 202 | |
| 203 | // Standard I/O unit numbers — actual values. |
| 204 | insert_param_val(st, m, "input_unit", ik4.clone(), Some(5)); |
| 205 | insert_param_val(st, m, "output_unit", ik4.clone(), Some(6)); |
| 206 | insert_param_val(st, m, "error_unit", ik4.clone(), Some(0)); |
| 207 | insert_param_val(st, m, "iostat_end", ik4.clone(), Some(-1)); |
| 208 | insert_param_val(st, m, "iostat_eor", ik4.clone(), Some(-2)); |
| 209 | |
| 210 | // Kind parameters — values are the kind numbers themselves. |
| 211 | insert_param_val(st, m, "int8", ik4.clone(), Some(1)); |
| 212 | insert_param_val(st, m, "int16", ik4.clone(), Some(2)); |
| 213 | insert_param_val(st, m, "int32", ik4.clone(), Some(4)); |
| 214 | insert_param_val(st, m, "int64", ik4.clone(), Some(8)); |
| 215 | insert_param_val(st, m, "real32", ik4.clone(), Some(4)); |
| 216 | insert_param_val(st, m, "real64", ik4.clone(), Some(8)); |
| 217 | insert_param_val(st, m, "real128", ik4.clone(), Some(16)); |
| 218 | insert_param_val(st, m, "character_kinds", ik4.clone(), Some(1)); |
| 219 | insert_param_val(st, m, "integer_kinds", ik4.clone(), Some(4)); |
| 220 | insert_param_val(st, m, "logical_kinds", ik4.clone(), Some(4)); |
| 221 | insert_param_val(st, m, "real_kinds", ik4.clone(), Some(4)); |
| 222 | |
| 223 | // Storage size constants (F2008). Values reflect armfortas's |
| 224 | // ARM64/macOS layout: one-byte default character (Fortran wide |
| 225 | // characters and EBCDIC are not used), 32-bit default integer/real, |
| 226 | // 8-bit file storage units. stdlib relies on |
| 227 | // `character_storage_size`/`bit_size(0_int8)` to compute byte |
| 228 | // counts for `transfer(...)` calls — without this entry, the |
| 229 | // module parameter folded to 0 and `transfer(value, mold, |
| 230 | // bytes_char * len(value))` requested a zero-byte copy, leaving |
| 231 | // hashmap key buffers empty and downstream key compares wrong. |
| 232 | insert_param_val(st, m, "character_storage_size", ik4.clone(), Some(8)); |
| 233 | insert_param_val(st, m, "file_storage_size", ik4.clone(), Some(8)); |
| 234 | insert_param_val(st, m, "numeric_storage_size", ik4.clone(), Some(32)); |
| 235 | // Coarray stat constants (F2008/F2018). |
| 236 | insert_param_val(st, m, "stat_stopped_image", ik4.clone(), Some(-3)); |
| 237 | insert_param_val(st, m, "stat_failed_image", ik4.clone(), Some(-4)); |
| 238 | insert_param_val(st, m, "stat_locked", ik4.clone(), Some(-5)); |
| 239 | insert_param_val(st, m, "stat_locked_other_image", ik4.clone(), Some(-6)); |
| 240 | insert_param_val(st, m, "stat_unlocked", ik4, Some(-7)); |
| 241 | |
| 242 | // Inquiry functions — lowered to string constants by the compiler. |
| 243 | insert_proc(st, m, "compiler_version"); |
| 244 | insert_proc(st, m, "compiler_options"); |
| 245 | |
| 246 | st.pop_scope(); |
| 247 | } |
| 248 | |
| 249 | /// Register stub IEEE module scopes so `USE ieee_arithmetic` etc. |
| 250 | /// don't produce a "module not found" error. The procedures |
| 251 | /// themselves are not yet implemented (sprint 30.7). |
| 252 | fn register_ieee_stubs(st: &mut SymbolTable) { |
| 253 | for name in ["ieee_arithmetic", "ieee_exceptions", "ieee_features"] { |
| 254 | let m = st.push_scope(ScopeKind::Module(name.into())); |
| 255 | // Populate with commonly-referenced symbols so USE ONLY |
| 256 | // doesn't fail on standard names. |
| 257 | match name { |
| 258 | "ieee_arithmetic" => { |
| 259 | insert_type(st, m, "ieee_class_type"); |
| 260 | insert_type(st, m, "ieee_round_type"); |
| 261 | let ik4 = TypeInfo::Integer { kind: Some(4) }; |
| 262 | for (name, value) in [ |
| 263 | ("ieee_quiet_nan", 1), |
| 264 | ("ieee_positive_inf", 2), |
| 265 | ("ieee_negative_inf", 3), |
| 266 | ("ieee_signaling_nan", 4), |
| 267 | ("ieee_positive_zero", 5), |
| 268 | ("ieee_negative_zero", 6), |
| 269 | ("ieee_positive_denormal", 7), |
| 270 | ("ieee_negative_denormal", 8), |
| 271 | ("ieee_positive_normal", 9), |
| 272 | ("ieee_negative_normal", 10), |
| 273 | ("ieee_other_value", 11), |
| 274 | ] { |
| 275 | insert_param_val(st, m, name, ik4.clone(), Some(value)); |
| 276 | } |
| 277 | insert_proc(st, m, "ieee_is_nan"); |
| 278 | insert_proc(st, m, "ieee_is_finite"); |
| 279 | insert_proc(st, m, "ieee_is_normal"); |
| 280 | insert_proc(st, m, "ieee_value"); |
| 281 | insert_proc(st, m, "ieee_class"); |
| 282 | insert_proc(st, m, "ieee_selected_real_kind"); |
| 283 | insert_proc(st, m, "ieee_support_datatype"); |
| 284 | insert_proc(st, m, "ieee_support_denormal"); |
| 285 | insert_proc(st, m, "ieee_support_inf"); |
| 286 | insert_proc(st, m, "ieee_support_nan"); |
| 287 | insert_proc(st, m, "ieee_support_subnormal"); |
| 288 | insert_proc(st, m, "ieee_support_underflow_control"); |
| 289 | insert_proc(st, m, "ieee_support_halting"); |
| 290 | insert_proc(st, m, "ieee_support_flag"); |
| 291 | insert_proc(st, m, "ieee_support_standard"); |
| 292 | insert_proc(st, m, "ieee_support_rounding"); |
| 293 | insert_proc(st, m, "ieee_support_io"); |
| 294 | insert_proc(st, m, "ieee_support_divide"); |
| 295 | insert_proc(st, m, "ieee_support_sqrt"); |
| 296 | insert_proc(st, m, "ieee_get_rounding_mode"); |
| 297 | insert_proc(st, m, "ieee_set_rounding_mode"); |
| 298 | insert_proc(st, m, "ieee_get_underflow_mode"); |
| 299 | insert_proc(st, m, "ieee_set_underflow_mode"); |
| 300 | insert_proc(st, m, "ieee_copy_sign"); |
| 301 | insert_proc(st, m, "ieee_logb"); |
| 302 | insert_proc(st, m, "ieee_next_after"); |
| 303 | insert_proc(st, m, "ieee_rem"); |
| 304 | insert_proc(st, m, "ieee_rint"); |
| 305 | insert_proc(st, m, "ieee_scalb"); |
| 306 | insert_proc(st, m, "ieee_unordered"); |
| 307 | insert_proc(st, m, "ieee_fma"); |
| 308 | } |
| 309 | "ieee_exceptions" => { |
| 310 | insert_type(st, m, "ieee_flag_type"); |
| 311 | insert_type(st, m, "ieee_status_type"); |
| 312 | insert_proc(st, m, "ieee_get_flag"); |
| 313 | insert_proc(st, m, "ieee_set_flag"); |
| 314 | insert_proc(st, m, "ieee_get_halting_mode"); |
| 315 | insert_proc(st, m, "ieee_set_halting_mode"); |
| 316 | } |
| 317 | "ieee_features" => { |
| 318 | for feat in [ |
| 319 | "ieee_datatype", |
| 320 | "ieee_denormal", |
| 321 | "ieee_divide", |
| 322 | "ieee_halting", |
| 323 | "ieee_inexact_flag", |
| 324 | "ieee_inf", |
| 325 | "ieee_invalid_flag", |
| 326 | "ieee_nan", |
| 327 | "ieee_rounding", |
| 328 | "ieee_sqrt", |
| 329 | "ieee_underflow_flag", |
| 330 | ] { |
| 331 | insert_param(st, m, feat, TypeInfo::Logical { kind: Some(4) }); |
| 332 | } |
| 333 | } |
| 334 | _ => {} |
| 335 | } |
| 336 | st.pop_scope(); |
| 337 | } |
| 338 | } |
| 339 |