Shem Prelude

gistfile1.txt

+ (macro [x y]
  (: (Fn Num Num Num))
  (Js.binary "+" x y))

- (macro [what from]
  (: (Fn Num Num Num))
  (Js.binary "-" from what))

* (macro [x y]
  (: (Fn Num Num Num))
  (Js.binary "*" x y))

/ (macro [by what]
  (: (Fn Num Num Num))
  (Js.binary "/" what by))

mod (macro [by of]
  (: (Fn Num Num Num))
  (Js.binary "%" of by))

sqrt (macro [n]
  (: (Fn Num Num))
  (Js.call "Math.sqrt" {n}))

^ (macro [to what]
  (: (Fn Num Num Num))
  (Js.call "Math.pow" {what to}))

sin (macro [x]
  (: (Fn Num Num))
  (# x is in radians.)
  (Js.call "Math.sin" {x}))

cos (macro [x]
  (: (Fn Num Num))
  (# x is in radians.)
  (Js.call "Math.cos" {x}))

round (macro [x]
  (: (Fn Num Num))
  (# x is in radians.)
  (Js.call "Math.round" {x}))

rem (fn [by of]
  (mod by (+ by (mod by of))))

~ (macro [x]
  (: (Fn Num Num))
  (Js.unary "-" x))

and (macro [first then]
  (: (Fn Bool Bool Bool))
  (Js.binary "&&" first then))

or (macro [first then]
  (: (Fn Bool Bool Bool))
  (Js.binary "||" first then))

not (macro [x]
  (: (Fn Bool Bool))
  (Js.unary "!" x))

if (macro [what then else]
  (: (Fn Bool a a a))
  (Js.ternary what then else))

Eq (class [a]
  = (fn [x y] (: (Fn a a Bool))))

!= (fn [x y]
  (not (= x y)))

bool= (macro [x y]
  (: (Fn Bool Bool Bool))
  (Js.binary "===" x y))

bool-eq (instance (Eq Bool)
  = (fn [x y] (bool= x y)))

num= (macro [x y]
  (: (Fn Num Num Bool))
  (Js.binary "===" x y))

num-eq (instance (Eq Num)
  = (fn [x y] (num= x y)))

Ord (class [a]
  {(Eq a)}
  <= (fn [than what] (: (Fn a a Bool))))

< (fn [than what]
  (: (Fn a a Bool) (Ord a))
  (and (<= than what) (not (= than what))))

> (fn [than what]
  (: (Fn a a Bool) (Ord a))
  (not (<= than what)))

>= (fn [than what]
  (: (Fn a a Bool) (Ord a))
  (or (= than what) (> than what)))

num<= (macro [than what]
  (: (Fn Num Num Bool))
  (Js.binary "<=" what than))

num-ord (instance (Ord Num)
  <= (fn [than what]
    (num<= than what)))

even? (fn [x]
  (: (Fn Num Bool))
  (= 0 (rem 2 x)))

odd? (fn [x]
  (: (Fn Num Bool))
  (not (even? x)))

id (fn [x] (: (Fn a a)) x)

const (fn [x y] (: (Fn a b a)) x)

. (fn [second first x]
  (: (Fn (Fn b c) (Fn a b) a c))
  (second (first x)))

fst (fn [tuple]
  (: (Fn [a b] a))
  x
  [x y] tuple)

snd (fn [tuple]
  (: (Fn [a b] b))
  y
  [x y] tuple)

curry (fn [fun x y]
  (: (Fn (Fn [a b] c) a b c))
  (fun [x y]))

uncurry (fn [fun tuple]
  (: (Fn (Fn a b c) [a b] c))
  (fun x y)
  [x y] tuple)

& (macro [what to]
  (: (Fn a (List a) (List a)))
  (Js.call (Js.access to "unshift") {what}))

map (fn [what over]
  (match over
    {} {}
    {x ..xs} (& (what x) (map what xs))))

join (fn [what with]
  (match what
    {} with
    {x ..xs} (& x (join xs with))))

filter (fn [cond list]
  (match list
    {} list
    {x ..xs} (if (cond x)
      (& x (filter cond xs))
      (filter cond xs))))

fold (fn [with initial list]
  (match list
    {} initial
    {x ..xs} (fold with (with initial x) xs)))

concat (fn [lists]
  (fold join {} lists))

concat-map (fn [what over]
  (concat (map what over)))

head (fn [list]
  x
  {x ..xs} list)

tail (fn [list]
  xs
  {x ..xs} list)

length (macro [list]
  (: (Fn (List a) Num))
  (Js.access list "size"))

at (fn [index in]
  (match index
    0 (head in)
    n (at (- 1 n) (tail in))))

take (fn [n from]
  (if (<= 0 n)
    {}
    (match from
      {} from
      {x ..xs} (& x (take (- 1 n) xs)))))

drop (fn [n from]
  (if (<= 0 n)
    from
    (match from
      {} from
      {x ..xs} (drop (- 1 n) xs))))

range (fn [from exclude-to]
  (if (<= from exclude-to)
    {}
    (& from (range (+ 1 from) exclude-to))))

sum (fold + 0)
all (fold and True)
any (fold or False)

all-map (fn [fun list]
  (all ((map fun) list)))

any-map (fn [fun list]
  (any ((map fun) list)))

null? (fn [list]
  (= 0 (length list)))

add (macro [what to]
  (: (Fn a (Set a) (Set a)))
  (Js.call (Js.access to "add") {what}))

remove (macro [what from]
  (: (Fn a (Set a) (Set a)))
  (Js.call (Js.access from "remove") {what}))

elem? (macro [what in]
  (: (Fn a (Set a) Bool))
  (Js.call (Js.access in "has") {what}))

not-elem? (fn [what in]
  (not (elem? what in)))

size (macro [list]
  (: (Fn (Set a) Num))
  (Js.access list "size"))

empty? (fn [list]
  (= 0 (size list)))

put (macro [key value into]
  (: (Fn k v (Map k v) (Map k v)))
  (Js.call (Js.access into "set") {key value}))

get (macro [key from]
  (: (Fn k (Map k v) v))
  (Js.call (Js.access from "get") {key}))

key? (macro [key in]
  (: (Fn k (Map k v) Bool))
  (Js.call (Js.access in "has") {key}))

count (macro [map]
  (: (Fn (Map k v) Num))
  (Js.access map "size"))

key-set (macro [map]
  (: (Fn (Map k v) (Set k)))
  (Js.call (Js.access
      (Js.call (Js.access map "keySeq") {}) "toSet") {}))

value-list (macro [map]
  (: (Fn (Map k v) (List v)))
  (Js.call (Js.access map "toStack") {}))

entry-list (macro [map]
  (: (Fn (Map k v) (List [k v])))
  (Js.call (Js.access
      (Js.call (Js.access map "entrySeq") {}) "toStack") {}))

chars (macro [string]
  (: (Fn String (List Char)))
  (Js.call "Immutable.Stack"
    {(Js.call (Js.access string "split") {"''"})}))

append (macro [before after]
  (: (Fn String String String))
  (Js.binary "+" before after))

implode (fn [strings]
  (fold append "" strings))

implode-map (fn [what over]
  (implode (map what over)))

make-pi (macro [x]
  (: (Fn a Num))
  (Js.access "Math" "PI"))

math-pi (make-pi 0)

radians (fn [degrees]
  (* math-pi (/ 180 degrees)))