1 files changed, 126 insertions, 0 deletions
diff --git a/ps/core.ps b/ps/core.ps
new file mode 100644
index 0000000..09bfe2b
--- /dev/null
+++ b/ps/core.ps
@@ -0,0 +1,126 @@
+(in core.ps\n) print
+
+% requires types.ps
+
+% Errors/Exceptions
+
+% data -> throw ->
+% Takes an arbitrary data and puts it in $error:/errorinfo. Then calls
+% stop to transfer control to end of nearest stopped context.
+/throw {
+    $error exch /errorinfo exch put
+    $error /command /throw put
+    stop
+} def
+
+
+% sequence functions
+
+% [obj list] -> cons -> new_list
+/cons {
+    /args exch def
+    /elem args 0 get def
+    /lst args 1 get def
+    lst length 1 add array
+    dup 0 elem put % first element
+    dup 1 lst putinterval % rest of the elements
+} def
+
+% [listA listB] -> concat -> [listA... listB...]
+/concat { % replaces matric concat
+    dup length 0 eq { %if just concat
+        0 _list
+    }{ dup length 1 eq { %elseif concat of single item
+        0 get % noop
+    }{ % else
+        [] exch
+        {
+            concatenate
+        } forall
+    } ifelse } ifelse
+} def
+
+% [obj ...] -> first -> obj
+/first {
+    0 get _first
+} def
+
+% [obj objs...] -> first -> [objs..]
+/rest {
+    0 get _rest
+} def
+
+% [function args... arg_list] -> apply -> result
+/apply { 1 dict begin
+    /args exch def
+    args 0 get callable % make sure function is callable
+    args 1 args length 2 sub getinterval
+    args args length 1 sub get
+    concatenate args 0 get % stack: args function
+    exec
+end } def
+
+% [function list] -> _map -> new_list
+/map { 1 dict begin
+    dup 0 get exch 1 get % stack: function list
+    /args exch def
+    callable % make sure function is callable
+    %/new_list args length array def
+    args {
+        1 array astore
+        exch dup 3 1 roll % stack: fn arg fn
+        exec exch % stack: result fn
+    } forall 
+    pop % remove the function
+    args length array astore
+end } def
+
+/conj { 5 dict begin
+    /args exch def
+    /src_list args 0 get def
+    /new_len src_list length   args length 1 sub   add def
+    /new_list new_len array def
+    new_list   new_len src_list length sub   src_list putinterval
+    args length 1 sub -1 1 {
+        /idx exch def
+        new_list   args length idx sub 1 sub   args idx get   put
+    } for
+    new_list
+end } def
+
+
+% core_ns is namespace of core functions
+
+/core_ns <<
+    (pr-str)  { ( ) true _pr_str_args }
+    (str)     { () false _pr_str_args }
+    (prn)     { ( ) true _pr_str_args print (\n) print null }
+    (println) { () false _pr_str_args print (\n) print null }
+    (=)       { dup 0 get exch 1 get _equal? }
+    (symbol?) { 0 get _symbol? }
+    (nil?)    { 0 get _nil? }
+    (true?)   { 0 get _true? }
+    (false?)  { 0 get _false? }
+    (<)       { dup 0 get exch 1 get lt }
+    (<=)      { dup 0 get exch 1 get le }
+    (>)       { dup 0 get exch 1 get gt }
+    (>=)      { dup 0 get exch 1 get ge }
+    (+)       { dup 0 get exch 1 get add }
+    (-)       { dup 0 get exch 1 get sub }
+    (*)       { dup 0 get exch 1 get mul }
+    (/)       { dup 0 get exch 1 get idiv }
+    (throw)   { 0 get throw }
+    (list)    { dup pop } % noop
+    (list?)   { 0 get _list? }
+    (cons)    { cons }
+    (concat)  { concat }
+    (sequential?) { 0 get _sequential? }
+    (empty?)  { 0 get length 0 eq }
+    (count)   { 0 get length }
+    (nth)     { dup 0 get exch 1 get _nth }
+    (first)   { first }
+    (rest)    { rest }
+    (apply)   { apply }
+    (map)     { map }
+    (conj)    { conj }
+>> def