mpl-sl/Owner.mpl at master · Matway/mpl-sl · GitHub

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
# Copyright (C) Matway Burkow
#
# This repository and all its contents belong to Matway Burkow (referred here and below as "the owner").
# The content is for demonstration purposes only.
# It is forbidden to use the content or any part of it for any purpose without explicit permission from the owner.
# By contributing to the repository, contributors acknowledge that ownership of their work transfers to the owner.

"control.Ref"      use
"control.assert"   use
"control.over"     use
"control.pfunc"    use
"control.swap"     use
"control.when"     use
"memory.mplFree"   use
"memory.mplMalloc" use

objectSize: [storageSize];
objectSize: ["SIZE" has] [.SIZE] pfunc;

OwnerWithDestructor: [
  Value: destructor:;;
  {
    SCHEMA_NAME: "Owner<" @Value schemaName & ">" & virtual;

    virtual OWNER: ();
    destructor: @destructor;
    virtual elementType: @Value Ref;
    memory: @elementType Ref;

    INIT: [
      @elementType Ref !memory
    ];

    DIE: [
      valid? [
        @memory @destructor call @memory storageAddress mplFree
      ] when
    ];

    valid?: [
      addr: @memory storageAddress;
      addr 0nx = ~
    ];

    acquire: [
      element:;

      valid? [
        @memory @destructor call @memory storageAddress mplFree
      ] when

      @element !memory
    ];

    clear: [
      valid? [
        @memory @destructor call @memory storageAddress mplFree
        @elementType Ref !memory
      ] when
    ];

    get: [
      [valid?] "invalid Owner" assert
      @memory
    ];

    lower: [
      [valid?] "invalid Owner" assert
      base: @memory.base;
      @elementType Ref !memory
      result: @base Owner;
      @base @result.!memory
      @result
    ];

    init: [
      [valid? ~] "Owner is already set" assert
      object:;
      data: @object storageSize mplMalloc @object addressToReference;
      @data manuallyInitVariable
      @object @data set
      @data !memory
    ];

    initDerived: [
      [valid? ~] "Owner is already set" assert
      object:;
      data: @object storageSize mplMalloc @object addressToReference;
      @data manuallyInitVariable
      @object @data set
      @data storageAddress @elementType addressToReference !memory
    ];

    release: [
      [valid?] "invalid Owner" assert
      result: @memory;
      @elementType Ref !memory
      @result
    ];
  }
];

Owner: [
  [
    x:;
    @x manuallyDestroyVariable
    @x objectSize
  ] OwnerWithDestructor
];

owner: [
  element:;
  result: @element Owner;
  @element @result.init
  @result
];

ownerDerived: [
  element: base: destructor:;;;
  result: @base @destructor OwnerWithDestructor;
  @element @result.initDerived
  @result
];

getHeapUsedSize: ["OWNER" has] [
  arg:;
  arg.valid? [
    i: 0;
    arg.elementType objectSize
    arg.get getHeapUsedSize +
  ] [
    0nx
  ] if
] pfunc;