Merge branch 'master' of git://factorcode.org/git/factor

basis/functors/functors-tests.factor

@@ -63,6 +63,24 @@ WHERE
 
 [ 4 ] [ 1 3 blah ] unit-test
 
+<<
+
+FUNCTOR: symbol-test ( W -- )
+
+W DEFINES ${W}
+
+WHERE
+
+SYMBOL: W
+
+;FUNCTOR
+
+"blorgh" symbol-test
+
+>>
+
+[ blorgh ] [ blorgh ] unit-test
+
 GENERIC: some-generic ( a -- b )
 
 ! Does replacing an ordinary word with a functor-generated one work?
@@ -72,6 +90,7 @@ GENERIC: some-generic ( a -- b )
     TUPLE: some-tuple ;
     : some-word ( -- ) ;
     M: some-tuple some-generic ;
+    SYMBOL: some-symbol
     "> <string-reader> "functors-test" parse-stream
 ] unit-test
 
@@ -82,6 +101,7 @@ GENERIC: some-generic ( a -- b )
         "some-tuple" "functors.tests" lookup
         "some-generic" "functors.tests" lookup method >boolean
     ] unit-test ;
+    [ t ] [ "some-symbol" "functors.tests" lookup >boolean ] unit-test
 
 test-redefinition
 
@@ -90,12 +110,14 @@ FUNCTOR: redefine-test ( W -- )
 W-word DEFINES ${W}-word
 W-tuple DEFINES-CLASS ${W}-tuple
 W-generic IS ${W}-generic
+W-symbol DEFINES ${W}-symbol
 
 WHERE
 
 TUPLE: W-tuple ;
 : W-word ( -- ) ;
 M: W-tuple W-generic ;
+SYMBOL: W-symbol
 
 ;FUNCTOR
 
@@ -105,4 +127,5 @@ M: W-tuple W-generic ;
     "> <string-reader> "functors-test" parse-stream
 ] unit-test
 
-test-redefinition
+test-redefinition
+

basis/functors/functors.factor

@@ -5,7 +5,7 @@ words interpolate namespaces sequences io.streams.string fry
 classes.mixin effects lexer parser classes.tuple.parser
 effects.parser locals.types locals.parser generic.parser
 locals.rewrite.closures vocabs.parser classes.parser
-arrays accessors ;
+arrays accessors words.symbol ;
 IN: functors
 
 ! This is a hack
@@ -90,6 +90,10 @@ SYNTAX: `:
     parse-declared*
     \ define-declared* parsed ;
 
+SYNTAX: `SYMBOL:
+    scan-param parsed
+    \ define-symbol parsed ;
+
 SYNTAX: `SYNTAX:
     scan-param parsed
     parse-definition*
@@ -128,6 +132,7 @@ DEFER: ;FUNCTOR delimiter
         { ":" POSTPONE: `: }
         { "INSTANCE:" POSTPONE: `INSTANCE: }
         { "SYNTAX:" POSTPONE: `SYNTAX: }
+        { "SYMBOL:" POSTPONE: `SYMBOL: }
         { "inline" POSTPONE: `inline }
         { "call-next-method" POSTPONE: `call-next-method }
     } ;

basis/math/quaternions/quaternions-docs.factor

@@ -1,6 +1,16 @@
 USING: help.markup help.syntax math math.vectors vectors ;
 IN: math.quaternions
 
+HELP: q+
+{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u+v" "a quaternion" } }
+{ $description "Add quaternions." }
+{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q+ ." "{ C{ 0 1 } 1 }" } } ;
+
+HELP: q-
+{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u-v" "a quaternion" } }
+{ $description "Subtract quaternions." }
+{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q- ." "{ C{ 0 1 } -1 }" } } ;
+
 HELP: q*
 { $values { "u" "a quaternion" } { "v" "a quaternion" } { "u*v" "a quaternion" } }
 { $description "Multiply quaternions." }

basis/math/quaternions/quaternions-tests.factor

@@ -24,3 +24,7 @@ math.constants ;
 [ t ] [ qk q>v v>q qk = ] unit-test
 [ t ] [ 1 c>q q1 = ] unit-test
 [ t ] [ C{ 0 1 } c>q qi = ] unit-test
+[ t ] [ qi qi q+ qi 2 q*n = ] unit-test
+[ t ] [ qi qi q- q0 = ] unit-test
+[ t ] [ qi qj q+ qj qi q+ = ] unit-test
+[ t ] [ qi qj q- qj qi q- -1 q*n = ] unit-test

basis/math/quaternions/quaternions.factor

@@ -20,6 +20,12 @@ IN: math.quaternions
 
 PRIVATE>
 
+: q+ ( u v -- u+v )
+    v+ ;
+
+: q- ( u v -- u-v )
+    v- ;
+
 : q* ( u v -- u*v )
     [ q*a ] [ q*b ] 2bi 2array ;
 

core/classes/tuple/parser/parser.factor

@@ -89,11 +89,14 @@ ERROR: bad-literal-tuple ;
     swap [ [ slot-named offset>> 2 - ] curry dip ] curry assoc-map
     [ dup <enum> ] dip update boa>tuple ;
 
-: parse-tuple-literal ( -- tuple )
+: parse-tuple-literal-slots ( class -- tuple )
-    scan-word scan {
+    scan {
         { f [ unexpected-eof ] }
         { "f" [ \ } parse-until boa>tuple ] }
         { "{" [ parse-slot-values assoc>tuple ] }
         { "}" [ new ] }
         [ bad-literal-tuple ]
     } case ;
+
+: parse-tuple-literal ( -- tuple )
+    scan-word parse-tuple-literal-slots ;