src/lib/module.slate

   1 globals define: #modules &builder: [ExtensibleArray new].
   2
   3 _@lobby currentModule [Module current].
   4 _@lobby currentModule: m [Module current: m].
   5 "TODO: form and implement a generic (non-global) idea of the current module."
   6
   7 ns@(Namespace traits) enterModule: name
   8 [
   9   modules include: name.
  10   currentModule: name
  11 ].
  12
  13 ns@(Namespace traits) provides: objects
  14 [
  15   currentModule exports addAll: objects.
  16   features addAll: objects
  17 ].
  18
  19 ns@(Namespace traits) requires: objects
  20 [
  21   currentModule imports addAll: objects.
  22   objects do:
  23     [| :requirement |
  24      (lobby features includes: requirement)
  25        ifFalse: [warn: 'Missing feature required for loading this: ' ; requirement printString]].
  26 ].
  27
  28 prototypes define: #Module
  29 "Modules are a collection of objects and methods, which together provide
  30 certain features, and require other modules' features to function."
  31   &slots: {
  32 #requirements -> Set new.
  33 "The set of modules that this requires before it can be loaded."
  34 #imports -> Set new.
  35 "Imports are objects and features referenced by the module's code."
  36 #exports -> Set new.
  37 "Exports are objects and features provided by the module's code."
  38 #objects -> Set new.
  39 "These are the non-method objects that the module defines and installs."
  40 #methods -> Set new.
  41 "These are the closures that the module defines and installs, whether named or
  42 dispatched or anonymous."
  43 #name -> ''}.
  44
  45 m@(Module traits) initialize
  46 "Reset all of the module's attributes."
  47 [
  48   m requirements := m requirements new.
  49   m imports := m imports new.
  50   m exports := m exports new.
  51   m objects := m objects new.
  52   m methods := m methods new.
  53   m
  54 ].
  55
  56 m@(Module traits) new &name: name
  57 [
  58   m clone initialize `>> [name := name `defaultsTo: ''. ]
  59 ].
  60
  61 (Module traits hasSlotNamed: #current)
  62   ifFalse: [Module traits addSlot: #current valued: Module new].
  63
  64 m@(Module traits) newForFileNamed: filename
  65 [
  66   FileModule newLocated: filename
  67 ].
  68
  69 m@(Module traits) copy
  70 [m clone `setting: #{#requirements. #imports. #exports. #objects. #methods}
  71    to: {m requirements copy.
  72         m imports copy.
  73         m exports copy.
  74         m objects copy.
  75         m methods copy}
  76 ].
  77
  78 m@(Module traits) newBasedOn: moduleSet
  79 [m clone initialize `>>
  80    [requirements := moduleSet select: #(is: Module) `er. ]].
  81
  82 m@(Module traits) provide: obj
  83 [
  84   "TODO: include some check here to avoid arbitrary provision."
  85   m exports include: obj
  86 ].
  87
  88 m@(Module traits) provides: obj
  89 [
  90   m exports includes: obj
  91 ].
  92
  93 m@(Module traits) import: obj from: prereq
  94 [
  95   (prereq provides: obj)
  96     ifTrue: [m requirements include: prereq. m imports include: obj].
  97   m
  98 ].
  99
 100 m@(Module traits) allSelectorsSent
 101 [
 102   [| :result | m methods do: [| :each | result ; each allSelectorsSent]]
 103     writingAs: IdentitySet
 104 ].
 105
 106 m@(Module traits) allSelectorsSentNotDefined
 107 [
 108   [| :result | m methods do:
 109     [| :each |
 110      result ; (each allSelectorsSent reject:
 111                  [| :sel | m methods anySatisfy:
 112                              [| :method | method selector = sel]])]]
 113     writingAs: IdentitySet
 114 ].
 115
 116 m@(Module traits) importAll: c from: prereq
 117 [
 118   c do: [| :each | (prereq provides: each)
 119     ifFalse: [^ (prereq error:
 120                    prereq name ; ' does not provide ' ; (each as: String))]].
 121   m requirements include: prereq.
 122   c do: [| :each | m imports include: each].
 123   m
 124 ].
 125
 126 m@(Module traits) defines: obj
 127 [
 128   m defines: ((RootedPath to: obj) ifNil: [RootedPath to: obj traits])
 129 ].
 130
 131 m@(Module traits) defines: path@(Path traits)
 132 [overrideThis].
 133
 134 m@(Module traits) load
 135 "Loads the Module's contents, if external."
 136 [overrideThis].
 137
 138 m@(Module traits) build
 139 "Compiles the Module's contents, if external."
 140 [overrideThis].
 141
 142 m@(Module traits) locator
 143 [overrideThis].
 144
 145 prototypes define: #Load &parents: {Cloneable} &slots: {
 146   #source.
 147   #parser -> Syntax Parser.
 148   #targetNamespace -> lobby.
 149   #verbose -> False.
 150   #showMessage -> True.
 151 }.
 152 Load traits addSlot: #Level valued: 0.
 153 "How many levels of recursion has load: been invoked on."
 154 "TODO: This should be a dynamic, not a global."
 155 Load traits define: #DefaultSourceDir &builder: [Directory current].
 156 "Records the concrete directory where the sources are available and where
 157 the bootstrap occurred."
 158 Load traits define: #defaultPaths &builder: [ExtensibleArray new].
 159
 160 Load defaultPaths include: Load DefaultSourceDir.
 161 Load defaultPaths include: Load DefaultSourceDir / 'src'.
 162 Load defaultPaths include: Load DefaultSourceDir / 'src/demo'.
 163 Load defaultPaths include: Load DefaultSourceDir / 'src/core'.
 164 Load defaultPaths include: Load DefaultSourceDir / 'src/mobius'.
 165 Load defaultPaths include: Load DefaultSourceDir / 'src/lib'.
 166 Load defaultPaths include: Load DefaultSourceDir / 'src/i18n'.
 167 Load defaultPaths include: Load DefaultSourceDir / 'src/net'.
 168 Load defaultPaths include: Load DefaultSourceDir / 'src/ui'.
 169 Load defaultPaths include: Load DefaultSourceDir / 'src/unfinished'.
 170 Load defaultPaths include: Load DefaultSourceDir / 'src/web'.
 171 Load defaultPaths include: Load DefaultSourceDir / 'src/syntax'.
 172
 173 l@(Load traits) of: file@(File traits)
 174 [| oldLevel |
 175   l resolvePathOf: file.
 176   oldLevel := l Level.
 177   l Level := l Level + 1.
 178   [file sessionDo:
 179      [| :input | l process: input reader] &mode: file Read]
 180     ensure: [l Level := oldLevel]
 181 ].
 182
 183 l@(Load traits) resolvePathOf: file@(File traits)
 184 [
 185   file locator := l resolve: file locator
 186 ].
 187
 188 l@(Load traits) resolve: relative@(File RelativeLocator traits)
 189 [
 190   relative fileType `defaultsTo: 'slate'.
 191   l defaultPaths reverseDo:
 192     [| :dir |
 193      relative basePath := dir locator.
 194      relative exists ifTrue: [^ relative]].
 195   error: 'Could not find the file relative to any of the default directories.'.
 196   relative
 197 ].
 198
 199 l@(Load traits) resolve: filename@(File AbsoluteLocator traits)
 200 [
 201   l resolve: (File RelativeLocator new `>> [name := filename name. ])
 202 ].
 203
 204 l@(Load traits) retry
 205 [
 206   l source reset.
 207   l source close. l source reopen.
 208   l process: l source.
 209 ].
 210
 211 l@(Load traits) process: source
 212 [| retry skip ns |
 213   ns := Namespace new.
 214   retry := ns define: #Retry &parents: {Restart}.
 215   _@retry describeOn: out
 216   [out ; 'Retry loading ' ; l source resource locator printString ;'\n'].
 217   skip := ns define: #Skip &parents: {Restart}.
 218   _@skip describeOn: out
 219   [out ; 'Skip loading ' ; l source resource locator printString ; '\n' ].
 220   l source := source.
 221   [l run] handlingCases: {retry -> [| :_ | ^ (l retry)].
 222                           skip -> [| :_ | ^ Nil]}.
 223 ].
 224
 225 l@(Load traits) printMessage
 226 [
 227   l Level timesRepeat: [DebugConsole writer nextPut: $\s].
 228   inform: 'Loading ' ; l source resource locator printString &target: DebugConsole.
 229 ].
 230
 231 l@(Load traits) skipShebang
 232 "Ignore an initial she-bang line."
 233 [
 234   (l source peek: 2) = '#!' ifTrue: [l source upTo: $\n].
 235 ].
 236
 237 l@(Load traits) run
 238 "Evaluate the input from the open source ReadStream."
 239 [
 240   l showMessage ifTrue: [l printMessage].
 241   l skipShebang.
 242   "Ensure a fresh Parser."
 243   (l parser := l parser newOn: l source) do:
 244     [| :each |
 245      l verbose ifTrue:
 246        [l Level timesRepeat: [DebugConsole writer nextPut: $\s].
 247         inform: 'Parsed to line ' ; l parser lexer lineNumber printString &target: DebugConsole].
 248      [each evaluateIn: l targetNamespace]
 249        on: RebindError do: [| :c | c return]].
 250 ].
 251
 252 _@(Root traits) copyright
 253 "Describes the copyright for given objects/source. Override this on a per-type
 254 or per-module basis."
 255 [
 256   (Load DefaultSourceDir / 'LICENSE') sessionDo: [| :in | in >> Console. ].
 257 ].
 258
 259 x@(Root traits) license
 260 [x copyright].
 261
 262 "Override the more primitive load: commands with high level Module hooks:"
 263
 264 ns@(Namespace traits) load: fileName@(String traits) &imports: imports
 265 [
 266   ns load: (fileName as: File Locator) &imports: imports
 267 ].
 268
 269 ns@(Namespace traits) load: locator@(File Locator traits) &in: namespace &verbose: verbose &showLoadMessage: showLoadMessage &imports: imports
 270 "A command to open a file with the name, load, and compile/evaluate the
 271 contents within the argument namespace or an optional override."
 272 [| src |
 273   locator fileType = 'image' ifTrue:
 274     [error: 'Image filename specified where Slate source expected. Make sure you run slate with the -i flag to specify an image.'].
 275   src := File newNamed: locator &mode: File Read.
 276   src exists ifFalse: [locator fileType `defaultsTo: 'slate'].
 277   src exists ifFalse: [src locator := Load resolve: src locator].
 278   src exists
 279     ifTrue: [ns load: src &in: namespace &verbose: verbose &showLoadMessage: showLoadMessage &imports: imports]
 280     ifFalse: [warn: 'You tried to call load: on something that didn\'t describe a file. Returning the input: ' ; locator printString. locator]
 281 ].
 282
 283 ns@(Namespace traits) load: file@(File traits) &in: namespace
 284   &verbose: verbose &showLoadMessage: showMessage &imports: imports
 285 "A command to open the file, load, and compile/evaluate the
 286 contents within the argument namespace or an optional override."
 287 [| oldLevel loader |
 288   namespace `defaultsTo: ns.
 289   (imports `defaultsTo: #{}) do: [| :import | namespace import: import value from: import key].
 290   loader := Load clone `>>
 291     [targetNamespace := namespace. verbose ?= verbose. showMessage ?= showMessage. ].
 292   loader resolvePathOf: file.
 293   oldLevel := loader Level.
 294   loader Level := loader Level + 1.
 295   [file ASCIIReader sessionDo: #(loader process: _) `er &mode: file Read]
 296     ensure: [loader Level := oldLevel].
 297 ].
 298
 299 ns@(Namespace traits) reload: file &in: namespace &verbose: verbose &showLoadMessage: showLoadMessage &imports: imports
 300 [
 301   [ns load: file &in: namespace &verbose: verbose &showLoadMessage: showLoadMessage &imports: imports]
 302     on: RebindError do: [| :x | x return: Nil]
 303 ].
 304
 305 prototypes define: #FileModule &parents: {Module} &slots: {#source -> File}.
 306 "FileModules are Modules which are drastically simplified for the purposes of
 307 bootstrapping. Requirements and provisions are symbols, and other features are
 308 ignored."
 309
 310 m@(FileModule traits) newLocated: filename
 311 [m new `>> [source := m source newNamed: filename &mode: File Read. ]].
 312
 313 f@(File traits) as: m@(Module traits)
 314 [FileModule new `>> [source := f. ]].
 315
 316 m@(FileModule traits) locator
 317 [m source locator].
 318
 319 m@(FileModule traits) load &in: namespace
 320 [
 321   Load of: m source
 322 ].
 323
 324 m@(FileModule traits) build
 325 [
 326   m load
 327 ].
 328
 329 m@(FileModule traits) readDefinitions
 330 "Reads in a file, building the module's collections while evaluating the
 331 contents."
 332 "TODO: implement it!"
 333 [
 334   m source
 335     sessionDo: [| :in | ].
 336   m
 337 ].
 338
 339 Module traits define: #DefinitionSelectors
 340               &builder: [#{#addPrototype:. #addPrototype:derivedFrom:.
 341                          #define:. #define:using:. #define:on:as:.
 342                          #ensureNamespace:}]
 343 "Selectors for the standard accessor-producing definitions.".
 344
 345 m@(FileModule traits) parseSessionDo: block
 346 [
 347   m source sessionDo:
 348     [| :input | block applyWith: (Syntax Parser newOn: input reader)]
 349 ].
 350
 351 m@(FileModule traits) definedPaths &in: namespace
 352 "Answers a Set of Path objects that would be defined if the source were
 353 evaluated."
 354 [
 355   namespace `defaultsTo: here.
 356   [| :result |
 357    m parseSessionDo:
 358      [| :p |
 359       p do: [| :tree | tree walk:
 360         [| :node accessor partPath |
 361          "Handle the slot-based definitions which produce an accessor."
 362          (node is: Syntax Message)
 363            /\ [m DefinitionSelectors includes: node selector]
 364            /\ [node arguments second is: Syntax Literal]
 365            ifTrue:
 366              [accessor: node arguments second value.
 367               partPath: node arguments first]
 368            "Handle unary top-level method definitions."
 369            ifFalse:
 370              [(node is: Syntax MethodDefinition)
 371                 /\ [node selector isUnarySelector]
 372                 /\ [node parentScope isNil]
 373                 ifTrue:
 374                   [accessor := node selector.
 375                    partPath := node roles first]].
 376          "Given an accessor, check the path for validity, then add it."
 377          accessor ifNotNil:
 378            [(partPath as: RootedPath &root: namespace) ifNotNilDo:
 379              [| :path | result nextPut: (path childNamed: accessor)]]
 380          ]]]] writingAs: Set
 381 ].
 382
 383 m@(FileModule traits) defines: path@(Path traits)
 384 [m definedPaths includes: path].
 385
 386 globals ensureNamespace: #AutoLoader
 387 "Manages 'autoloading' stubs - these are mock accessors for unloaded features
 388 which load those features transparently and return them once done."
 389   &slots: {#defs -> Dictionary new.
 390            #storage -> (File newNamed: 'AutoLoad').
 391            #standardFiles -> (
 392   "Extra generic libraries."
 393   ({'extlib'. 'time'. 'dimensioned'. 'predicate'. 'group'. 'heap'. 'skiplist'.
 394     'tree'. 'tokenizer'. 'set-sorted'. 'relation'.
 395     'set-single'. 'matrix'. 'wordarray'.
 396     'terminal'. 'version'. 'test'. 'random'. 'xml'.
 397     'suspension'. 'process'.
 398     'graph'. 'digraph'}
 399     collect: [| :name | 'src/lib/' ; name ; '.slate']) ;
 400   "Networking libraries, platform libraries."
 401   {'src/net/sockets.slate'. 'src/net/http.slate'} ;
 402   "Bootstrapper libraries."
 403   ({'bootstrap'. 'build'}
 404     collect: [| :name | 'src/mobius/' ; name ; '.slate']) as: Set)}.
 405
 406 l@AutoLoader readFromSourceIn: file
 407 "Parses the source in the specified file and creates entries for each path
 408 directly defined."
 409 [| mod paths |
 410   mod := FileModule newLocated: file.
 411   (paths := mod definedPaths) do:
 412     [| :path |
 413      path isOneSlotFromDefinition /\ [(paths includes: path parent) not]
 414        ifTrue: [l defs at: path := mod]].
 415 ].
 416
 417 l@AutoLoader performScan &files: fileList
 418 "Scans the source in the given collection of filenames or the default, adding
 419 to the in-memory database."
 420 [
 421   fileList `defaultsTo: l standardFiles.
 422   fileList do: [| :file |
 423                 inform: 'Scanning \'' ; file ; '\''.
 424                 l readFromSourceIn: file]
 425 ].
 426
 427 l@AutoLoader install: m@(Module traits) when: selector isCalledOn: namespace
 428 "The basic unit of creating an auto-loading method. This checks for a pre-
 429 existing method on the exact same object to avoid duplicate work, and informs
 430 the user of the creation. The method itself tells the module to load itself,
 431 which will presumably clobber that method called, so that the final action
 432 of re-calling it will return the intended object."
 433 [
 434   (selector isFoundOn: {namespace}) ifTrue: [^ Nil].
 435   inform: 'Installing auto-loader for: ' ; selector printString
 436    ; ' in: ' ; ((RootedPath from: here to: namespace) as: Syntax Node) printString.
 437   [| :ns |
 438    selector removeMethodFrom: {namespace}. "Remove this method before replacement."
 439    m load. "Have the module object load itself, presumably replacing this."
 440    l installReadyItems. "Have AutoLoader rescan for further hooks."
 441    "Re-call the method, presuming that the module installed a replacement."
 442    [selector sendTo: {ns}] on: MethodNotFound do:
 443      [| :c | error: 'The module failed to define this accessor.']]
 444     asMethod: selector on: {namespace}
 445 ].
 446
 447 l@AutoLoader installReadyItems
 448 "Iterate through the in-memory definitions, installing methods for those
 449 that are one slot definition away from completion."
 450 [
 451   l defs keysAndValuesDo:
 452     [| :path :mod |
 453      path isOneSlotFromDefinition
 454        ifTrue:
 455          [l install: mod when: path names last isCalledOn: path parent target]]
 456 ].
 457
 458 l@AutoLoader readStorage &from: file &in: namespace
 459 "Reads a quirky file format we've defined from path-spec -> locator-spec per
 460 line in the text file or default storage."
 461 [
 462   file `defaultsTo: l storage.
 463   namespace `defaultsTo: here.
 464   file exists
 465     ifFalse: [warn: 'The database file for auto-loaders is not present.'.
 466               ^ Nil].
 467   file sessionDo:
 468     [| :f r |
 469      r := f reader lines.
 470      [r isAtEnd] whileFalse:
 471        [r next ifNotNilDo:
 472          [| :line |
 473           (line indexOfSubSeq: ' ->') ifNotNilDo:
 474             [| :splitIndex path filename |
 475              path := (line first: splitIndex + 1) split
 476                as: RootedPath &root: namespace.
 477              filename := String readFrom: (line copyFrom: splitIndex + 4).
 478              AutoLoader defs at: path := FileModule newLocated: filename]]]].
 479   l installReadyItems
 480 ].
 481
 482 l@AutoLoader writeToStorage
 483 "Writes definitions to the default storage."
 484 [
 485   l storage sessionDo:
 486     [| :f out |
 487      out := f writer.
 488      l defs keysAndValuesDo:
 489        [| :path :mod |
 490         out ; ((path as: Syntax Node) printString
 491           ; ' -> ' ; (mod locator as: String) printString as: ByteArray) ; '\n']]
 492     &mode: l storage CreateWrite.
 493 ].
 494
 495 lobby ensureNamespace: #systems.
 496
 497 prototypes define: #System &slots: {#modules -> Set new}.
 498
 499 s@(System traits) newForAll: modules
 500 "Creates a new System object for the given Module objects."
 501 [(s clone `setting: #{#modules} to: {modules as: s modules}) `>>
 502    [| :newS | modules do: [| :each | newS fillRequirementsFor: each]. ]
 503 ].
 504
 505 s@(System traits) fillRequirementsFor: module
 506 "Fills the requirements slot of the module, based on the knowledge that the
 507 System has by holding several other Modules, and return the requirements."
 508 [| features covered |
 509   features := module imports.
 510   covered := Set newSizeOf: features.
 511   s modules
 512     do: [| :each coverage |
 513          coverage := each exports intersection: features.
 514          coverage isEmpty
 515            ifFalse: [module requirements include: each.
 516                      covered includeAll: coverage]].
 517   module requirements
 518 ].
 519
 520 s@(System traits) add: module
 521 [
 522   s modules include: module.
 523   s fillRequirementsFor: module.
 524   module
 525 ].
 526
 527 s@(System traits) build
 528 "Compile the System's modules."
 529 [
 530   s modules do: #build`er.
 531 ].
 532
 533 s@(System traits) load
 534 "Load the System's modules in a consistent order."
 535 [| remaining |
 536   remaining := s modules copy.
 537   [remaining isEmpty]
 538     whileFalse:
 539       [remaining do:
 540         [| :each |
 541          (features includesAllOf: each requirements)
 542                  ifTrue: [each load. remaining remove: each]]].
 543 ].
 544
 545 s@(System traits) load: module
 546 "Loads the given module and recursively re-loads modules that depend upon it."
 547 [
 548   module load.
 549   s modules
 550     do: [| :each | (each dependsOn: module) ifTrue: [s load: each]].
 551 ].
 552
 553 systems define: #Core &builder: [System newForAll: globals modules].
 554 "This relies on being loaded just after all the standard libraries, and more
 555 importantly before other systems."