Hi All,
I've pushed a new vocabulary to my repository (git://
factorcode.org/git/wrunt.git) called 'hats'. Hats is a protocol for getting
and setting. We have protocols for assocs, sequences, etc., but not one like
this (as far as I know). I've pasted the code and the unit tests below.
The basic idea is that you have a 'hat' that can be passed around on the
stack. This hat abstracts away some value, which could be stored in the hat
itself, in a variable, a slot of some tuple, or maybe even nowhere at all.
You can put values into the hat using the word 'in'. You can pull values out
using the word 'out'. To implement a new type of hat, all you have to do is
define the methods '(in)' and 'out', and mark it as an instance of hat.
I don't know whether this will actually prove to be a useful thing, but I'd
like to at least put the idea out there and see what others think. The hat
metaphor is not the core of this idea, nor are the specific words used for
the protocol (in, out, etc.). I think the main advantage is in indirection.
You are able to pass around and manipulate something without knowing exactly
what it is.
The motivation for this was me wanting to be able to pass around particular
slots of a tuple (see slot-hats below). For this to really work well we
would need to change the words that get created when a new tuple type is
defined. Here are some initial thoughts:
When you define a tuple:
TUPLE: foo bar ;
Factor would create the words:
bar ( -- slot ) ! slot being a number?
bar-hat ( tuple -- slot-hat )
And we also have the words:
o> ( tuple slot -- value )
>o ( tuple slot value -- tuple )
(>o) ( value tuple slot -- )
So now to manipulate a tuple:
foo new bar "bar" >o bar o> .
And to pass a single slot to be changed by some word that expects a hat:
foo new bar-hat eat-hat
What do you think? Am I off my rocker, or is this idea worth exploring? Is
at already part of core somewhere, and you're all shaking your heads at my
folly?
Alex :)
The code:
! Copyright (C) 2008 Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors boxes kernel namespaces ;
IN: hats
! Bullwinkle: Hey Rocky, watch me pull a rabbit out of my hat!
! Rocky: But that trick never works!
! Bullwinkle: This time for sure!
! hat protocol
MIXIN: hat
GENERIC: out ( hat -- object )
GENERIC: (in) ( object hat -- )
: in ( hat object -- hat ) over (in) ; inline
: empty-hat? ( hat -- ? ) out not ; inline
: empty-hat ( hat -- hat ) f in ; inline
: take ( hat -- object ) dup out f rot (in) ; inline
: change-hat ( hat quot -- hat )
over >r >r out r> call r> swap in ; inline
! caps (the simplest of hats)
TUPLE: cap object ;
C: <cap> cap
M: cap out ( cap -- object ) object>> ;
M: cap (in) ( object cap -- ) (>>object) ;
INSTANCE: cap hat
! bowlers (dynamic variable hats)
TUPLE: bowler variable ;
C: <bowler> bowler
M: bowler out ( bowler -- object ) variable>> get ;
M: bowler (in) ( object bowler -- ) variable>> set ;
INSTANCE: bowler hat
! Top Hats (global variable hats)
TUPLE: top-hat variable ;
C: <top-hat> top-hat
M: top-hat out ( top-hat -- object ) variable>> get-global ;
M: top-hat (in) ( object top-hat -- ) variable>> set-global ;
INSTANCE: top-hat hat
USE: slots.private
! Slot hats
TUPLE: slot-hat tuple slot ;
C: <slot-hat> slot-hat
: >slot-hat< ( slot-hat -- tuple slot ) [ tuple>> ] [ slot>> ] bi ; inline
M: slot-hat out ( slot-hat -- object ) >slot-hat< slot ;
M: slot-hat (in) ( object slot-hat -- ) >slot-hat< set-slot ;
INSTANCE: slot-hat hat
! Put a box on your head
M: box out ( box -- object ) box> ;
M: box (in) ( object box -- ) >box ;
INSTANCE: box hat
The tests (usage examples):
! Copyright (C) 2008 Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
USING: boxes hats kernel namespaces symbols tools.test ;
IN: hats.tests
SYMBOLS: lion giraffe elephant rabbit ;
! caps
[ rabbit ] [ rabbit <cap> out ] unit-test
[ rabbit ] [ f <cap> rabbit in out ] unit-test
[ rabbit ] [ rabbit <cap> take ] unit-test
[ f ] [ rabbit <cap> empty-hat out ] unit-test
[ rabbit f ] [ rabbit <cap> [ take ] keep out ] unit-test
[ rabbit t ] [ rabbit <cap> [ take ] keep empty-hat? ] unit-test
[ lion ] [ rabbit <cap> [ drop lion ] change-hat out ] unit-test
! bowlers
[ giraffe ] [ [ giraffe rabbit set rabbit <bowler> out ] with-scope ]
unit-test
[ rabbit ]
[
[
lion rabbit set [
rabbit rabbit set rabbit <bowler> out
] with-scope
] with-scope
] unit-test
[ rabbit ] [
rabbit <bowler>
[
lion rabbit set [
rabbit rabbit set out
] with-scope
] with-scope
] unit-test
[ elephant ] [
rabbit <bowler>
[
elephant rabbit set [
rabbit rabbit set
] with-scope
out
] with-scope
] unit-test
[ rabbit ] [
rabbit <bowler>
[
elephant in [
rabbit in out
] with-scope
] with-scope
] unit-test
[ elephant ] [
rabbit <bowler>
[
elephant in [
rabbit in
] with-scope
out
] with-scope
] unit-test
! Top Hats
[ lion ] [ lion rabbit set-global rabbit <top-hat> out ] unit-test
[ giraffe ] [ rabbit <top-hat> giraffe in out ] unit-test
! Tuple hats
TUPLE: foo bar ;
C: <foo> foo
: test-tuple ( -- tuple )
rabbit <foo> ;
: test-slot-hat ( -- slot-hat )
test-tuple 2 <slot-hat> ; ! hack!
[ rabbit ] [ test-slot-hat out ] unit-test
[ lion ] [ test-slot-hat lion in out ] unit-test
! Boxes as hats
[ rabbit ] [ <box> rabbit in out ] unit-test
[ <box> rabbit in lion in ] must-fail
[ <box> out ] must-fail
-------------------------------------------------------------------------
This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
Build the coolest Linux based applications with Moblin SDK & win great prizes
Grand prize is a trip for two to an Open Source event anywhere in the world
http://moblin-contest.org/redirect.php?banner_id=100&url=/
_______________________________________________
Factor-talk mailing list
Factor-talk@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/factor-talk
