some naive type checking interpreter mix

gistfile1.clj

(ns interpreter.protocols)

(class '())

(defprotocol IExpr
  )

(defprotocol IType
  )

(defprotocol IInterpret
  (-expr [expr ctx])
  (-type [expr ctx])
  (-interpret [expr ctx]))


(def Sexpr nil)
(defprotocol Sexpr
  (-dispatch->sexpr [expr ctx]))

;; Protocol for managing set explosion
(defprotocol ISet
  (-set [x])
  (-unset [x]))

(extend-protocol ISet
  Object
  (-set [x] #{x})
  (-unset [x] x)

  clojure.lang.APersistentSet
  (-set [x] x)
  (-unset [x]
    (if (= (count x) 1)
      (first x)
      x)))

interpreter.clj

(ns interpreter.core
  (:require [interpreter.protocols :refer :all]
            [clojure.set]))

(defn get-type [expr]
  (-type expr {}))

(extend-protocol Sexpr
  clojure.lang.Symbol
  (-dispatch->sexpr [expr ctx]
    expr)

  clojure.lang.APersistentVector
  (-dispatch->sexpr [expr ctx]
    :vector))

(defn dispatch->sexpr [[dispatch :as sexpr] ctx]
  #_(-dispatch->sexpr dispatch ctx)
  ;; REVIEW dispatch could be protocol?
  (cond (symbol? dispatch) dispatch
        (keyword? dispatch) :keyword
        #_(keyword? dispatch)

        (vector? dispatch) :vector
    ;; Do something with
        :else
        :unknown))

(defmulti ->sexpr #'dispatch->sexpr)

(defmethod ->sexpr :default [[dispatch :as sexpr] ctx]
  (throw (ex-info "Didn't recognize sexpr" {:dispatch (dispatch->sexpr sexpr ctx)
                                            :sexpr sexpr})))
(class (int 1))
(extend-protocol IInterpret
  nil
  (-type [_ _] 'Nil)
  (-interpret [_ _] nil)

  Boolean
  (-type [x _] (if x 'True 'False))
  (-interpret [expr _] expr)

  Integer
  (-type [_ _] #{'Integer 'Number})
  (-interpret [expr _] expr)
  Long
  (-type [_ _] #{'Integer 'Number})
  (-interpret [expr _] expr)

  Number
  (-type [_ _] 'Number)
  (-interpret [expr _] expr)

  Character
  (-type [_ _] 'Character)
  (-interpret [expr _] expr)

  String
  (-type [_ _] 'String)
  (-interpret [expr _] expr)

  clojure.lang.Keyword
  (-type [_ _] 'Keyword)
  (-interpret [expr _] expr)

  clojure.lang.Symbol
  (-type [_ _] 'Symbol)
  (-interpret [expr _] expr)

  clojure.lang.PersistentList$EmptyList
  (-type [expr ctx] '[List])
  (-interpret [expr ctx] expr)

  clojure.lang.APersistentMap
  (-type [m ctx]
    ['Map
     (into {} (map (fn [[k v]]
                     [(-type k ctx) (-type v ctx)])
                   m))])

  (-interpret [m ctx]
    (into {}
          (map (fn [[k v]]
                 [(-interpret k ctx) (-interpret v ctx)])
               m)))

  clojure.lang.APersistentVector
  (-type [coll ctx]
    ['Vector
     (mapv (fn [v] (-type v ctx)) coll)])

  (-interpret [coll ctx]
    (mapv (fn [v] (-interpret v ctx)) coll))

  clojure.lang.PersistentList
  (-type [expr ctx]
    (if (:quoted? ctx)
      ['List (map (fn [el] (-type expr ctx)) expr)]
      (-type (->sexpr expr ctx) ctx)))

  (-interpret [expr ctx]
    (if (:quoted? ctx)
      expr
      (-interpret (->sexpr expr ctx) ctx))))

(def falsey #{'Nil 'False})

(defn always-true? [t]
  ;; REVIEW Protocol function here maybe, if it is not a set we don't have to bother
  (empty? (clojure.set/intersection (-set t) falsey)))

(defn always-false? [t]
  ;; REVIEW Protocol function here maybe, if it is not a set we don't have to bother
  (empty? (clojure.set/difference (-set t) falsey)))

(defrecord IfExpr [cond a b expr]
  IInterpret
  (-type [_ ctx]
    (let [t (-type cond ctx)]
      (cond
        (always-true? t)  (-type a ctx)
        (always-false? t) (-type b ctx)

        #_(clojure.set/union (-set (-type a ctx))
                                   (-set (-type b ctx)))
        :else
        (-unset (clojure.set/union (-set (-type a ctx))
                                   (-set (-type b ctx)))))))

  (-interpret [_ ctx]
    (if (-interpret cond ctx)
      (-interpret cond a)
      (-interpret cond b))))

(defmethod ->sexpr 'if [[_ cond a b :as expr] ctx]
  (-interpret (->IfExpr cond a b expr) ctx))

(some identity [false 2 3 false 4])

(defrecord AndExpr [exprs expr]
  IInterpret
  (-type [_ ctx]
    (-unset (reduce (fn [acc expr]
                      (let [t (-type expr ctx)]
                        (if (always-false? t)
                          (reduced t)
                          (conj (-unset t)))))
                    #{}
                    exprs)))

  (-interpret [_ ctx]
    (reduce (fn [acc expr]
              (let [ret (-interpret expr ctx)]
                (if ret
                  ret
                  (reduced ret))))
            true
            exprs)))

(defmethod ->sexpr 'and [[_ & exprs :as expr] ctx]
  (->AndExpr exprs expr))

(defrecord OrExpr [exprs expr]
  IInterpret
  (-type [_ ctx]
    (-unset (or (not-empty
                 (reduce (fn [acc expr]
                           (let [t (-type expr ctx)]
                             (cond
                               (always-true? t) (reduced t)
                               (always-false? t) acc
                               :else
                               (clojure.set/union acc (-set t)))))
                         #{} exprs))
                (-type (last exprs) ctx))))

  (-interpret [_ ctx]
    (reduce (fn [acc expr]
              (let [ret (-interpret expr ctx)]
                (if ret
                  (reduced ret)
                  ret)))
            nil
            exprs)))

(defmethod ->sexpr 'or [[_ & exprs :as expr] ctx]
  (->OrExpr exprs expr))

(defrecord QuoteExpr [inner expr]
  IInterpret
  (-type [_ ctx]
    ;; TODO Turn of inner evaluation?
    (-type inner (assoc ctx :quoted? true)))

  (-interpret [expr ctx]
    (-interpret inner (assoc ctx :quoted? true))))

(defmethod ->sexpr 'quote [[_ inner :as expr] ctx]
  (->QuoteExpr inner expr))


(defrecord VectorExpr [v idx expr]
  IInterpret
  (-type [_ ctx]
    (if (not= '#{Integer})
      (throw (ex-info "Vector as function expects an integer" {:expr expr}))

      ;; TODO Turn of inner evaluation?
      (-type (nth v idx) ctx)))

  (-interpret [expr ctx]
    (nth v idx)))

(defmethod ->sexpr :vector [[v idx :as expr] ctx]
  (->VectorExpr v idx expr))

(-interpret '(if 1 2) {})

(-type '() {})
(-type '(if nil 2 nil) {})
(-type '(and  nil; false
             ) {})
(-type '(or false 2 nil false) {})
(-type '(or false nil ) {})

(-type '(or) {})
(-type (or) {})
(or)

(-type '(and false nil) {})
(and )


(prn (parents clojure.lang.APersistentVector))


(require '[clojure.test :refer [deftest is are]])

(identity ;deftest simple-examples
  (are [x y] (= (-type x {}) y)
    ;; Numbers
    1 '#{Integer Number}
    1.1 'Number
    nil 'Nil
    ;; Boolean
    true 'True
    false 'False
    ;; Char
    \a 'Character

    ;; String
    "a" 'String

    ;; keywords
    :a 'Keyword

    ;; Symbols
    '(quote a) 'Symbol

    ;; Maps
    {} '[Map {}]
    {:a 1} '[Map {Keyword #{Integer Number}}]
;    {{:a 1} 2} '[Map {[Map {Keyword #{Integer Number}} #{Integer Number}]}]

    ;; TODO sexpr in maps
    ;; '{(+ 1 2) 2}

    ;; Vectors
    [] '[Vector []]
    [:a] '[Vector [Keyword]]

    ;; Lists
    () '[List ]
    '() '[List ]
    ;'(quote ()) 'EmptyList
    ;'(quote (1 2 3 4)) '[List ]
    ;; '(1)

    ;; Vector function invocation

    '([1] 0) '#{Number Integer}
    ;; Spec error cases
    ;; '([] 0)


    ;;; -- Macros --

    ;; If
    (if 1 2) '#{Number Integer}
    (if 1 2 3) '#{Number Integer}
    (if nil 2 3) '#{Number Integer}
    (if nil 2 3.0) 'Number

    ;; And
    (and) 'True
    (and false) 'False
    (and nil) 'Nil
    (and 1 2) '#{Number Integer}
    (and 1 2 nil) 'Nil
    (and 1 2 false) 'False
    ;(and 1 2 true) '#{Number Integer}

    ;; Or
    (or) 'Nil
    (or false) 'False
    (or nil) 'Nil
    (or 1 2) '#{Number Integer}
    (or 1 2 nil) '#{Number Integer}
    (or 1 2 false) '#{Number Integer}

    #_ (comment
         '(or) 'True
    '(or false) 'False
    '(or nil) 'Nil
    '(or 1 2) '#{Number Integer}
    '(or 1 2 nil) 'Nil
    '(or 1 2 false) 'False
         )))


(identity ;deftest simple-examples
  (are [x] (= (-interpret x {}) (eval x))
    ;; Numbers
    1 2 3 4
    1.1 1.2 4.5
    ;; Boolean
    true false
    ;; Char
    \a \b

    ;; String
    "a" "bn"

    ;; keywords
    :a :b :namespace/adfasdf

    ;; Symbols
    '(quote a) '(quote bb) '(quote ccc)

    ;; Maps
    {} {:a 1} {{:a 1} 2}

    ;; TODO sexpr in maps
    ;; '{(+ 1 2) 2}

    ;; Vectors
    [] [:a]

    ;; Lists
    () '()

    ;; TODO lists
    ;; '(1 2 3 4 5)
    ;; '(1)

    ;; Quoted
    '(quote ()) '(quote (1 2 3 4))

    ;; Vector function invocation

    ([1] 0)
    ;; Spec error cases
    ;; '([] 0)


    ;;; -- Macros --

    ;; If
    (if 1 2) (if 1 2 3) (if nil 2 3)

    ;; And
    (and) (and false) (and nil) (and 1 2) (and 1 2 nil) (and 1 2 false)

    ;; Or
    (or) (or false) (or nil) (or 1 2) (or 1 2 nil) (or 1 2 false)

    #_2
    ;'(or false)
    #_(and)



    )

  )


(or false)


(-interpret '(or false) {})

; (-interpret '(if (= 1) false) {})
(defn -main [& arg]
  :good)