Constructors experiment

extra/constructors/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/constructors/constructors-tests.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test constructors calendar kernel accessors
+combinators.short-circuit ;
+IN: constructors.tests
+
+TUPLE: stock-spread stock spread timestamp ;
+
+CONSTRUCTOR: stock-spread ( stock spread -- stock-spread )
+   now >>timestamp ;
+
+SYMBOL: AAPL
+
+[ t ] [
+    AAPL 1234 <stock-spread>
+    {
+        [ stock>> AAPL eq? ]
+        [ spread>> 1234 = ]
+        [ timestamp>> timestamp? ]
+    } 1&&
+] unit-test

extra/constructors/constructors.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: slots kernel sequences fry accessors parser lexer words
+effects.parser ;
+IN: constructors
+
+! An experiment
+
+: constructor-quot ( class slot-names body -- quot )
+    [ <reversed> [ setter-word '[ swap _ execute ] ] map [ ] join ] dip
+    '[ _ new @ @ ] ;
+
+: define-constructor ( name class effect body -- )
+    [ [ in>> ] dip constructor-quot ] [ drop ] 2bi
+    define-declared ;
+
+: CONSTRUCTOR:
+    scan-word [ name>> "<" ">" surround create-in ] keep
+    "(" expect ")" parse-effect
+    parse-definition
+    define-constructor ; parsing