initial commit

.gitignore

@@ -0,0 +1,10 @@
+/target
+/lib
+/classes
+/checkouts
+pom.xml
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins

README.md

@@ -0,0 +1,15 @@
+# beauforth
+
+I'm an app. Or maybe I'm a library? I haven't decided yet. 
+
+The choice is up to you!
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2012 FIXME
+
+Distributed under the Eclipse Public License, the same as Clojure.

forth/core.fs

@@ -0,0 +1,48 @@
+clj
+(beauforth.core/define ":*"
+  (fn []
+    (let [w (beauforth.core/word) exp (read)]
+      (beauforth.core/define w
+        (fn [] (eval exp))))))
+
+:* : (let [w (beauforth.core/word)]
+       (print "subroutine ")
+       (println w)
+       (println "push(returnstack, nextword)")
+       (beauforth.core/define w #(println "subcall" w "nextword")))
+
+:* ; (do
+       (println "pop(returnstack, nextword)")
+       (println "subret nextword")
+       (println "ends"))
+
+:* nbc (println (read-line))
+
+: +
+nbc pop(datastack, val1)
+nbc pop(datastack, val2)
+nbc add val1, val2, val3
+nbc push(datastack, val3)
+;
+
+: -
+nbc pop(datastack, val1)
+nbc pop(datastack, val2)
+nbc sub val1, val2, val3
+nbc push(datastack, val3)
+;
+
+: *
+nbc pop(datastack, val1)
+nbc pop(datastack, val2)
+nbc mul val1, val2, val3
+nbc push(datastack, val3)
+;
+
+: dup
+nbc pop(datastack, val1)
+nbc push(datastack, val1)
+nbc push(datastack, val1)
+;
+
+1 dup *

forth/forthlib.nbc

@@ -0,0 +1,43 @@
+dseg segment
+
+  TStack struct
+    data word[]
+    offset word
+  TStack ends
+
+  returnstack TStack
+  nextword word
+
+  datastack TStack
+
+  val1 word
+  val2 word
+  val3 word
+  val4 word
+
+dseg ends
+
+#define push(stack, val) \
+  replace stack.data stack.data stack.offset val \
+  add stack.offset stack.offset 1
+
+#define pop(stack, val) \
+  sub stack.offset stack.offset 1 \
+  index val stack.data stack.offset
+
+
+thread main
+  arrinit datastack.data 0 32
+  arrinit returnstack.data 0 32
+
+  push(datastack, 1)
+  push(datastack, 2)
+  push(datastack, 9)
+  push(datastack, 7)
+  callword(even)
+
+  pop(datastack, number)
+  NumOut(0,0,number)
+
+  wait 5000
+endt

project.clj

@@ -0,0 +1,8 @@
+(defproject beauforth "0.1.0-SNAPSHOT"
+  :description "FIXME: write description"
+  :url "http://example.com/FIXME"
+  :license {:name "Eclipse Public License"
+            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :main beauforth.core
+  :dependencies [[org.clojure/clojure "1.3.0"]
+                 [org.clojure/core.incubator "0.1.0"]])

src/beauforth/core.clj

@@ -0,0 +1,40 @@
+(ns beauforth.core
+  (:use [clojure.string :only [blank?]]))
+
+(defn read-char []
+  (let [ch (.read *in*)]
+    (if (= -1 ch)
+      nil
+      (char ch))))
+
+(defn wordseq []
+  (->> #(read-char)
+    repeatedly
+    (take-while identity)
+    (partition-by #(Character/isWhitespace %))
+    (map #(apply str %))
+    (remove blank?)))
+
+(defn word []
+  (first (wordseq)))
+
+(def definitions (atom ())) ; might switch to map
+
+(defn lookup [sym]
+  (some #(when (= sym (first %)) (peek %)) @definitions))
+
+(defn define [sym f]
+  (swap! definitions conj [sym f]))
+
+(define "clj" (comp eval read))
+
+(defn evaluate [s]
+  (if-let [f (lookup s)]
+    (f)
+    (println "push(datastack," s ")")))
+
+(defn -main
+  "I don't do a whole lot."
+  [& args]
+  (doseq [w (wordseq)]
+    (evaluate w)))

test/beauforth/core_test.clj

@@ -0,0 +1,7 @@
+(ns beauforth.core-test
+  (:use clojure.test
+        beauforth.core))
+
+(deftest a-test
+  (testing "FIXME, I fail."
+    (is (= 0 1))))