MirrorGroups.ns

Newspeak3
'Root'
class MirrorGroups usingPlatform: platform = (
(* Mirror groups are designed to aggregate mirrors of any kind.
They make the mirror API compositional and not too
heavyweight.  Consider the API of an immutable mixin mirror:


name
methods
slots
classes

the latter three all return mirror groups, which all share a common protocol:

findMirrorNamed: #foo
includesMirrorNamed: #foo
do: blk

In a more traditional API, we would need to support methods like:

findMethodNamed: #foo
findSlotNamed: #foo
findClassNamed: #foo

includesMethodNamed: #foo
includesSlotNamed: #foo
includesClassNamed: #foo

methodsDo: blk
slotsDo: blk
classesDo: blk

This means 3 times as many methods, which need to be kept consistent.
When the mirror is mutable, the actual mixin API does not change much. The
implementation returns mutable mirror groups, which support:

addMirror: aMirror
addFromSource: aSourceString

instead of having the mutable mixin support:

addMethodMirror:
addMethodFromSource:
addSlotMirror:
addSlotFromSource:
addClassStencilMirror:
addClassFromSource:

   Copyright 2008 Cadence Design Systems, Inc.
   Copyright 2011 Ryan Macnak

   Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0 *)
|
private Collection = platform collections Collection.
private List = platform collections List.
|) (
public class ImmutableMirrorGroup group: ms <List[Mirror]> = Collection (
(* Immutable mirror groups do not support adding or removing mirrors. They are created from an initial set of mirrors passed to the factory method.

However, the API does include mutators, which all fail if called.  This allows them to provide good error messages when used in a context that might attempt to mutate them. An example would be a mutable mixin mirror that does not allow changes to its representation; it includes immutable mirror groups for its slots and classes, and a mutable mirror group for its methods. *)
|
	protected mirrors <List[Mirror]> = List withAll: ms. (* Preserve order.  Keep source code order if applicable.  Shape is important for many classes known to the VM. *)
|) (
public addFromSource: s <String> = (
	^Error signal: 'Adding mirrors not allowed on an immutable mirror group!'
)
public addMirror: m <Mirror> = (
	^Error signal: 'Adding mirrors not allowed on an immutable mirror group!'
)
public do: blk <[:Mirror]> = (
	mirrors do: blk
)
public findMirrorNamed: n <Symbol> ^ <Mirror> = (
	mirrors do: [:mirror <Mirror> | mirror name = n ifTrue: [^mirror]].
	^nil
)
public includesMirrorNamed: n <Symbol> = (
	mirrors do: [:mirror <Mirror> | mirror name = n ifTrue: [^true]].
	^false
)
public removeMirror: m <Mirror> = (
	^Error signal: 'Removng mirrors not allowed on an immutable mirror group!'
)
public removeMirrorNamed: m <Symbol | String> = (
	^Error signal: 'Removng mirrors not allowed on an immutable mirror group!'
)
public size ^ <Integer> = (
	^mirrors size
)
) : (
)
class MirrorGroup group: ms <Collection[Mirror]> = ImmutableMirrorGroup group: ms (
(* A mutable mirror group; mirrors can be added or removed after its creation. *)
) (
public addFromSource: s <String> = (
	self subclassResponsibility
)
addMirror: m <Mirror> = (
	mirrors keysAndValuesDo: [:index :mirror |
		mirror simpleName = m simpleName ifTrue: [^mirrors at: index put: m]].
	^mirrors addLast: m
)
removeAll = (
	mirrors: List new.
)
removeAllSuchThat: blk = (
	mirrors select: blk thenDo: [:m <Mirror> | removeMirrorNamed: m name].
)
removeMirror: m <Mirror> = (
	^mirrors remove: m
)
removeMirrorNamed: n <Symbol | String> = (
	| m |
	m:: findMirrorNamed: n.
	^m ifNotNil: [removeMirror: m].
)
) : (
)
) : (
)