Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
(ns Archimedes.bar
(:refer-clojure :exclude [==])
(:require [clojure.core.logic :refer :all]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; databaseo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def types
{:long {:primitive true
:natural true
:fixed-width true}
:double {:primitive true
:floating-point true
:fixed-width true}
:Long {:boxed :long
:object true
:natural true
:fixed-width true}
:Double {:boxed :double
:object true
:floating-point true
:fixed-width true}
:float {:primitive true
:floating-point true
:fixed-width true}
:Float {:boxed :float
:object true
:floating-point true
:fixed-width true}
:int {:primitive true
:natural true
:fixed-width true}
:Integer {:boxed :int
:object true
:natural true
:fixed-width true}
:Ratio {:boxed false}
:Number {:boxed false}
:Object {:boxed false}
:BigDecimal {:boxed false
:floating-point true}
:BigInteger {:boxed false
:natural true}
:BigInt {:boxed false
:natural true}})
(def operations
{:add {:arity 2}
:subtract {:arity 2}
:zero? {:arity 1
:return :boolean}
:neg {:arity 1}
:divide {:arity 2}
:multiply {:arity 2}
})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; predicates
(defn binaryo [op]
(fn [s]
(let [op (get (.s s) op)
{:keys [arity]} (get operations op)]
(when (= 2 arity)
s))))
(defn unaryo [op]
(fn [s]
(let [op (get (.s s) op)
{:keys [arity]} (get operations op)]
(when (= 1 arity)
s))))
(defn returno [op]
(fn [s]
(let [op (get (.s s) op)
{:keys [return]} (get operations op)]
(when return
s))))
(defn not-boxedo [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [boxed]} (get types type)]
(when-not boxed
s))))
(defn boxedo [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [boxed]} (get types type)]
(when boxed
s))))
(defn floating-pointo [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [floating-point]} (get types type)]
(when floating-point
s))))
(defn not-floating-pointo [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [floating-point]} (get types type)]
(when-not floating-point
s))))
(defn naturalo [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [natural]} (get types type)]
(when natural
s))))
(defn not-naturalo [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [natural]} (get types type)]
(when-not natural
s))))
(defn fixed-widtho [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [fixed-width]} (get types type)]
(when fixed-width
s))))
(defn not-fixed-widtho [type]
(fn [s]
(let [type (get (.s s) type)
{:keys [fixed-width]} (get types type)]
(when-not fixed-width
s))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn sameo [arg1 arg2 return]
(conde
[(== arg1 arg2) (== arg1 :int) (== return :long)]
[(== arg1 arg2) (== arg1 :float) (== return :double)]
[(== arg1 arg2) (boxedo arg1) (not-boxedo return)]
[(== arg1 arg2) (not-boxedo arg1) (== arg1 return)]
[(!= arg1 arg2)]))
(defn floating-point-contaminato [arg1 arg2 return]
(conde
[(floating-pointo arg1) (floating-pointo arg2) (floating-pointo return)]
[(floating-pointo arg1) (not-floating-pointo arg2) (floating-pointo return)]
[(not-floating-pointo arg1) (floating-pointo arg2) (floating-pointo return)]
[(not-floating-pointo arg1) (not-floating-pointo arg2) (not-floating-pointo return)]))
(defn ratio-contaminato [arg1 arg2 return]
(conde
[(== arg1 :Ratio) (== arg2 :Ratio) (== return :Ratio)]
[(floating-pointo arg1) (== arg2 :Ratio) (floating-pointo return)]
[(== arg1 :Ratio) (floating-pointo arg2) (floating-pointo return)]
[(not-floating-pointo arg1) (== arg2 :Ratio) (== return :Ratio)]
[(== arg1 :Ratio) (not-floating-pointo arg2) (== return :Ratio)]
[(!= arg1 :Ratio) (!= arg2 :Ratio)]))
(defn object-contaminato [arg1 arg2 return]
(conde
[(== arg1 :Object) (== arg2 :Object) (== return :Number)]
[(!= arg1 :Object) (== arg2 :Object) (== return :Number)]
[(== arg1 :Object) (!= arg2 :Object) (== return :Number)]
[(!= arg1 :Object) (!= arg2 :Object)]))
(defn number-contaminato [arg1 arg2 return]
(conde
[(== arg1 :Number) (== arg2 :Number) (== return :Number)]
[(!= arg1 :Number) (== arg2 :Number) (== return :Number)]
[(== arg1 :Number) (!= arg2 :Number) (== return :Number)]
[(!= arg1 :Number) (!= arg2 :Number)]))
(defn bigdecimal-contaminato [arg1 arg2 return]
(conde
[(== arg1 :BigDecimal) (== arg2 :BigDecimal) (== return :BigDecimal)]
[(!= arg1 :BigDecimal) (== arg2 :BigDecimal) (== return :BigDecimal)]
[(== arg1 :BigDecimal) (!= arg2 :BigDecimal) (== return :BigDecimal)]
[(!= arg1 :BigDecimal) (!= arg2 :BigDecimal)]))
(defn special-diviso [op arg1 arg2 return]
(conde
[(== op :divide) (floating-pointo arg1) (floating-pointo arg2) (floating-pointo return)]
[(== op :divide) (floating-pointo arg1) (not-floating-pointo arg2) (floating-pointo return)]
[(== op :divide) (not-floating-pointo arg1) (floating-pointo arg2) (floating-pointo return)]
[(== op :divide) (not-floating-pointo arg1) (not-floating-pointo arg2) (== return :Ratio)]
[(!= op :divide)]))
(defn constrain-returno [return]
(fresh
[]
(!= return :float)
(!= return :int)
(!= return :Object)
(!= return :BigInteger)
(not-boxedo return)))
(defn setupo [q op arg1 arg2 return]
(fresh
[]
(== q [op arg1 arg2 return])
(membero op (keys operations))
(membero arg1 (keys types))
(membero arg2 (keys types))
(membero return (keys types))))
(defn fixed-width-cantaminato [op arg1 arg2 return]
(conde
[(!= :divide op) (fixed-widtho arg1) (fixed-widtho arg2) (fixed-widtho return)]
[(!= :divide op) (not-fixed-widtho arg1) (fixed-widtho arg2) (not-fixed-widtho return)]
[(!= :divide op) (fixed-widtho arg1) (not-fixed-widtho arg2) (not-fixed-widtho return)]
[(!= :divide op) (not-fixed-widtho arg1) (not-fixed-widtho arg2) (not-fixed-widtho return)]
[(== :divide op) (fixed-widtho arg1) (fixed-widtho arg2)
(conde
[(floating-pointo arg1) (floating-pointo arg2) (fixed-widtho return)]
[(floating-pointo arg1) (not-floating-pointo arg2) (fixed-widtho return)])]))
(defn f []
(run*
[q]
(fresh
[op arg1 arg2 return]
(setupo q op arg1 arg2 return)
(binaryo op)
(constrain-returno return)
(sameo arg1 arg2 return)
(floating-point-contaminato arg1 arg2 return)
(ratio-contaminato arg1 arg2 return)
(object-contaminato arg1 arg2 return)
(number-contaminato arg1 arg2 return)
(bigdecimal-contaminato arg1 arg2 return)
(special-diviso op arg1 arg2 return)
(fixed-width-cantaminato op arg1 arg2 return)
(conde
[(!= :divide op) (naturalo arg1) (naturalo arg2) (naturalo return)]
[(!= :divide op) (not-naturalo arg1) (naturalo arg2) (not-naturalo return)]
[(!= :divide op) (naturalo arg1) (not-naturalo arg2) (not-naturalo return)]
[(== :divide op)])
)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.