steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

s/word-property/word-prop/

cvs
Daniel Ehrenberg 2005-03-05 23:55:31 +00:00
parent a74632b243
commit d47fbc8d1a
2 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
contrib/algebra/algebra.factor
View File

@ -10,13 +10,13 @@ M: list2 (fold-consts)
2unlist (fold-consts) [ 2unlist (fold-consts) [
2list t 2list t
] [ ] [
swap arith-1 word-property unit call f swap arith-1 word-prop unit call f
] ifte ; ] ifte ;
M: list3 (fold-consts) M: list3 (fold-consts)
3unlist >r (fold-consts) r> swapd (fold-consts) >r rot r> or [ 3unlist >r (fold-consts) r> swapd (fold-consts) >r rot r> or [
3list t 3list t
] [ ] [
rot arith-2 word-property unit call f rot arith-2 word-prop unit call f
] ifte ; ] ifte ;
: fold-consts ( infix -- infix ) : fold-consts ( infix -- infix )

30
contrib/algebra/infix.factor
View File

@ -6,11 +6,11 @@ SYMBOL: variable?
#! For word props: will this be a var in an infix expression? #! For word props: will this be a var in an infix expression?
PREDICATE: word var PREDICATE: word var
#! Class of variables #! Class of variables
variable? word-property ; variable? word-prop ;
SYMBOL: constant? SYMBOL: constant?
#! Word prop for things like pi and e #! Word prop for things like pi and e
PREDICATE: word con PREDICATE: word con
constant? word-property ; constant? word-prop ;
PREDICATE: cons single PREDICATE: cons single
#! Single-element list #! Single-element list
@ -45,7 +45,7 @@ M: list-nvl infix
: VARIABLE: : VARIABLE:
#! Make a variable, which acts like a symbol #! Make a variable, which acts like a symbol
CREATE dup define-symbol t variable? set-word-property ; parsing CREATE dup define-symbol t variable? set-word-prop ; parsing
VARIABLE: x VARIABLE: x
VARIABLE: y VARIABLE: y
VARIABLE: z VARIABLE: z
@ -86,11 +86,11 @@ M: var (eval-infix)
: swap-in-infix ( var fix1 fix2 -- [ fix1solved swap fix2solved ] ) : swap-in-infix ( var fix1 fix2 -- [ fix1solved swap fix2solved ] )
>r dupd (eval-infix) swap r> (eval-infix) \ swap swons append ; >r dupd (eval-infix) swap r> (eval-infix) \ swap swons append ;
M: list3 (eval-infix) M: list3 (eval-infix)
unswons arith-2 word-property unit -rot 2unlist unswons arith-2 word-prop unit -rot 2unlist
swap-in-infix \ dup swons swap append ; swap-in-infix \ dup swons swap append ;
M: list2 (eval-infix) M: list2 (eval-infix)
2unlist swapd (eval-infix) swap arith-1 word-property unit append ; 2unlist swapd (eval-infix) swap arith-1 word-prop unit append ;
: build-prefix ( num-of-vars -- quote ) : build-prefix ( num-of-vars -- quote )
#! What needs to be placed in front of the eval-infix quote #! What needs to be placed in front of the eval-infix quote
@ -122,25 +122,25 @@ DEFER: fold-consts
#! :| sq x |: x * x ; #! :| sq x |: x * x ;
CREATE [ CREATE [
"in-defintion" off "in-defintion" off
3dup nip "infix-code" set-word-property 3dup nip "infix-code" set-word-prop
end-infix define-compound end-infix define-compound
] f "in-definition" on ; parsing ] f "in-definition" on ; parsing
: |: : |:
#! :| sq x |: x * x ; #! :| sq x |: x * x ;
reverse 3dup nip "infix-args" set-word-property reverse 3dup nip "infix-args" set-word-prop
swap f ; parsing swap f ; parsing
: .w/o-line ( obj -- ) : .w/o-line ( obj -- )
[ one-line on 4 swap prettyprint* drop ] with-scope ; [ one-line on 4 swap prettyprint* drop ] with-scope ;
PREDICATE: compound infix-word "infix-code" word-property ; PREDICATE: compound infix-word "infix-code" word-prop ;
M: infix-word see M: infix-word see
dup prettyprint-IN: dup prettyprint-IN:
":| " write dup prettyprint-word " " write ":| " write dup prettyprint-word " " write
dup "infix-args" word-property [ prettyprint-word " " write ] each dup "infix-args" word-prop [ prettyprint-word " " write ] each
"|:\n " write "|:\n " write
"infix-code" word-property .w/o-line "infix-code" word-prop .w/o-line
" ;" print ; " ;" print ;
@ -177,17 +177,17 @@ M: infix-word see
! Install arithmetic operators into words ! Install arithmetic operators into words
[ + - / * ^ and or xor mod +- min gcd max bitand polar> align shift /mod /i /f rect> bitor proj [ + - / * ^ and or xor mod +- min gcd max bitand polar> align shift /mod /i /f rect> bitor proj
bitxor dot rem || ] [ bitxor dot rem || ] [
dup arith-2 set-word-property dup arith-2 set-word-prop
] each ] each
[ [[ = new= ]] [[ > new> ]] [[ < new< ]] [[ >= new>= ]] [[ <= new<= ]] ] [ [ [[ = new= ]] [[ > new> ]] [[ < new< ]] [[ >= new>= ]] [[ <= new<= ]] ] [
uncons arith-2 set-word-property uncons arith-2 set-word-prop
] each ] each
[ sqrt abs fac sq asin denominator rational? rad>deg exp recip sgn >rect acoth arg fixnum [ sqrt abs fac sq asin denominator rational? rad>deg exp recip sgn >rect acoth arg fixnum
bitnot sinh acosec acosh acosech complex? ratio? number? >polar number= cis deg>rad >fixnum bitnot sinh acosec acosh acosech complex? ratio? number? >polar number= cis deg>rad >fixnum
cot cos sec cosec tan imaginary coth asech atanh absq >float numerator acot acos atan asec cot cos sec cosec tan imaginary coth asech atanh absq >float numerator acot acos atan asec
cosh log bignum? conjugate asinh sin float? real? >bignum tanh sech ] [ cosh log bignum? conjugate asinh sin float? real? >bignum tanh sech ] [
dup arith-1 set-word-property dup arith-1 set-word-prop
] each ] each
[ [[ - neg ]] ] [ uncons arith-1 set-word-property ] each [ [[ - neg ]] ] [ uncons arith-1 set-word-prop ] each
[ pi i e -i inf -inf pi/2 ] [ t constant? set-word-property ] each [ pi i e -i inf -inf pi/2 ] [ t constant? set-word-prop ] each