Moved some unfinished code in.

cc mozart/mozart2#256.

Makefile

@@ -0,0 +1,13 @@
+all: $(addprefix build/,$(addsuffix .ozf,$(basename $(notdir $(wildcard src/*.oz)))))
+
+test: all build/TestRunner.ozf
+	@cd build && ozengine TestRunner.ozf *Test.ozf
+
+clean:
+	rm -f build/*.ozf
+
+build/%.ozf: src/%.oz
+	ozc -c -g -o $@ $^
+
+.PHONY: all clean test
+

dss4/Classifier.oz

@@ -0,0 +1,60 @@
+functor
+
+import
+    Reflection at 'x-oz://boot/Reflection'
+
+export
+    Classify
+    SpecialTypes
+
+define
+    %%% A record of types which needs to be treated specially. This record is to
+    %%% be used in `Pickle.packWithReplacements`.
+    SpecialTypes = r(
+        cell:unit
+        array:unit
+        dictionary:unit
+        port:unit
+        object:unit
+        'thread':unit
+        value:unit % ForeignPointer
+        abstraction:unit
+    )
+
+    %%% Classifies an object into one of the 6 object classes in DSS.
+    %%%
+    %%% Example:
+    %%%
+    %%% ```
+    %%% value = {Classify 1.0}
+    %%% structural = {Classify [2 3]}   % should never happen after serialization
+    %%% immutable = {Classify (proc {$} skip end)}
+    %%% mutable = {Classify {NewCell 0}}
+    %%% variable = {Classify _}
+    %%% future = {Classify !!_}
+    %%% ```
+    fun {Classify Obj}
+        case {Reflection.getStructuralBehavior Obj}
+        of token then
+            case {Value.type Obj}
+            of name then
+                value
+            [] procedure then
+                immutable
+            [] 'class' then
+                immutable
+            else
+                mutable
+            end
+        [] variable then
+            if {IsFuture Obj} then
+                future
+            else
+                variable
+            end
+        [] B then
+            B
+        end
+    end
+end
+

dss4/ClassifierTest.oz

@@ -0,0 +1,79 @@
+functor
+
+import
+    Classifier(classify:Classify)
+    BootName at 'x-oz://boot/Name'
+    OS
+
+export
+    Return
+
+define
+    Return = classifyTests([
+        classifyValueTest(
+            proc {$}
+                value = {Classify 1.0}
+                value = {Classify {NewName}}
+                value = {Classify true}
+                value = {Classify false}
+                value = {Classify unit}
+                value = {Classify nil}
+                value = {Classify {Pow 2 100}}
+                value = {Classify object}
+                value = {Classify 'Test漢字テスト'}
+                value = {Classify {VirtualString.toCompactString "CompactString"}}
+                value = {Classify {BootName.newUnique uniqueName}}
+                value = {Classify {BootName.newNamed namedName}}
+                value = {Classify {ByteString.make "ByteString"}}
+                value = {Classify NewCell}
+            end
+        )
+
+        classifyCompositeTest(
+            proc {$}
+                structural = {Classify a(b)}
+                structural = {Classify a|nil}
+                structural = {Classify [a]}
+                structural = {Classify a#b}
+                structural = {Classify x(a:b)}
+                structural = {Classify "OldString"}
+            end
+        )
+
+        classifyImmutableTest(
+            proc {$}
+                immutable = {Classify (proc {$} skip end)}
+                immutable = {Classify (fun {$} Return end)}
+                immutable = {Classify (class $ meth x skip end end)}
+                immutable = {Classify BaseObject}
+            end
+        )
+
+        classifyMutableTest(
+            proc {$}
+                mutable = {Classify {NewCell _}}
+                mutable = {Classify {NewPort _}}
+                mutable = {Classify {New BaseObject noop}}
+                mutable = {Classify {NewArray 1 2 unit}}
+                mutable = {Classify {NewDictionary}}
+                mutable = {Classify OS.stdout}
+            end
+        )
+
+        classifyVariableTest(
+            proc {$}
+                variable = {Classify _}
+                variable = {Classify {ByNeed NewName}}
+            end
+        )
+
+        classifyFutureTest(
+            proc {$}
+                future = {Classify !!_}
+                future = {Classify {ByNeedFuture NewName}}
+            end
+        )
+    ])
+
+end
+

dss4/PickleResource.oz

@@ -0,0 +1,30 @@
+functor
+
+import
+    BootName at 'x-oz://boot/Name'
+    Reflection at 'x-oz://boot/Reflection'
+
+export
+    New
+    Is
+    Substitute
+
+define
+    PickleResourceID = {BootName.newUnique dssPickleResource}
+
+    fun {New ObjName ObjClass}
+        {NewChunk dss(PickleResourceID:(ObjName#ObjClass))}
+    end
+
+    fun {Is C}
+        {IsChunk C} andthen {HasFeature C PickleResourceID}
+    end
+
+    proc {Substitute C F}
+        ObjName#ObjClass = C.PickleResourceID
+    in
+        {Reflection.become C {F ObjName ObjClass}}
+    end
+end
+
+

dss4/Serializer.oz

@@ -0,0 +1,84 @@
+functor
+
+import
+    Pickle
+    BootSerializer at 'x-oz://boot/Serializer'
+    System
+    Classifier
+    PickleResource
+    Reflection at 'x-oz://boot/Reflection'
+
+export
+    Serialize
+    Deserialize
+
+define
+    proc {PrintTypes S}
+        case S
+            of I#V#K#Rest then
+                {System.show I#K#V}
+                {PrintTypes Rest}
+            [] nil then
+                skip
+        end
+    end
+
+    fun {CollectNonValues Obj LinkName Repository}
+        SpecialObjects
+    in
+        %{PrintTypes {BootSerializer.serialize {BootSerializer.new} [Obj#_]}}
+
+        SpecialObjects = {BootSerializer.extractByLabels Obj Classifier.specialTypes}
+
+        for collect:C SubObj#Type in SpecialObjects do
+            Status ObjName Replacement ObjClass
+        in
+            {Repository link(object:SubObj link:LinkName name:?ObjName status:?Status)}
+            % Perform replacement if:
+            %  - it is not a function, or
+            %  - it is a function, but has been sent to the same link before.
+            if {Label Type} \= abstraction orelse Status == old then
+                ObjClass = {Classifier.classify SubObj}
+                Replacement = {PickleResource.new ObjName ObjClass}
+                {C (SubObj#Replacement)}
+            end
+        end
+    end
+
+    %%% Serializes an object. The resulting virtual byte string can then be sent
+    %%% through wires.
+    %%%
+    %%% Parameters:
+    %%%
+    %%% * Obj --- The object to serialize.
+    %%% * LinkName --- A unique name within this VM to identify the peer to send
+    %%%                the object to.
+    %%% * Repository --- A SharedObjects instance to register any non-values.
+    fun {Serialize Obj LinkName Repository}
+        TemporaryReplacements = {CollectNonValues Obj LinkName Repository}
+    in
+        {Pickle.packWithReplacements Obj TemporaryReplacements}
+    end
+
+    %%% Deserialize an object from a virtual-byte-string.
+    %%%
+    %%% All non-values will be transformed into using the function F. The
+    %%% function should have signature:
+    %%%
+    %%%     fun {F ObjectName ObjectKind}
+    %%%         {CreateReflectiveObjectFor ObjectName ObjectKind}
+    %%%     end
+    %%%
+    fun {Deserialize VBS F}
+        UnpackRes = {Pickle.unpack VBS}
+        AllChunks = {BootSerializer.extractByLabels UnpackRes r(chunk:unit)}
+    in
+        for Ch#_ in AllChunks do
+            if {PickleResource.is Ch} then
+                {PickleResource.substitute Ch F}
+            end
+        end
+        UnpackRes
+    end
+end
+