Merge branch 'master' into inline_caching
commit
7b08accb7e
basis
core/classes/tuple/parser
|
@ -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
|
||||
|
||||
|
|
|
@ -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 }
|
||||
} ;
|
||||
|
|
|
@ -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." }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue