oops
Slava Pestov
parent
cf8b059c9b
commit
e376755fda
|
|
@ -1,5 +0,0 @@
|
|||
This is the infix minilanguage created by Daniel Ehrenberg, allowing you to do infix math in Factor. The syntax is simple: all operators are right-associative, and square brackets ('[' and ']') are used for paretheses. The syntax for creating an infix expression is ([ infix code goes here ]). That will leave the expression in the internal s-expression format which is easier to process by the evaluator and the CAS. The CAS subsystem of the infix minilanguage does algebra. Currently, it doesn't do very much, only modular arithmetic, though there may be more by the time you read this. There is also constant folding. The way to evaluate an infix expression is to use the synatx (| args | expression |). Args are one or more variables that you use in the expression. Their values come from the stack. Variables are effectively substituted in to the expression. To make a new variable, use the syntax VARIABLE: variablename in top level code. The variables included by default are x, y, z, a, b, and c. To make a new operator, just set its arith-1 and/or arith-2 word properties, which should link to a word that is the unary or binary arithmetic version, respectively. To make a new constant, like pi, just set the constant? word property of a word that pushes it to t. To close, here's an implementation of the quadratic formula using infix math. This is included in the module.
|
||||
: quadratic-formula (| a b c |
|
||||
[ [ - b ] / 2 * a ] +- [ sqrt [ sq b ] - 4 * a * c ] / 2 * a |) ;
|
||||
|
||||
If you find any bugs in this or have any questions, please contact me at microdan @ gmail . com, ask LittleDan@irc.freenode.net, or ask irc.freenode.net/#concatenative
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
This is the infix minilanguage created by Daniel Ehrenberg, allowing you to do infix math in Factor. The syntax is simple: all operators are right-associative, and square brackets ('[' and ']') are used for paretheses. The syntax for creating an infix expression is ([ infix code goes here ]). That will leave the expression in the internal s-expression format which is easier to process by the evaluator and the CAS. The CAS subsystem of the infix minilanguage does algebra. Currently, it doesn't do very much, only modular arithmetic, though there may be more by the time you read this. There is also constant folding. The way to evaluate an infix expression is to use the synatx (| args | expression |). Args are one or more variables that you use in the expression. Their values come from the stack. Variables are effectively substituted in to the expression. To make a new variable, use the syntax VARIABLE: variablename in top level code. The variables included by default are x, y, z, a, b, and c. To make a new operator, just set its arith-1 and/or arith-2 word properties, which should link to a word that is the unary or binary arithmetic version, respectively. To make a new constant, like pi, just set the constant? word property of a word that pushes it to t. To close, here's an implementation of the quadratic formula using infix math. This is included in the module.
|
||||
: quadratic-formula (| a b c |
|
||||
[ [ - b ] / 2 * a ] +- [ sqrt [ sq b ] - 4 * a * c ] / 2 * a |) ;
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
IN: algebra USING: lists math kernel words namespaces ;
|
||||
|
||||
GENERIC: (fold-consts) ( infix -- infix ? )
|
||||
|
||||
M: number (fold-consts)
|
||||
f ;
|
||||
M: var (fold-consts)
|
||||
t ;
|
||||
M: list2 (fold-consts)
|
||||
2unlist (fold-consts) [
|
||||
2list t
|
||||
] [
|
||||
swap arith-1 word-property unit call f
|
||||
] ifte ;
|
||||
M: list3 (fold-consts)
|
||||
3unlist >r (fold-consts) r> swapd (fold-consts) >r rot r> or [
|
||||
3list t
|
||||
] [
|
||||
rot arith-2 word-property unit call f
|
||||
] ifte ;
|
||||
|
||||
: fold-consts ( infix -- infix )
|
||||
#! Given a mathematical s-expression, perform constant folding,
|
||||
#! which is doing all the calculations it can do without any
|
||||
#! variables added.
|
||||
(fold-consts) drop ;
|
||||
|
||||
|
||||
VARIABLE: modularity
|
||||
#! This is the variable that stores what mod we're in
|
||||
|
||||
|
||||
GENERIC: (install-mod) ( infix -- infix-with-mod )
|
||||
|
||||
: put-mod ( object -- [ mod object modularity ] )
|
||||
[ \ mod , , modularity , ] make-list ;
|
||||
|
||||
M: num/vc (install-mod)
|
||||
put-mod ;
|
||||
|
||||
M: list2 (install-mod)
|
||||
2unlist (install-mod) 2list put-mod ;
|
||||
|
||||
M: list3 (install-mod)
|
||||
3unlist (install-mod) swap (install-mod) swap 3list put-mod ;
|
||||
|
||||
: install-mod ( arglist infix -- new-arglist infix-with-mod)
|
||||
#! Given an argument list and an infix expression, produce
|
||||
#! a new arglist and a new infix expression that will evaluate
|
||||
#! the given one using modular arithmetic.
|
||||
>r modularity swons r> (install-mod) ;
|
||||
|
||||
: quadratic-formula (| a b c |
|
||||
[ [ - b ] / 2 * a ] +- [ sqrt [ sq b ] - 4 * a * c ] / 2 * a |) ;
|
||||
|
|
@ -1,150 +0,0 @@
|
|||
IN: algebra
|
||||
USING: kernel lists math namespaces test stdio words parser generic errors prettyprint vectors ;
|
||||
|
||||
SYMBOL: variable?
|
||||
#! For word props: will this be a var in an infix expression?
|
||||
PREDICATE: word var
|
||||
#! Class of variables
|
||||
variable? word-property ;
|
||||
SYMBOL: constant?
|
||||
#! Word prop for things like pi and e
|
||||
PREDICATE: word con
|
||||
constant? word-property ;
|
||||
|
||||
PREDICATE: cons single
|
||||
#! Single-element list
|
||||
cdr not ;
|
||||
UNION: num/vc number var con ;
|
||||
PREDICATE: cons list-word
|
||||
#! List where first element is a word but not a variable
|
||||
unswons tuck word? and [ var? not ] [ drop f ] ifte ;
|
||||
PREDICATE: cons list-nvl
|
||||
#! List where first element is a number, variable, or list
|
||||
unswons dup num/vc? swap cons? or and ;
|
||||
UNION: num/con number con ;
|
||||
|
||||
GENERIC: infix ( list -- list )
|
||||
#! Parse an infix expression. This is right associative
|
||||
#! and everything has equal precendence. The output is
|
||||
#! an s-expression. Operators can be unary or binary.
|
||||
M: num/vc infix ;
|
||||
M: single infix car infix ;
|
||||
M: list-word infix
|
||||
uncons infix 2list ;
|
||||
M: list-nvl infix
|
||||
unswons infix swap uncons infix swapd 3list ;
|
||||
|
||||
|
||||
: ([
|
||||
#! Begin a literal infix expression
|
||||
[ ] ; parsing
|
||||
: ])
|
||||
#! End a literal infix expression.
|
||||
reverse infix swons ; parsing
|
||||
|
||||
: VARIABLE:
|
||||
#! Make a variable, which acts like a symbol
|
||||
CREATE dup define-symbol t variable? set-word-property ; parsing
|
||||
VARIABLE: x
|
||||
VARIABLE: y
|
||||
VARIABLE: z
|
||||
VARIABLE: a
|
||||
VARIABLE: b
|
||||
VARIABLE: c
|
||||
|
||||
SYMBOL: arith-1
|
||||
#! Word prop for unary mathematical function
|
||||
SYMBOL: arith-2
|
||||
#! Word prop for binary mathematical function
|
||||
SYMBOL: nsmanip?
|
||||
#! Does this manipulate the namestack (Should vars be allowed?)
|
||||
|
||||
PREDICATE: cons list2
|
||||
#! List of 2 elements
|
||||
length 2 = ;
|
||||
PREDICATE: cons list3
|
||||
#! List of 3 elements
|
||||
length 3 = ;
|
||||
PREDICATE: list2 namestack-manip
|
||||
#! List of 2 elements that manipulates the namestack
|
||||
car nsmanip? word-property ;
|
||||
|
||||
|
||||
GENERIC: (eval-infix) ( varstuff infix -- quote )
|
||||
|
||||
M: num/con (eval-infix)
|
||||
nip unit \ drop swons ;
|
||||
|
||||
: (find) ( counter item list -- index )
|
||||
dup [
|
||||
2dup car = [ 2drop ] [ >r >r 1 + r> r> cdr (find) ] ifte
|
||||
] [
|
||||
"Undefined variable in infix expression" throw
|
||||
] ifte ;
|
||||
: find ( list item -- index )
|
||||
0 -rot swap (find) ;
|
||||
M: var (eval-infix)
|
||||
find [ swap vector-nth ] cons ;
|
||||
|
||||
: swap-in-infix ( var fix1 fix2 -- [ fix1solved swap fix2solved ] )
|
||||
>r dupd (eval-infix) swap r> (eval-infix) \ swap swons append ;
|
||||
M: list3 (eval-infix)
|
||||
unswons arith-2 word-property unit -rot 2unlist
|
||||
swap-in-infix \ dup swons swap append ;
|
||||
|
||||
M: list2 (eval-infix)
|
||||
2unlist swapd (eval-infix) swap arith-1 word-property unit append ;
|
||||
|
||||
M: namestack-manip (eval-infix)
|
||||
nip 2unlist swap 2list \ drop swons ;
|
||||
|
||||
: eval-infix
|
||||
#! Given a list of variables and an infix expression in s-expression
|
||||
#! form, build a quotation which takes as many arguments from the
|
||||
#! datastack as there are elements in the varnames list, builds
|
||||
#! it into a vector, and calculates the values of the expression with
|
||||
#! the values filled in.
|
||||
over length [ f , [ \ cons , ] times ] make-list
|
||||
[ list>vector ] append -rot (eval-infix) append ;
|
||||
|
||||
: (| f ; parsing
|
||||
: | reverse f ; parsing
|
||||
: |) reverse infix fold-consts eval-infix swons \ call swons ; parsing
|
||||
|
||||
: (fac) dup 0 = [ drop ] [ dup 1 - >r * r> (fac) ] ifte ;
|
||||
: fac
|
||||
#! Factorial
|
||||
1 swap (fac) ;
|
||||
|
||||
: infix-relation
|
||||
#! Wraps operators like = and > so that if they're given
|
||||
#! f as either argument, they return f, and they return f if
|
||||
#! the operation yields f, but if it yields t, it returns the
|
||||
#! left argument. This way, these types of operations can be
|
||||
#! composed.
|
||||
>r 2dup and not [
|
||||
r> 3drop f
|
||||
] [
|
||||
dupd r> call [
|
||||
drop f
|
||||
] unless
|
||||
] ifte ;
|
||||
! Wrapped operations
|
||||
: new= [ = ] infix-relation ;
|
||||
: new> [ > ] infix-relation ;
|
||||
: new< [ < ] infix-relation ;
|
||||
: new>= [ >= ] infix-relation ;
|
||||
: new<= [ <= ] infix-relation ;
|
||||
|
||||
: +- ( a b -- a+b a-b )
|
||||
[ + ] 2keep - ;
|
||||
|
||||
! Install arithmetic operators into words
|
||||
[ + - / * ^ and or mod +- ] [ dup arith-2 set-word-property ] each
|
||||
[ [[ = new= ]] [[ > new> ]] [[ < new< ]] [[ >= new>= ]] [[ <= new<= ]] ] [
|
||||
uncons arith-2 set-word-property
|
||||
] each
|
||||
[ sqrt abs fac get sq ] [ dup arith-1 set-word-property ] each
|
||||
[ [[ - neg ]] ] [ uncons arith-1 set-word-property ] each
|
||||
\ get t nsmanip? set-word-property
|
||||
[ pi i e -i inf -inf pi/2 ] [ t constant? set-word-property ] each
|
||||
|
|
@ -1,150 +0,0 @@
|
|||
IN: algebra
|
||||
USING: kernel lists math namespaces test stdio words parser generic errors prettyprint vectors ;
|
||||
|
||||
SYMBOL: variable?
|
||||
#! For word props: will this be a var in an infix expression?
|
||||
PREDICATE: word var
|
||||
#! Class of variables
|
||||
variable? word-property ;
|
||||
SYMBOL: constant?
|
||||
#! Word prop for things like pi and e
|
||||
PREDICATE: word con
|
||||
constant? word-property ;
|
||||
|
||||
PREDICATE: cons single
|
||||
#! Single-element list
|
||||
cdr not ;
|
||||
UNION: num/vc number var con ;
|
||||
PREDICATE: cons list-word
|
||||
#! List where first element is a word but not a variable
|
||||
unswons tuck word? and [ var? not ] [ drop f ] ifte ;
|
||||
PREDICATE: cons list-nvl
|
||||
#! List where first element is a number, variable, or list
|
||||
unswons dup num/vc? swap cons? or and ;
|
||||
UNION: num/con number con ;
|
||||
|
||||
GENERIC: infix ( list -- list )
|
||||
#! Parse an infix expression. This is right associative
|
||||
#! and everything has equal precendence. The output is
|
||||
#! an s-expression. Operators can be unary or binary.
|
||||
M: num/vc infix ;
|
||||
M: single infix car infix ;
|
||||
M: list-word infix
|
||||
uncons infix 2list ;
|
||||
M: list-nvl infix
|
||||
unswons infix swap uncons infix swapd 3list ;
|
||||
|
||||
|
||||
: ([
|
||||
#! Begin a literal infix expression
|
||||
[ ] ; parsing
|
||||
: ])
|
||||
#! End a literal infix expression.
|
||||
reverse infix swons ; parsing
|
||||
|
||||
: VARIABLE:
|
||||
#! Make a variable, which acts like a symbol
|
||||
CREATE dup define-symbol t variable? set-word-property ; parsing
|
||||
VARIABLE: x
|
||||
VARIABLE: y
|
||||
VARIABLE: z
|
||||
VARIABLE: a
|
||||
VARIABLE: b
|
||||
VARIABLE: c
|
||||
|
||||
SYMBOL: arith-1
|
||||
#! Word prop for unary mathematical function
|
||||
SYMBOL: arith-2
|
||||
#! Word prop for binary mathematical function
|
||||
SYMBOL: nsmanip?
|
||||
#! Does this manipulate the namestack (Should vars be allowed?)
|
||||
|
||||
PREDICATE: cons list2
|
||||
#! List of 2 elements
|
||||
length 2 = ;
|
||||
PREDICATE: cons list3
|
||||
#! List of 3 elements
|
||||
length 3 = ;
|
||||
PREDICATE: list2 namestack-manip
|
||||
#! List of 2 elements that manipulates the namestack
|
||||
car nsmanip? word-property ;
|
||||
|
||||
|
||||
GENERIC: (eval-infix) ( varstuff infix -- quote )
|
||||
|
||||
M: num/con (eval-infix)
|
||||
nip unit \ drop swons ;
|
||||
|
||||
: (find) ( counter item list -- index )
|
||||
dup [
|
||||
2dup car = [ 2drop ] [ >r >r 1 + r> r> cdr (find) ] ifte
|
||||
] [
|
||||
"Undefined variable in infix expression" throw
|
||||
] ifte ;
|
||||
: find ( list item -- index )
|
||||
0 -rot swap (find) ;
|
||||
M: var (eval-infix)
|
||||
find [ swap vector-nth ] cons ;
|
||||
|
||||
: swap-in-infix ( var fix1 fix2 -- [ fix1solved swap fix2solved ] )
|
||||
>r dupd (eval-infix) swap r> (eval-infix) \ swap swons append ;
|
||||
M: list3 (eval-infix)
|
||||
unswons arith-2 word-property unit -rot 2unlist
|
||||
swap-in-infix \ dup swons swap append ;
|
||||
|
||||
M: list2 (eval-infix)
|
||||
2unlist swapd (eval-infix) swap arith-1 word-property unit append ;
|
||||
|
||||
M: namestack-manip (eval-infix)
|
||||
nip 2unlist swap 2list \ drop swons ;
|
||||
|
||||
: eval-infix
|
||||
#! Given a list of variables and an infix expression in s-expression
|
||||
#! form, build a quotation which takes as many arguments from the
|
||||
#! datastack as there are elements in the varnames list, builds
|
||||
#! it into a vector, and calculates the values of the expression with
|
||||
#! the values filled in.
|
||||
over length [ f , [ \ cons , ] times ] make-list
|
||||
[ list>vector ] append -rot (eval-infix) append ;
|
||||
|
||||
: (| f ; parsing
|
||||
: | reverse f ; parsing
|
||||
: |) reverse infix eval-infix swons \ call swons ; parsing
|
||||
|
||||
: (fac) dup 0 = [ drop ] [ dup 1 - >r * r> (fac) ] ifte ;
|
||||
: fac
|
||||
#! Factorial
|
||||
1 swap (fac) ;
|
||||
|
||||
: infix-relation
|
||||
#! Wraps operators like = and > so that if they're given
|
||||
#! f as either argument, they return f, and they return f if
|
||||
#! the operation yields f, but if it yields t, it returns the
|
||||
#! left argument. This way, these types of operations can be
|
||||
#! composed.
|
||||
>r 2dup and not [
|
||||
r> 3drop f
|
||||
] [
|
||||
dupd r> call [
|
||||
drop f
|
||||
] unless
|
||||
] ifte ;
|
||||
! Wrapped operations
|
||||
: new= [ = ] infix-relation ;
|
||||
: new> [ > ] infix-relation ;
|
||||
: new< [ < ] infix-relation ;
|
||||
: new>= [ >= ] infix-relation ;
|
||||
: new<= [ <= ] infix-relation ;
|
||||
|
||||
: +- ( a b -- a+b a-b )
|
||||
[ + ] 2keep - ;
|
||||
|
||||
! Install arithmetic operators into words
|
||||
[ + - / * ^ and or mod +- ] [ dup arith-2 set-word-property ] each
|
||||
[ [[ = new= ]] [[ > new> ]] [[ < new< ]] [[ >= new>= ]] [[ <= new<= ]] ] [
|
||||
uncons arith-2 set-word-property
|
||||
] each
|
||||
[ sqrt abs fac get sq ] [ dup arith-1 set-word-property ] each
|
||||
[ [[ - neg ]] ] [ uncons arith-1 set-word-property ] each
|
||||
\ get t nsmanip? set-word-property
|
||||
[ pi i e -i inf -inf pi/2 ] [ t constant? set-word-property ] each
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
USING: algebra test math kernel ;
|
||||
|
||||
[ [ - [ + x [ mod [ * 2 pi ] 4 ] ] ] ] [
|
||||
([ - x + [ 2 * pi ] mod 4 ])
|
||||
] unit-test
|
||||
[ 13/3 ] [
|
||||
1 2 3 [ x y z ] ([ [ sq y ] + x / z ]) eval-infix call
|
||||
] unit-test
|
||||
[ [ + x 1/2 ] ] [ ([ x + 3 / 6 ]) fold-consts ] unit-test
|
||||
[ 1 ] [ 5 3 [ x ] ([ sq x + 6 ]) install-mod eval-infix call ] unit-test
|
||||
[ 1.0 -1.0 ] [ 1 0 -1 quadratic-formula ] unit-test
|
||||
Loading…
Reference in New Issue