Janet stuff

bf.janet

(def bf-peg
  (do
    (defn pair-sym [up down f]
      ~(/ (some (+ (* :skip (/ '(some ,up) ,length))
                   (* :skip (/ '(some ,down) ,(comp - length)))))
          ,(comp f +)))
    ~{:skip    (any (if-not (set "+-<>[],.") 1))
      :add    ,(pair-sym "+" "-" |~(+= (mem ptr) ,$))
      :shift  ,(pair-sym ">" "<" |~(+= ptr ,$))
      :output  (/ "." (:write stdout (string/from-bytes (mem ptr))))
      :input   (/ "," (set (mem ptr) ((:read stdin 1) 0)))
      :loop    (/ (* "[" :chunk "]") ,|~(while (not= 0 (mem ptr)) ,;$&))
      :stmt    (+ :add :shift :loop :output :input :skip)
      :chunk   (any :stmt)
      :main    (* :chunk -1)}))

(def bf-compiled-peg (peg/compile bf-peg))

(defn bf-compile [src &opt mem-size]
  (default mem-size 65536)
  (compile
    ~(do
       (def mem (buffer/new-filled ,mem-size))
       (var ptr 0)
       ,;(assert (peg/match bf-compiled-peg src) "compile error")
       nil)))

(defn bf-run [src & opts]
  (def prog (bf-compile src ;opts))
  (prog))

(defn main [prog srcfile]
  (with [f (file/open srcfile)]
    (bf-run (file/read f :all))))

nbody.janet

(defn system-energy [bodies]
  (var e 0)
  (loop [i :range [0 (length bodies)]
         :let [[bim [bix biy biz] [vx vy vz]] (in bodies i)
               ek (* 0.5 bim (+ (* vx vx) (* vy vy) (* vz vz)))]
         :before (+= e ek)
         j :range [0 i]
         :let [[bjm [bjx bjy bjz] _] (in bodies j)
                 [dx dy dz] [(- bix bjx) (- biy bjy) (- biz bjz)]
                 dist (math/sqrt (+ (* dx dx) (* dy dy) (* dz dz)))
                 ep (/ (* bim bjm) dist)]]
    (-= e ep))
  e)

(defmacro vec [v op1 u op2 m]
  ~(do ,;(seq [i :range [0 (length u)]]
           ~(,op1 (,v ,i) (,op2 ,(u i) ,m)))))

(defn system-advance [dt bodies]
  (loop [i :range [0 (length bodies)]
         :let [[bim [bix biy biz] biv] (in bodies i)]
         j :range [0 i]
         :let [[bjm [bjx bjy bjz] bjv] (in bodies j)
               [dx dy dz] [(- bix bjx) (- biy bjy) (- biz bjz)]
               dist (math/sqrt (+ (* dx dx) (* dy dy) (* dz dz)))
               mag (/ dt (* dist dist dist))
               bimm (* bim mag)
               bjmm (* bjm mag)]]
      (vec biv -= [dx dy dz] * bjmm)
      (vec bjv += [dx dy dz] * bimm))
  (each [_ pos [vx vy vz]] bodies
    (vec pos += [vx vy vz] * dt)))

(defn momentum [bodies]
  (def p @[0 0 0])
  (each [bim _ [bivx bivy bivz]] bodies
    (vec p += [bivx bivy bivz] * bim))
  p)

(defn scale [s [x y z]]
  @[(* s x) (* s y) (* s z)])

(def system
  (let
    [solar-mass (* 4 math/pi math/pi)
     days-per-year 365.24
     planets
     [#jupiter
      {:mass  9.54791938424326609e-04
       :pos   [ 4.84143144246472090e+00 -1.16032004402742839e+00 -1.03622044471123109e-01]
       :veloc [ 1.66007664274403694e-03  7.69901118419740425e-03 -6.90460016972063023e-05]}
      #saturn
      {:mass  2.85885980666130812e-04
       :pos   [ 8.34336671824457987e+00  4.12479856412430479e+00 -4.03523417114321381e-01]
       :veloc [-2.76742510726862411e-03  4.99852801234917238e-03  2.30417297573763929e-05]}
      #uranus
      {:mass  4.36624404335156298e-05
       :pos   [ 1.28943695621391310e+01 -1.51111514016986312e+01 -2.23307578892655734e-01]
       :veloc [ 2.96460137564761618e-03  2.37847173959480950e-03 -2.96589568540237556e-05]}
      #neptune
      {:mass  5.15138902046611451e-05
       :pos   [ 1.53796971148509165e+01 -2.59193146099879641e+01  1.79258772950371181e-01]
       :veloc [ 2.68067772490389322e-03  1.62824170038242295e-03 -9.51592254519715870e-05]}]
     bodies (seq [body :in planets]
              [(* solar-mass (body :mass))
               (array ;(body :pos))
               (scale days-per-year (body :veloc))])
     sun [solar-mass @[0 0 0] (scale (/ -1 solar-mass) (momentum bodies))]]
    [sun ;bodies]))

(defn main [& args]
  (def n (if-let [x (get args 1)
                  y (scan-number x)
                  _ (and (int? y) (>= y 0))]
           y
           1000))
  (def dt 0.01)
  (print (system-energy system))
  (repeat n (system-advance dt system))
  (print (system-energy system)))