[Pleac-commits] CVS: pleac/pleac/include/picolisp/ch02 bigfact, NONE, 1.1

[Guillaume C. <gg...@us...>]

Update of /cvsroot/pleac/pleac/pleac/include/picolisp/ch02
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv28000/include/picolisp/ch02

Added Files:
	bigfact 
Log Message:
add picolisp from Alexander Burger

--- NEW FILE: bigfact ---
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(load "@lib/misc.l")

(de factor (N)
   (make
      (let (D 2  L (1 2 2 . (4 2 4 2 4 6 2 6 .))  M (sqrt N))
         (while (>= M D)
            (if (=0 (% N D))
               (setq M (sqrt (setq N (/ N (link D)))))
               (inc 'D (pop 'L)) ) )
         (link N) ) ) )

(while (opt)
   (let? N (format @)
      (let Factors (factor N)
         (tab (-11 1 -60)
            N
            " "
            (ifn (cdr Factors)
               "PRIME"
               (glue " "
                  (mapcar
                     '((L)
                        (if (cdr L)
                           (pack (car L) "**" (length L))
                           (car L) ) )
                     (by prog group Factors) ) ) ) ) ) ) )

(bye)