picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

fannkuch.l (1163B)

      1 # 07nov09abu
      2 # (c) Software Lab. Alexander Burger
      3 # Fannkuch benchmark (http://shootout.alioth.debian.org)
      4 
      5 (de fannkuch (N)
      6    (let (Lst (range 1 N)  L Lst  Max)
      7       (recur (L)  # Permute
      8          (if (cdr L)
      9             (do (length L)
     10                (recurse (cdr L))
     11                (rot L) )
     12             (zero N)  # For each permutation
     13             (for (P (copy Lst)  (> (car P) 1)  (flip P (car P)))
     14                (inc 'N) )
     15             (setq Max (max N Max)) ) )
     16       Max ) )
     17 
     18 # Parallelized version
     19 (de fannkuch+ (N)
     20    (let (Res (need N)  Lst (range 1 N)  L Lst  Max)
     21       (for (R Res R (cdr R))
     22          (later R
     23             (let L (cdr Lst)
     24                (recur (L)  # Permute
     25                   (if (cdr L)
     26                      (do (length L)
     27                         (recurse (cdr L))
     28                         (rot L) )
     29                      (zero N)  # For each permutation
     30                      (for (P (copy Lst)  (> (car P) 1)  (flip P (car P)))
     31                         (inc 'N) )
     32                      (setq Max (max N Max)) ) )
     33                Max ) )
     34          (rot Lst) )
     35       (wait NIL (full Res))
     36       (apply max Res) ) )
     37 
     38 # vi:et:ts=3:sw=3