| 18 | | {- |
| 19 | | instances of these objects represent the Perl 6 Class Model, ie |
| 20 | | with names like "Class", "Role", "Trait", etc. |
| 21 | | |
| 22 | | DEFINITIONS |
| 23 | | ----------- |
| 24 | | |
| 25 | | Get these right, or you will burn forever in Meta-Meta-Hell. |
| 26 | | |
| 27 | | Haskell S12 term Access from Perl as |
| 28 | | ------- -------- ------------------- |
| 29 | | MetaClass - MyClass.meta.meta |
| 30 | | Class MetaClass MyClass.meta |
| 31 | | ? Class MyClass |
| 32 | | |
| 33 | | Looks like we still need an angel to figure this all out! :-) |
| 34 | | |
| 35 | | -} |
| 36 | | |
| 37 | | data MetaClass = MetaClass |
| 38 | | { clsName :: Label |
| 39 | | , clsSuper :: MetaClass |
| 40 | | , clsSubClasses :: Set MetaClass |
| 41 | | , clsProperties :: Map Label (Visibility, MetaProperty) |
| 42 | | , clsMethods :: Map Label (Visibility, MetaMethod) |
| 43 | | --, clsAssocs :: Map Label MetaAssoc |
| 44 | | --, clsRevAssocs :: Map Label MetaAssoc |
| 45 | | , clsCats :: Map Label (Visibility, MetaAssoc) |
| 46 | | } |
| 47 | | |
| 48 | | {- |
| 49 | | Rules of these collections; note that the meta-model is *not* a |
| 50 | | multiple inheritance model. |
| 51 | | |
| 52 | | ∀ MetaClass A, B : A.clsSuper = B ↔ A ∈ B.clsSupClasses |
| 53 | | |
| 54 | | -} |
| 55 | | |
| 56 | | data MetaMethod = MetaMethod |
| 57 | | { methodParams :: Params |
| 58 | | , methodInvoke :: [Val] -> Eval Val |
| 59 | | } |
| 60 | | |
| 61 | | data MetaProperty = MetaProperty |
| 62 | | { propType :: Type |
| 63 | | , propDefault :: Eval Val |
| 64 | | } |
| 65 | | |
| 66 | | {- |
| 67 | | The old association metametaclass... |
| 68 | | |
| 69 | | data MetaAssoc = MetaAssoc |
| 70 | | { assocSource :: MetaClass |
| 71 | | , assocTarget :: MetaClass |
| 72 | | , assocSourceRange :: Range |
| 73 | | , assocTargetRange :: Range |
| 74 | | , assocCategory :: Category |
| 75 | | , assocIsComposite :: Bool -- if you kill this, its children |
| 76 | | -- makes no sense to live either |
| 77 | | } |
| 78 | | -} |
| 79 | | |
| 80 | | {- |
| 81 | | This is a bit like an association, but easier to deal with for |
| 82 | | writing proofs. |
| 83 | | -} |
| 84 | | data MetaAssoc = MetaAssoc |
| 85 | | { catClass :: MetaClass |
| 86 | | , catPair :: MetaAssoc |
| 87 | | , catRange :: Range |
| 88 | | , catIsComposite :: Bool -- if you kill this, its children |
| 89 | | -- makes no sense to live either |
| 90 | | , catOrdered :: Bool -- default false |
| 91 | | , catKeyed :: Bool -- default false |
| 92 | | , catCompanion :: Label |
| 93 | | } |
| 94 | | |
| 95 | | {- |
| 96 | | |
| 97 | | ∀ MetaClass A, MetaAssoc C : A.clsCats ∋ C ↔ C.catClass = A |
| 98 | | |
| 99 | | ∀ MetaAssoc C₁, C₂ : C₁.catPair = C₂ ↔ C₂.catPair = C₁ |
| 100 | | |
| 101 | | -- can't be composite both ways |
| 102 | | |
| 103 | | ∀ MetaAssoc C₁, C₂ : C₁.catPair = C₂ ∧ C₁.catIsComposite |
| 104 | | → ¬(C₂.catIsComposite) |
| 105 | | |
| 106 | | -- this seems the simplest way to specify complementary categories |
| 107 | | |
| 108 | | ∀ MetaAssoc C₁, C₂, MetaClass M₁, M₂ |
| 109 | | : C₁.catPair = C₂ ∧ C₁.assocCompanion |
| 110 | | ∧ C₁.catClass = M₁ ∧ C₂.catClass = M₂ |
| 111 | | → ( ∃ M₁.clsCats{C₂.catCompanion} |
| 112 | | ∧ ∃ M₂.clsCats{C₁.catCompanion} |
| 113 | | ∧ M₁.clsCats{C₂.catCompanion}[1] = C₁ |
| 114 | | ∧ M₂.clsCats{C₁.catCompanion}[1] = C₂ |
| 115 | | ∧ M₁.clsCats{C₂.catCompanion}[0] = M₂.clsCats{C₁.catCompanion}[0] |
| 116 | | ) |
| 117 | | -} |
| 118 | | |
| 119 | | data Visibility = Public | Private |
| 120 | | |
| 121 | | type Label = String |
| 122 | | |
| 123 | | type Range = (Multi, Multi) |
| 124 | | |
| 125 | | data Multi = Zero | One | Many |
| 126 | | |
| 127 | | {- |
| 128 | | simple range sanity stuff... enforce ordering |
| 129 | | ∀ Range R : R[0] = One → R[1] ∈ ( One | Many ) |
| 130 | | ∀ Range R : R[1] = One → R[0] ∈ ( Zero | One ) |
| 131 | | ∀ Range R : R[0] = Many → R[1] = Many |
| 132 | | ∀ Range R : R[1] = Zero → R[1] = Zero |
| 133 | | |
| 134 | | -} |
| 135 | | |
| 136 | | data Category = Unordered | Ordered | Keyed |
| 137 | | |
| 138 | | data Type = Int | Str |
| 139 | | |
| 140 | | {- |
| 141 | | these classes represent the Perl 6 Class model and/or type system |
| 142 | | |
| 143 | | So far, there exists only this pseudo-code :) |
| 144 | | |
| 145 | | ∀ initTree Node N ∃ MetaClass M : M.clsName = N |
| 146 | | |
| 147 | | Note: in the below expression, N₁ ∋ N₂ means (N₂ is a direct |
| 148 | | child member of N₁ within the tree it exists in) |
| 149 | | |
| 150 | | ∀ initTree Node N₁, N₂, MetaClass M₁, M₂ |
| 151 | | : N₁ ∋ N₂ ∧ N₁ = M₁.clsName ∧ N₂ = M₂.clsName |
| 152 | | → M₁.subClasses ∋ M₂ |
| 153 | | |
| 154 | | -- |
| 155 | | |
| 156 | | Note: what follows might all be kack, and is written by someone who |
| 157 | | hasn't read http://xrl.us/tapl, which is not ideal. Maybe |
| 158 | | someone who has will come along later and fix this. Or maybe |
| 159 | | I'll get through the book soon :). Don't hold your breath... |
| 160 | | |
| 161 | | {- |
| 162 | | PkgIsGlobal is not quite right - a package is global if it exists |
| 163 | | in the global package namespace. Packages either need to |
| 164 | | know their "own" namespace for $?PACKAGE to work (perhaps...), or |
| 165 | | have a back-reference to the namespace they exist in that has a |
| 166 | | String category that is the name, or something like that. consider |
| 167 | | this a FIXME :-) |
| 168 | | -} |
| 169 | | |
| 170 | | Package := MetaClass where clsName = "Package" |
| 171 | | Package.clsProperties = |
| 172 | | { pkgName = MetaProperty { type = Symbol } |
| 173 | | , pkgIsGlobal = MetaProperty { type = Bool } |
| 174 | | , pkgStash = MetaProperty { type = Map (sigil, Symbol) Object } |
| 175 | | } |
| 176 | | |
| 177 | | -- Package->has_many("pkgChildren" => Package) |
| 178 | | -- Package->maybe_has_one("pkgParent" => Package) |
| 179 | | Package.clsCats = |
| 180 | | { pkgChildren = |
| 181 | | (Public, MetaAssoc |
| 182 | | { catIsComposite = true, |
| 183 | | catRange = (Zero, One), |
| 184 | | catCompanion = "pkgParent", |
| 185 | | catPair = MetaAssoc { |
| 186 | | catClass = Package, |
| 187 | | catRange = (Zero, Many), |
| 188 | | }, |
| 189 | | }) |
| 190 | | } |
| 191 | | |
| 192 | | {- |
| 193 | | Traits - just what do we know about them? They're mentioned in S02, |
| 194 | | S04, etc as applying to Packages, Blocks, etc. There is a |
| 195 | | *lot* in S06 on block traits... |
| 196 | | |
| 197 | | Perhaps *all* objects should be able to have generic |
| 198 | | "Traits" in the Meta-Model ? |
| 199 | | |
| 200 | | Or are traits just the word we use to mean a property of |
| 201 | | something in the MetaModel? In the context of packages, |
| 202 | | they seem to be more generic than that. This is why I have |
| 203 | | made this specifically a PkgTrait class |
| 204 | | -} |
| 205 | | PkgTrait := MetaClass where clsName = "PkgTrait" |
| 206 | | |
| 207 | | Module := MetaClass where clsName = "Module" |
| 208 | | Module.clsProperties = |
| 209 | | { modVersion = MetaProperty { type = Version } |
| 210 | | , modAuthorizer = MetaProperty { type = String } |
| 211 | | } |
| 212 | | |
| 213 | | Module.clsMethods = |
| 214 | | { modName = MetaMethod |
| 215 | | { methodInvoke = ( self.pkgName |
| 216 | | ~ "-" ~ self.modVersion |
| 217 | | ~ "-" ~ self.modAuthorizer ) } |
| 218 | | } |
| 219 | | |
| 220 | | Module.clsAssocs = |
| 221 | | { modTraits = (Public, MetaAssoc |
| 222 | | { catIsComposite = true, |
| 223 | | catRange = (Zero, Many), |
| 224 | | catCompanion = "pkgParent", |
| 225 | | catKeyed = true, |
| 226 | | catPair = MetaAssoc |
| 227 | | ( { catClass = PkgTrait, |
| 228 | | catRange = (One, One) } ), |
| 229 | | }) |
| 230 | | } |
| 231 | | |
| 232 | | Class := MetaClass where clsName = "Class" |
| 233 | | Class.clsAssocs = |
| 234 | | { isa = (Public, MetaAssoc |
| 235 | | { catOrdered = true, |
| 236 | | catRange = (Zero, Many), |
| 237 | | catCompanion = "subClasses", |
| 238 | | catPair = MetaAssoc |
| 239 | | { catRange = (Zero, Many), |
| 240 | | catClass = Class } |
| 241 | | }), |
| 242 | | methods = (Public, MetaAssoc |
| 243 | | { catKeyed = true, |
| 244 | | catRange = (Zero, Many), |
| 245 | | catCompanion = "Class", |
| 246 | | catPair = MetaAssoc |
| 247 | | { catRange = (One, One), |
| 248 | | catClass = Method |
| 249 | | } }), |
| 250 | | } |
| 251 | | |
| 252 | | |
| 253 | | |
| 254 | | -- starting to look like the beginning again? :) |
| 255 | | |
| 256 | | ∀ Class C₁, C₂ : C₁.superClasses ∋ C₂ |
| 257 | | ↔ C₂.subClasses ∋ C₁ ∧ C₂ ∉ C₁.subClasses |
| 258 | | |
| 259 | | -- hmm, anyone know how to induct the above to disallow circular inheritance? |
| 260 | | |
| 261 | | -- & (reading TAPL) |
| 262 | | |
| 263 | | -} |
| 264 | | |
