changes to algebra

contrib/algebra/README.TXT

@@ -1,5 +1,5 @@
-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.
+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 make a seperate word to evaluate it in. The syntax for this is :| name | args |: body ; . 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. When opening the files in this package, open first infix.factor, then algebra.factor, then repl.factor. To close, here's an implementation of the quadratic formula using infix math. This is included in the module.
-: quadratic-formula (| a b c |
+:| quadratic-formula a b c |:
-    [ [ - b ] / 2 * a ] +- [ sqrt [ sq b ] - 4 * a * c ] / 2 * a |) ;
+    [ [ - 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

contrib/algebra/algebra.factor

@@ -50,5 +50,6 @@ M: list3 (install-mod)
     #! the given one using modular arithmetic.
     >r modularity swons r> (install-mod) ;
 
-: quadratic-formula (| a b c |
+:| quadratic-formula a b c |:
-    [ [ - b ] / 2 * a ] +- [ sqrt [ sq b ] - 4 * a * c ] / 2 * a |) ;
+    [ [ - b ] / 2 * a ] +- [ sqrt [ sq b ] - 4 * a * c ] / 2 * a ;
+

contrib/algebra/infix.factor

@@ -52,6 +52,7 @@ VARIABLE: z
 VARIABLE: a
 VARIABLE: b
 VARIABLE: c
+VARIABLE: d
 
 SYMBOL: arith-1
     #! Word prop for unary mathematical function
@@ -106,9 +107,42 @@ M: list2 (eval-infix)
     over length build-prefix -rot (eval-infix) append ;
 
 DEFER: fold-consts
-: (| f ; parsing
+: (| f ; parsing ! delete
-: | reverse f ; parsing
+: | reverse f ; parsing ! delete
-: |) reverse infix fold-consts eval-infix swons \ call swons ; parsing
+: end-infix ( vars reverse-infix -- code )
+    infix fold-consts eval-infix ;
+: |) reverse end-infix swons \ call swons ; parsing ! delete
+
+: 3keep
+    #! like keep or 2keep but with 3
+    -rot >r >r swap r> r> 3dup
+    >r >r >r >r rot r> swap call r> r> r> ;
+
+: :|
+    #! :| sq x |: x * x ;
+    CREATE [
+        "in-defintion" off
+        3dup nip "infix-code" set-word-property
+        end-infix define-compound
+    ] f "in-definition" on ; parsing
+: |:
+    #! :| sq x |: x * x ;
+    reverse 3dup nip "infix-args" set-word-property
+    swap f ; parsing
+
+: .w/o-line ( obj -- )
+    [ one-line on 4 swap prettyprint* drop ] with-scope ;
+
+PREDICATE: compound infix-word "infix-code" word-property ;
+
+M: infix-word see
+    dup prettyprint-IN:
+    ":| " write dup prettyprint-word " " write
+    dup "infix-args" word-property [ prettyprint-word " " write ] each
+    "|:\n    " write
+    "infix-code" word-property .w/o-line
+    " ;" print ;
+
 
 : (fac) dup 0 = [ drop ] [ dup 1 - >r * r> (fac) ] ifte ;
 : fac
@@ -138,9 +172,11 @@ DEFER: fold-consts
 : +- ( a b -- a+b a-b )
     [ + ] 2keep - ;
 
+: || ;
+
 ! Install arithmetic operators into words
 [ + - / * ^ 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
 ] each
 [ [[ = new= ]] [[ > new> ]] [[ < new< ]] [[ >= new>= ]] [[ <= new<= ]] ] [
@@ -154,3 +190,4 @@ DEFER: fold-consts
 ] each
 [ [[ - neg ]] ] [ uncons arith-1 set-word-property ] each
 [ pi i e -i inf -inf pi/2 ] [ t constant? set-word-property ] each
+