Skip to content

Instantly share code, notes, and snippets.

@capitancook
Last active August 29, 2015 13:56
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save capitancook/9248111 to your computer and use it in GitHub Desktop.
Save capitancook/9248111 to your computer and use it in GitHub Desktop.
Clojure code described in
;; this gist contain the CLojure code for the blog post:
;; http://highorderdysfunctions.blogspot.it/2014/03/frame-language-in-clojure-part-2.html
;; Remember to include dependencies for [clj-time "0.6.0"] and [seesaw "1.4.4"] in your project file.
(ns employees.core)
(use 'seesaw.core)
(use 'clj-time.core)
(use 'clj-time.format)
(use 'clojure.test)
;; Knowledge Base
(def employee)
(def unit-coordinator {:ako {:value 'employee}
:bonus {:value 5000,00}})
(def accountant {:ako {:value 'employee}
:bonus {:value 3000.00}})
(def Henry {:is-a {:value 'system-analyst}
:working-at {:value 'unit-i}
:recruitment-date {:value "20100304"}
:gross-salary {:value 3000,00}})
(def Bob {:is-a {:value 'accountant}
:working-at {:value 'unit-i}
:recruitment-date {:value "20140214"}
:years-in-the-role {:value 6}
:gross-salary {:if-needed 'estimate-salary}})
;; Service functions
(def built-in-formatter (formatters :basic-date-time))
(def basic-formatter (formatter "yyyyMMdd"))
; dissoc-in was once part of clojure.contrib.core, and is now part of core.incubator
(defn dissoc-in
"Dissociates an entry from a nested associative structure returning a new
nested structure. keys is a sequence of keys. Any empty maps that result
will not be present in the new structure."
[m [k & ks :as keys]]
(if ks
(if-let [nextmap (get m k)]
(let [newmap (dissoc-in nextmap ks)]
(if (seq newmap)
(assoc m k newmap)
(dissoc m k)))
m)
(dissoc m k)))
;; Frame Language function
(defn fget
"Fetches information from a given frame, slot, and facet"
[frame slot facet]
(get-in frame [slot facet]))
(defn fput
"Places information in a given frame, slot, and facet"
[frame slot facet v]
(assoc-in frame [slot facet] v))
(defn fput-p
"Places information in a given frame, slot, and facet and activate the demons :range and :if-added"
[frame slot facet v]
(assoc-in frame [slot facet] v)
(if ((fget frame slot :range) frame slot)
nil
((fget frame slot :if-added) frame slot)))
(defn fremove
"Remove information in a given frame, slot, and facet"
[frame slot facet]
(dissoc-in frame [slot facet]))
(defn fcheck
"Check if the information stored in a given frame, slot, and facet is equal to value"
[frame slot facet value]
(= (fget frame slot facet) value))
(defn fget-v-d
"Fetches :value information from a given frame and slot or, in case there is no :value facet, fetches :default facet"
[frame slot]
(let [v (fget frame slot :value)]
(if v v (fget frame slot :default))))
(defn fget-v-d-p
"Fetches :value information from a given frame and slot and, in case there is no :value facet, fetches :default facet,
otherwise activate the :if-neede demon"
[frame slot]
(let [result (or (fget-v-d frame slot) (fget frame slot :if-needed))]
(if (function? result) (result frame slot) result)))
(defn fget-i [frame slot]
"Fetches :value information from the :isa frames of a given frame and slot"
(defn fget-i1[frames slot]
(if (nil? frames)
nil
(if-let [value (fget (eval (first frames)) slot :value)]
value
(recur (next frames) slot))))
(if-let [classes (fget frame :isa :value)]
(if (not(list? classes))
(fget (eval classes) slot :value)
(fget-i1 classes slot))
nil))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment