Introduce Sum Types

Collections-Homogeneous/Array.extension.st

@@ -8,7 +8,7 @@ Array class >> of: elementSpecies [
 		superclass: HomogeneousArray superclass
 		methodDictionary: HomogeneousArray methodDictionary
 		format: HomogeneousArray format;
-		setName: 'Array of: ', elementSpecies name;
+		setName: 'Array of: ', elementSpecies nameForHomoArray;
 		instVarNamed: #elementSpecies put: elementSpecies;
 		yourself.
 	^c

Collections-Homogeneous/Class.extension.st

@@ -4,3 +4,8 @@ Extension { #name : #Class }
 Class >> array [
 	^Array of: self
 ]
+
+{ #category : #'*Collections-Homogeneous' }
+Class >> nameForHomoArray [
+	^self name
+]

MachineArithmetic-MathNotation-Tests/A.class.st

@@ -0,0 +1,25 @@
+Class {
+	#name : #A,
+	#superclass : #AorB,
+	#instVars : [
+		's'
+	],
+	#category : #'MachineArithmetic-MathNotation-Tests'
+}
+
+{ #category : #accessing }
+A class >> instVarTyping [
+	^{
+	#s  -> String.
+	}
+]
+
+{ #category : #accessing }
+A >> s [
+	^ s
+]
+
+{ #category : #accessing }
+A >> s: anObject [
+	s := anObject
+]

MachineArithmetic-MathNotation-Tests/AorB.class.st

@@ -0,0 +1,10 @@
+"
+AorB =
+  | A of String
+  | B of Integer
+"
+Class {
+	#name : #AorB,
+	#superclass : #Sum,
+	#category : #'MachineArithmetic-MathNotation-Tests'
+}

MachineArithmetic-MathNotation-Tests/B.class.st

@@ -0,0 +1,25 @@
+Class {
+	#name : #B,
+	#superclass : #AorB,
+	#instVars : [
+		'i'
+	],
+	#category : #'MachineArithmetic-MathNotation-Tests'
+}
+
+{ #category : #accessing }
+B class >> defaultMetavarTyping [
+	^{
+	#i  -> Integer.
+	}
+]
+
+{ #category : #accessing }
+B >> i [
+	^ i
+]
+
+{ #category : #accessing }
+B >> i: anObject [
+	i := anObject
+]

MachineArithmetic-MathNotation-Tests/SumTest.class.st

@@ -0,0 +1,34 @@
+Class {
+	#name : #SumTest,
+	#superclass : #TestCaseWithZ3Context,
+	#category : #'MachineArithmetic-MathNotation-Tests'
+}
+
+{ #category : #tests }
+SumTest >> deserialize: jsonString as: aClass [
+	| reader |
+	reader := NeoJSONReader on: jsonString readStream.
+	^reader nextAs: aClass
+]
+
+{ #category : #tests }
+SumTest >> testJsonA [
+	| obj |
+	obj := self deserialize: '["A","asdf"]' as: AorB.
+	self assert: obj s equals: 'asdf'
+]
+
+{ #category : #tests }
+SumTest >> testJsonB [
+	| obj |
+	obj := self deserialize: '["B",42]' as: AorB.
+	self assert: obj i equals: 42
+]
+
+{ #category : #tests }
+SumTest >> testJsonBoth [
+	| objs |
+	objs := self deserialize: '[["A","asdf"],["B",42]]' as: AorB array.
+	self assert: objs first s equals: 'asdf'.
+	self assert: objs second i equals: 42.
+]

MachineArithmetic-MathNotation/Product.class.st

@@ -21,6 +21,11 @@ Product >> mkRelationNamed: aString [
 	^aString functionFrom: self to: Bool sort
 ]
 
+{ #category : #'as yet unclassified' }
+Product >> nameForHomoArray [
+	^self printString
+]
+
 { #category : #printing }
 Product >> printOn: aStream [
 	aStream nextPut: $(.

MachineArithmetic-MathNotation/Sum.class.st

@@ -0,0 +1,20 @@
+Class {
+	#name : #Sum,
+	#superclass : #Object,
+	#category : #'MachineArithmetic-MathNotation'
+}
+
+{ #category : #'as yet unclassified' }
+Sum class >> metavars [
+	^Metavars current
+]
+
+{ #category : #accessing }
+Sum class >> neoJsonMapping: mapper [
+	mapper for: self customDo: [ :mapping | mapping reader: [ :jsonReader |
+			| decoderThisTime |
+			decoderThisTime := SumConstructorDecoder jsonReader: jsonReader sumClass: self.
+			jsonReader parseListDo: [ decoderThisTime := decoderThisTime next ].
+			decoderThisTime object
+		]].
+]

MachineArithmetic-MathNotation/SumArgumentDecoder.class.st

@@ -0,0 +1,57 @@
+Class {
+	#name : #SumArgumentDecoder,
+	#superclass : #SumDecoder,
+	#instVars : [
+		'concreteSubclass',
+		'object',
+		'stillLeft'
+	],
+	#category : #'MachineArithmetic-MathNotation'
+}
+
+{ #category : #'instance creation' }
+SumArgumentDecoder class >> jsonReader: r concreteSubclass: c stillLeft: aCollection [
+	^self basicNew
+		jsonReader: r;
+		concreteSubclass: c;
+		stillLeft: aCollection;
+		yourself
+]
+
+{ #category : #accessing }
+SumArgumentDecoder >> concreteSubclass [
+	^ concreteSubclass
+]
+
+{ #category : #accessing }
+SumArgumentDecoder >> concreteSubclass: anObject [
+	concreteSubclass := anObject
+]
+
+{ #category : #API }
+SumArgumentDecoder >> next [
+	| instarVarName instVarType value |
+	stillLeft isEmpty ifTrue: [ ^self ].
+	instarVarName := stillLeft first key.
+	instVarType   := stillLeft first value.
+	value := jsonReader nextAs: (instVarType isJsonPrimitive ifTrue: [nil] ifFalse: [instVarType]).
+	self object instVarNamed: instarVarName put: value.
+	stillLeft := stillLeft allButFirst.
+	^self
+]
+
+{ #category : #accessing }
+SumArgumentDecoder >> object [
+	object isNil ifTrue: [ object := concreteSubclass new ].
+	^ object
+]
+
+{ #category : #accessing }
+SumArgumentDecoder >> stillLeft [
+	^ stillLeft
+]
+
+{ #category : #accessing }
+SumArgumentDecoder >> stillLeft: anObject [
+	stillLeft := anObject
+]

MachineArithmetic-MathNotation/SumConstructorDecoder.class.st

@@ -0,0 +1,37 @@
+Class {
+	#name : #SumConstructorDecoder,
+	#superclass : #SumDecoder,
+	#instVars : [
+		'sumClass'
+	],
+	#category : #'MachineArithmetic-MathNotation'
+}
+
+{ #category : #'instance creation' }
+SumConstructorDecoder class >> jsonReader: jsonReader sumClass: c [
+	^self basicNew
+		jsonReader: jsonReader;
+		sumClass: c;
+		yourself
+]
+
+{ #category : #API }
+SumConstructorDecoder >> next [
+	| constructorName concreteSubclass argumentClasses ivarTyping orderedIvarTyping |
+	constructorName := jsonReader next.
+	concreteSubclass := sumClass subclasses detect: [ :sub | sub name = constructorName ].
+	^SumArgumentDecoder
+		jsonReader: jsonReader
+		concreteSubclass: concreteSubclass
+		stillLeft: concreteSubclass allInstVarsWithMaybeTyping
+]
+
+{ #category : #accessing }
+SumConstructorDecoder >> sumClass [
+	^ sumClass
+]
+
+{ #category : #accessing }
+SumConstructorDecoder >> sumClass: anObject [
+	sumClass := anObject
+]

MachineArithmetic-MathNotation/SumDecoder.class.st

@@ -0,0 +1,23 @@
+Class {
+	#name : #SumDecoder,
+	#superclass : #Object,
+	#instVars : [
+		'jsonReader'
+	],
+	#category : #'MachineArithmetic-MathNotation'
+}
+
+{ #category : #accessing }
+SumDecoder >> jsonReader [
+	^ jsonReader
+]
+
+{ #category : #accessing }
+SumDecoder >> jsonReader: anObject [
+	jsonReader := anObject
+]
+
+{ #category : #API }
+SumDecoder >> next [
+	self subclassResponsibility
+]

PreSmalltalks/Metavars.class.st

@@ -0,0 +1,25 @@
+"
+I encode a culture of default variable name conventions by type,
+similar to how in FORTRAN the integers are taken (by default, but
+can be overridden) to be I,J,K,L,M,N.
+
+Similarly, the Ott codebase follows the convention that i stands
+for ""any integer variable"", l is ""any loc"", etc.
+
+This first implementation is extremely primitive, allowing for
+one global convention.  This will be changed in the future.
+"
+Class {
+	#name : #Metavars,
+	#superclass : #Dictionary,
+	#classInstVars : [
+		'current'
+	],
+	#category : #PreSmalltalks
+}
+
+{ #category : #accessing }
+Metavars class >> current [
+	current isNil ifTrue: [ current := self new ].
+	^current
+]

PreSmalltalks/Object.extension.st

@@ -12,6 +12,17 @@ Object >> at: index nonDestructivePut: value [
 		yourself
 ]
 
+{ #category : #'*PreSmalltalks' }
+Object >> defaultMetavarTyping [
+	(self respondsTo: #metavars) ifFalse: [ ^#() ].
+	^(self metavars selectByKey: [ :ivarName | self allInstVarNames includes: ivarName ]) associations
+]
+
+{ #category : #'*PreSmalltalks' }
+Object >> instVarTyping [
+	^self defaultMetavarTyping
+]
+
 { #category : #'*PreSmalltalks' }
 Object >> maybe: _ f: aBlock [
 	"Haskell's analog of #ifNil:.