initial commit

.gitignore

@@ -0,0 +1,3 @@
+*.rbc
+*.ayc
+.rbx/

.rvmrc

@@ -0,0 +1 @@
+rvm use rbx-2.0.0pre

Rakefile

@@ -0,0 +1,17 @@
+task :default => :test
+
+task :parser do
+  sh "kpeg -f -s lib/hummus.kpeg"
+end
+
+task :formatter do
+  sh "kpeg -f -s lib/formatter.kpeg"
+end
+
+task :clean do
+  sh "find . -name '*.rbc' -delete; find . -name '*.ayc' -delete"
+end
+
+task :install do
+  sh "rm *.gem; rbx -S gem uninstall hummus; rbx -S gem build hummus.gemspec; rbx -S gem install hummus-*.gem --no-ri --no-rdoc"
+end

kernel/boot.knl

@@ -0,0 +1,115 @@
+(define sequence
+  ((wrap
+     (vau (seq2) #ignore
+          (seq2
+            (define aux
+              (vau (head . tail) env
+                   (if (null? tail)
+                     (eval head env)
+                     (seq2
+                       (eval head env)
+                       (eval (cons aux tail) env)))))
+            (vau body env
+                 (if (null? body)
+                   #inert
+                   (eval (cons aux body) env))))))
+   (vau (first second) env
+        ((wrap (vau #ignore #ignore (eval second env)))
+         (eval first env)))))
+
+(define list (wrap (vau x #ignore x)))
+
+(define list*
+  (wrap
+    (vau args #ignore
+         (sequence
+           (define aux
+             (wrap
+               (vau ((head . tail)) #ignore
+                    (if (null? tail)
+                      head
+                      (cons head (aux tail))))))
+           (aux args)))))
+
+(define lambda
+  (vau (formals . body) env
+       (wrap (eval (list* vau formals #ignore body) env))))
+
+(define vau
+  ((wrap
+     (vau (vau) #ignore
+          (vau (formals eformal . body) env
+               (eval (list vau formals eformal
+                           (cons sequence body)) env))))
+   vau))
+
+(define car (lambda ((x . #ignore)) x))
+(define cdr (lambda ((#ignore . x)) x))
+
+(define apply
+  (lambda (appv arg . opt)
+    (eval (cons (unwrap appv) arg)
+          (if (null? opt)
+            (make-environment)
+            (car opt)))))
+
+(define cond
+  (vau clauses env
+       (define aux
+         (lambda ((test . body) . clauses)
+           (if (eval test env)
+             (apply (wrap sequence) body env)
+             (apply (wrap cond) clauses env))))
+       (if (null? clauses) #inert
+         (apply aux clauses))))
+
+(define get-list-metrics
+  (lambda (ls)
+    (define aux
+      (lambda (kth k nth n)
+        (if (>=? k n)
+          (if (pair? (cdr nth))
+            (aux ls 0 (cdr nth) (+ n 1))
+            (list (+ n 1)
+                  (if (null? (cdr nth)) 1 0) (+ n 1)
+                  0))
+          (if (eq? kth nth)
+            (list n 0 k (- n k))
+            (aux (cdr kth) (+ k 1) nth n)))))
+    (if (pair? ls)
+      (aux ls 0 ls 0)
+      (list 0 (if (null? ls) 1 0) 0 0))))
+
+(define list-tail
+  (lambda (ls k)
+    (if (>? k 0)
+      (list-tail (cdr ls) (- k 1))
+      ls)))
+
+(define <?
+  (lambda (a b)
+    (send to_kernel (send < (send value a) (send value b)))))
+
+(define >?
+  (lambda (a b)
+    (send to_kernel (send > (send value a) (send value b)))))
+
+(define >=?
+  (lambda (a b)
+    (send to_kernel (send >= (send value a) (send value b)))))
+
+(define <=?
+  (lambda (a b)
+    (send to_kernel (send <= (send value a) (send value b)))))
+
+(define +
+  (lambda (a b)
+    (send to_kernel (send + (send value a) (send value b)))))
+
+(define -
+  (lambda (a b)
+    (send to_kernel (send - (send value a) (send value b)))))
+
+(define *
+  (lambda (a b)
+    (send to_kernel (send * (send value a) (send value b)))))

lib/boot.ay

@@ -0,0 +1,229 @@
+env = Hummus::Environment new
+
+env define(#print) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car
+      val evaluate-in(env) write
+
+env define(#send) $:
+  Hummus::Core new $:
+    [args, env]:
+      message = args car name
+      target = args cdr car evaluate-in(env)
+      rest = args cdr cdr evaluate-all-in(env) to-list
+      target send(message, *rest)
+
+env define(#boolean?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val == Hummus::True || val == Hummus::False)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#eq?) $:
+  Hummus::Core new $:
+    [args, env]:
+      a = args car evaluate-in(env)
+      b = args cdr car evaluate-in(env)
+
+      if(a equal?(b))
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#equal?) $:
+  Hummus::Core new $:
+    [args, env]:
+      a = args car evaluate-in(env)
+      b = args cdr car evaluate-in(env)
+
+      if(a == b)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#symbol?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val symbol?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#inert?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val inert?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#pair?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val pair?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#null?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val null?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#cons) $:
+  Hummus::Core new $:
+    [args, env]:
+      a = args car evaluate-in(env)
+      b = args cdr car evaluate-in(env)
+      Hummus::Pair new(a, b)
+
+env define(#"set-car!") $:
+  Hummus::Core new $:
+    [args, env]:
+      a = args car evaluate-in(env)
+      b = args cdr car evaluate-in(env)
+
+      when(a immutable?):
+        error(#cannot-mutate(a))
+
+      a car = b
+      Hummus::Inert
+
+env define(#"set-cdr!") $:
+  Hummus::Core new $:
+    [args, env]:
+      a = args car evaluate-in(env)
+      b = args cdr car evaluate-in(env)
+
+      when(a immutable?):
+        error(#cannot-mutate(a))
+
+      a cdr = b
+      Hummus::Inert
+
+env define(#"copy-es-immutable") $:
+  Hummus::Core new $:
+    [args, env]:
+      args car evaluate-in(env) copy-es-immutable
+
+env define(#if) $:
+  Hummus::Core new $:
+    [args, env]:
+      cond = args car evaluate-in(env)
+      consequent = args cdr car
+      alternative = args cdr cdr car
+
+      condition:
+        cond == Hummus::True ->
+          consequent evaluate-in(env)
+
+        cond == Hummus::False ->
+          alternative evaluate-in(env)
+
+        _ -> error(#not-boolean(cond))
+
+env define(#environment?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val environment?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#ignore?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val ignore?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#eval) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car
+      in = args cdr car
+      val evaluate-in(env) evaluate-in(in evaluate-in(env))
+
+env define(#"make-environment") $:
+  Hummus::Core new $:
+    [args, env]:
+      parents = Hummus evaluate-all(env, args to-list)
+      Hummus::Environment new(Hash new, parents)
+
+env define(#define) $:
+  Hummus::Core new $:
+    [args, env]:
+      key = args car
+      val = args cdr car evaluate-in(env)
+      env define(key, val)
+      Hummus::Inert
+
+env define(#operative?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val operative?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#applicative?) $:
+  Hummus::Core new $:
+    [args, env]:
+      val = args car evaluate-in(env)
+
+      if(val applicative?)
+        then: Hummus::True
+        else: Hummus::False
+
+env define(#vau) $:
+  Hummus::Core new $:
+    [args, env]:
+      formals = args car
+      eformal = args cdr car
+      body = args cdr cdr car
+
+      Hummus::Operative new(
+        formals copy-es-immutable
+        eformal
+        body copy-es-immutable
+        env
+      )
+
+env define(#wrap) $:
+  Hummus::Core new $:
+    [args, env]:
+      combiner = args car
+      Hummus::Applicative new(combiner evaluate-in(env))
+
+env define(#unwrap) $:
+  Hummus::Core new $:
+    [args, env]:
+      x = args car evaluate-in(env)
+
+      unless(x applicative?):
+        error(#not-an-applicative(x))
+
+      x combiner
+
+
+base = File expand-path("../../", _FILE)
+Hummus evaluate-all(env, Hummus::Parser parse-file(base + "/kernel/boot.knl"))
+
+{ repl } bind:
+  #input(source) -> doc:
+    res = Hummus evaluate-all(env, Hummus::Parser parse-string(source))
+    (text(" =>") <+> res pretty) render(76) println
+    restart(#override)