From 0d03dea74be4c77c112e2723e21c5b380c5cce58 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 26 Apr 2009 15:59:26 -0500
Subject: [PATCH 1/3] factor out tuple literal slot parsing from the rest of
tuple literal parsing
---
core/classes/tuple/parser/parser.factor | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor
index 5e12322a48..85a6249dd3 100644
--- a/core/classes/tuple/parser/parser.factor
+++ b/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 )
- scan-word scan {
+: parse-tuple-literal-slots ( class -- tuple )
+ 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 ;
From 18abc8b9f141d6047102acb50a2a16f002ff07ff Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Mon, 27 Apr 2009 17:23:59 +0200
Subject: [PATCH 2/3] Add q+ and q- to math.quaternions
This makes the quaternions library self-contained and more independent
of the underlying representation.
---
basis/math/quaternions/quaternions-docs.factor | 10 ++++++++++
basis/math/quaternions/quaternions-tests.factor | 4 ++++
basis/math/quaternions/quaternions.factor | 6 ++++++
3 files changed, 20 insertions(+)
diff --git a/basis/math/quaternions/quaternions-docs.factor b/basis/math/quaternions/quaternions-docs.factor
index bb34ec8da2..a24011cb7c 100644
--- a/basis/math/quaternions/quaternions-docs.factor
+++ b/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." }
diff --git a/basis/math/quaternions/quaternions-tests.factor b/basis/math/quaternions/quaternions-tests.factor
index a6d255e421..3efc417e42 100644
--- a/basis/math/quaternions/quaternions-tests.factor
+++ b/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
diff --git a/basis/math/quaternions/quaternions.factor b/basis/math/quaternions/quaternions.factor
index f2c2c6d226..b713f44ebd 100755
--- a/basis/math/quaternions/quaternions.factor
+++ b/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 ;
From 49771779c10bb6d7bf9d7fe9b038c3f9480f529d Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 27 Apr 2009 14:02:14 -0500
Subject: [PATCH 3/3] symbols in functors
---
basis/functors/functors-tests.factor | 25 ++++++++++++++++++++++++-
basis/functors/functors.factor | 7 ++++++-
2 files changed, 30 insertions(+), 2 deletions(-)
diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index 37ec1d3e15..b500d9f5ca 100644
--- a/basis/functors/functors-tests.factor
+++ b/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
\ No newline at end of file
+test-redefinition
+
diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 309154fb49..fc502a5695 100644
--- a/basis/functors/functors.factor
+++ b/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
@@ -80,6 +80,10 @@ SYNTAX: `:
parse-declared*
\ define-declared* parsed ;
+SYNTAX: `SYMBOL:
+ scan-param parsed
+ \ define-symbol parsed ;
+
SYNTAX: `SYNTAX:
scan-param parsed
parse-definition*
@@ -116,6 +120,7 @@ DEFER: ;FUNCTOR delimiter
{ ":" POSTPONE: `: }
{ "INSTANCE:" POSTPONE: `INSTANCE: }
{ "SYNTAX:" POSTPONE: `SYNTAX: }
+ { "SYMBOL:" POSTPONE: `SYMBOL: }
{ "inline" POSTPONE: `inline }
} ;