Commit 27a3b137 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

number factorisation Lisp code, ported from lingo, and the builtins

to make it work (<<, >>, %)
parent 054ab35f
(defun last-pair (l)
"Return the last pair of list L, or nil if L is nil"
(while (cdr l)
(setq l (cdr l)))
l)
(setq *primes* '(2 3))
(setq *last-prime-pair* (last-pair *primes*))
(defun add-next-prime (n)
(let ((newlast (list n)))
(rplacd *last-prime-pair* newlast)
(setq *last-prime-pair* newlast)))
(defun highest-prime ()
(car *last-prime-pair*))
(defun have-divisor (n)
(let ((limit (isqrt n))
(p *primes*)
result)
(while (and p (<= (car p) limit))
(if (zerop (% n (car p)))
(progn (setq result t)
(setq p nil)))
(setq p (cdr p)))
result))
(defun grow-primes ()
(let ((candidate (+ (highest-prime) 2)))
(while (have-divisor candidate)
(setq candidate (+ candidate 2)))
(add-next-prime candidate)))
(defun next-prime ()
(while (null (cdr next-p))
(grow-primes))
(let ((this-one (car next-p)))
(setq next-p (cdr next-p))
this-one))
(defun factor (n &optional print-factor)
(setq next-p *primes*)
(let ((limit (isqrt n))
(working t)
(result '()))
(while working
(let ((p (next-prime)))
(if (<= p limit)
(while (and (> n 1)
(zerop (% n p)))
(setq result (cons p result))
(if print-factor
(format t " %d" p))
(setq n (/ n p)))
(setq working nil))))
(if (> n 1)
(progn
(setq result (cons n result))
(if print-factor
(format t " %d" n))))
(if print-factor (terpri))
(nreverse result)))
(defun isqrt (n)
(let ((op n)
(res 0)
(one (<< 1 62)))
(while (> one op)
(setq one (>> one 2))
(while (not (zerop one))
(if (> op (+ res one))
(progn
(setq op (- op (+ res one)))
(setq res (+ res (<< one 1)))))
(setq res (>> res 1))
(setq one (>> one 2))))
res))
;; func isqrt(args []lob.Object) lob.Object {
;; n := numberValue(args[0], "isqrt:")
;; op := uint64(n)
;; res := uint64(0)
;; one := uint64(1 << 62)
;; for one > op {
;; one >>= 2
;; }
;; for one != 0 {
;; if op >= res+one {
;; op -= res + one
;; res += one << 1 // <-- faster than 2 * one
;; }
;; res >>= 1
;; one >>= 2
;; }
;; return lob.NewNumber(float64(res))
;; }
......@@ -6,6 +6,39 @@
# %P: parameter declarations
# %C: code
N: Remainder
T: f
F: %
D=
Return remainder of NUM1 divided by NUM2 (which must be fixnums).
EOD
P: num1 num2
C=
return ((NumberAtom) num1).remainder(num2);
EOC
---
N: ShiftRight
T: f
F: >>
D=
Shift N right by BITS.
EOD
P: n bits
C=
return ((NumberAtom) n).shiftRight(bits);
EOC
---
N: ShiftLeft
T: f
F: <<
D=
Shift N left by BITS.
EOD
P: n bits
C=
return ((NumberAtom) n).shiftLeft(bits);
EOC
---
N: Print
T: f
F: print
......
#!/usr/local/bin/perl -w
#!/usr/bin/perl -w
use strict ; $0 =~ s/.*\/// ; # -*- perl -*-
use Data::Dumper ;
......
......@@ -79,6 +79,19 @@ public class Fixnum extends NumberAtom {
}
}
/** Remainder.
* @param operand the right-side operand of the operation.
* @return the result of the operation, with possibly a different NumberAtom
* type.
*/
public NumberAtom remainder(LispObject operand) throws EvalException {
if (operand instanceof Fixnum) {
return new Fixnum(value % ((Fixnum) operand).value) ;
} else {
throw new EvalException("operand is not a fixnum: %s", operand) ;
}
}
/** Division.
* @param operand the right-side operand of the operation.
* @return the result of the operation, with possibly a different NumberAtom
......@@ -94,6 +107,32 @@ public class Fixnum extends NumberAtom {
}
}
/** Shift right.
* @param operand the right-side operand of the operation.
* @return the result of the operation, with possibly a different NumberAtom
* type.
*/
public NumberAtom shiftRight(LispObject operand) throws EvalException {
if (operand instanceof Fixnum) {
return new Fixnum(value >> ((Fixnum) operand).value) ;
} else {
throw new EvalException("operand is not a fixnum: %s", operand) ;
}
}
/** Shift left.
* @param operand the right-side operand of the operation.
* @return the result of the operation, with possibly a different NumberAtom
* type.
*/
public NumberAtom shiftLeft(LispObject operand) throws EvalException {
if (operand instanceof Fixnum) {
return new Fixnum(value << ((Fixnum) operand).value) ;
} else {
throw new EvalException("operand is not a fixnum: %s", operand) ;
}
}
/** Return true iff the argument is equal to this.
* @param other the object to compare with.
* @return true iff the argument is equal to this.
......
......@@ -79,6 +79,15 @@ public class Flonum extends NumberAtom {
}
}
/** Remainder.
* @param operand the right-side operand of the operation.
* @return throw an exception, we do this for fixnums only
* type.
*/
public NumberAtom remainder(LispObject operand) throws EvalException {
throw new EvalException("operand is not a fixnum: %s", operand) ;
}
/** Division.
* @param operand the right-side operand of the operation.
* @return the result of the operation, with possibly a different NumberAtom
......@@ -94,6 +103,24 @@ public class Flonum extends NumberAtom {
}
}
/** Shift right.
* @param operand the right-side operand of the operation.
* @return throw an exception, as we do this only for integers
* type.
*/
public NumberAtom shiftRight(LispObject operand) throws EvalException {
throw new EvalException("operand is not a fixnum: %s", this) ;
}
/** Shift left.
* @param operand the right-side operand of the operation.
* @return throw an exception, as we do this only for integers
* type.
*/
public NumberAtom shiftLeft(LispObject operand) throws EvalException {
throw new EvalException("operand is not a fixnum: %s", this) ;
}
public LispObject gt(LispObject operand) throws EvalException {
if (operand instanceof Fixnum) {
return value > ((Fixnum) operand).value ? T.t : Nil.nil ;
......
......@@ -65,4 +65,8 @@ public abstract class NumberAtom extends Atom {
* type.
*/
abstract public NumberAtom divide(LispObject operand) throws EvalException ;
abstract public NumberAtom shiftLeft(LispObject operand) throws EvalException ;
abstract public NumberAtom shiftRight(LispObject operand) throws EvalException ;
abstract public NumberAtom remainder(LispObject operand) throws EvalException ;
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment