Skip to content
Browse files

Removing the Defn record type from CTCO.

Previously the compiler represented (almost) each supported language
form as a separate record type. Steps are being taken to strip back
the number of internal record types to use few more than what are
considered the "core forms" of the Clojure language. In order to
support a wide array of expressions, it falls to the parser to
reexpress those expressions in terms of semantically equivalent core
forms.

The removal of the Defn record is the most major step in this
direction. Rather than having an explicit internal representation, the
parser now parses defn expressions in terms of def and fn.
  • Loading branch information...
1 parent 7abd193 commit fd32807b46af0292a0b25f274fa0a30fcaa583e5 @cjfrisz committed
Showing with 53 additions and 108 deletions.
  1. +0 −63 src/ctco/expr/defn.clj
  2. +14 −9 src/ctco/mini_passes.clj
  3. +22 −24 src/ctco/parse.clj
  4. +11 −6 test/ctco/test/cps.clj
  5. +6 −6 test/ctco/test/unparse.clj
View
63 src/ctco/expr/defn.clj
@@ -1,63 +0,0 @@
-;;----------------------------------------------------------------------
-;; File defn.clj
-;; Written by Chris Frisz
-;;
-;; Created 4 Apr 2012
-;; Last modified 30 Aug 2012
-;;
-;; Defines the Defn record type for 'defn' expressions in the TCO
-;; compiler. It supports multiple arity definitions and represents
-;; them as a vector of FnBody records.
-;;
-;; Defn implements the following protocols:
-;;
-;; PAbstractK:
-;; Maps abstract-k over the enclosed function
-;; definitions.
-;;
-;; PUnparse:
-;; Unparses (recursively) the expression as syntax i the
-;; form `(defn ~name ~@body*) where body* is the list of
-;; vectors of unparsed function definitions only including
-;; the formal parameters lists and bodies.
-;;
-;; PCpsTriv:
-;; Maps cps-triv over the vector of function definitions.
-;;
-;; PThunkify:
-;; Maps thunkify over the vector of function definitions.
-;;
-;; PWalkable:
-;; Maps the given function over the vector of function
-;; definitions, returning a new Defn record.
-;;----------------------------------------------------------------------
-
-(ns ctco.expr.defn
- (:require [ctco.expr
- fn thunk]
- [ctco.protocol :as proto])
- (:import [ctco.expr.fn
- FnBody]
- [ctco.expr.thunk
- Thunk]))
-
-(defrecord Defn [name func*]
- proto/PAbstractK
- (abstract-k [this app-k]
- (let [f #(proto/abstract-k % app-k)]
- (proto/walk-expr this f nil)))
-
- proto/PUnparse
- (unparse [this]
- `(defn ~(proto/unparse (:name this))
- ~@(map proto/unparse (:func* this))))
-
- proto/PCpsTriv
- (cps-triv [this] (proto/walk-expr this proto/cps-triv nil))
-
- proto/PThunkify
- (thunkify [this] (proto/walk-expr this proto/thunkify nil))
-
- proto/PWalkable
- (walk-expr [this f _]
- (Defn. (:name this) (vec (map f (:func* this))))))
View
23 src/ctco/mini_passes.clj
@@ -3,7 +3,7 @@
;; Written by Chris Frisz
;;
;; Created 14 Apr 2012
-;; Last modified 29 Aug 2012
+;; Last modified 31 Aug 2012
;;
;; Defines the small, one-time code transformations for the TCO
;; compiler. These include the following:
@@ -16,9 +16,6 @@
(:use [clojure.core.match
:only (match)]))
-;; NB: This only overloads one of the variadic forms for a "defn" expression.
-;; NB: Need to iterate over all forms to properly transform the whole
-;; NB: definition.
(defn overload
"Takes an expression in the TCO compiler (in record representation) and, if it
represents a function type (i.e. 'defn'), overloads the expression.
@@ -43,11 +40,19 @@
;; NB: getting rid of overloading for defn expressions entirely. Second, why
;; NB: would you say things like that about me?
(match [expr]
- [(['clojure.core/defn name ([fml* & bexpr*] :seq)] :seq)]
- (let [fml-bl* (vec (butlast fml*))]
- `(defn ~name
- (~fml-bl* (~tramp (~name ~@fml-bl* nil)))
- (~fml* ~@bexpr*)))
+ [(['def sym (['clojure.core/fn & func*] :seq)] :seq)]
+ `(def ~sym
+ (fn
+ ~@(reduce
+ (fn [v* v]
+ (let [fml* (first v)
+ bexpr* (next v)
+ fml-bl* (vec (butlast fml*))]
+ (concat v*
+ `((~fml-bl* (~tramp (~sym ~@fml-bl* nil)))
+ (~fml* ~@bexpr*)))))
+ '()
+ func*)))
:else expr))
(defn make-apply-k
View
46 src/ctco/parse.clj
@@ -12,7 +12,7 @@
(:use [clojure.core.match
:only (match)])
(:require [ctco.expr
- app simple def defn fn if let simple-op]
+ app simple def fn if let simple-op]
[ctco.protocol :as proto]
[ctco.util :as util])
(:import [ctco.expr.app
@@ -21,8 +21,6 @@
Simple]
[ctco.expr.def
DefSrs DefTriv]
- [ctco.expr.defn
- Defn]
[ctco.expr.fn
Fn FnBody]
[ctco.expr.if
@@ -34,6 +32,11 @@
(declare parse)
+(defn- conj-parse
+ "Helper function used in 'reduce' calls throughout parsing."
+ [base val]
+ (conj base (parse val)))
+
(defn- parse-simple
"Takes a sequence representing a Clojure expression (generally passed from a
macro) and returns the parsed representation of the expression if it is a
@@ -52,6 +55,7 @@
(Simple. expr)))
(defn- parse-def
+ "Helper function for parsing 'def' expressions."
[sym init]
(let [SYM (parse sym)
INIT (parse init)]
@@ -62,19 +66,20 @@
(defn- parse-fn-body
[fml* cmap bexpr*]
- (FnBody. (vec (map parse fml*)) cmap (vec (map parse bexpr*))))
+ (FnBody. (reduce conj-parse [] fml*) cmap (reduce conj-parse [] bexpr*)))
(defn- parse-fn
"Helper function for parse that handles 'fn' expressions."
[body*]
- (Fn. nil (vec (map
- (fn [b]
- (condp = (count b)
- 2 (parse-fn-body (first b) nil (next b))
- 3 (parse-fn-body (first b) (fnext b) (nnext b))
- :else (throw (Exception.
- (str "invalid function body" b)))))
- body*))))
+ (Fn. nil (reduce
+ (fn [v* b]
+ (conj v* (condp = (count b)
+ 2 (parse-fn-body (first b) nil (next b))
+ 3 (parse-fn-body (first b) (fnext b) (nnext b))
+ :else (throw (Exception.
+ (str "invalid function body" b))))))
+ []
+ body*)))
(defn- parse-if
"Helper function for parse that handles 'if' expressions."
@@ -89,7 +94,7 @@
(defn- parse-let
"Helper function for parse that handles 'let' expressions."
[bind* body]
- (let [BIND* (vec (map parse bind*))
+ (let [BIND* (reduce conj-parse [] bind*)
BODY (parse body)]
(assert (even? (count BIND*)))
(if (or (some util/serious? (take-nth 2 (next BIND*)))
@@ -112,16 +117,9 @@
:else false))
(defn- parse-defn
- "Helper function for parse that handles 'defn' expression."
+ "Helper function for parse that handles 'defn' expressions."
[name func*]
- (letfn [(parse-func* [func* out*]
- (if (nil? (seq func*))
- out*
- (recur (next func*)
- (conj out* (parse-fn-body (ffirst func*)
- nil
- (nfirst func*))))))]
- (Defn. (Simple. name) (parse-func* func* []))))
+ (DefTriv. (parse name) (parse-fn func*)))
(defn- parse-cond
"Helper function for parse that handles 'cond' expressions. Currently
@@ -157,7 +155,7 @@
"Helper function for parse that handles simple op expressions (e.g. +, -,
zero?, nil?, etc."
[op opnd*]
- (let [OPND* (vec (map parse opnd*))]
+ (let [OPND* (reduce conj-parse [] opnd*)]
(if (some util/serious? OPND*)
(SimpleOpSrs. op OPND*)
(SimpleOpTriv. op OPND*))))
@@ -165,7 +163,7 @@
(defn- parse-function-application
"Helper function for parse that handles function application."
[rator rand*]
- (App. (parse rator) (vec (map parse rand*))))
+ (App. (parse rator) (reduce conj-parse [] rand*)))
(defn- parse-application
"Takes a sequence representing a Clojure expression (generally passed from a
View
17 test/ctco/test/cps.clj
@@ -3,7 +3,7 @@
;; Written by Chris Frisz
;;
;; Created 10 Apr 2012
-;; Last modified 29 Aug 2012
+;; Last modified 31 Aug 2012
;;
;; Testing for the CPSer in the record+protocol'd version of the TCO
;; compiler.
@@ -13,7 +13,7 @@
(:use [clojure.test]
[clojure.pprint])
(:require [ctco.expr
- app simple cont defn fn if simple-op]
+ app simple cont def fn if simple-op]
[ctco.protocol :as proto]
[ctco.util :as util])
(:import [ctco.expr.app
@@ -22,8 +22,8 @@
Simple]
[ctco.expr.cont
Cont AppCont]
- [ctco.expr.defn
- Defn]
+ [ctco.expr.def
+ DefCps DefSrs DefTriv]
[ctco.expr.fn
Fn FnBody]
[ctco.expr.if
@@ -75,12 +75,17 @@
(is (= (:alt test-if-triv) (:alt test-if-cps)))
(is (instance? IfCps test-if-cps)))))
-(let [test-defn (Defn. 'id [(FnBody. [(Simple. 'x)] nil [(Simple. 'x)])])]
+;; Since changing the internal representation of defn, this is kind of a pun
+;; now.
+(let [test-defn (DefTriv. (Simple. 'id) (Fn. nil [(FnBody. [(Simple. 'x)] nil
+ [(Simple. 'x)])]))]
(deftest defn-triv
(is (extends? proto/PCpsTriv (type test-defn)))
(is (not (extends? proto/PCpsSrs (type test-defn))))
(let [test-defn-cps (proto/cps-triv test-defn)]
- (is (instance? AppCont (first (:bexpr* (first (:func* test-defn-cps)))))))))
+ (is (instance?
+ AppCont
+ (first (:bexpr* (first (:body* (:init test-defn-cps))))))))))
(let [test-op (SimpleOpTriv. '+ [(Simple. 3) (Simple. 4) (Simple. 5)])]
(deftest simple-op-triv
View
12 test/ctco/test/unparse.clj
@@ -3,7 +3,7 @@
;; Written by Chris Frisz
;;
;; Created 15 Apr 2012
-;; Last modified 30 Aug 2012
+;; Last modified 31 Aug 2012
;;
;; Testing for the correctness of unparse
;;----------------------------------------------------------------------
@@ -13,7 +13,7 @@
[clojure.pprint]
[ctco.parse :only (parse)])
(:require [ctco.expr
- app simple cont defn fn if simple-op]
+ app simple cont def fn if simple-op]
[ctco.protocol :as proto])
(:import [ctco.expr.app
App]
@@ -21,8 +21,8 @@
Simple]
[ctco.expr.cont
Cont AppCont AppContAbs]
- [ctco.expr.defn
- Defn]
+ [ctco.expr.def
+ DefCps DefSrs DefTriv]
[ctco.expr.fn
FnBody]
[ctco.expr.if
@@ -51,9 +51,9 @@
(Simple. (quote 'thonk)))))))
(deftest defn-test
- (is (= '(clojure.core/defn id ([x] x))
+ (is (= '(def id (clojure.core/fn ([x] x)))
(proto/unparse (parse '(defn id [x] x)))))
- (is (= '(clojure.core/defn id ([x] x) ([x y] x))
+ (is (= '(def id (clojure.core/fn ([x] x) ([x y] x)))
(proto/unparse (parse '(defn id ([x] x) ([x y] x)))))))

0 comments on commit fd32807

Please sign in to comment.
Something went wrong with that request. Please try again.