added moo_iskindof().

changed isKindOf: to utilize a new primitive _is_kind_of.
marked BlockContext and MethodContext to be #final and #limited
This commit is contained in:
hyunghwan.chung 2017-09-29 15:03:54 +00:00
parent e38a4f1f20
commit 303b49270d
9 changed files with 120 additions and 12 deletions

View File

@ -215,10 +215,15 @@ extend Apex
{
| c |
c := self superclass.
[c notNil] whileTrue: [
(* [c notNil] whileTrue: [
[ c == aClass ] ifTrue: [^true].
c := c superclass.
].
]. *)
while (c notNil)
{
if (c == aClass) { ^true }.
c := c superclass.
}.
^false
}
@ -233,6 +238,7 @@ extend Apex
method(#class) isKindOf: aClass
{
<primitive: #_is_kind_of>
^(self isMemberOf: aClass) or: [self inheritsFrom: aClass].
}
@ -243,6 +249,7 @@ extend Apex
method isKindOf: aClass
{
<primitive: #_is_kind_of>
^(self isMemberOf: aClass) or: [self class inheritsFrom: aClass].
}

View File

@ -42,7 +42,7 @@ block context...
---------------------------------- *)
}
class(#pointer) MethodContext(Context)
class(#pointer,#final,#limited) MethodContext(Context)
{
var method, receiver, home, origin.
@ -99,7 +99,7 @@ class(#pointer) MethodContext(Context)
}
}
class(#pointer) BlockContext(Context)
class(#pointer,#final,#limited) BlockContext(Context)
{
var nargs, source, home, origin.

View File

@ -94,12 +94,14 @@ TODO: timed wait...
}
*)
(* TODO: MIGRATE TO MUTEX...
method critical: aBlock
{
self wait.
^aBlock ensure: [ self signal ]
}
}*)
## ==================================================================
method heapIndex
@ -133,6 +135,26 @@ TODO: timed wait...
}
}
class Mutex(Semaphore)
{
method(#class) new
{
| s |
s := super new.
s signal.
^s.
}
method lock { ^self wait }
method unlock { ^self signal }
method critical: block
{
self wait.
^block ensure: [ self signal ]
}
}
(*
xxx := Semaphore new.

View File

@ -1,5 +1,7 @@
## TODO: use this file as a regress testing source.
## rename it to test-001.moo and use it as a test case file.
##
## TEST CASES for namespacing
##
#include 'Moo.moo'.

View File

@ -1,3 +1,6 @@
##
## TEST CASES for basic methods
##
#include 'Moo.moo'.
@ -50,8 +53,30 @@ class MyObject(TestObject)
method(#class) main
{
'START OF MAIN' dump.
'EDN OF MAIN' dump.
}
| tc limit |
tc := %(
## 0 - 4
[(Object isKindOf: Class) == true],
[(Object isKindOf: Apex) == true],
[(Class isKindOf: Class) == true],
[(Class isKindOf: Apex) == true],
[(Class isKindOf: Object) == false],
[(Apex isKindOf: Class) == true],
[(SmallInteger isKindOf: Integer) == false],
[(10 isKindOf: Integer) == true],
[(Apex isMemberOf: Class) == true],
[(Class isMemberOf: Class) == true]
).
limit := tc size.
0 priorTo: limit by: 1 do: [ :idx |
| tb |
tb := tc at: idx.
System log(System.Log.INFO, idx asString, (if (tb value) { ' PASS' } else { ' FAIL' }), S'\n').
]
}
}

View File

@ -2098,6 +2098,27 @@ static moo_pfrc_t pf_hash (moo_t* moo, moo_ooi_t nargs)
return MOO_PF_SUCCESS;
}
static moo_pfrc_t pf_is_kind_of (moo_t* moo, moo_ooi_t nargs)
{
moo_oop_t rcv, _class;
rcv = MOO_STACK_GETRCV(moo, nargs);
_class = MOO_STACK_GETARG(moo, nargs, 0);
MOO_PF_CHECK_ARGS (moo, nargs, MOO_CLASSOF(moo, _class) == moo->_class);
if (moo_iskindof(moo, rcv, (moo_oop_class_t)_class))
{
MOO_STACK_SETRET (moo, nargs, moo->_true);
}
else
{
MOO_STACK_SETRET (moo, nargs, moo->_false);
}
return MOO_PF_SUCCESS;
}
static moo_pfrc_t pf_responds_to (moo_t* moo, moo_ooi_t nargs)
{
moo_oop_t rcv, selector;
@ -4135,6 +4156,7 @@ static pf_t pftab[] =
{ "_hash", { pf_hash, 0, 0 } },
{ "_is_kind_of", { pf_is_kind_of, 1, 1, } },
{ "_responds_to", { pf_responds_to, 1, 1 } },
{ "_perform", { pf_perform, 1, MA } },

View File

@ -224,7 +224,7 @@ static kernel_class_info_t kernel_classes[] =
{ 13,
{ 'M','e','t','h','o','d','C','o','n','t','e','x','t' },
0,
MOO_CLASS_SELFSPEC_FLAG_FINAL | MOO_CLASS_SELFSPEC_FLAG_LIMITED,
MOO_CONTEXT_NAMED_INSTVARS,
MOO_CLASS_SPEC_FLAG_INDEXED,
MOO_OBJ_TYPE_OOP,
@ -232,7 +232,7 @@ static kernel_class_info_t kernel_classes[] =
{ 12,
{ 'B','l','o','c','k','C','o','n','t','e','x','t' },
0,
MOO_CLASS_SELFSPEC_FLAG_FINAL | MOO_CLASS_SELFSPEC_FLAG_LIMITED,
MOO_CONTEXT_NAMED_INSTVARS,
MOO_CLASS_SPEC_FLAG_INDEXED,
MOO_OBJ_TYPE_OOP,

View File

@ -973,3 +973,27 @@ moo_oop_t moo_findclass (moo_t* moo, moo_oop_nsdic_t nsdic, const moo_ooch_t* na
return ass->value;
}
int moo_iskindof (moo_t* moo, moo_oop_t obj, moo_oop_class_t _class)
{
moo_oop_class_t c;
c = MOO_CLASSOF(moo,obj); /* c := self class */
if (c == moo->_class)
{
/* object is a class */
if (_class == moo->_class) return 1;
}
else
{
if (c == _class) return 1;
}
c = (moo_oop_class_t)c->superclass;
while ((moo_oop_t)c != moo->_nil)
{
if (c == _class) return 1;
c = (moo_oop_class_t)c->superclass;
}
return 0;
}

View File

@ -1729,6 +1729,12 @@ MOO_EXPORT moo_oop_t moo_findclass (
const moo_ooch_t* name
);
MOO_EXPORT int moo_iskindof (
moo_t* moo,
moo_oop_t obj,
moo_oop_class_t _class
);
/* =========================================================================
* TRAILER MANAGEMENT
* ========================================================================= */