Skip to content

Commit

Permalink
add defclass :accessor and :boundp methods
Browse files Browse the repository at this point in the history
  • Loading branch information
arvyy committed Nov 7, 2023
1 parent 7dabcf4 commit 9cd63be
Show file tree
Hide file tree
Showing 7 changed files with 142 additions and 14 deletions.
Original file line number Diff line number Diff line change
@@ -0,0 +1,79 @@
package com.github.arvyy.islisp.functions;

import com.github.arvyy.islisp.ISLISPContext;
import com.github.arvyy.islisp.exceptions.ISLISPError;
import com.github.arvyy.islisp.runtime.StandardClass;
import com.github.arvyy.islisp.runtime.StandardClassObject;
import com.github.arvyy.islisp.runtime.Symbol;
import com.oracle.truffle.api.CompilerDirectives;
import com.oracle.truffle.api.TruffleLanguage;
import com.oracle.truffle.api.dsl.Cached;
import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.api.frame.VirtualFrame;
import com.oracle.truffle.api.nodes.RootNode;
import com.oracle.truffle.api.staticobject.StaticProperty;

/**
* Function instantiated for defclass slots with :boundp option.
*/
public abstract class ISLISPClassSlotBoundp extends RootNode {

private final Symbol slot;

/**
* Create slot boundp root node.
*
* @param slot slot's name
* @param language language reference
*/
public ISLISPClassSlotBoundp(Symbol slot, TruffleLanguage<?> language) {
super(language);
this.slot = slot;
}

@Override
public final Object execute(VirtualFrame frame) {
var obj = frame.getArguments()[1];
return executeGeneric(obj);
}

abstract Object executeGeneric(Object object);

@Specialization(guards = "clsObject.clazz() == clazz", limit = "999")
Object doSpecialized(
StandardClassObject clsObject,
@Cached("clsObject.clazz()") StandardClass clazz,
@Cached("lookupProperty(clazz)") StaticProperty property
) {
var ctx = ISLISPContext.get(this);
return property.getObject(clsObject.data()) == null
? ctx.getNil()
: ctx.getT();
}

@Specialization
Object doUnspecialized(StandardClassObject clsObject) {
var property = lookupProperty(clsObject.clazz());
var ctx = ISLISPContext.get(this);
return property.getObject(clsObject.data()) == null
? ctx.getNil()
: ctx.getT();
}

@CompilerDirectives.TruffleBoundary
StaticProperty lookupProperty(StandardClass clazz) {
for (var classSlot: clazz.slots()) {
if (classSlot.name().equals(slot.identityReference())) {
return classSlot.property();
}
}
return null;
}

@Fallback
Object doFallback(Object o) {
throw new ISLISPError("Bad parameter", this);
}

}
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,9 @@ Object doSpecialized(

@Specialization
Object doUnspecialized(StandardClassObject clsObject) {
return lookupProperty(clsObject.clazz()).getObject(clsObject.data());
return Objects.requireNonNullElse(
lookupProperty(clsObject.clazz()).getObject(clsObject.data()),
ISLISPContext.get(this).getNil());
}

@CompilerDirectives.TruffleBoundary
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -34,17 +34,17 @@ public ISLISPClassSlotWriter(Symbol slot, TruffleLanguage<?> language) {

@Override
public final Object execute(VirtualFrame frame) {
var obj = frame.getArguments()[1];
var value = frame.getArguments()[2];
return executeGeneric(obj, value);
var value = frame.getArguments()[1];
var obj = frame.getArguments()[2];
return executeGeneric(value, obj);
}

abstract Object executeGeneric(Object object, Object value);
abstract Object executeGeneric(Object value, Object classObject);

@Specialization(guards = "clsObject.clazz() == clazz", limit = "999")
Object doSpecialized(
StandardClassObject clsObject,
Object value,
StandardClassObject clsObject,
@Cached("clsObject.clazz()") StandardClass clazz,
@Cached("lookupProperty(clazz)") StaticProperty property
) {
Expand All @@ -53,7 +53,7 @@ Object doSpecialized(
}

@Specialization
Object doUnspecialized(StandardClassObject clsObject, Object value) {
Object doUnspecialized(Object value, StandardClassObject clsObject) {
lookupProperty(clsObject.clazz()).setObject(clsObject.data(), value);
return ISLISPContext.get(this).getNil();
}
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -69,10 +69,10 @@ public Object execute(VirtualFrame frame) {
var conditionValue = frame.getArguments()[1];
var shouldFill = fillStacktrace.call(null, conditionValue);
if (shouldFill != ctx.getNil()) {
setStacktrace.call(null, conditionValue, ISLISPCurrentStacktrace.currentStacktrace());
setStacktrace.call(null, ISLISPCurrentStacktrace.currentStacktrace(), conditionValue);
}
var continuable = frame.getArguments()[2];
setContinuable.call(null, conditionValue, continuable);
setContinuable.call(null, continuable, conditionValue);
if (continuable != ctx.getNil()) {
var handler = ctx.popHandler();
try {
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@

import com.github.arvyy.islisp.ISLISPContext;
import com.github.arvyy.islisp.exceptions.ISLISPError;
import com.github.arvyy.islisp.functions.ISLISPClassSlotBoundpNodeGen;
import com.github.arvyy.islisp.functions.ISLISPClassSlotReaderNodeGen;
import com.github.arvyy.islisp.functions.ISLISPClassSlotWriterNodeGen;
import com.github.arvyy.islisp.runtime.*;
Expand Down Expand Up @@ -77,10 +78,38 @@ private ISLISPExpressionNode[] buildSlotFunctionNodes(TruffleLanguage<?> languag
ISLISPDefMethodNode.MethodQualifier.none,
writer,
false,
new Symbol[]{name, ISLISPContext.get(this).namedSymbol("<object>")},
new Symbol[]{ISLISPContext.get(this).namedSymbol("<object>"), name},
false,
ISLISPClassSlotWriterNodeGen.create(slot.getName(), language)));
}
for (var accessor: slot.getAccessorName()) {
exprs.add(new ISLISPDefGenericNode(accessor, false, 1, false, null));
exprs.add(new ISLISPDefMethodNode(
ISLISPDefMethodNode.MethodQualifier.none,
accessor,
false,
new Symbol[]{name},
false,
ISLISPClassSlotReaderNodeGen.create(slot.getName(), language)));
exprs.add(new ISLISPDefGenericNode(accessor, true, 2, false, null));
exprs.add(new ISLISPDefMethodNode(
ISLISPDefMethodNode.MethodQualifier.none,
accessor,
true,
new Symbol[]{ISLISPContext.get(this).namedSymbol("<object>"), name},
false,
ISLISPClassSlotWriterNodeGen.create(slot.getName(), language)));
}
for (var boundp: slot.getBoundpName()) {
exprs.add(new ISLISPDefGenericNode(boundp, false, 1, false, null));
exprs.add(new ISLISPDefMethodNode(
ISLISPDefMethodNode.MethodQualifier.none,
boundp,
false,
new Symbol[]{name},
false,
ISLISPClassSlotBoundpNodeGen.create(slot.getName(), language)));
}
}
return exprs.toArray(ISLISPExpressionNode[]::new);
}
Expand Down
3 changes: 3 additions & 0 deletions tests/defclass.expect.txt
Original file line number Diff line number Diff line change
Expand Up @@ -2,3 +2,6 @@
2
2
3
4
5
6
23 changes: 19 additions & 4 deletions tests/defclass.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -3,11 +3,11 @@
(format-char (standard-output) #\newline))

(defclass <foo> ()
((bar :reader get-bar :writer set-bar :initarg bar)))
((bar :reader get-bar :writer set-bar :accessor bar :initarg bar :boundp bar-boundp)))

(let ((f (create (class <foo>) 'bar 1)))
(print (get-bar f))
(set-bar f 2)
(set-bar 2 f)
(print (get-bar f)))

;; check inheritance
Expand All @@ -18,6 +18,21 @@
;; check initialize-object
(defclass <foo3> () ((bar3 :reader get-bar3 :writer set-bar3 :initarg bar)))
(defmethod initialize-object ((f <foo3>) :rest args)
(set-bar3 f 3)
(set-bar3 3 f)
(call-next-method))
(print (get-bar3 (create (class <foo3>) 'bar 0)))
(print (get-bar3 (create (class <foo3>) 'bar 0)))

;; check accessor
(let ((obj (create (class <foo>))))
(setf (bar obj) 4)
(print (bar obj)))

;; check boundp
(let ((obj (create (class <foo>))))
(if (bar-boundp obj)
(print 0)
(print 5))
(setf (bar obj) 6)
(if (bar-boundp obj)
(print 6)
(print 0)))

0 comments on commit 9cd63be

Please sign in to comment.