Access and Assign methods, _SCREEN and _VFP, released forms, FOR EACH over Forms

crates/foxvm/src/bytecode.rs

@@ -357,6 +357,9 @@ pub enum Instr {
     /// FOR EACH support: [array, index] -> [array, index+1, element]; at the end pops both and
     /// jumps to the exit.
     ForEachNext(u32),
+    /// `FOR EACH x IN obj.Member`: [obj] -> [items] and a jump past the member's ordinary read
+    /// when the host enumerates the member as a collection; otherwise [obj] -> [] and on.
+    ForEachItems { member: u32, target: u32 },
 
     // ---- calls
     /// `name(args)`: array element access when `name` resolves to an array, else a user function
@@ -403,6 +406,15 @@ pub enum Instr {
     LoadScreen,
     /// [obj] -> [value or child object]
     GetMember(u32),
+    /// [obj, subs...] -> [element]   `obj.aProp[1]`: the subscripts are the Access method's
+    /// arguments when the object has one for the property, and index what it holds when not.
+    GetMemberIndex {
+        name: u32,
+        argc: u8,
+    },
+    /// [obj] -> [value]   the property itself, past any Access method: what `ALEN(obj.aProp)`
+    /// is handed.
+    GetProp(u32),
     /// [obj, name] -> [value]   the same, for a member named by a variable: `obj.&cName`.
     GetMemberByName,
     /// `obj.&cName = v`: the member a variable names is written. [value, obj, name] -> []

crates/foxvm/src/compiler.rs

@@ -376,7 +376,8 @@ impl FuncBuilder {
             | Instr::JumpIfFalseKeep(t)
             | Instr::JumpIfTrueKeep(t)
             | Instr::ForTest(t)
-            | Instr::ForEachNext(t) => *t = target,
+            | Instr::ForEachNext(t)
+            | Instr::ForEachItems { target: t, .. } => *t = target,
             _ => unreachable!("patching a non-jump"),
         }
     }
@@ -943,7 +944,21 @@ impl ModuleCompiler {
             }
             StmtKind::ForEach { var, collection, body } => {
                 let target = self.var_target(fb, var);
+                // `obj.Member` may be a collection the host walks rather than a value it reads -
+                // `_SCREEN.Forms` - so the host is asked first, and the member is read as any
+                // other expression only when it is not one
+                let items = match &collection.kind {
+                    ExprKind::Member { obj, name } if !matches!(&obj.kind, ExprKind::Var(base) if base.upper == "M") => {
+                        self.expr(fb, obj);
+                        let member = self.member(name);
+                        Some(fb.emit(Instr::ForEachItems { member, target: 0 }))
+                    }
+                    _ => None,
+                };
                 self.expr(fb, collection);
+                if let Some(at) = items {
+                    fb.patch_here(at);
+                }
                 let zero = self.constant(Constant::num(0.0));
                 fb.emit(Instr::Const(zero));
                 let top = fb.pc();
@@ -3871,6 +3886,15 @@ impl ModuleCompiler {
                 }
             }
             ExprKind::Call { name, args } => self.call(fb, e, name, args),
+            // `obj.aProp[1]` is one read, not a read and then a subscript: measured, an Access
+            // method for an array property is handed the subscript as its argument
+            ExprKind::Index { base, args } if object_member(base).is_some() => {
+                let (obj, name) = object_member(base).expect("an object's member");
+                self.expr(fb, obj);
+                let n = self.subscripts(fb, args, e.span);
+                let m = self.member(name);
+                fb.emit(Instr::GetMemberIndex { name: m, argc: n });
+            }
             ExprKind::Index { base, args } => {
                 self.expr(fb, base);
                 let n = self.subscripts(fb, args, e.span);
@@ -3991,6 +4015,15 @@ impl ModuleCompiler {
             }
             let argc = match builtins::array_to_fill(spec.name) {
                 Some(at) => self.args_filling_array(fb, args, at),
+                // measured: ALEN(obj.aProp) is the array itself, and its Access method is not
+                // called
+                None if spec.name == "ALEN" && args.first().is_some_and(|a| !a.by_ref && object_member(&a.expr).is_some()) => {
+                    let (obj, name) = object_member(&args[0].expr).expect("an object's member");
+                    self.expr(fb, obj);
+                    let m = self.member(name);
+                    fb.emit(Instr::GetProp(m));
+                    1 + self.args(fb, &args[1..], true, false)
+                }
                 None => self.args(fb, args, true, false),
             };
             fb.emit(Instr::CallBuiltin { id, argc });
@@ -4007,6 +4040,15 @@ impl ModuleCompiler {
     }
 }
 
+/// `obj.Member` where `obj` is an object: anything but the `m.` prefix, which names a memory
+/// variable.
+fn object_member(e: &Expr) -> Option<(&Expr, &Name)> {
+    match &e.kind {
+        ExprKind::Member { obj, name } if !matches!(&obj.kind, ExprKind::Var(base) if base.upper == "M") => Some((obj, name)),
+        _ => None,
+    }
+}
+
 /// One column of a `CREATE TABLE` or `ALTER TABLE` as the table format holds it.
 fn column_of(f: &CursorField) -> crate::bytecode::ColumnDef {
     crate::bytecode::ColumnDef { field: field_of(f), nullable: f.nullable }

crates/foxvm/src/host.rs

@@ -93,6 +93,19 @@ pub trait Host {
     fn members(&mut self, _obj: Handle) -> Option<Vec<MemberInfo>> {
         None
     }
+    /// The objects a collection member holds, in the order `FOR EACH` visits them - an array
+    /// value - for a member that is a collection rather than a property: `_SCREEN.Forms`, which
+    /// Visual FoxPro will not read as a value (1924, measured) but will walk. `None` when the
+    /// member is not one, and `FOR EACH` then reads it as it reads anything else.
+    fn enumerate(&mut self, _obj: Handle, _member: &str) -> Option<Value> {
+        None
+    }
+    /// Whether the object was a form (or a member of one) that has since been released. A
+    /// variable or array element still holding it reads as .NULL. from then on - measured:
+    /// `oForm.Release()`, then `ISNULL(oForm)` is .T. and `VARTYPE(oForm)` is "X".
+    fn released(&mut self, _obj: Handle) -> bool {
+        false
+    }
     /// `None` when the handle has been released ("Object is not valid").
     fn object_class(&mut self, obj: Handle) -> Option<String>;
     /// The file the object was built from, for `SYS(1271, oObject)`: a form's `.scx`. Measured:
@@ -118,6 +131,12 @@ pub trait Host {
     fn class_method(&mut self, _obj: Handle, _name: &str) -> bool {
         false
     }
+    /// True when the object carries FoxPro source for a method of that name, whether its class
+    /// wrote it or the form or library it came from did. What asks is a property read or write,
+    /// looking for the `Prop_Access` or `Prop_Assign` method that stands in for it.
+    fn has_code_method(&mut self, _obj: Handle, _name: &str) -> bool {
+        false
+    }
     /// Where the mouse pointer is over the character screen, in rows and columns from its
     /// top left, and whether a button is down. A host that does not track it says so by
     /// leaving the pointer at the corner with nothing pressed.

crates/foxvm/src/parser.rs

@@ -1127,10 +1127,6 @@ impl Parser {
                 Name::new("", head.span)
             }
         };
-        if name.upper.ends_with("_ACCESS") || name.upper.ends_with("_ASSIGN") {
-            let (span, text) = (name.span, name.text.clone());
-            self.warning(span, format!("{text}: access and assign methods are not honoured yet"));
-        }
         let mut params = Vec::new();
         if self.eat(&TokKind::LParen) {
             match self.param_list(&TokKind::RParen) {

crates/foxvm/src/vm.rs

@@ -3189,6 +3189,73 @@ impl Vm {
         }
     }
 
+    /// What reading `name` of `obj` comes to: its value, or the Access method that answers for
+    /// it - which `access` false passes over, as `ALEN(obj.aProp)` does.
+    fn read_member(&self, host: &mut dyn Host, fb: &Fiber, obj: &Value, name: &str, access: bool) -> Result<MemberRead, RtError> {
+        if let Some(v) = json_member(obj, name) {
+            return v.map(MemberRead::Value);
+        }
+        let h = self.check_object(host, obj, name)?;
+        if let Some(v) = self.native_member(h, name) {
+            return v.map(MemberRead::Value);
+        }
+        if access && let Some(method) = self.accessor(host, fb, h, name, "ACCESS") {
+            return Ok(MemberRead::Access(h, method));
+        }
+        match host.get_member(h, name)? {
+            Member::Child(c) => Ok(MemberRead::Value(Value::Object(c))),
+            Member::Property => Ok(MemberRead::Value(host.get_prop(h, name)?.deref())),
+            Member::Method | Member::None => Err(RtError::unknown_member(name)),
+        }
+    }
+
+    /// Calls the Access method `method` of `h` with `args`, its answer going on the stack.
+    fn call_access(fb: &mut Fiber, h: Handle, method: String, args: Vec<JsonValue>) -> Flow {
+        fb.pending = Some(Pending::Push);
+        Flow::Suspend(HostRequest::CallMethod { obj: h.0, name: method, args })
+    }
+
+    /// What an Access method is handed for a read of its property with no subscript. Measured:
+    /// an array property named whole - `VARTYPE(obj.aProp)` - hands it 1, the first element.
+    fn whole_access_args(host: &mut dyn Host, h: Handle, name: &str) -> Vec<JsonValue> {
+        let array = matches!(host.get_member(h, name), Ok(Member::Property))
+            && matches!(host.get_prop(h, name).map(|v| v.deref()), Ok(Value::Array(_)));
+        if array { vec![JsonValue::Num(1.0)] } else { Vec::new() }
+    }
+
+    /// The Access or Assign method that stands in for reading or writing `name` on `h` - `which`
+    /// is "ACCESS" or "ASSIGN" - when the object has one. Measured: inside either of the two,
+    /// `THIS.name` is the property itself, which is the only way they can reach what they guard.
+    fn accessor(&self, host: &mut dyn Host, fb: &Fiber, h: Handle, name: &str, which: &str) -> Option<String> {
+        if h.0 == 0 || crate::foxscript::in_range(h) {
+            return None;
+        }
+        let method = format!("{}_{which}", name.to_ascii_uppercase());
+        if !host.has_code_method(h, &method) {
+            return None;
+        }
+        let env = env_index(fb, fb.frames.len() - 1);
+        let frame = &fb.frames[env];
+        if frame.this == Some(h) {
+            let running = &self.proto(frame.module, frame.func).display_name;
+            let last = running.rsplit('.').next().unwrap_or(running);
+            let last = last.split('#').next().unwrap_or(last).to_ascii_uppercase();
+            let property = name.to_ascii_uppercase();
+            if last == format!("{property}_ACCESS") || last == format!("{property}_ASSIGN") {
+                return None;
+            }
+        }
+        Some(method)
+    }
+
+    /// A value as a variable reads it: a released form is .NULL. to everything still holding it.
+    fn live(host: &mut dyn Host, v: Value) -> Value {
+        match v.deref() {
+            Value::Object(h) if h.0 != 0 && !crate::foxscript::in_range(h) && host.released(h) => Value::Null,
+            _ => v,
+        }
+    }
+
     fn check_object(&self, host: &mut dyn Host, v: &Value, what: &str) -> Result<Handle, RtError> {
         let h = match v.deref() {
             Value::Object(h) => h,
@@ -3283,7 +3350,7 @@ impl Vm {
             }
             Instr::LoadLocal(s) => {
                 let v = self.load_local(fb, *s)?;
-                fb.stack.push(v);
+                fb.stack.push(Self::live(host, v));
             }
             Instr::StoreLocal(s) => {
                 let v = pop!();
@@ -3299,7 +3366,7 @@ impl Vm {
                         FieldRead::Suspend(req) => return Ok(self.ask(fb, req)),
                     }
                 } else if let Some(v) = self.load_name(fb, &name) {
-                    fb.stack.push(v);
+                    fb.stack.push(Self::live(host, v));
                 } else if let Some(alias) = self.query_field(fb, &name) {
                     // inside a query a name that is nothing else is a field of one of its
                     // sources, which is how a join names the columns it did not have to qualify
@@ -3386,7 +3453,7 @@ impl Vm {
                 let subs = pop_subscripts(fb, *n)?;
                 let arr = pop!();
                 let v = index_array(&arr, &subs)?;
-                fb.stack.push(v);
+                fb.stack.push(Self::live(host, v));
             }
             Instr::StoreIndex(n) => {
                 let subs = pop_subscripts(fb, *n)?;
@@ -3523,6 +3590,17 @@ impl Vm {
                     fb.frames.last_mut().expect("frame").pc = *t as usize;
                 }
             }
+            Instr::ForEachItems { member, target } => {
+                let obj = pop!();
+                let items = match obj.deref() {
+                    Value::Object(h) => host.enumerate(h, &module.members[*member as usize]),
+                    _ => None,
+                };
+                if let Some(items) = items {
+                    fb.stack.push(items);
+                    fb.frames.last_mut().expect("frame").pc = *target as usize;
+                }
+            }
             Instr::ForEachNext(t) => {
                 let len = fb.stack.len();
                 if len < 2 {
@@ -3717,23 +3795,38 @@ impl Vm {
             Instr::GetMember(m) => {
                 let obj = pop!();
                 let name = &module.members[*m as usize];
-                if let Some(v) = json_member(&obj, name) {
-                fb.stack.push(v?);
-                return Ok(Flow::Next);
-                }
-
-                let h = self.check_object(host, &obj, name)?;
-                if let Some(v) = self.native_member(h, name) {
-                    fb.stack.push(v?);
-                    return Ok(Flow::Next);
+                // `Prop_Access` answers for the property when the object has one
+                match self.read_member(host, fb, &obj, name, true)? {
+                    MemberRead::Value(v) => fb.stack.push(v),
+                    MemberRead::Access(h, method) => {
+                        let args = Self::whole_access_args(host, h, name);
+                        return Ok(Self::call_access(fb, h, method, args));
+                    }
                 }
-                match host.get_member(h, name)? {
-                    Member::Child(c) => fb.stack.push(Value::Object(c)),
-                    Member::Property => {
-                        let v = host.get_prop(h, name)?;
-                        fb.stack.push(v.deref());
+            }
+            // `obj.aProp[1]`: measured, the subscripts are the Access method's arguments, and the
+            // method's own THIS.aProp[n] reads the element without calling it again
+            Instr::GetMemberIndex { name, argc } => {
+                let subs = pop_n(fb, *argc as usize)?;
+                let obj = pop!();
+                let name = &module.members[*name as usize];
+                match self.read_member(host, fb, &obj, name, true)? {
+                    MemberRead::Value(v) => {
+                        let subs = subs.iter().map(Value::as_usize).collect::<Result<Vec<_>, _>>()?;
+                        let v = index_array(&v, &subs)?;
+                        fb.stack.push(Self::live(host, v));
+                    }
+                    MemberRead::Access(h, method) => {
+                        return Ok(Self::call_access(fb, h, method, subs.iter().map(JsonValue::from_value).collect()));
                     }
-                    Member::Method | Member::None => return Err(RtError::unknown_member(name)),
+                }
+            }
+            Instr::GetProp(m) => {
+                let obj = pop!();
+                let name = &module.members[*m as usize];
+                match self.read_member(host, fb, &obj, name, false)? {
+                    MemberRead::Value(v) => fb.stack.push(v),
+                    MemberRead::Access(..) => unreachable!("an Access method was asked for"),
                 }
             }
             Instr::SetMember(m) => {
@@ -3745,6 +3838,10 @@ impl Vm {
                     return Err(native_write_refused(&self.natives, h, name));
                 }
                 fb.pending = Some(Pending::Discard);
+                // `Prop_Assign` is handed the value instead of the property taking it
+                if let Some(method) = self.accessor(host, fb, h, name, "ASSIGN") {
+                    return Ok(Flow::Suspend(HostRequest::CallMethod { obj: h.0, name: method, args: vec![JsonValue::from_value(&v)] }));
+                }
                 return Ok(Flow::Suspend(HostRequest::SetProp {
                     obj: h.0,
                     name: name.clone(),
@@ -3839,6 +3936,11 @@ impl Vm {
                 if self.natives.contains(h) {
                     return self.native_call(fb, h, name, args);
                 }
+                // `obj.aProp("x")` is a read of the property as much as `obj.aProp["x"]` is, so
+                // measured, its Access method is handed what is in the parentheses
+                if let Some(method) = self.accessor(host, fb, h, name, "ACCESS") {
+                    return Ok(Self::call_access(fb, h, method, args.iter().map(JsonValue::from_value).collect()));
+                }
                 fb.pending = Some(Pending::Push);
                 return Ok(Flow::Suspend(HostRequest::CallMethod {
                     obj: h.0,
@@ -5765,27 +5867,17 @@ impl Vm {
                     if base == "M" {
                         let upper = field.to_ascii_uppercase();
                         let v = self.load_name(fb, &upper).ok_or_else(|| RtError::variable_not_found(&upper))?;
-                        fb.stack.push(v);
+                        fb.stack.push(Self::live(host, v));
                         return Ok(Flow::Next);
                     }
                     if let Some(obj) = self.load_name(fb, &base) {
-                        if let Some(v) = json_member(&obj, &field) {
-                        fb.stack.push(v?);
-                        return Ok(Flow::Next);
-                        }
-
-                        let h = self.check_object(host, &obj, &field)?;
-                        if let Some(v) = self.native_member(h, &field) {
-                            fb.stack.push(v?);
-                            return Ok(Flow::Next);
-                        }
-                        match host.get_member(h, &field)? {
-                            Member::Child(c) => fb.stack.push(Value::Object(c)),
-                            Member::Property => {
-                                let v = host.get_prop(h, &field)?;
-                                fb.stack.push(v.deref());
+                        let obj = Self::live(host, obj);
+                        match self.read_member(host, fb, &obj, &field, true)? {
+                            MemberRead::Value(v) => fb.stack.push(v),
+                            MemberRead::Access(h, method) => {
+                                let args = Self::whole_access_args(host, h, &field);
+                                return Ok(Self::call_access(fb, h, method, args));
                             }
-                            Member::Method | Member::None => return Err(RtError::unknown_member(&field)),
                         }
                         return Ok(Flow::Next);
                     }
@@ -9914,6 +10006,13 @@ fn native_write_refused(natives: &crate::foxscript::Natives, h: Handle, name: &s
     }
 }
 
+/// What reading an object's member comes to.
+enum MemberRead {
+    Value(Value),
+    /// The object has an Access method for the member, named here, that answers instead.
+    Access(Handle, String),
+}
+
 /// A member of a JSON value by name, or nothing when the value is not one.
 ///
 /// A name a JSON object has not got is the product's own unknown-member error, because that is