|(require qtops/things)||package: qtops|
(create-core-thing) → procedure?
A thing created by create-core-thing have one procedure in its record, the ’call~ procedure, which provides direct access to the thing’s record.
(Things’ procedures often have suffixes like ! or ~ which represent information about the procedure’s (potential) side-effects. See the documentation on qualities for details.)
The procedures held within things follow certain conventions: not violating Racket’s own, but extending it. Procedures might have one of the four following suffixes. (Suffices?)
! means a procedure changes that thing
!! means a procedure changes that and at least another thing
^! means a procedure doesn’t change itself, but does change another thing.
~ means a procedure might change that thing
~~ means a procedure might change that and at least another thing.
You might see other combinations, like ~!, whose meanings can hopefully be deduced from the list above.
Procedures outside things, but affecting them, follow other conventions, and might have one of these prefixes:
> means a procedure returns a procedure to be added to a thing’s procedures. These always take a thing as their first argument.
>> means a procedure returns multiple procedures to be added to a thing’s procedures. These also always take a thing as their first argument.
<> means a procedure returns a thing, after doing something to it - usually calling one or more procedures of the first two types here.
(create-thing given-name additional-procedures) → procedure? given-name : string? additional-procedures : (listof procedure?)
> (define pear (create-thing "pear")) > (pear 'name)
> (pear 'set-procedure! 'fall (λ () (printf ((pear 'prerender-string (list 'name " falls.")))))) > (pear 'fall)
> (define milkweed (create-thing "milkweed" (list (λ (t) (list (cons 'pop (λ () (printf "Pop!")))))))) > (milkweed 'pop)
> (stone 'set-procedure! 'procedures (>procedures stone)) > (stone 'procedures)
'#hash((call~~ . #<procedure:...gs/qtops/things.rkt:145:23>)
(name . #<procedure>)
(procedures . #<procedure:...gs/qtops/things.rkt:18:2>)
(roll . #<procedure>)
(set-procedure! . #<procedure:...gs/qtops/things.rkt:45:2>))
> (stone 'set-procedure! 'procedure (>procedure stone)) > (stone 'procedure 'roll)
> ((stone 'procedure 'roll))
"The stone rolls."
> (stone 'procedure 'fake-procedure)
stone: contract violation
expected: thing with fake-procedure procedure
result: "stone with (name call~~ roll set-procedure!
procedures procedure) procedures"
> (stone 'set-procedure! 'remove-procedure! (>remove-procedure! stone)) > (stone 'roll)
"The stone rolls."
> (stone 'remove-procedure! 'roll) > (stone 'roll)
thing: contract violation
expected: #<procedure> is missing procedure roll
given: '(name call~~ set-procedure! procedures procedure
set-mass! remove-procedure! set-procedures! mass)
> (stone 'set-procedure! 'has-procedure? (>has-procedure? stone)) > (stone 'has-procedure? 'roll)
> (stone 'has-procedure? 'crack)
> ((pear 'with-procedure~~ 'set-mass!) 135 #:alternate (printf "Pear ain't got set-mass!"))
Pear ain't got set-mass!
> (stone 'set-procedure! 'with-procedure~~ (>with-procedure~~ stone))
> ((stone 'with-procedure~~ 'set-mass!) 2700) > (stone 'mass)