Merge branch 'master' into inline_caching

db4
Slava Pestov 2009-04-27 16:14:45 -05:00
commit 7b08accb7e
6 changed files with 55 additions and 4 deletions

View File

@ -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

View File

@ -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 }
} ;

View File

@ -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." }

View File

@ -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

View File

@ -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 ;

View File

@ -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 ;