├── bin └── babar.sh ├── examples ├── simple.babar ├── asking.babar ├── requests_until.babar ├── speech_acts.babar └── drone │ ├── spotboat.babar │ ├── fly.babar │ └── orient.babar ├── dronelibs ├── opencv-245.jar └── h264-decoder-1.0.jar ├── doc └── intro.md ├── .gitignore ├── test └── babar │ ├── parser_test.clj │ ├── functions_test.clj │ ├── data_types_test.clj │ ├── commands_test.clj │ └── speech_acts_test.clj ├── project.clj ├── src └── babar │ ├── repl.clj │ ├── commands.clj │ ├── parser.clj │ └── speech_acts.clj └── README.md /bin/babar.sh: -------------------------------------------------------------------------------- 1 | java -jar ./bin/babar-0.1.0-SNAPSHOT-standalone.jar 2 | -------------------------------------------------------------------------------- /examples/simple.babar: -------------------------------------------------------------------------------- 1 | assert a 1. 2 | assert b 10. 3 | assert c [:a :b (+ a b)]. 4 | -------------------------------------------------------------------------------- /dronelibs/opencv-245.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gigasquid/babar/HEAD/dronelibs/opencv-245.jar -------------------------------------------------------------------------------- /dronelibs/h264-decoder-1.0.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gigasquid/babar/HEAD/dronelibs/h264-decoder-1.0.jar -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to babar 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | .lein-deps-sum 10 | .lein-failures 11 | .lein-plugins 12 | .lein-repl-history 13 | logs/drone.log -------------------------------------------------------------------------------- /examples/asking.babar: -------------------------------------------------------------------------------- 1 | speak-config true. 2 | ask-config true. 3 | 4 | request *task1 fn [] + 10 x. 5 | query request-is-done *task1? 6 | assert x 3. 7 | sleep 10. 8 | query request-is-done *task1? 9 | query request-value *task1? -------------------------------------------------------------------------------- /examples/requests_until.babar: -------------------------------------------------------------------------------- 1 | speak-config true. 2 | 3 | assert counter atom 1. 4 | convince #done "I am done counting" fn [] > @counter 3. 5 | request *count-up until #done fn [] swap! counter inc. 6 | sleep 25. 7 | query request-value *count-up? -------------------------------------------------------------------------------- /examples/speech_acts.babar: -------------------------------------------------------------------------------- 1 | speak-config true. 2 | assert sunny false. 3 | convince #nice-day "It is a nice day." fn [] = sunny true. 4 | request *open-window when #nice-day fn [] println "Opened the window". 5 | sleep 10. 6 | query request-is-done *open-window? 7 | 8 | assert sunny true. 9 | sleep 10. 10 | query request-is-done *open-window? -------------------------------------------------------------------------------- /test/babar/parser_test.clj: -------------------------------------------------------------------------------- 1 | (ns babar.parser-test 2 | (:require [midje.sweet :refer :all] 3 | [babar.parser :refer :all])) 4 | 5 | (fact "about programs that are one expression" 6 | (parse "+ 1 2") => 3) 7 | 8 | (facts "about ignorning newline as whitespace in expression" 9 | (parse "(+ 1\n 3)") => 4 10 | (parse "+ 1\n 3") => 4) 11 | 12 | (facts "about reading babar files" 13 | (parse "read \"./examples/simple.babar\"") => anything 14 | (parse "c") => [:a :b 11]) 15 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject babar "0.1.0" 2 | :description "A little language for machines based on the speech acts" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main babar.repl 7 | :dependencies [[org.clojure/clojure "1.5.1"] 8 | [instaparse "1.2.2"] 9 | [clj-time "0.6.0"] 10 | [me.raynes/conch "0.5.1"] 11 | [clj-drone "0.1.8"]] 12 | :profiles {:dev {:dependencies [[midje "1.5.1"]] 13 | :plugins [[lein-midje "2.0.1"]] }}) 14 | -------------------------------------------------------------------------------- /examples/drone/spotboat.babar: -------------------------------------------------------------------------------- 1 | speak-config true. 2 | 3 | import "clj-drone.core". 4 | import "clj-drone.navdata". 5 | 6 | (drone-initialize). 7 | (drone-init-navdata). 8 | 9 | assert navdata (get-nav-data :default). 10 | assert drone-navdata [key] get @navdata key. 11 | assert navdata-equal [key val] = (drone-navdata key) val. 12 | assert navdata-gt [key val] > (drone-navdata key) val. 13 | assert see-boat false. 14 | 15 | convince #spotboat "I see a boat!" fn [] = see-boat true. 16 | convince #high-enough "I am signaling the boat" fn [] (navdata-gt :altitude 1.3). 17 | 18 | request *take-off when #spotboat fn [] (drone :take-off). 19 | request *cruising-alt when #flying until #high-enough fn [] (drone :up 0.3). 20 | request *land when #high-enough fn [] do (drone :hover) 21 | (drone :anim-double-phi-theta-mixed) 22 | (sleep 5000) 23 | (drone :land). 24 | -------------------------------------------------------------------------------- /test/babar/functions_test.clj: -------------------------------------------------------------------------------- 1 | (ns babar.functions-test 2 | (:require [midje.sweet :refer :all] 3 | [babar.parser :refer :all])) 4 | (declare dog2) 5 | (facts "about defn and functions" 6 | (dog2 2) => 8 7 | (parse "(dog2 2)") => 8 8 | (parse "dog2: 2") => 8 9 | (against-background (before :facts (parse "defn dog2 [x] + x 1 2 3")))) 10 | 11 | (declare dog3) 12 | (facts "about functions with many arguments" 13 | (dog3 3 4 5) => 12 14 | (parse "(dog3 3 4 5)") => 12 15 | (parse "dog3: 3 4 5") => 12 16 | (against-background (before :facts (parse "defn dog3 [x y z] + x y z")))) 17 | 18 | (declare dog4) 19 | (facts "about functions with no arguments" 20 | (dog4) => [3 4 4] 21 | (parse "(dog4)") => [3 4 4] 22 | (parse "dog4:") => [3 4 4] 23 | (against-background (before :facts (parse "defn dog4 [] [3 4 4]")))) 24 | 25 | (facts "about anonymous functions" 26 | ((parse "fn [x] (+ x 1)") 3) => 4 27 | (parse "((fn [x] + x 1) 3)") => 4 28 | (parse "((fn [x y z] (+ x y z)) 1 2 3)") => 6 29 | (parse "((fn [] [4 5 6]))") => [4 5 6]) 30 | 31 | -------------------------------------------------------------------------------- /examples/drone/fly.babar: -------------------------------------------------------------------------------- 1 | speak-config true. 2 | 3 | import "clj-drone.core". 4 | import "clj-drone.navdata". 5 | 6 | (drone-initialize). 7 | 8 | assert navdata (get-nav-data :default). 9 | assert drone-navdata [key] get @navdata key. 10 | assert navdata-equal [key val] = (drone-navdata key) val. 11 | assert navdata-gt [key val] > (drone-navdata key) val. 12 | 13 | 14 | convince #landed "I am on the ground" fn [] (navdata-equal :control-state :landed). 15 | convince #flying "I am flying" fn [] or (navdata-equal :control-state :flying) 16 | (navdata-equal :control-state :hovering). 17 | convince #high-enough "I am high enough" fn [] (navdata-gt :altitude 1.5). 18 | 19 | request *take-off when #landed fn [] (drone :take-off). 20 | request *cruising-alt when #flying until #high-enough fn [] (drone :up 0.1). 21 | request *land when #high-enough fn [] (drone :land). 22 | 23 | convince #done "Whee! I am done." fn [] and (navdata-equal :control-state :landed) 24 | query request-is-done *land. 25 | request *end-navstream when #done fn [] (end-navstream). 26 | 27 | (drone-init-navdata). 28 | -------------------------------------------------------------------------------- /src/babar/repl.clj: -------------------------------------------------------------------------------- 1 | (ns babar.repl 2 | (:gen-class) 3 | (:require [babar.parser :as parser])) 4 | 5 | 6 | (defn complete-input? [input] 7 | (let [lbrackets (count (re-find #"\[" input)) 8 | rbrackets (count (re-find #"]" input)) 9 | rparens (count (re-find #"\(" input)) 10 | lparens (count (re-find #"\)" input)) 11 | ] 12 | (and (= lparens rparens) (= lbrackets rbrackets)))) 13 | 14 | (defn get-input [input] 15 | (let [new-input (str input (read-line))] 16 | (if (complete-input? new-input) 17 | new-input 18 | (do 19 | (print " ..babar> ") 20 | (flush) 21 | (recur (str new-input "\n")))))) 22 | 23 | 24 | (defn repl [] 25 | (do 26 | (print "babar> ") 27 | (flush)) 28 | (let [input (get-input "")] 29 | (if-not (= input "quit") 30 | (do 31 | (println (try (parser/parse input) 32 | (catch Exception e (str "Sorry: " e " - " (.getMessage e))))) 33 | (recur)) 34 | (do (println "Bye!") 35 | (System/exit 0))))) 36 | 37 | 38 | (defn -main [& args] 39 | (parser/init) 40 | 41 | 42 | (println "Hello Babar!") 43 | (println " ____ ") 44 | (println " /. \\_ ") 45 | (println " /_ \\_/ \\") 46 | (println " // \\ ___ ||") 47 | (println " \\\\ |_| |_| ") 48 | (println " ") 49 | 50 | (println "ctl-c or quit to exit") 51 | (println "===============") 52 | (flush) 53 | (repl)) 54 | 55 | -------------------------------------------------------------------------------- /test/babar/data_types_test.clj: -------------------------------------------------------------------------------- 1 | (ns babar.data-types-test 2 | (:require [midje.sweet :refer :all] 3 | [babar.parser :refer :all])) 4 | 5 | (facts "about parsing numbers" 6 | (parse "1") => 1 7 | (parse "100") => 100 8 | (parse "1.2") => 1.2 9 | (parse "100.2") => 100.2 10 | (parse "-1") => -1 11 | (parse "-1.3") => -1.3 12 | (parse "-140.3") => -140.3) 13 | 14 | (facts "about parsing strings" 15 | (parse "\"cat\"") => "cat" 16 | (parse "\"The cat is nice.\"") => "The cat is nice.") 17 | 18 | (facts "about parsing booleans" 19 | (parse "false") => false 20 | (parse "true") => true) 21 | 22 | (facts "about parsing keywords" 23 | (parse ":key1") => :key1) 24 | 25 | (facts "about parsing vectors" 26 | (parse "1 2") 27 | (parse "1 2 3 4") => [1 2 3 4] 28 | (parse "1 2 3 4 5") => [1 2 3 4 5] 29 | (parse "1.2 3.4 2.5") => [1.2 3.4 2.5] 30 | (parse "-5.0 -2 -3.2") => [-5.0 -2 -3.2] 31 | (parse "[1]") => [1] 32 | (parse "[]") => [] 33 | (parse "[ 1 ]") => [1] 34 | (parse "[1 2 3]") => [1 2 3] 35 | (parse "[\"cat\" \"dog\" \"bird\"]") => ["cat" "dog" "bird"] 36 | (parse "[1 2.0 -4.5 \"cat\"]") => [1 2.0 -4.5 "cat"] 37 | (parse "true false true") => [true false true] 38 | (parse ":key1 :key2 :key3") => [:key1 :key2 :key3] 39 | (parse "1 1.2 true \"cat\" :key1") => [1 1.2 true "cat" :key1] 40 | (parse "[1 [2 3]]") => [1 [2 3]] 41 | (parse "1 2 3 {:cat 1}") => [1 2 3 {:cat 1}] 42 | (parse "1 2 \t 3 \n 4") => [1 2 3 4]) 43 | 44 | (facts "about parsing maps" 45 | (parse "{:cat 1 :dog 2}") => {:cat 1 :dog 2} 46 | (parse "{:cat [1 3 4]}") => {:cat [1 3 4]} 47 | (parse "{:cat {:dog 1}}") => {:cat {:dog 1}}) 48 | 49 | (facts "about parsing atoms" 50 | (type (parse "atom 1")) => clojure.lang.Atom) 51 | 52 | -------------------------------------------------------------------------------- /examples/drone/orient.babar: -------------------------------------------------------------------------------- 1 | speak-config true. 2 | import "clj-drone.core". 3 | import "clj-drone.navdata". 4 | 5 | 6 | assert init-drone [] do (drone-initialize) 7 | (set-log-data [:seq-num :battery :targets-num :targets]) 8 | (drone :init-targeting) 9 | (drone :target-roundel-v) 10 | (drone :hover-on-roundel). 11 | assert init-nav [] (drone-init-navdata). 12 | (init-drone). 13 | 14 | 15 | 16 | assert navdata (get-nav-data :default). 17 | assert drone-navdata [key] get @navdata key. 18 | assert navdata-equal [key val] = (drone-navdata key) val. 19 | assert navdata-gt [key val] > (drone-navdata key) val. 20 | assert see-target [] (navdata-equal :targets-num 1). 21 | assert target-data [] first (get-navdata :targets). 22 | assert first-target [] first (target-data). 23 | assert orient [] get (first-target) :target-orient-angle. 24 | assert get-orient [] if (see-target) (orient). 25 | assert in-range [] if (get-orient) (< (get-orient) 45). 26 | assert out-of-range [] if (get-orient) (> (get-orient) 45). 27 | 28 | convince #oriented "I am good" fn [] (in-range). 29 | convince #not-oriented "I am not oriented" fn [] (out-of-range). 30 | request *be-oriented when #not-oriented ongoing fn [] (drone :led_blink_orange). 31 | request *celebrate when #oriented ongoing fn [] (drone :led_blink_green). 32 | 33 | convince #landed "I am on the ground" fn [] (navdata-equal :control-state :landed). 34 | convince #flying "I am flying" fn [] or (navdata-equal :control-state :flying) 35 | (navdata-equal :control-state :hovering). 36 | convince #high-enough "I am high enough" fn [] (navdata-gt :altitude 1.5). 37 | 38 | request *take-off when #landed fn [] (drone :take-off). 39 | request *cruising-alt when #flying until #high-enough fn [] (drone :up 0.5). 40 | request *cruise when #high-enough fn [] (drone :hover). 41 | 42 | (init-nav). -------------------------------------------------------------------------------- /src/babar/commands.clj: -------------------------------------------------------------------------------- 1 | (ns babar.commands) 2 | 3 | (defn babar-defn [v] 4 | (let [s (first v) 5 | params (second v) 6 | expr (nth v 2)] 7 | `(defn ~s ~params ~expr))) 8 | 9 | (defn babar-fn [v] 10 | (let [params (first v) 11 | expr (second v)] 12 | `(fn ~params ~expr))) 13 | 14 | (defn babar-def [v] 15 | (let [s (first v) 16 | val (second v)] 17 | `(def ~s ~val))) 18 | 19 | (defn babar-if [v] 20 | (let [[test then else] v] 21 | `(if ~test ~then ~else))) 22 | 23 | (defn babar-compare [op v] 24 | (let [[x y] v] 25 | `(~op ~x ~y))) 26 | 27 | (defn babar-operation [op v] 28 | `(apply ~op ~v)) 29 | 30 | (defn babar-and [v] 31 | `(reduce #(and %1 %2) ~v)) 32 | 33 | (defn babar-or [v] 34 | `(reduce #(or %1 %2) ~v)) 35 | 36 | (defn babar-println [v] 37 | `(println (apply str ~v))) 38 | 39 | (defn babar-import [v] 40 | `(require '[~(symbol (first v)) :refer :all])) 41 | 42 | (defn babar-deref [item] 43 | `@~item) 44 | 45 | (defn babar-get [v] 46 | `(get (first ~v) (second ~v))) 47 | 48 | (defn babar-do [v] 49 | `(do ~v)) 50 | 51 | (defn babar-sleep [v] 52 | `(Thread/sleep (first ~v))) 53 | 54 | (defn babar-first [v] 55 | `(if (vector? (first ~v)) (first (first ~v)) (first ~v))) 56 | 57 | (defn babar-atom [v] 58 | `(atom (first ~v))) 59 | 60 | (defn babar-swap [v] 61 | `(swap! ~(first v) ~(second v))) 62 | 63 | (defn babar-reset [v] 64 | `(reset! ~(first v) ~(second v))) 65 | 66 | (defn babar-command [command v] 67 | (case command 68 | "+" (babar-operation + v) 69 | "-" (babar-operation - v) 70 | "*" (babar-operation * v) 71 | "/" (babar-operation / v) 72 | "def" (babar-def v) 73 | "defn" (babar-defn v) 74 | "fn" (babar-fn v) 75 | "if" (babar-if v) 76 | "=" (babar-compare = v) 77 | ">" (babar-compare > v) 78 | "<" (babar-compare < v) 79 | "and" (babar-and v) 80 | "or" (babar-or v) 81 | "import" (babar-import v) 82 | "println" (babar-println v) 83 | "get" (babar-get v) 84 | "do" (babar-do v) 85 | "sleep" (babar-sleep v) 86 | "first" (babar-first v) 87 | "atom" (babar-atom v) 88 | "swap!" (babar-swap v) 89 | "reset!" (babar-reset v))) 90 | 91 | (defn babar-functioncall [sym & [v]] 92 | `(apply ~sym ~v)) 93 | 94 | -------------------------------------------------------------------------------- /test/babar/commands_test.clj: -------------------------------------------------------------------------------- 1 | (ns babar.commands-test 2 | (:require [midje.sweet :refer :all] 3 | [babar.parser :refer :all])) 4 | 5 | (facts "about operations" 6 | (parse "+ 1 2") => 3 7 | (parse "+ 1 2 3 4 5") => 15 8 | (parse "- 5 3") => 2 9 | (parse "- 5 3 1") => 1 10 | (parse "* 2 3") => 6 11 | (parse "* 2 3 2") => 12 12 | (parse "/ 4 2") => 2 13 | (parse "/ 8 2 2") => 2 14 | (parse "+ 1.2 3.4 2.5") => 7.1 15 | (parse "+ 5.2 -2.6 1.2") => 3.8 16 | (parse "* 2 5") => 10 17 | (parse "- 10 5") => 5 18 | (parse "/ 10 5") => 2) 19 | 20 | (declare dog1) 21 | (facts "about def" 22 | dog1 => 16 23 | (parse "dog1") => 16 24 | (parse "1 3 4 dog1") => [1 3 4 16] 25 | (parse "+ 1 dog1") => 17 26 | (against-background (before :facts (parse "def dog1 16")))) 27 | 28 | (facts "about if" 29 | (parse "if true 3 4") => 3 30 | (parse "if dog1 5 2") => 2 31 | (parse "[ (if true 3 2) 5 6 ]") => [3 5 6] 32 | (parse "if true (if true 4 3) 6") => 4 33 | (against-background (before :facts (parse "def dog1 false")))) 34 | 35 | (facts "about =" 36 | (parse "= 1 1") => true 37 | (parse "= 3 4") => false) 38 | 39 | (facts "about >" 40 | (parse "> 2 1") => true 41 | (parse "> 3 4") => false) 42 | 43 | (facts "about <" 44 | (parse "< 2 1") => false 45 | (parse "< 3 4") => true) 46 | 47 | (facts "about and" 48 | (parse "and true true") => true 49 | (parse "and true false") => false 50 | (parse "and true true true true") => true 51 | (parse "and true true false true") => false) 52 | 53 | (facts "about or" 54 | (parse "or true true") => true 55 | (parse "or true false") => true 56 | (parse "or false false") => false 57 | (parse "or true true true true") => true 58 | (parse "or true true false true") => true) 59 | 60 | 61 | (facts "about import" 62 | (parse "import \"clojure.java.io\"") 63 | (class (parse "(file \"test\")")) => java.io.File) 64 | 65 | (facts "about println" 66 | (parse "println \"cat\"") => nil 67 | (parse "println 1 2 3") => nil ) 68 | 69 | (facts "about get" 70 | (parse "get {:a 1} :a") => 1) 71 | 72 | (facts "about do" 73 | (parse "do def s1 1 def s2 2") => anything 74 | (parse "s1") => 1 75 | (parse "s2") => 2) 76 | 77 | (def bird (atom 5)) 78 | (facts "about derefering clojure atoms" 79 | (parse "@bird") => 5) 80 | 81 | (facts "about sleep" 82 | (parse "sleep 5") => anything) 83 | 84 | (facts "about first" 85 | (parse "first [1 2 3 4]") => 1 86 | (def x [2 3 4]) => anything 87 | (parse "first x") => 2) 88 | 89 | (facts "about atoms" 90 | (parse "def x atom 2") => anything 91 | (parse "@x") => 2 92 | (parse "swap! x inc") => 3 93 | (parse "@x") => 3 94 | (parse "reset! x 8") => 8 95 | (parse "@x") => 8) -------------------------------------------------------------------------------- /src/babar/parser.clj: -------------------------------------------------------------------------------- 1 | (ns babar.parser 2 | (:require [instaparse.core :as insta] 3 | [clojure.java.io :as io] 4 | [babar.commands :refer :all] 5 | [babar.speech-acts :refer :all])) 6 | 7 | (declare parse) 8 | 9 | (def parser 10 | (insta/parser 11 | "program = (expr / vector) / (expr <('.'|'?')> space*)+ 12 | expr = item | command | functioncall | readprogram 13 | readprogram = <'read'> space string 14 | command = commandkey space vector | 15 | <'('> (space)* commandkey space vector (space)* <')'> 16 | commandkey = operation | special 17 | functioncall = <'('> item <')'> / 18 | <'('> item space vector <')'> / 19 | item <':'> space vector / 20 | item <':'> 21 | map = <'{'> ((space)* item (space)*)+ <'}'> 22 | = svector | bvector 23 | svector = ((space)* item (space)*)+ 24 | bvector = <#'\\['> ((space)* item (space)*)+ <#'\\]'> | 25 | <#'\\[\\]'> 26 | = <#'[\\s\\t\\n\\,]+'> 27 | = command / speech-act / deref / functioncall / string / number / boolean / 28 | keyword / bvector / map / identifier 29 | speech-act = commitment | belief | query | request | convince | assertion | speak-config | ask-config 30 | assertion = (<'assert'> | <'defn'>) space #'[a-z][0-9a-zA-Z\\-\\_]*' space bvector space item / 31 | (<'assert'> | <'def'>) space #'[a-z][0-9a-zA-Z\\-\\_]*' space item 32 | query = 'query' space querytype space (commitment | belief) / 33 | 'query' space querytype space identifier / 34 | 'query' space querytype / 35 | 'ask-query' space #'[a-z][0-9a-zA-Z\\-\\_]*' 36 | querytype = 'request-value' | 'request-details' | 'request-completed' | 37 | 'request-created' | 'request-errors' | 'request-fn' | 38 | 'request-when' | 'request-is-done' | 'request-until' | 39 | 'request-ongoing' | 'request-cancelled' | 'belief-str' | 'belief-fn' | 40 | 'requests-all' | 'beliefs-all' | 'value' 41 | request = 'request' space <'*'> #'[a-z][0-9a-zA-Z\\-\\_]*' space 42 | ('when'| 'until' | 'ongoing') space belief space expr / 43 | 'request' space <'*'> #'[a-z][0-9a-zA-Z\\-\\_]*' space 44 | 'when' space belief space 'until' space belief space expr / 45 | 'request' space <'*'> #'[a-z][0-9a-zA-Z\\-\\_]*' space 46 | 'when' space belief space 'ongoing' space expr / 47 | 'request' space <'*'> #'[a-z][0-9a-zA-Z\\-\\_]*' space 48 | 'ongoing' space expr / 49 | 'request' space <'*'> #'[a-z][0-9a-zA-Z\\-\\_]*' space expr / 50 | 'request-cancel' space <'*'> #'[a-z][0-9a-zA-Z\\-\\_]*' 51 | convince = 'convince' space <'#'> #'[a-z][0-9a-zA-Z\\-\\_]*' 52 | space string space expr 53 | speak-config = <'speak-config'> space boolean / 54 | <'speak-config'> space boolean space string 55 | ask-config = <'ask-config'> space boolean 56 | commitment = <'*'> #'[a-z][0-9a-zA-Z\\-\\_]*' 57 | belief = <'#'> #'[a-z][0-9a-zA-Z\\-\\_]*' 58 | = '+' | '-' | '*' | '/' 59 | deref = <'@'> identifier 60 | identifier = #'[a-z][0-9a-zA-Z\\-\\_]*' 61 | = 'if' | '=' | '<' | '>' | 'and' | 'or' 62 | | 'import' | 'fn' | 'println' | 'get' | 'do' | 'sleep' | 'first' | 63 | 'atom' | 'swap!' | 'reset!' 64 | string = <'\\\"'> #'([^\"\\\\]|\\\\.)*' <'\\\"'> 65 | keyword = <#'[:]'> #'[\\w|-]+' 66 | boolean = #'true' | #'false' 67 | number = integer | decimal 68 | = #'-?[0-9]+\\.[0-9]+' 69 | = #'-?[0-9]+'")) 70 | 71 | 72 | (defn babar-eval [expr] 73 | (eval expr)) 74 | 75 | (defn eval-program [expr-list] 76 | (let [result (babar-eval (first expr-list))] 77 | (if (empty? (rest expr-list)) result (recur (rest expr-list))))) 78 | 79 | (defn read-program [filename] 80 | `(parse (slurp ~filename))) 81 | 82 | (def transform-options 83 | {:number read-string 84 | :string str 85 | :keyword keyword 86 | :boolean read-string 87 | :svector (comp vec list) 88 | :bvector (comp vec list) 89 | :map hash-map 90 | :deref babar-deref 91 | :assertion babar-assert 92 | :commitment commitment 93 | :belief belief 94 | :request request 95 | :convince convince 96 | :speech-act identity 97 | :identifier babar-indentifier 98 | :commandkey identity 99 | :command babar-command 100 | :functioncall babar-functioncall 101 | :expr identity 102 | :querytype identity 103 | :query query 104 | :readprogram read-program 105 | :speak-config speak-config 106 | :ask-config ask-config 107 | :program (comp eval-program list)}) 108 | 109 | (defn parse [input] 110 | (->> (parser input) (insta/transform transform-options))) 111 | 112 | (defn init [] 113 | (init-commitments)) 114 | 115 | -------------------------------------------------------------------------------- /src/babar/speech_acts.clj: -------------------------------------------------------------------------------- 1 | (ns babar.speech-acts 2 | (:require [clj-time.core :as time] 3 | [clj-time.format :as tformat] 4 | [babar.commands :refer :all] 5 | [me.raynes.conch.low-level :as conchll])) 6 | 7 | (def commitments (atom {})) 8 | (def beliefs (atom {})) 9 | (def commitments-agent (agent {})) 10 | (def speak-flag (atom false)) 11 | (def ask-flag (atom false)) 12 | (def last-said (atom nil)) 13 | (def speak-voice (atom "Bruce")) 14 | 15 | (defrecord Commitment [fn val completed created errors when until ongoing cancelled]) 16 | (defrecord Belief [str fn]) 17 | 18 | (def built-in-formatter (tformat/formatters :date-hour-minute-second-ms)) 19 | (tformat/unparse built-in-formatter (time/now)) 20 | 21 | (defn speak-config [val & [voice]] 22 | (if val (reset! speak-flag true) (reset! speak-flag false)) 23 | (when voice (reset! speak-voice voice))) 24 | 25 | (defn ask-config [val] 26 | (if val (reset! ask-flag true) (reset! ask-flag false))) 27 | 28 | (defn gen-timestamp [] 29 | (tformat/unparse built-in-formatter (time/now))) 30 | 31 | (defn belief [name] 32 | `((keyword ~name) @beliefs)) 33 | 34 | (defn make-belief [str fn] 35 | (let [cfn (if (vector? fn) (first fn) fn)] 36 | (Belief. str cfn))) 37 | 38 | (defn be-convinced [id str expr] 39 | `((keyword ~id) 40 | (swap! beliefs merge 41 | {(keyword ~id) (make-belief ~str ~expr)}))) 42 | 43 | (defn convince [name id str expr] 44 | (if (= name "convince") 45 | (be-convinced id str expr))) 46 | 47 | (defn make-commitment [fn val completed errors when until ongoing] 48 | (let [cfn (if (vector? fn) (first fn) fn)] 49 | (Commitment. cfn val completed (gen-timestamp) errors when until ongoing nil))) 50 | 51 | 52 | (defn request-plain [name id expr ongoing] 53 | `((keyword ~id) 54 | (swap! commitments merge 55 | {(keyword ~id) (make-commitment ~expr nil nil nil nil nil ~ongoing)}))) 56 | 57 | (defn request-when-until [name id when until expr ongoing] 58 | `((keyword ~id) 59 | (swap! commitments merge 60 | {(keyword ~id) (make-commitment ~expr nil nil nil ~when ~until ~ongoing)}))) 61 | 62 | (defn cancel-commitment [id] 63 | `(swap! commitments merge 64 | {(keyword ~id) (assoc ((keyword ~id) @commitments) :cancelled true)})) 65 | 66 | (defn request 67 | ([name id] (when (= name "request-cancel") (cancel-commitment id))) 68 | ([name id expr] (request-plain name id expr nil)) 69 | ([name id ongoing expr] (request-plain name id expr true)) 70 | ([name id type belief expr] (case type 71 | "when" (request-when-until name id belief nil expr nil) 72 | "until" (request-when-until name id nil belief expr nil))) 73 | ([name id when when-belief ongoing expr] 74 | (request-when-until name id when-belief nil expr true)) 75 | ([name id when when-belief until until-belief expr] 76 | (request-when-until name id when-belief until-belief expr nil))) 77 | 78 | (defn commitment [name] 79 | `((keyword ~name) @commitments)) 80 | 81 | (defn commitment-belief-query [c key] 82 | `(~key ~c)) 83 | 84 | (defn commitment-is-done [c] 85 | `(not (nil? (:completed ~c)))) 86 | 87 | (defn all-commitments-beliefs [a] 88 | (vec (keys @a))) 89 | 90 | (defn ask-query [s] 91 | (let [question (str "\nquery " s "?")] 92 | (do 93 | (println question) 94 | (when @speak-flag 95 | (future (conchll/proc "say" "-v" @speak-voice question)))))) 96 | 97 | (defn answer-query [type v] 98 | (case type 99 | "request-value" (commitment-belief-query v :val) 100 | "request-fn" (commitment-belief-query v :fn) 101 | "request-completed" (commitment-belief-query v :completed) 102 | "request-is-done" (commitment-is-done v) 103 | "request-created" (commitment-belief-query v :created) 104 | "request-errors" (commitment-belief-query v :errors) 105 | "request-when" (commitment-belief-query v :when) 106 | "request-until" (commitment-belief-query v :until) 107 | "request-ongoing" (commitment-belief-query v :ongoing) 108 | "request-cancelled" (commitment-belief-query v :cancelled) 109 | "requests-all" (all-commitments-beliefs commitments) 110 | "belief-str" (commitment-belief-query v :str) 111 | "belief-fn" (commitment-belief-query v :fn) 112 | "beliefs-all" (all-commitments-beliefs beliefs) 113 | "value" `~v)) 114 | 115 | (defn query [name id & v] 116 | (case name 117 | "query" (answer-query id (first v)) 118 | "ask-query" (ask-query id))) 119 | 120 | (defn say-belief [str] 121 | (when-not (= @last-said str) 122 | (do 123 | (reset! last-said str) 124 | (future (conchll/proc "say" "-v" @speak-voice str))))) 125 | 126 | (defn babar-assert ([id val] (babar-def (list (symbol id) val))) 127 | ([id params form] (babar-defn (list (symbol id) params form)))) 128 | 129 | 130 | (defn check-when-belief [when-pred] 131 | (if ((:fn when-pred)) 132 | (do (when @speak-flag (say-belief (:str when-pred)) 133 | ) 134 | true))) 135 | 136 | (defn need-to-fufill-commitment? [c] 137 | (try 138 | (let [not-complete (and 139 | (nil? (:completed (val c))) 140 | (nil? (:cancelled (val c)))) 141 | when-pred (:when (val c))] 142 | (and not-complete 143 | (if when-pred (check-when-belief when-pred) true))) 144 | (catch Exception e (do 145 | (swap! commitments merge {(key c) (assoc ((key c) @commitments) :errors (str e " " (.getMessage e)))}) 146 | nil)))) 147 | 148 | (defn unfufilled-commitments [] 149 | (into {} (filter need-to-fufill-commitment? @commitments))) 150 | 151 | (defn complete-until [until] 152 | (do 153 | (when @speak-flag (say-belief (:str until))) 154 | true)) 155 | 156 | (defn should-mark-complete? [c] 157 | (if (:until c) 158 | (if ((:fn (:until c))) (complete-until (:until c)) false) 159 | (not (:ongoing c)))) 160 | 161 | (defn fufill-commitment [entry] 162 | (try 163 | (let [[k c] entry 164 | result ((:fn c))] 165 | [ k (merge c {:val result :completed (when (should-mark-complete? c) (gen-timestamp))})] 166 | ) 167 | (catch Exception e 168 | [ (first entry) (merge (last entry) {:errors (str e " " (.getMessage e))})]))) 169 | 170 | (defn fufill-commitments [_] 171 | (do 172 | (swap! commitments merge 173 | (into {} (map fufill-commitment (unfufilled-commitments)) 174 | )) 175 | (Thread/sleep 5) 176 | (recur nil))) 177 | 178 | (defn init-commitments [] 179 | (send commitments-agent fufill-commitments)) 180 | 181 | (defn b-declare [s] 182 | (eval `(declare ~s))) 183 | 184 | (defn babar-indentifier [s] 185 | (if (resolve (read-string s)) 186 | (read-string s) 187 | (if @ask-flag 188 | (do 189 | (ask-query s) 190 | (b-declare (read-string s)) 191 | (symbol s)) 192 | (read-string s)))) 193 | 194 | -------------------------------------------------------------------------------- /test/babar/speech_acts_test.clj: -------------------------------------------------------------------------------- 1 | (ns babar.speech-acts-test 2 | (:require [midje.sweet :refer :all] 3 | [babar.parser :refer :all] 4 | [babar.speech-acts :refer :all])) 5 | 6 | (init-commitments) 7 | 8 | (defn reset-commitments [] 9 | (reset! commitments {})) 10 | 11 | (defn setup-commitments [] 12 | (swap! commitments merge 13 | {:test (make-commitment (fn [] "test") 1 "completed" "error" 14 | (make-belief "Everything is fine" 15 | (fn [] (= 1 1))) nil nil)})) 16 | 17 | 18 | (defn reset-beliefs [] 19 | (reset! beliefs {})) 20 | 21 | (defn setup-beliefs [] 22 | (swap! beliefs merge 23 | {:nice-day (make-belief "It is a nice day."(fn [] (= 2 2)))})) 24 | 25 | 26 | (facts "about parsing beliefs" 27 | (= babar.speech_acts.Belief (type (parse "#rainy"))) => true 28 | (against-background (before :facts 29 | (swap! beliefs merge 30 | {:rainy (make-belief "It is rainy out." 31 | (fn [] (= 1 1)))})))) 32 | 33 | (facts "about being convinced of a belief" 34 | (type 35 | (parse "convince #sunny \"It is sunny\" fn [] = 1 1")) => babar.speech_acts.Belief 36 | (parse "query belief-str #sunny") => "It is sunny" 37 | ((parse "query belief-fn #sunny")) => true) 38 | 39 | (facts "about parsing commitments" 40 | (= babar.speech_acts.Commitment (type (parse "*raise-temp"))) => true 41 | (against-background (before :facts 42 | (swap! commitments merge 43 | {:raise-temp (make-commitment '(+ 1 1) 1 true nil nil nil nil)})))) 44 | 45 | 46 | (facts "about accepting requests" 47 | (type (parse "request *up-temp fn [] (+ 3 1)")) => babar.speech_acts.Commitment 48 | (nil? (:up-temp @commitments)) => false) 49 | 50 | 51 | (facts "about querying queries about requests" 52 | (parse "query request-value *test") => 1 53 | (parse "query request-completed *test") => "completed" 54 | (nil? (parse "query request-created *test")) => false 55 | (nil? (parse "query request-fn *test")) => false 56 | (nil? (parse "query request-when *test")) => false 57 | (nil? (parse "query request-until *test")) => true 58 | (nil? (parse "query request-ongoing *test")) => true 59 | (nil? (parse "query request-cancelled *test")) => true 60 | (parse "query request-errors *test") => "error" 61 | (against-background (before :facts (setup-commitments)))) 62 | 63 | (facts "about querying query about all requests" 64 | (parse "request *up-temp fn [] (+ 3 1)") => anything 65 | (parse "request *down-temp fn [] (- 3 1)") => anything 66 | (parse "query requests-all") => (contains[:up-temp :down-temp] :in-any-order) 67 | (against-background (before :facts (reset-commitments)))) 68 | 69 | (facts "about querying queries about beliefs" 70 | (parse "query belief-str #nice-day") => "It is a nice day." 71 | ((parse "query belief-fn #nice-day")) => true 72 | (against-background (before :facts (setup-beliefs)))) 73 | 74 | (facts "about querying all beliefs" 75 | (parse "convince #sunny \"It is sunny\" fn [] = 1 1") 76 | (parse "convince #cloudy \"It is cloudy\" fn [] = 1 3") 77 | (parse "query beliefs-all") => (contains [:sunny :cloudy] :in-any-order) 78 | (against-background (before :facts (reset-beliefs)))) 79 | 80 | (facts "about assertions" 81 | (parse "assert apple 1") => anything 82 | (parse "apple") => 1 83 | (parse "assert apple-pie [x] + x 1") 84 | (parse "(apple-pie 3)") => 4) 85 | 86 | (facts "about processing commitments" 87 | (type (parse "request *dog fn [] :bark")) => babar.speech_acts.Commitment 88 | (Thread/sleep 30) 89 | (parse "query request-value *dog") => :bark 90 | (nil? (parse "query request-completed *dog")) => false 91 | (against-background (before :facts (reset-commitments)))) 92 | 93 | (facts "about processing commitments with when" 94 | (parse "def temperature 65") 95 | (parse "convince #too-warm \"It is too warm.\" fn [] > temperature 70") 96 | (parse "request *lower-temp when #too-warm fn [] :lower-the-temp-action") 97 | (type (parse "query request-when *lower-temp")) => babar.speech_acts.Belief 98 | (parse "query request-completed *lower-temp") => nil 99 | (parse "query request-value *lower-temp") => nil 100 | (parse "def temperature 75") => anything 101 | (Thread/sleep 80) 102 | (parse "query request-value *lower-temp") => :lower-the-temp-action 103 | (nil? (parse "query request-completed *lower-temp")) => false 104 | (against-background (before :facts (reset-commitments)))) 105 | 106 | (def temp (atom 65)) 107 | (defn increase-temp [] 108 | (swap! temp inc)) 109 | 110 | (facts "about processing commitments with until" 111 | (parse "convince #just-right \"It is just-right\" fn [] > @temp 70") => anything 112 | (parse "request *raise-temp until #just-right fn [] (increase-temp)") => anything 113 | (Thread/sleep 60) 114 | (parse "query request-is-done *raise-temp") => true 115 | (parse "query request-value *raise-temp") => 71 116 | (nil?(parse "query request-completed *raise-temp")) => false 117 | (against-background (before :facts (reset! temp 69)))) 118 | 119 | (facts "about processing commitments with when and until" 120 | (parse "convince #just-right \"It is just-right\" fn [] > @temp 70") => anything 121 | (parse "convince #start \"Time to start\" fn [] > @temp 68") => anything 122 | (parse "request *raise-temp when #start until #just-right fn [] (increase-temp)") => anything 123 | (Thread/sleep 60) 124 | (parse "query request-is-done *raise-temp") => false 125 | (parse "query request-value *raise-temp") => nil 126 | (nil? (parse "query request-completed *raise-temp")) => true 127 | (reset! temp 69) => anything 128 | (Thread/sleep 60) 129 | (parse "query request-is-done *raise-temp") => true 130 | (parse "query request-value *raise-temp") => 71 131 | (nil? (parse "query request-completed *raise-temp")) => false 132 | (against-background (before :facts (reset! temp 65)))) 133 | 134 | 135 | (facts "about processing multiple commitments" 136 | (type (parse "request *cat fn [] :meow")) => babar.speech_acts.Commitment 137 | (type (parse "request *bird fn [] :tweet")) => babar.speech_acts.Commitment 138 | (type (parse "request *horse fn [] :neigh")) => babar.speech_acts.Commitment 139 | (parse "query request-value *cat") => :meow 140 | (nil? (parse "query request-completed *cat")) => false 141 | (parse "query request-is-done *cat") => true 142 | (parse "query request-value *bird") => :tweet 143 | (nil? (parse "query request-completed *bird")) => false 144 | (parse "query request-is-done *bird") => true 145 | (parse "query request-value *horse") => :neigh 146 | (nil? (parse "query request-completed *horse")) => false 147 | (parse "query request-is-done *horse") => true 148 | (against-background (before :facts (reset-commitments)))) 149 | 150 | (facts "about processing commitment with an error" 151 | (type (parse "request *cat fn [] / 0 0")) => babar.speech_acts.Commitment 152 | (parse "query request-completed *cat") => nil 153 | (parse "query request-is-done *cat") => false 154 | (parse "query request-value *cat") => nil 155 | (parse "query request-errors *cat") => "java.lang.ArithmeticException: Divide by zero Divide by zero" 156 | (against-background (before :facts (reset-commitments)))) 157 | 158 | 159 | (facts "about processing commitment with a when error" 160 | (type (parse "convince #bad \"This is really bad.\" fn [] / 0 0")) => babar.speech_acts.Belief 161 | (type (parse "request *cat when #bad fn [] + 1 1")) => babar.speech_acts.Commitment 162 | (Thread/sleep 30) => anything 163 | (parse "query request-completed *cat") => nil 164 | (parse "query request-is-done *cat") => false 165 | (parse "query request-value *cat") => nil 166 | (parse "query request-errors *cat") => "java.lang.ArithmeticException: Divide by zero Divide by zero" 167 | (against-background (before :facts (reset-commitments)))) 168 | 169 | (def x1 (atom 1)) 170 | (defn inc-x1 [] 171 | (swap! x1 inc)) 172 | (facts "about processing ongoing commitments" 173 | (parse "request *count ongoing fn [] (inc-x1)") => anything 174 | (Thread/sleep 20) => anything 175 | (> (parse "@x1") 2) => true 176 | (against-background (before :facts (reset-commitments)))) 177 | 178 | (def y2 1) 179 | (facts "about processing when and ongoing commitments" 180 | (parse "convince #start \"Time to start\" fn [] = y2 2") 181 | (parse "request *count when #start ongoing fn [] (inc-x1)") => anything 182 | (Thread/sleep 20) => anything 183 | (parse "@x1") => 1 184 | (def y2 2) => anything 185 | (Thread/sleep 20) => anything 186 | (> (parse "@x1") 2) => true 187 | (against-background (before :facts (do (reset! x1 1) 188 | (reset-commitments))))) 189 | 190 | (facts "about cancelling commitments" 191 | (parse "def x atom 1") => anything 192 | (parse "request *count ongoing fn [] swap! x inc") => anything 193 | (Thread/sleep 5) => anything 194 | (> (parse "@x") 1) => true 195 | (parse "request-cancel *count") => anything 196 | (parse "def y @x") => anything 197 | (Thread/sleep 5) => anything 198 | (parse "= y @x") => true) 199 | 200 | (facts "about processing multi step requests" 201 | (parse "request *step1 fn [] + 1 1") => anything 202 | (parse "convince #done1 \"Done with 1\" fn [] query request-is-done *step1") => anything 203 | (parse "request *step2 when #done1 fn [] + 2 2") => anything 204 | (parse "convince #done2 \"Done with 2\" fn [] query request-is-done *step2") => anything 205 | (parse "request *step3 when #done2 fn [] + 3 3") => anything 206 | (Thread/sleep 30) => anything 207 | (parse "query request-is-done *step1") => true 208 | (parse "query request-is-done *step2") => true 209 | (parse "query request-is-done *step3") => true 210 | (against-background (before :facts (reset-commitments)))) 211 | 212 | 213 | (facts "about speak-config" 214 | (parse "speak-config true") => anything 215 | @speak-flag => true 216 | (parse "speak-config false") => anything 217 | @speak-flag => false) 218 | 219 | (facts "about ask-config" 220 | (parse "ask-config true") => anything 221 | @ask-flag => true 222 | (parse "ask-config false") => anything 223 | @ask-flag => false) 224 | 225 | (facts "about querying values" 226 | (def x 1) 227 | (parse "query value x") => 1) 228 | 229 | (facts "about asking questions about unbound vars" 230 | (parse "ask-config true") 231 | (parse "assert cat [] + x 1") => anything 232 | (parse "assert x 2") => anything 233 | (parse "cat:") => 3) 234 | 235 | 236 | ;question outputs are side effects 237 | (facts "about asking questions" 238 | (parse "ask-query ssd") => nil) 239 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # babar 2 | 3 | ``` 4 | Hello Babar! 5 | ____ 6 | /. \_ 7 | /_ \_/ \ 8 | // \ ___ || 9 | \\ |_| |_| 10 | 11 | ctl-c or quit to exit 12 | =============== 13 | babar> 14 | ``` 15 | 16 | A little language for machines with Speech Acts inspired by 17 | [Elephant 2000](http://www-formal.stanford.edu/jmc/elephant/elephant.html). 18 | The parser uses the wonderful Clojure 19 | [Instaparse](https://github.com/Engelberg/instaparse) library. 20 | The language aims to have syntactically sugared "speech acts" that the 21 | machine uses as inputs and outputs. The language also supports 22 | beliefs and goals from McCarthy's paper, 23 | [Ascribing Mental Qualities to Machines](http://www-formal.stanford.edu/jmc/ascribing/ascribing.html). 24 | 25 | 26 | Expressions and programs are run through the Babar REPL and have the 27 | following features: 28 | 29 | - The Babar program can accept requests, that are then stored as 30 | internal commitments. 31 | - The Babar program can be convinced of beliefs that can affect when 32 | and how often a request is executed. 33 | - The Babar program has one goal - to fulfill its commitments. It 34 | checks every 5ms to see if it has any commitments to fulfill and will 35 | execute them based on its beliefs. (An Elephant is true 100 percent.) 36 | - The Babar program can be queried about its commitments. For 37 | example, was the request completed, what was the value, etc.. 38 | - The Babar program can speak aloud its beliefs. Specifically, it 39 | will vocalize any belief that is held (evaluate to true), while it 40 | is fulfilling commitments. 41 | - The Babar program remembers all the commitments that it ever had 42 | and they can all be queried - even cancelled ones. (An Elephant 43 | never forgets.) 44 | - The Babar program can ask a question - (very experimental still). 45 | The only questions that it will ask currently is about undeclared vars. 46 | 47 | 48 | ## Installation 49 | Git clone this repo 50 | 51 | In some of the examples, I hook up to the clj-drone library, 52 | which uses some local jars. 53 | 54 | You need to install the h264 (for video conversion) jar locally. You can use the 55 | [lein-localrepo](https://github.com/kumarshantanu/lein-localrepo) plug 56 | in. Run: 57 | 58 | lein localrepo install dronelibs/h264-decoder-1.0.jar h264-decoder/h264-decoder 1.0 59 | lein localrepo install dronelibs/opencv-245.jar opencv/opencv 2.4.5 60 | 61 | 62 | Or - If you don't really care about drone stuff - feel free to remove 63 | the clj-drone from the project.clj 64 | 65 | 66 | 67 | 68 | Let's back up a bit and look at the basic datatypes and commands. 69 | 70 | ## Data Types 71 | Most of the data types are directly from Clojure. You have integers, 72 | decimals, strings, booleans, keywords, maps, vectors, and atoms 73 | 74 | ```clojure 75 | 1 ;=> 1 76 | 2.3 ;=> 2.3 77 | -3.4 ;=> -3.4 78 | "cat" ;=> cat 79 | :bird ;=> bird 80 | true ;=> true 81 | {:cat :meow :dog :bark} ;=> {:cat :meow :dog :bark} 82 | [1 2 true :bird] ;=> [1 2 true bird] 83 | atom 1 ;=> # 84 | ``` 85 | Vectors are a bit interesting in the respect that you don't need 86 | to input the square brackets. If you just put in space delimited 87 | items, it will automatically construct a vector for you. 88 | 89 | ```clojure 90 | 1 2 3 4 ;=> [1 2 3 4] 91 | ``` 92 | 93 | If you want to nest the vectors, you need to include the square 94 | brackets. 95 | 96 | ```clojure 97 | 1 2 [3 4 5] ;=> [1 2 [3 4 5]] 98 | ``` 99 | 100 | ## Operations 101 | The basic usual suspects are supported : ( +, -, / , *). 102 | The interesting thing to note is that parens are optional, 103 | and all operations work on a vector by default - so: 104 | 105 | ```clojure 106 | (+ 1 2 3 4 5) ;=> 15 107 | ``` 108 | Is the same as: 109 | 110 | ````clojure 111 | + 1 2 3 4 5 ;=> 15 112 | ```` 113 | 114 | 115 | ## Commands 116 | A subset of the clojure commands have been included. This will 117 | grow in time. Mind you parens are optional in most cases. You can call functions 118 | with the typical () or with a shorthand : syntax 119 | 120 | - **def** - def identifier expression 121 | ```clojure 122 | (def dog 16) 123 | dog ;=> 16 124 | def cat 18 125 | cat ;=> 18 126 | ``` 127 | - **defn** - defn identifier params expression 128 | ```clojure 129 | (defn cat [x] (+ x 2)) 130 | (cat 2); => 4 131 | defn dog [] "woof" 132 | dog: ;=> "woof" 133 | ``` 134 | - **if** - if predicate truecase falsecase 135 | ```clojure 136 | if true :cat :dog ;=> :cat 137 | ``` 138 | - **=**, **<**,**>** - operator val1 val2 139 | ```clojure 140 | = :dog :dog ;=> true 141 | ``` 142 | - **and** - and val1 val2 & others 143 | ```clojure 144 | and true true true ;=> true 145 | and true true false ;=> false 146 | ``` 147 | - **or** - or val1 val2 & others 148 | ```clojure 149 | or true false true ;=> true 150 | or false false false ;=> false 151 | ``` 152 | - **import** - import "ns" 153 | There is basic support for importing clojure namespaces. 154 | At this basic level it imports the whole namespace and does require 155 | :refer :all 156 | ```clojure 157 | import "clojure.java.io" 158 | ``` 159 | 160 | - **println** - println item & others 161 | 162 | Concatenates the items as a string and prints it out to stdout 163 | 164 | ```clojure 165 | println "cat" ;=> "cat" (returns nil) 166 | println "cat" " " 1 " " :duck ;=> "cat 1 :duck" (returns nil) 167 | ``` 168 | 169 | - **get** - get hash key 170 | Gets the value of a hash by key 171 | 172 | ```clojure 173 | get {:a 1} :a => :a 174 | ``` 175 | 176 | - **do** - do expr expr+ 177 | Do multiple expressions 178 | 179 | ```clojure 180 | do def s1 1 181 | def s2 2 182 | s1 ;=> 1 183 | s2 ;=> 2 184 | ``` 185 | 186 | - **sleep** - sleep ms 187 | Sleep for given milliseconds 188 | 189 | ```clojure 190 | sleep 5 191 | ``` 192 | 193 | - **first** - first vec 194 | First element of vector 195 | 196 | ```clojure 197 | first [1 2 3] ;=> 1 198 | ``` 199 | 200 | - **swap!** - swap atom fn 201 | applies a fn to the atom and changes the value in a safe manner 202 | 203 | ```clojure 204 | def x atom 1 ;=> x 205 | swap! x inc ;=> 2 206 | @x ;=> 2 207 | ``` 208 | 209 | - **reset!** - swap atom val 210 | resets the value of atom in a safe manner 211 | 212 | ```clojure 213 | def x atom 1 ;=> x 214 | reset! x 8 ;=> 8 215 | @x ;=> 8 216 | ``` 217 | 218 | 219 | ### Anonymous Functions 220 | You can create anonymous functions with the fn [x] syntax from 221 | clojure. And call them with surrounding parens. 222 | 223 | ```clojure 224 | fn [x] + x 1 ;=> fn 225 | (fn [x] + x 1) ;=> fn 226 | ((fn [x] + x 1) 3) ;=> 4 227 | ((fn [x y z] + x y z) 1 2 3) ;=> 6 228 | ((fn [] [4 5 6])) ;=> [4 5 6] 229 | ``` 230 | 231 | ## Speech Acts 232 | According to John Searle's 233 | [Speech Acts](http://en.wikipedia.org/wiki/Speech_act) 234 | There are [Illocutionary Acts](http://en.wikipedia.org/wiki/Illocutionary_act) 235 | that involve the pragmatic meaning of a behind a sentence. Some of the 236 | english verbs denoting these acts are "assert", "command", "request", 237 | "query". For example the sentence, "Pass the salt.", is an 238 | illocutionary act. When a person hears the sentence, the meaning is 239 | interpreted as a command. There are also 240 | [Perlocutionary Acts](http://en.wikipedia.org/wiki/Perlocutionary_act), 241 | in which significance is on the statement's effect on the hearer's 242 | actions, thoughts, and beliefs. An example of this is "persuade" or 243 | "convince". Some of these speech acts have been incorporated into the 244 | language. So far there is support for: 245 | 246 | ### Datatypes 247 | - **Commitment** - *name 248 | 249 | A commitment is a datatype designated by a *name 250 | 251 | ```clojure 252 | *bark 253 | ``` 254 | 255 | - **Belief** - #name 256 | 257 | A belief is a datatype designated by a #name 258 | 259 | ```clojure 260 | #sunny 261 | ``` 262 | 263 | ### Convincing 264 | 265 | - **convince** - convinced belief string predicate-function 266 | 267 | To be convinced will create an internal belief that has a human 268 | readable string as a description and a predicate function that 269 | evaluates to true when the machine "believes" it. 270 | 271 | ```clojure 272 | convince #sunny "It is sunny" fn [x] (= 1 1) 273 | ``` 274 | 275 | ### Requests 276 | - **request** - request commitment function 277 | 278 | Accepting a request creates an internal commitment that is evaluated 279 | at a future time. Behind the scenes there is a cron-like watcher 280 | that continually sees if it has any commitments to execute. If there 281 | is an error that occurs, then it will have an error captured that you 282 | can query by using "query request-errors". 283 | 284 | ```clojure 285 | request *dog fn [] :bark ;=> babar.speech_acts.Commitment 286 | ``` 287 | 288 | - **request when** - request commitment when belief function 289 | 290 | You can also specify a request to be executed when a belief is held. 291 | The request is executed when the belief predicate function evaluates 292 | to true. 293 | ```clojure 294 | convince #too-warm "It is too warm." fn [] > temperature 70 295 | request *lower-temp when #too-warm fn [] :lower-the-temp-action 296 | ``` 297 | 298 | - **request until** - request commitment until belief function 299 | 300 | You can specify a request to be executed until a belief is held. 301 | The request will continue to execute until the belief is held. 302 | ```clojure 303 | convince #just-right "It is just-right" fn [] > @temp 70 304 | request *raise-temp until #just-right fn [] (increase-temp) 305 | ``` 306 | 307 | - **request when until** - request commitment when belief until function 308 | 309 | You can specify a request to be executed when a belief is held and 310 | until another belief is held. 311 | 312 | ````clojure 313 | convince #just-right "It is just-right" fn [] > @temp 70 314 | convince #start "Time to start" fn [] > @temp 68 315 | request *raise-temp when #start until #just-right fn [] (increase-temp) 316 | ```` 317 | 318 | - **request ongoing** - request commitment ongoing function 319 | 320 | You can specify a request to be executed repeatedly with no end. 321 | 322 | ```clojure 323 | request *count ongoing fn [] (inc-x1) 324 | ``` 325 | 326 | - **request when ongoing** - request commitment when belief ongoing function 327 | 328 | You can specify a request to be executed repeatedly with no end, when 329 | a belief is true. 330 | 331 | ```clojure 332 | convince #start "Time to start" fn [] = y2 2 333 | request *count when #start ongoing fn [] (inc-x1) 334 | ``` 335 | 336 | - **cancel-request** - cancel-request request 337 | 338 | You can cancel a request. The request itself is still remembered and 339 | can be queried, but it will not be executed. 340 | 341 | ```clojure 342 | cancel-request *dog 343 | ``` 344 | 345 | ### Answering Queries 346 | * query 347 | 348 | Answering questions about requests, beliefs and values. 349 | 350 | - **query** - 351 | request-[fn | completed | value | errors | created | when | until | is-done | cancelled | ongoing] 352 | request) 353 | 354 | ```clojure 355 | request *dog fn [] :bark. 356 | query request-value *dog ;=> :bark 357 | query request-completed *dog? ;=> "2013-05-17T19:58:07.882" 358 | query request-is-done? ;=> true 359 | ``` 360 | 361 | - **query belief-[str | fn ]** 362 | 363 | ```clojure 364 | convince #sunny "It is sunny" fn [] = 1 1 ;=> belief 365 | query belief-str #sunny ;=> "It is sunny" 366 | query belief-fn #sunny ;=> function 367 | ``` 368 | 369 | - **query requests-all** 370 | 371 | ```clojure 372 | request *step1 fn [] + 1 1 ;=> commitment 373 | request *step2 fn [] + 2 2 ;=> commitment 374 | query requests-all ;=> [:step1 :step2] 375 | ``` 376 | 377 | - **query beliefs-all** 378 | 379 | ```clojure 380 | convince #sunny "It is sunny" fn [] = 1 1 ;=> belief 381 | convince #rainy "It is rainy" fn [] = 1 2 ;=> belief 382 | query beliefs-all? ;=> [:sunny :rainy] 383 | ``` 384 | 385 | - **query value identifier** 386 | 387 | You can ask what the value of a identifier is 388 | 389 | ```clojure 390 | assert x 1 ;=> x 391 | query value x ;=> 1 392 | ``` 393 | 394 | ### Asking Queries 395 | *Experimental* 396 | 397 | You can ask queries are well as answering them. Asking a query is 398 | manifested as a side effect - a printed speech act. Right now the 399 | statement prints on the REPL console. It always could be directed to 400 | an external file that another system could read... 401 | 402 | - **ask-query** identifier 403 | 404 | ```clojure 405 | ask-query what-is-this ;=> query what-is-this. 406 | ``` 407 | 408 | - **ask-config** true | false 409 | 410 | This configures the repl to automcatically ask questions about unbound 411 | vars. 412 | 413 | ```clojure 414 | ask-config true 415 | ``` 416 | 417 | The REPL will also respond with an ask-query if you define 418 | a function with a undeclared variable. You need to config to ask 419 | questions automatically first. 420 | 421 | ```clojure 422 | ask-config true 423 | assert cat [] + x 1 ;=> query x. 424 | assert cat x 2 ;=> x 425 | cat: ;=> 3 426 | ``` 427 | 428 | Even cooler - if the speak-beliefs flag is true, it will also 429 | speak the query aloud as well :) 430 | 431 | ### Speaking the Beliefs using Say 432 | * **speak-config** 433 | - **speak-config** [true | false ] 434 | - **speak-config** true voice-name 435 | 436 | ```clojure 437 | speak-config true ;=> default voice 438 | speak-config true "Zarvox" ;=> speak with Zarvox 439 | ``` 440 | 441 | If you toggle on the speak-beliefs, then (if you have a mac and say), 442 | then any beliefs will be spoken aloud when there belief fns evaluate 443 | to true - or the beliefs are being held. If there are multiple 444 | beliefs, (like using an until), then it will only speak when the 445 | belief changes. 446 | 447 | ## Reading babar programs 448 | * **read** - read filename 449 | 450 | This command will read a *.babar file into the repl and evaluate it 451 | it. A program is composed of multiple expressions that are delimited 452 | by a period or a question mark. Question marks can of course be used 453 | for queries. 454 | 455 | simple.babar 456 | ```clojure 457 | assert a 1. 458 | assert b 10. 459 | assert c [:a :b (+ a b)]. 460 | ``` 461 | 462 | ```clojure 463 | read "simple.babar" ;=> #'user/c 464 | c ;=> [:a :b 11] 465 | ``` 466 | 467 | 468 | ## REPL 469 | Launch a REPL 470 | 471 | lein run 472 | 473 | or run the standalone shell script 474 | 475 | ./bin/babar.sh 476 | 477 | ## Examples 478 | There are a couple of examples to get you going with playing with it. 479 | To run the examples: 480 | 481 | - launch a repl using ```'lein run'``` or ```./bin/babar.sh'``` 482 | 483 | At the babar repl prompt 484 | 485 | ``` 486 | read "./examples/simple.babar" 487 | ``` 488 | 489 | There are also other example programs. 490 | - examples/speech_acts.babar 491 | - examples/requests_until.babar 492 | - examples/asking.babar 493 | 494 | The programs has the speak-config 495 | set to true. This will work fine if you have a mac, just turn it to 496 | false if you are on another system. 497 | 498 | Have fun! 499 | 500 | ## Videos 501 | 502 | I made a few videos to show Babar in action 503 | 504 | - An example of the Babar REPL speaking beliefs with requests 505 | [video](https://www.youtube.com/watch?v=bt2iYsVyCOM) 506 | - An example of Babar REPL using a request with an until belief 507 | [video] (https://www.youtube.com/watch?v=aT8MK0w71LM) 508 | - An example of Babar REPL asking you a question about an undeclared 509 | var [video] (https://www.youtube.com/watch?v=nmi_fafmjsg) 510 | - An example of Babar REPL flying an AR Drone with Speech Acts [video] (https://www.youtube.com/watch?v=CIzR8jD2d3c) 511 | 512 | ## TESTS 513 | 514 | lein midje 515 | 516 | ## Ascii Art 517 | The lovely ascii elepant is a modified version of the one found [here](http://www.retrojunkie.com/asciiart/animals/elephant.htm) 518 | 519 | ## License 520 | 521 | Copyright © 2013 Carin Meier 522 | 523 | Distributed under the Eclipse Public License, the same as Clojure. 524 | --------------------------------------------------------------------------------