src/core/namespace.slate

   1 "Some utility methods for Namespace objects."
   2
   3 ns@(Namespace traits) new
   4 "Answer a new Namespace with no slots."
   5 [Namespace clone].
   6
   7 ns@(Namespace traits) newDelegatingTo: parentObj
   8 [
   9   result ::= ns new.
  10   result _delegates := {parentObj. result traitsWindow}.
  11   result
  12 ].
  13
  14 ns@(Namespace traits) newSubSpace
  15 [ns newDelegatingTo: ns].
  16
  17 "a hack for now? namespaces were one place where named delegates made more sense"
  18 "put traitswindow last so it has more priority so ns new doesn't call someone else's new function"
  19 ns@(Namespace traits) parentNamespace
  20 [
  21   ns _delegates size > 1
  22     ifTrue: [ns _delegates first]
  23     ifFalse: [ns "is this right?"]
  24 ].
  25
  26 ns@(Namespace traits) parentNamespace: parent
  27 [
  28   ns _delegates size > 1
  29     ifTrue: [ns _delegates at: 0 put: parent]
  30     ifFalse: [ns insertDelegate: parent. parent]
  31 ].
  32
  33 ns@(Namespace traits) newSisterSpace
  34 [
  35   ns _delegates size <= 1
  36     ifTrue: [ns newDelegatingTo: ns parentNamespace]
  37     ifFalse: [ns new]
  38 ].
  39
  40 ns@(Namespace traits) flattened
  41 "Creates a new single Namespace object with all the slot-values and inherited
  42 slot values of the original Namespace structure."
  43 [
  44   result ::= Namespace clone.
  45   result addSlotsFrom: ns.
  46   ns allDelegatesDo:
  47     [| :each | (each isSameAs: ns) ifTrue: [result addSlotsFrom: each]].
  48   result
  49 ].
  50
  51 ns@(Namespace traits) here
  52 "A convenient implicit context handle to the Namespace object."
  53 [ns].
  54
  55 ns@(Namespace traits) import: objName@(Symbol traits) from: nsParent
  56 [
  57   ns addImmutableSlot: objName valued: (nsParent atSlotNamed: objName)
  58 ].
  59
  60 ns@(Namespace traits) import: names"@(Collections traits)" from: nsParent
  61 [
  62   #(ns import: _ from: nsParent) `er for: names
  63 ].
  64
  65 "TODO: FIXME: this needs to be fixed to treat delegates right (Huh?)"
  66 x@(Root traits) ensureNamespace: name &slots: slotSpecs &delegate: delegate
  67 "Create and link to a Namespace object by the slot name if it doesn't exist
  68 or if there is a non-Namespace object there. This also takes specs for
  69 immutable slot values, and a &delegate flag for delegated-vs-not namespace."
  70 [| ns |
  71   (x hasSlotNamed: name)
  72    ifTrue:
  73      [((old ::= x atSlotNamed: name) is: Namespace)
  74         ifTrue: [old]
  75         ifFalse: [x atSlotNamed: name put: Namespace clone]]
  76    ifFalse: [(delegate `defaultsTo: False)
  77                ifTrue: [ns := Namespace clone. x insertDelegate: ns. x addImmutableSlot: name valued: ns. ns]
  78                ifFalse: [x addImmutableSlot: name valued: Namespace clone]].
  79   ns := x atSlotNamed: name.
  80   (slotSpecs `defaultsTo: #{}) do:
  81     [| :each | (each is: Association)
  82        ifTrue: [ns addImmutableSlot: each key valued: each value]
  83        ifFalse: [ns addImmutableSlot: each]].
  84   ns
  85 ].