Source

newspeak / Mirrors4.ns3

The default branch has multiple heads

Full commit
   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
Newspeak3
'Mirrors'
class Mirrors4 usingLib: platform = NewspeakObject (
"The new Newspeak  mirrors API. It is a work in progress that attempts to address weaknesses of the current API and of past mirror APIs. The mirrors here are high level mirrors: they represent language constructs in NS2 and above.

The API follows several general guidelines:

1) Operations return mirrors (an exception is getting the reflectee).
2) Operations take non-mirrors as arguments.
3) Operations take a failure block.

The motivation for (3) is that mirrors should be useful in both local and distributed settings. Forcing the user to confront the possibility of failure helps make code more robust in the distributed case.  This also contributes to (1); returned results may refer to remote values, and going through the mirror API to deal with them will help ensure failure scenarios are dealt with.

On the other hand, arguments can always be converted to mirrors by the API.  Much of the awkwardness in mirror APIs stems from the need to package arguments as mirrors - with the API often immediately extracting the reflectee afterwards.  The API should endeavor to deal with either mirrors or non-mirrors when this makes sense (e.g., when applying a mixin to a superclass, the superclass argument could be either a class or a class mirror) or to provide a separate call for mirrors (say, when adding a method - one call might accept source as a string, another a MethodMirror).

The implementation will likely change. As we reform the reflective interface, we are likely to reduce our reliance on existing code like SqueakVMMirror and NS2Reflection; either their code will migrate here or vice versa.

The API is divided into immutable and mutable parts. Mirrors are basically immutable.  As such they support introspection directly. In order to mutate code, one uses MirrorBuilders. These are created based on a mirror, and allow modifications to be accumulated without having any effect on the system.  The builder can be asked to provide a mirror reflecting its current state at any time. This allows the results of multiple builders to be batched and submitted to the atomic installer as well.

All this brings up the question of how mirrors differ from ASTs. Mirrors and ASTs should ideally be viewed as different implementations of the same interface.  Mirrors differ in how they are constructed and how they compute their subtrees. Mirrors may be connected to a live representation, or to a source base or whatever. 

MirrorBuilders also differ in supporting mutability and in what inputs can drive them (e.g, addFromSource:) so they extend the base API of mirrors and ASTs. 

It may be a while before this module realizes the ideal description given above. Also, the implementation still relies heavily on earlier reflective APIs - be they the built-in Squeak reflection classes or other efforts. Ultimately, the actual logic for this should reside here.

   Copyright 2008 Cadence Design Systems, Inc.
   Copyright (c) 2009-2010 Gilad Bracha
   Copyright 2011 Gilad Bracha, Ryan Macnak and Cadence Design Systems

   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"|  
MutableHashedMap = platform collections Dictionary.
MutableList = platform collections OrderedCollection.
IdentitySet = platform IdentitySet.
IdentityDictionary = platform IdentityDictionary.

Duct = platform blackMarket Duct. "Note: not the one in brazil because brazil is not available during bootstrap"
BrazilWeakStorage = platform blackMarket BrazilWeakStorage.

Error = platform Exceptions Error.
Metaclass = platform Metaclass.
zSystemMetadata = platform NewsqueakMixins SystemMetadata.
zLanguage = platform NsMultilanguage Language.
SystemChangeNotifier = platform SystemChangeNotifier.


"atomicInstaller = platform namespace AtomicInstaller usingPlatform: platform."
atomicInstaller = platform AtomicInstaller4 usingPlatform: platform.

lowLevelMirrors = platform namespace LowLevelMirrors usingLib: platform.
LowLevelMirror = lowLevelMirrors Mirror.
CompiledMixinMirror = lowLevelMirrors CompiledMixinMirror.
LowLevelMixinMirror = lowLevelMirrors LowLevelMixinMirror.
LowLevelMethodMirror = lowLevelMirrors LowLevelMethodMirror.
InstanceVariableMirror = lowLevelMirrors InstanceVariableMirror.
ImmutableMirrorGroup = (platform namespace MirrorGroups usingLib: platform) ImmutableMirrorGroup.


private vmmirror = platform blackMarket NewspeakCore VMMirror new.

parserLib = Delay computation: [platform namespace BlocklessCombinatorialParsing usingLib: platform].
grammar = Delay computation: [platform namespace Newspeak3Grammar parserLib: parserLib].
asts = Delay computation: [platform namespace Newspeak3AST usingLib: platform].
parsing = Delay computation: [platform namespace Newspeak3Parsing
	usingLib: platform
	ast: asts
	grammar: grammar].
compilation = Delay computation: [platform namespace Newspeak3Compilation
	usingPlatform: platform 
	newspeakParser: parsing
	mirrorLib: platform mirrors].

protected storedCompiler "cached compiler and module"


private mixinBasedMirrors <WeakIdentitySet[MixinMirror]> = BrazilWeakStorage new.
|)
(
class ClassDeclarationBuilder fromMixinRep: rep <MixinRep> forExistingMixin: mixin <Mixin> = (
"
Builders do not give an ordinary mirror representing their current state: ask the builder itself. (Although this could be done: submit to atomic install without a namespace, don't install into Smalltalk, don't update the existingMixin, and reflect on the result.)

Builders internally keep a CompiledMixinMirror that reflects the current state, including edits made but not yet installed. Queries reflect the state of this CMM.

Builders are connected up and down.  If you get a builder on a declaration, if you ask *the builder* for an enclosing or nested declaration and edit, installing any of them means installing all of them.  Builders created de novo (via reflecting: or fromSource:) remain independent.
"|
	"Used to create the namespace for AtomicInstall so existing instances are updated"
	prvtExistingMixin <Mixin | nil> = mixin.

	"Lazy.  It should not be neccessary to always unpack an entire module definition.
	Perhaps this should be eager to complete creating-a-builder-is-like-forking semantics."
	prvtEnclosingDeclaration <ClassDeclarationBuilder>
	
	"Eager. Simplifies CDB on installed CD versus new CD.  This must be computed anyway to install."
	public instanceSide <MixinBuilder> = MixinBuilder 
		forClassDeclaration: self
		lowLevelMixin: rep first lowLevelMirror
		withNestedReps: rep last.
		
	public classSide <MixinBuilder> = MixinBuilder 
		forClassDeclaration: self
		lowLevelMixin: rep first lowLevelMirror classMixin
		withNestedReps: {}.
	
	prvtCompiledMixinMirror <CompiledMixinMirror> = rep first.
	
	public header <ClassHeaderBuilder> = ClassHeaderBuilder forClassDeclaration: self.
|)
('API'
enclosingClass ^<ClassDeclarationBuilder> = (
	prvtEnclosingDeclaration ifNil: [
		| enclosing <Mixin> |
		
		prvtExistingMixin isNil ifTrue: [^nil].
		
		enclosing:: prvtExistingMixin enclosingMixin.
		enclosing ifNil:[^nil].
		
		prvtEnclosingDeclaration:: ClassDeclarationBuilder reflecting: enclosing.
		
		prvtEnclosingDeclaration instanceSide nestedClasses addMirror: self
	].
	^prvtEnclosingDeclaration
)
fullyQualifiedName ^<Symbol> = (
	^prvtCompiledMixinMirror name
)
headerFromSource: newHeader <String> = (
	|
	compiledResults <MixinRep>
	|
	
	#BOGUS yourself.
	"API:
		<ClassDeclarationBuilder> headerFromSource:
		vs
		<ClassDeclarationBuilder> header source:
	
	Semantics: Do we allow the name to be changed? If so:	
		Have to check for conflicts with methods/slots of enclosing.
		If it conflicts with another class, override it?
		If it is new, does this make a copy, or replace the old one?
		
		Currently, this takes 'Foo = ()' instead of 'class Foo = ()'.  Perhaps we should do the latter since an access modifier might be specified?
	"
	compiledResults:: compiler compileClassHeader: ('Newspeak3 ''', header category, ''' class ', newHeader) readStream of: self.

	lazyIsTopLevel ifTrue: [
		"Result directly corresponds to me"
		checkForSlotConflicts: compiledResults first.
		checkForNameChange: compiledResults first.
		prvtCompiledMixinMirror: compiledResults first.
	] ifFalse: [
		"Result corresponds to my enclosing class, since my slot/accessor may have been adjusted"
		| newRep <MixinRep> = onlyElementOf: compiledResults last. |
		checkForSlotConflicts: newRep first.
		checkForNameChange: newRep first.
		enclosingClass prvtCompiledMixinMirror: compiledResults first.	
		prvtCompiledMixinMirror: newRep first.
	].
)
install ^<ClassDeclarationMirror> = (
	|
	reps <List[MixinRep]>
	existingMixinMap <IdentityMap[MixinRep,Mixin]>
	mixinResults <List[Mixin]>
	|
	prvtEnclosingDeclaration ifNotNil: [
		"Modifications were made to my enclosing class, must go up to really install."
		prvtEnclosingDeclaration install.
		assert: [reflectee notNil] 
			message: 'Reflectee should have been filled in after install'.
		^ClassDeclarationMirror reflecting: reflectee
	].
 
	
	existingMixinMap: IdentityDictionary new.
	reps: {collectMixinRepInto: existingMixinMap}.

	mixinResults:: atomicInstaller install: reps withExistingMixins: existingMixinMap.
	
	"Fill-in reflectees for builders that were created from source"
	self extractReflecteeFrom: (onlyElementOf: mixinResults).

	"Notify those listening on the mirrors' Ducts (the IDE)"
	self notifyExistingMirrors. 
	
	"Notify those listening for Squeak change nofitications (background source saver, VCS image source mirror cache)"
	SystemChangeNotifier uniqueInstance
		classDefinitionChangedFrom: reflectee definingClass
		to: reflectee definingClass.
	
	assert: [reflectee notNil] message: 'Reflectee should have been filled in after install'.
	^ClassDeclarationMirror reflecting: reflectee
)
name ^<Symbol> = (
	^self fullyQualifiedName
)
reflectee ^<Mixin | nil> = (
	#BOGUS yourself.
	"If this builder corresponds to a class declaration that was already installed, we're okay. But this builder might represent a new class declaration that doesn't have a corresponding Mixin yet (#install will ensure it is filled, though). So, do we return a potentially nil reflectee or not support accessing a reflectee at all?"
	
	^prvtExistingMixin
)
simpleName ^<Symbol> = (
	^fullyQualifiedNameToSimple: fullyQualifiedName
)'as yet unclassifed'
printOn: stm = (
	stm nextPutAll: 'ClassDeclarationBuilder:'; nextPutAll: fullyQualifiedName
)'private'
checkForNameChange: newCompiledMixinMirror = (
	
	newCompiledMixinMirror name = self name ifFalse: [Error signal: 'Cannot change name this way'].
)
checkForSlotConflicts: newCompiledMixinMirror = (
	
	newCompiledMixinMirror lowLevelMirror instVars do: [:each <InstanceVariableMirror> | instanceSide checkNameConflictsForSlot: each name].
)
collectMixinRepInto: dict <IdentityMap[MixinRep,Mixin]> ^<MixinRep> = (
	| rep |
	rep: {
		prvtCompiledMixinMirror.
		instanceSide nestedClasses collect: [:ea | ea collectMixinRepInto: dict].
	}.
	prvtExistingMixin ifNotNil: [dict at: rep put: prvtExistingMixin].
	^rep
)
compiledMixinMirror = (
	"Asked for by compiler"
	^prvtCompiledMixinMirror
)
extractReflecteeFrom: mixin <Mixin> = (

	"For builders that already had a non-nil reflectee, this is not necessary since the old reflectee has been become:d to the new one (at least if atomic install is working right...).  But this is required for builders that have been created from source and didn't have a reflectee yet.  This will connect them to their reflectees."

	prvtExistingMixin:: mixin.
	
	mixin nestedMixins keysAndValuesDo: [:fullName :nestedMixin |
		| n m |
		n:: fullyQualifiedNameToSimple: fullName.
		m:: instanceSide nestedClasses findMirrorNamed: n.
		m extractReflecteeFrom: nestedMixin
	].
)
lazyIsTopLevel = (

	prvtEnclosingDeclaration isNil ifFalse: [^false].
	
	"enclosingDeclaration not yet created"
	prvtExistingMixin isNil ifTrue: [^true "can't be created: must be new decl"].
	^prvtExistingMixin enclosingMixin isNil
)
notifyExistingMirrors = (
	instanceSide notifyExistingMirrors.
	classSide notifyExistingMirrors.
)'testing'
isClassDeclarationMirror ^<Boolean> = (
	^true
)) : ('accessing'
fromSource: src <String> ^<ClassDeclarationBuilder> = (
	^self fromUnitSource: 'Newspeak3 ''Uncategorized'' ', src
)'as yet unclassified'
fromUnitSource: src <String> ^<ClassDeclarationBuilder> = (
	| rep <MixinRep> |
	rep:: compiler
		compileClassSource: src readStream
		within: nil.
	^self fromMixinRep: rep forExistingMixin: nil
)
reflecting: mixin <Mixin> ^<ClassDeclarationBuilder> = (
	assert: [mixin isMixin & mixin isMeta not] message: 'Provide an instance-side mixin'.
	^self 
		fromMixinRep: (mixinRepFor: mixin)
		forExistingMixin: mixin
))
class ClassDeclarationMirror reflecting: mixin <Mixin> = Mirror reflecting: mixin (
"A class declaration defines the instance and class sides, and a header. Each side comprises methods and nested classes. The header provides a superclass clauses, a primary factory a class comment and an instance initializer.  

This mirror provides a view of a class declaration based on its runtime representation in the Newspeak image running on Squeak. To create an instance, provide the instance-side mixin. The mirror can obtain all necessary information from that."|
	instanceSideLazy
	classSideLazy
|assert: [mixin isMixin & mixin isMeta not] message: 'Provide an instance-side mixin')
('API'
classSide ^ <MixinMirror> = (
	classSideLazy ifNil: [
		classSideLazy:: MixinMirror reflecting: reflectee classMixin].
	^classSideLazy
)
enclosingClass ^ <ClassDeclarationMirror> = (
	| enclosing <Class> |
	enclosing:: reflectee enclosingMixin. 
	enclosing ifNil:[^nil].
	^ClassDeclarationMirror reflecting: enclosing mixin
)
fullyQualifiedName ^ <Symbol> = (
	^reflectee definingClass name
)
header ^ <ClassHeaderMirror> = (
	^ClassHeaderMirror reflecting: reflectee
)
instanceSide ^ <MixinMirror> = (
	instanceSideLazy ifNil: [
		instanceSideLazy:: MixinMirror reflecting: reflectee].
	^instanceSideLazy
)
name ^ <Symbol> = (
	^self fullyQualifiedName
)
simpleName ^ <Symbol> = (
	^fullyQualifiedNameToSimple: fullyQualifiedName
)
source ^ <String> = (
	^String streamContents: [ :s | reflectee printClassOn: s ]	
)'restricted'
compiledMixinMirror = (
	"Used by the compiler.  Polymorphic with ClassDeclarationBuilder, which must answer the one that represents edits in progress."
	^makeCompiledMixinMirrorForMixin: reflectee
)'testing'
isClassDeclarationMirror ^<Boolean> = (
	^true
))
class ClassHeaderBuilder forClassDeclaration: decl = (
"Describe the class in this comment."|
	prvtDeclaration <ClassDeclarationBuilder> = decl.
|)
('as yet unclassified'
category ^<Symbol> = (
	^prvtDeclaration prvtCompiledMixinMirror category ifNil: ['Uncategorized']
)
category: c <Symbol | String> = (
	prvtDeclaration prvtCompiledMixinMirror category: c asSymbol
)
name ^<Symbol> = (
	"Is this full or simple?"
	^prvtDeclaration name
)
name: newSimpleName <Symbol> = (
	|
	token
	newHeaderSource
	compiledResults <MixinRep>
	|

	"check for name conflict with sibling members"
	prvtDeclaration lazyIsTopLevel ifFalse: [
		| existing |
		existing:: prvtDeclaration enclosingClass instanceSide nestedClasses findMirrorNamed: newSimpleName.
		(existing isNil or: [existing = prvtDeclaration])
			ifFalse: [Error signal: 'A sibling already exists with the name ',newSimpleName].

		"remove old accessors"
		prvtDeclaration enclosingClass instanceSide nestedClasses
			removeSlotAndAccessorOf: prvtDeclaration.
	].


	"patch header source with the new name"
	token:: (grammar TypedNS3Grammar new classHeader parse: source readStream) first.
	newHeaderSource:: 
		(source copyFrom: 1 to: token start - 1) , 
		newSimpleName , 
		(source copyFrom: token end + 1 to: source size).


	"compile etc"

	compiledResults:: compiler 
		compileClassHeader: ('Newspeak3 ''', category, ''' class ', newHeaderSource) readStream
		of: prvtDeclaration.	
	
	prvtDeclaration lazyIsTopLevel ifTrue: [
		"Result directly corresponds to me"
		prvtDeclaration checkForSlotConflicts: compiledResults first.
		prvtDeclaration prvtCompiledMixinMirror: compiledResults first.
	] ifFalse: [
		"Result corresponds to my enclosing class, since my slot/accessor may have been adjusted"
		| newRep <MixinRep> = onlyElementOf: compiledResults last. |
		prvtDeclaration checkForSlotConflicts: newRep first.
		prvtDeclaration enclosingClass prvtCompiledMixinMirror: compiledResults first.	
		prvtDeclaration prvtCompiledMixinMirror: newRep first.
	].
)
primaryFactory ^ <MethodBuiler> = (

	| lowLevelMethodMirror |

	lowLevelMethodMirror:: prvtDeclaration prvtCompiledMixinMirror lowLevelMirror classMixin methods mirrors
		detect: [:mirror | mirror isConstructor].

	^MethodBuilder reflecting: lowLevelMethodMirror in: prvtDeclaration classSide
)
source ^<String> = (
	^prvtDeclaration prvtCompiledMixinMirror header
)
source: newHeaderSource <String> = (
	prvtDeclaration headerFromSource: newHeaderSource
))
class ClassHeaderMirror reflecting: mixin <Mixin> = Mirror reflecting: mixin ("A class header defines the class' name, primary factory, superclass clause, class comment and instance initializer (slots and init expressions).

This mirror provides access to a class header based on the runtime representation.")
('API'
category ^ <Symbol> = (
	^reflectee category
)
classComment ^ <String> = (
	^reflectee classComment
)
declaration ^<ClassDeclarationMirror> = (
	^ClassDeclarationMirror reflecting: self reflectee
)
primaryFactory ^ <MethodMirror> = (

	^MethodMirror reflecting: (reflectee classMixin
		methodDict at: primaryFactoryName)
)
source ^ <String> = (
	^ reflectee cachedHeaderSource
)'as yet unclassified'
name ^ <Symbol> = (
	^reflectee name
)
preamble ^<Symbol> = (
	"Foo factory = SuperFoo superFactory"
	| headerAst |
	headerAst:: Language newspeak3 parserInstance classHeader parse: self source readStream.
	^source copyFrom: headerAst start to: headerAst superConstructorCall end
)
primaryFactoryName ^ <Symbol> = (
	^reflectee cachedConstructorName
)
slotDecls ^ <MirrorGroup[SlotDefMirror]> = (
	
	^self slots
)
slots ^ <MirrorGroup[SlotDefMirror]> = (
	
	"Need also visibility, mutablity of each"
	^ImmutableMirrorGroup group: 
		((reflectee instVarNames
			reject: [:ea | ea includes: $`]) 
				collect: [:ea | SlotMirror named: ea])
)
superclassClause ^ <SendAST> = (
	self halt.
	^(SystemMetadata definingClassMetadataOf: reflectee definingClass) superclassClause
))
class ClassMirror reflecting: c <Class> = Mirror reflecting: c (
"WIP. New mirror for classes.  Does just what we need for porting the parser library.

Copyright (c) 2009-2010 Gilad Bracha

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the ''Software''), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
"|

|)
('as yet unclassified'
allSuperclasses ^ <List[ClassMirror]> = (
	| klass <Class> superclasses <List[Class]> |
	superclasses:: MutableList new.
	klass:: superclass.
	[klass isNil] whileFalse:[
		superclasses add: klass.
		klass:: klass superclass.
	].
	^superclasses
)
canUnderstand: selector <Symbol> ^<Boolean> = (
	
	(mixin canUnderstand: selector) ifTrue: [^true].
	superclass = nil
		ifTrue: [^false]
		ifFalse: [^superclass canUnderstand: selector].
)
computeMirrorGroup: mgAccessor <[Mirror, ^MirrorGroup]> ^ <MirrorGroup> = (
"Return a mirror group based on the mixins group and those of all superclasses. The argument mgAccessor extracts a mirror group from any mirror provided to it."
	| mg <MirrorGroup>  |
	
	mg:: MutableMirrorGroup group:{} within: self.
	(allSuperclasses reverse add: self; yourself) do:[:klass <ClassMirror> |
		mg addAllMirrors: (mgAccessor value: klass mixin)
	].
	^ ImmutableMirrorGroup group: mg	
)
enclosingObject ^ <ObjectMirror> = (
	^SystemMetadata enclosingObjectOf: reflectee
)
methods ^ <MirrorGroup[MethodMirror]> = (
	^computeMirrorGroup: [:r | r methods]
)
mixin ^ <MixinMirror> = (

	^MixinMirror reflecting: reflectee mixin
)
name ^ <Symbol> = (
	^reflectee name
)
nestedClasses ^ <MirrorGroup[ClassDeclarationMirror]> = (
	^computeMirrorGroup: [:r | r nestedClasses]
)
simpleName ^ <Symbol> = (

	^ mixin simpleName
)
slots ^ <MirrorGroup[SlotMirror]> = (
	^computeMirrorGroup: [:r | r slots].
)
superclass ^ <ClassMirror> = (
	reflectee superclass isNil ifTrue:[^nil].
	^ClassMirror reflecting: reflectee superclass
))
class ImmutableMirrorGroupInMixin group: mirrorz in: mixinMirror = ImmutableMirrorGroup group: mirrorz (|
	public enclosingMixin <MixinMirror> = mixinMirror.
	public channelForChanges <Duct> = Duct new.
|channelForChanges beWeak owner: self)
('private'
private notifyAddedMirror: newMirror = (
	channelForChanges send: (MirrorAddedEvent forNewMirror: newMirror)
)
private notifyRemovedMirror: oldMirror = (
	channelForChanges send: (MirrorRemovedEvent forOldMirror: oldMirror)
)
private notifyReplacedMirror: oldMirror with: newMirror = (
	channelForChanges send: (MirrorReplacedEvent from: oldMirror to: newMirror)
)'restricted'
updateToContain: actualMirrors <Collection[Mirror]> = (
	

	|
	mirrorNames
	|
	"'update' out.
	mirrors out.
	'->' out.
	actualMirrors out."

	mirrorNames:: actualMirrors collect: [:newMirror |
		| oldMirror |
		oldMirror:: findMirrorNamed: newMirror simpleName.
		oldMirror == nil ifTrue: [
			mirrors addLast: newMirror.
			notifyAddedMirror: newMirror.
		] ifFalse: [
			oldMirror = newMirror ifTrue: [
				"Unchanged"
			] ifFalse: [
				mirrors at: (mirrors indexOf: oldMirror) put: newMirror.
				notifyReplacedMirror: oldMirror with: newMirror.
			]
		].
		newMirror simpleName.
	].

	mirrors copy do: [:oldMirror |
		(mirrorNames includes: oldMirror simpleName) ifFalse: [
			mirrors remove: oldMirror.
			notifyRemovedMirror: oldMirror.
		].
	].
))
class MessageMirror selector: s <Symbol> args: as <List[Object]> = (
"Reifies the notion of a message, per the Newspeak specification. This is what should actually be sent to doesNotUnderstand:"|
	selector <Symbol>= s.
	arguments <List[Object]> = as.
|)
('as yet unclassified'
sendTo: r <Object> ^ <Object> = (
	^r perform: selector with: arguments
))
class MethodBuilder reflecting: llm in: mb = (
"Describe the class in this comment."|
	prvtLowLevelMethodMirror = llm.
	prvtMixinBuilder = mb.
|)
('as yet unclassified'
category ^<Symbol> = (
	^prvtLowLevelMethodMirror metadata at: #category
)
category: cat <String | Symbol> = (
	^prvtLowLevelMethodMirror metadata at: #category put: cat asSymbol
)
definingMixin ^<MixinBuilder> = (
	^prvtMixinBuilder
)
name ^<Symbol> = (
	^prvtLowLevelMethodMirror selector
)
reflectee ^<CompiledMethod> = (
	#BOGUS yourself.
	"Poorly defined: If this a new method, the compiled method retrieved from the low level method would not be able to answer with its source.  This is because in Squeak, the compiled method has to ask for it from its class, which will fail if the method is not yet installed. Perhaps it would be better to not give access to this."
	"^lowLevelMethodMirror compiledMethod"
	FAIL.
)
selector ^<Symbol> = (
	^name
)
simpleName ^<Symbol> = (
	^name
)
source ^<String> = (
	^prvtLowLevelMethodMirror method 
		ifNil: [prvtLowLevelMethodMirror src]
		ifNotNil: [:it | it getSource]
))
class MethodMirror reflecting: m <CompiledMethod> = Mirror reflecting: m (
"A basic mirror for a language level method.")
('as yet unclassified'
category ^<Symbol> = (
	^reflectee methodClass organization categoryOfElement: name
)
definingMixin ^<MixinMirror> = (
	^MixinMirror reflecting: reflectee methodClass mixin
)
name ^<Symbol> = (
	^reflectee selector
)
simpleName = (
	^ name
)
source ^<String> = (
	^reflectee getSource asString
)
visibility ^<Symbol> = (
	#BOGUS yourself.  "Is the NS3 compiler setting this info?  Not that the VM respects it yet anyway..."
	reflectee isProtected ifTrue: [^#protected].
	reflectee isPrivate ifTrue: [^#private].
	^#public
))
class Mirror reflecting: r <Object> = (
"Top of the Mirror hierarchy. An abstract class.  

Copyright (c) 2009-2010 Gilad Bracha

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the ''Software''), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

"|
	reflectee <Object> = r.
|)
('as yet unclassified'
= other = (
	^self class = other class and: [self reflectee == other reflectee]
)
hash = (
	^ reflectee identityHash
)
isMirror ^<Boolean> = (
	^true
)
printOn: stm = (
	stm	nextPutAll: class simpleName.
	stm	nextPutAll: ' reflecting: '.
	reflectee printOn: stm.
)
reflecteeIfFail:  fblk <[Exception]> ^ <Object>  = (
	^reflectee "default; we can always access the reflectee of a local object; subclasses may override if there are issues"
))
class MirrorAddedEvent forNewMirror: m = MirrorEvent (
"Sent by a mirror group on its channelForUpdates when a new mirror has been added."|
	public newMirror = m.
|)
('as yet unclassified'
isMirrorAddedEvent ^<Boolean> = (
	^true
))
class MirrorEvent = (
""|
|)
('testing'
isMirrorEvent ^<Boolean> = (
	^true
))
class MirrorRemovedEvent forOldMirror: m = MirrorEvent (
"Sent by a mirror group on its channelForUpdates when an existing mirror has been removed."|
	public oldMirror = m.
|)
('as yet unclassified'
isMirrorRemovedEvent ^<Boolean> = (
	^true
))
class MirrorReplacedEvent from: oldM to: newM = MirrorEvent (
"Sent by a mirror group on its channelForUpdates when an existing mirror has been replaced by a new mirror."|
	public oldMirror = oldM.
	public newMirror = newM.
|)
('as yet unclassified'
isMirrorReplacedEvent ^<Boolean> = (
	^true
))
class MixinBuilder forClassDeclaration: cbd lowLevelMixin: llm withNestedReps: reps = (
"The mirror builder for mixins.  See MixinMirror."|
	public declaration <ClassDeclarationBuilder> = cbd.
	public isMeta <Boolean> = llm isMeta.
	public methods <MutableMethodGroup> = MutableMethodGroup group: (methodsFrom: llm) within: self.
	public nestedClasses <MutableNestedClassGroup> = MutableNestedClassGroup group: (nestedClassesFrom: reps) within: self.
|)
('accessing'
canUnderstand: selector <Symbol> ^<Boolean> = (
	
	"Slot, method, nested class, or factory method"
	
	(methods includesMirrorNamed: selector) ifTrue: [^true].
	(nestedClasses includesMirrorNamed: selector) ifTrue: [^true].
	(slots includesMirrorNamed: selector) ifTrue: [^true].
	(selector last = $:) ifTrue: [
		#BOGUS. "Someday immutable slots will be enforced and this won't be quite right"
		(slots includesMirrorNamed: (selector allButLast: 1)) ifTrue: [^true].
	].
	isMeta ifTrue: [
		declaration header primaryFactory simpleName = selector ifTrue: [^true].
	].
	^false
)
slots ^ <ImmutableMirrorGroup[SlotMirror]> = (
	| slotMirrors <Collection[SlotMirror]> | 
	isMeta ifTrue: [ slotMirrors:: {} ] ifFalse: [
		slotMirrors:: (declaration prvtCompiledMixinMirror lowLevelMirror instVars 
			collect: [:each <InstanceVariableMirror> | SlotMirror named: each name])
				reject: [:each <SlotMirror> | each name includes: $`].
	].
	^ImmutableMirrorGroup group: slotMirrors
)'private'
checkNameConflictsForMethod: selector <Symbol> = (
	(nestedClasses includesMirrorNamed: selector)
		ifTrue:[^Error signal: 'Class already has nested class named ', selector].
	(slots includesMirrorNamed: selector)
		ifTrue:[^Error signal: 'Class already has slot named ', selector].
	isMeta ifTrue: [declaration header primaryFactory simpleName = selector 
		ifTrue:[^Error signal: 'Class already has primary factory named ', selector]].
)
checkNameConflictsForNestedClass: klassName <Symbol> = (
	(methods includesMirrorNamed: klassName)
		ifTrue:[^Error signal: 'Class already has method named ', klassName].
	(slots includesMirrorNamed: klassName)
		ifTrue:[^Error signal: 'Class already has slot named ', klassName]	
)
checkNameConflictsForSlot: slotName <Symbol> = (
	(nestedClasses includesMirrorNamed: slotName) 
		ifTrue:[^Error signal: 'Class already has nested class named ', slotName].		
	(methods includesMirrorNamed: slotName)
		ifTrue:[^Error signal: 'Class already has method named ', slotName]
)
methodsFrom: llm <LowLevelMixinMirror> ^<List[MethodBuilder]> = (
	^(llm methods 
		select: [:m <LowLevelMethodMirror> | m isSynthetic not])
			collect: [:m <LowLevelMethodMirror> | MethodBuilder reflecting: m in: self]
)
nestedClassesFrom: reps <List[MixinRep]> ^<List[ClassDeclarationBuilder]> = (
	^reps collect: [:rep <MixinRep> | | nc |
		
		nc:: (ClassDeclarationBuilder fromMixinRep: rep forExistingMixin: nil).
		nc prvtEnclosingDeclaration: declaration.
		
		"The existingMixin will be nil if this is a new (uninstalled) class declaration."
		declaration reflectee ifNotNil: [:mixin |
			| nestedMixin |
			nestedMixin:: mixin nestedMixins at: nc name.
			nc prvtExistingMixin: nestedMixin.
		].
		
		nc
	]
)
notifyExistingMirrors = (
	isMeta
		ifTrue: [mixinChanged: declaration reflectee classMixin]
		ifFalse: [mixinChanged: declaration reflectee].

	nestedClasses do: [:ea | ea notifyExistingMirrors].
)) : ('as yet unclassified'
reflecting: mixin <Mixin | ClassMixin> ^<MixinBuilder> = (
	^mixin isMeta
		ifTrue: [(ClassDeclarationBuilder reflecting: mixin definingClass theNonMetaClass mixin) classSide]
		ifFalse: [(ClassDeclarationBuilder reflecting: mixin) instanceSide]
))
class MixinMirror reflecting: m <Mixin> = Mirror reflecting: m (
"A mixin is the difference between a class and its superclass: a set of additional methods, slots and nested class declarations.  Newspeak class declarations define an instance-side mixin and a class-side mixin, and Newspeak classes (other than Top) are all the result of mixin application.

What about mirroring the initializer?
Need to decide who does these things - the class declaration mirror or the mixin mirror. One should delegate to the other."|
	slotsLazy
	methodsLazy 
	nestedClassesLazy 
|mixinBasedMirrors add: self)
('accessing'
applications ^<Set[ClassMirror]> = (

	^reflectee applications collect: [:ea | ClassMirror reflecting: ea]
)
canUnderstand: selector <Symbol> ^<Boolean> = (
	
	"Slot, method, nested class, or factory method"
	
	(methods includesMirrorNamed: selector) ifTrue: [^true].
	(nestedClasses includesMirrorNamed: selector) ifTrue: [^true].
	(slots includesMirrorNamed: selector) ifTrue: [^true].
	(selector last = $:) ifTrue: [
		#BOGUS. "Someday immutable slots will be enforced and this won't be quite right"
		(slots includesMirrorNamed: (selector allButLast: 1)) ifTrue: [^true].
	].
	isMeta ifTrue: [
		declaration header primaryFactory simpleName = selector ifTrue: [^true].
	].
	^false
)
declaration ^ <ClassDeclarationMirror> = (
	^ClassDeclarationMirror 
		reflecting: (isMeta ifFalse:[reflectee] ifTrue:[reflectee instanceMixin]) 
)
isMeta ^ <Boolean> = (
	^self reflectee isMeta
)
isMixinMirror ^<Boolean> = (
	^true
)
methods ^ <MirrorGroup[MethodMirror]> = (
	methodsLazy ifNil: [
		methodsLazy:: ImmutableMirrorGroupInMixin group: computeMethods in: self].
	^methodsLazy
)
name ^ <Symbol> = (
	^reflectee name
)
nestedClasses ^ <MirrorGroup[ClassDeclarationMirror]> = (
	nestedClassesLazy ifNil: [
		nestedClassesLazy:: ImmutableMirrorGroupInMixin group: computeNestedClasses in: self].
	^nestedClassesLazy
)
simpleName ^ <Symbol> = (

	^reflectee simpleName
)
slots ^ <MirrorGroup[SlotMirror]> = (
	slotsLazy ifNil: [
		slotsLazy:: ImmutableMirrorGroupInMixin group: computeSlots in: self].
	^slotsLazy
)'as yet unclassified'
classMixin ^ <MixinMirror> = (
	#BOGUS yourself.
	isMeta 
		ifFalse:[^MixinMirror reflecting: reflectee classMixin]
		ifTrue:[^MixinMirror reflecting: Metaclass mixin].
		"This would be true in a pure Newspeak system, but not on our implementation"
)
computeMethods ^ <Collection[MethodMirror]> = (

	^(reflectee methodDictionary values
		collect: [:each <CompiledMethod> | MethodMirror reflecting: each])
			reject: [:each <MethodMirror> | each reflectee isSynthetic].
)
dualMixin ^ <MixinMirror> = (
	isMeta 
		ifTrue:[^MixinMirror reflecting: reflectee instanceMixin]
		ifFalse:[^classMixin].
)'private'
computeNestedClasses ^<Collection[ClassDeclarationMirror]> = (
	| metadata |
	isMeta ifTrue: [^{}].

	^reflectee nestedMixins values 
		collect: [:each | ClassDeclarationMirror reflecting: each]
)
computeSlots ^ <Collection[SlotMirror]> = (

	^(reflectee instVarNames 
		reject: [:iv <String> | iv includes: $`])
			collect: [:iv <String> | SlotMirror named: iv].
)'restricted'
mixinChanged = (
	slotsLazy ifNotNil: [:it | it updateToContain: computeSlots].
	methodsLazy ifNotNil: [:it | it updateToContain: computeMethods].
	nestedClassesLazy ifNotNil: [:it | it updateToContain: computeNestedClasses].
))
class MutableMethodGroup group: mirrors within: mb = MutableMirrorGroup group: mirrors within: mb (
""|
|)
('accessing'
addFromSource: s <String> = (
	| 
	result <LowLevelMethodMirror>
	cat
	newM
	|
	result:: compiler
		compileMethodSource: s readStream 
		within: enclosingMixin declaration.
	
	cat:: (findMirrorNamed: result simpleName)
		ifNil: [#'as yet unclassified']
		ifNotNil: [:oldMirror | oldMirror category].
	
	result metadata at: #category put: cat.
	"Category must be set or it will think it's synthetic and lose the source"
	
	newM:: MethodBuilder reflecting: result in: enclosingMixin.
	addMirror: newM.
	^newM
)
addMirror: m <MethodBuilder>= (
	
	"What would it mean if a user of builders called this?  A MethodMirror would need to be converted to a MethodBuilder.  A MethodBuilder that already is a member of another method group may need to be copied."
	
	enclosingMixin checkNameConflictsForMethod: m name.
	
	super addMirror: m.
	lowLevelMixin methods addMirror: m prvtLowLevelMethodMirror.
	^m
)
removeMirror: m = (

	super removeMirror: m.
	lowLevelMixin methods removeMirror: m prvtLowLevelMethodMirror.
)'private'
lowLevelMixin = (
	"Cannot cache from instantiation: might be replaced by editing class header or add/remove nested class."	
	^enclosingMixin isMeta
		ifTrue: [enclosingMixin declaration compiledMixinMirror lowLevelMirror classMixin]
		ifFalse: [enclosingMixin declaration compiledMixinMirror lowLevelMirror].
))
class MutableMirrorGroup group: ms within: mb = ImmutableMirrorGroup group: ms (
"A mirror group for high level mirrors. Takes base level elements as arguments to be added, and supports a notion of ordering, so that source declaration ordering can be preserved.

A MutableMirrorGroup knows about its enclosing mirror, because it supports adding members in source form via the #addFromSource: abstract method, which is specialized by subclasses. The source must be compiled, and that requires the enclosing mirror to provide the necessary surrounding scope.
"| 
	public enclosingMixin <MixinBuilder> = mb.	"definingMixin?"
|)
('as yet unclassified'
addAllMirrors: mirrorGroup <MirrorGroup | Collection[Mirror]> = (
	mirrorGroup do: [:each | addMirror: each]
)
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
)
mirrors ^ <MutableHashedMap[Mirror]> = (
" mirrors is also an outer scope slot; we define this method to ensure we get the inherited one."
	^super mirrors
)
removeAll = (
	mirrors: MutableList 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].
))
class MutableNestedClassGroup group: mirrors within: mb = MutableMirrorGroup group: mirrors within: mb (
""|
|)
('accessing'
addFromSource: source <String> ^<ClassDeclarationBuilder> = (
	|
	enclosingDeclaration
	compiledResults <MixinRep>
	nestedReps
	newCDB
	|
	enclosingDeclaration:: enclosingMixin declaration.
	
	compiledResults:: compiler 
		compileClassSource: ('Newspeak3 ''', enclosingDeclaration header category, ''' ', source) readStream
		within: enclosingDeclaration.
		
	enclosingDeclaration prvtCompiledMixinMirror: compiledResults first.
	nestedReps:: compiledResults last.
	
	assert: [nestedReps size = 1] message: 'Does it only answer with me and not my siblings?'.
	
	newCDB:: ClassDeclarationBuilder fromMixinRep: nestedReps first forExistingMixin: nil.
	newCDB prvtEnclosingDeclaration: enclosingDeclaration.
		
	addMirror: newCDB.
	^newCDB
)
addMirror: m <ClassDeclarationBuilder> = (

	#BOGUS yourself.
	"What would it mean if a user of builders called this?  A ClassDeclarationMirror would need to be converted to a ClassDeclarationBuilder.  A ClassDeclarationBuilder that already has an enclosing class different than this group's would need to be deep copied."

	enclosingMixin checkNameConflictsForNestedClass: m simpleName.
	super addMirror: m.
	^m
)'as yet unclassified'
removeMirror: victim <ClassDeclarationBuilder> = (
	|
	victimName
	sep
	|
	"Must patch the enclosing class of the victim"
	removeSlotAndAccessorOf: victim.
	
	super removeMirror: victim.
)
removeSlotAndAccessorOf: victim <ClassDeclarationBuilder> = (
	|
	victimName
	sep
	|
	victimName: victim fullyQualifiedName.
	sep:: Language newspeak3 syntheticNameSeparator.
	lowLevelMixin methods removeMirrorNamed: victimName,sep,'slot'.
	lowLevelMixin methods removeMirrorNamed: victimName,sep,'slot:'.
	lowLevelMixin methods removeMirrorNamed: victim simpleName.
	lowLevelMixin instVars removeMirrorNamed: victimName,sep,'slot'.
	
	"Indices can change if the victim's slot is not the last one"
	compiler generateSlotAccessorsFor: lowLevelMixin.
)'private'
lowLevelMixin = (
	"Cannot cache from instaniation: might be replaced by editing class header or add/remove nested class."
	^enclosingMixin isMeta
		ifTrue: [enclosingMixin declaration compiledMixinMirror lowLevelMirror classMixin]
		ifFalse: [enclosingMixin declaration compiledMixinMirror lowLevelMirror].
))
class ObjectMirror reflecting: r <Object> = Mirror reflecting: r (
"A high level mirror on local objects. The API for a Newspeak object mirror is exceedingly simple. One can view or change its reflectee's class; one can send the reflectee a message; one can set the reflectee's slots; and one can request access to the reflectee.  We may later extend this with printing/safe printing, the ability to execute an arbitrary method on the reflectee, or generalized super-object access.

All of this is realized in methods of this class, except reflectee access which is inherited.

Note that there is no need to get slots - we can send a message to do that.  However, for the time being we support that as well, as there is no way to access overridden features.

The differences between #perform: on an object and a mirror are:

1. The mirror can perform private messages.
2. The mirror forces the user to deal with possible failure.
3. The result is also a mirror.

We may choose to refactor the implementation so that all the work is done by a NewspeakObjectMirorUtility. The idea is that in cases where many objects are involved, it is wasteful to allocate a dedicated mirror per object. Instead,  the utility can be shared across all the objects. This works as long as we are prepared to give out a global authority to mirror all objects; if we want fine grain security, we need a capability per object.

Copyright (c) 2009-2010 Gilad Bracha

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the ''Software''), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

")
('as yet unclassified'
evaluate: expression <String> ^<ObjectMirror> = (
	
	| cls mxn mtdMirror result |
	cls:: vmmirror classOf: reflectee.
	mxn:: MixinMirror reflecting: cls mixin.
	mtdMirror:: compiler
		compileExpressionSource: expression readStream
		inContext: nil
		inMixin: mxn declaration. 
		
	mtdMirror metadata at: #category put: 'DoIts'.
	mtdMirror klass: cls.
	
	result:: vmmirror 
		object: reflectee 
		executeMethod: mtdMirror compiledMethod
		with: {}
		ifFail: [primitiveFailed].

	^ObjectMirror reflecting: result
)
getClassIfFail:  fblk <[Exception]> ^ <ClassMirror>  = (
	^ClassMirror reflecting: (vmmirror classOf: reflectee)  "never fails on local objects"
)
getSlot: slotName <Symbol> ifFail:  fblk <[Exception, ^R def]> ^ <ObjectMirror | R> = (
	^self class reflecting: ( vmmirror
		namedSlotOf: reflectee
		at: (reflectee class instVarIndexFor: slotName)
		ifFail: fblk
	)
)
perform: selector <Symbol> with:  args <Array[Object]> ifFail:  fblk <[Exception]>  ^ <ObjectMirror> = (
	| result <Object> |
	result:: [reflectee perform: selector withArguments: args] on: Error do: [:ex <Error> | ^fblk value: ex].
	^self class reflecting: result
)
setClass: klass <Class | ClassMirror> ifFail:  fblk <[Exception]> ^ <ClassMirror>  = (
	vmmirror changeClassOf: reflectee to: klass ifFail: fblk
)
setSlot: slotName <Symbol> to:  obj <Object> ifFail:  fblk <[Exception]> = (
	vmmirror
		namedSlotOf: reflectee
		at: (reflectee class instVarIndexFor: slotName)
		put: obj
		ifFail: fblk
))
class SlotMirror named: n <String> = Mirror reflecting: n (
"WIP. Just enough to get us going.

Copyright (c) 2009-2010 Gilad Bracha

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the ''Software''), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.")
('as yet unclassified'
isMutable = (
	"Used by compiler in scope building"
	^true
)
name ^ <String> = (
	#BOGUS yourself.
	^reflectee
)
simpleName = (

	^ name
)
source = (
	^name
))'as yet unclassified'
compiler ^ <Newspeak3Compilation Compiler> = (
	storedCompiler ifNil:[
			storedCompiler:: compilation Compiler new.
			storedCompiler language: Language newspeak3.	].
	^storedCompiler
)
fullyQualifiedNameToSimple: name = (
	^(name subStrings: {$`}) last asSymbol
)
isSubInitializerSelector: sel = (
	| ts  <OrderedCollection[String]> | 
	ts:: sel findTokens: syntheticNameSeparator.
	^ ts size > 1 
		and: [(ts at: ts size - 1) allSatisfy: [:x|x isDigit]] 
		and: [ (ts last) startsWith: 'init' ].	
)
mixinChanged: mixin = (
	#BOGUS. "It really should be 'mirror reflectee == mixin', but it appears there are still issues with atomic install"
	mixinBasedMirrors do: [:mirror | 
		mirror reflectee definingClass = mixin definingClass ifTrue: [mirror mixinChanged]].
)
onlyElementOf: tuple = (
	assert: [tuple size = 1] message: 'The tuple does not have a single item.'.
	^tuple first
)'construct-mixinrep'
isConstructorSelector: sel forMixin: mxn = (
	^mxn declaration header primaryFactoryName = sel
	"^ (sel = 'new') 
		ifTrue: [ true ]
		ifFalse: [ | src <Yield> impl | 
			impl:: mxn isMeta
			ifFalse: [ mxn implementationMirror ]
			ifTrue: [ | klass <Class> |
				klass:: mxn implementationMirror implementationClass.
				(reflectionClass new mixinFor: klass theNonMetaClass) implementationMirror
			].
		src:: impl classHeader constructor.
		src isNil 
			ifTrue: [ false ]
			ifFalse: [ | mp <MessagePatternAST> |
				mp:: parserInstance messagePattern parse: src contents readStream.
				sel = mp selector]]."
)
isNestedClassAccessorSelector: sel forMixin: mxn = (
	| ts <OrderedCollection[String]> |
	ts:: sel findTokens: syntheticNameSeparator.
	^ (ts size = 1 and: [mxn nestedClasses includesMirrorNamed: ts anyOne])
		or: [ ts size > 2 
			and: [(ts last = 'slot' or: [ts last = 'slot:']) 
				and: [mxn nestedClasses includesMirrorNamed: (ts at: ts size - 1)]]]
)
isSlotAccessorSelector: sel forMixin: mxn = (
	^ (mxn slots includesMirrorNamed: sel)
		or: [(sel endsWith: ':') 
			and: [mxn slots includesMirrorNamed: (sel copyFrom: 1 to: sel size - 1)]].	
)
isSuperConstructorSelector: sel = (
	| ts  <OrderedCollection[String]> | 
	ts:: sel findTokens: syntheticNameSeparator.
	^ ts size > 1 and: [(ts at: ts size - 1) = 'superInit'].
)
makeCompiledMixinMirrorFor: lowLevelMixinMirror <LowLevelMixinMirror> from: mixin <Mixin> = (

	^(CompiledMixinMirror 
		language: mixin language
		header:  mixin cachedHeaderSource
		mirror: lowLevelMixinMirror)
	comment: mixin classComment.	
)
makeCompiledMixinMirrorForMixin: mixin <Mixin> = (
	^ makeCompiledMixinMirrorFor: (makeLowLevelMixinMirrorFor: mixin) from: mixin.
)
makeLowLevelMixinMirrorFor: mixin <Mixin> = (
	| llm <LowLevelMixinMirror> llcm | 
	assert:[mixin isMeta not] message: ''.
	
	llm:: LowLevelMixinMirror named: mixin name isMeta: false.

	"instance variables -- n.b. slot accessors need to be generated"
	mixin instVarNames do: [: iv | 
		llm instVars addMirror: (lowLevelMirrors InstanceVariableMirror named: iv)
	].

	"methods"
	mixin methodDictionary keysAndValuesDo: [ :selector :method |
		| methodMirror |
		methodMirror:: LowLevelMethodMirror new.
		methodMirror method: method. 
		methodMirror klass: mixin.
		methodMirror selector: selector.
		llm methods addMirror: methodMirror.
	].
	setMetadataForMixinMirror: llm inMixin: mixin .

	"category"
	llm category: (mixin category ifNil:['Uncategorized']).
	
	"meta class / class side"
	llcm:: lowLevelMirrors LowLevelMixinMirror named: mixin classMixin name isMeta: true.
	mixin classMixin methodDictionary keysAndValuesDo: [ :selector :method |
		| methodMirror |
		methodMirror:: LowLevelMethodMirror new.
		methodMirror method: method. 
		methodMirror klass: mixin classMixin.
		methodMirror selector: selector.
		llcm methods addMirror: methodMirror.
	].
	setMetadataForMixinMirror: llcm inMixin: mixin classMixin.
	llm cachedClassMixin: llcm.
	
	^llm
)
mixinRepFor: mixin <Mixin> ^ <MixinRep> = (
	^{
	makeCompiledMixinMirrorForMixin: mixin. 
	mixin nestedMixins values collect: [ :nc <Class> | mixinRepFor: nc ].
	}
)
setMetadataForMethodMirror: mirror <LowLevelMethodMirror> inMixin: mixin <Mixin|ClassMixin> = (
	| category <String> |

	category:: (mixin organization categoryOfElement: mirror selector).
	mirror metadata at: #isSynthetic put: category isNil.
	mirror metadata at: #category put: category.
	category ifNil: [ setMetadataForSyntheticMethod: mirror inMixin: mixin ].
)
setMetadataForMixinMirror: mirror <LowLevelMixinMirror> inMixin: mixin <Mixin|ClassMixin> = (

	mirror methods do: [ :mm <LowLevelMethodMirror> |
		setMetadataForMethodMirror: mm inMixin: mixin.
	].
)
setMetadataForSyntheticMethod: mtd <LowLevelMethodMirror> inMixin: mixin <Mixin|ClassMixin> = (
	| selector meta mxn |

	mxn:: MixinMirror reflecting: mixin.
	selector:: mtd selector.

	meta:: mtd metadata.
	"meta at: #isSuperConstructor put: false.
	meta at: #isSubInitializer put: false.
	meta at: #isConstructor put: false.
	meta at: #isSlotAccessor put: false.
	meta at: #isNestedClassAccessor put: false."

	"mutually exclusive, therefore shortcut semantics"
	"(isSuperConstructorSelector: selector)
		ifTrue: [ meta at: #isSuperConstructor put: true. ^ mtd]." "unused"
	"(isSubInitializerSelector: selector) 
		ifTrue: [meta at: #isSubInitializer put: true. ^ mtd]." "unused"
	"(isSlotAccessorSelector: selector forMixin: mxn)
		ifTrue: [meta at: #isSlotAccessor put: true. ^ mtd]." "unused"
	(isNestedClassAccessorSelector: selector forMixin: mxn)
		ifTrue: [meta at: #isNestedClassAccessor put: true. ^ mtd]. "important. used in recompiling headers"
	(isConstructorSelector: selector forMixin: mxn)
		ifTrue: [meta at: #isConstructor put: true. ^ mtd]. "used by these mirrors. should rewrite"
)
syntheticNameSeparator = (
	^ Language syntheticNameSeparator.
))