Yaltik/hy
2
0
Fork 0
Code Pull Requests Releases Activity

Refactor (loop) in terms of fnr; change to use decorator.

Browse Source
This commit is contained in:
Paul Tagliamonte 2014-01-13 20:37:25 -05:00
parent 0afbbeb68c
commit 5a64f18726
1 changed files with 10 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
hy/contrib/loop.hy
View File

@ -1,6 +1,7 @@
;;; Hy tail-call optimization ;;; Hy tail-call optimization
;; ;;
;; Copyright (c) 2014 Clinton Dreisbach <clinton@dreisbach.us> ;; Copyright (c) 2014 Clinton Dreisbach <clinton@dreisbach.us>
;; Copyright (c) 2014 Paul R. Tagliamonte <tag@pault.ag>
;; ;;
;; Permission is hereby granted, free of charge, to any person obtaining a ;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"), ;; copy of this software and associated documentation files (the "Software"),
@ -60,19 +61,19 @@
(let [[new-body (recursive-replace 'recur g!recur-fn body)]] (let [[new-body (recursive-replace 'recur g!recur-fn body)]]
`(do `(do
(import [hy.contrib.loop [--trampoline--]]) (import [hy.contrib.loop [--trampoline--]])
(def ~g!recur-fn (with-decorator
(--trampoline-- (fn [~@signature] --trampoline--
~@new-body))) (def ~g!recur-fn (fn [~@signature] ~@new-body)))
~g!recur-fn))) ~g!recur-fn)))
(defmacro defnr [name lambda-list &rest body] (defmacro defnr [name lambda-list &rest body]
(if (not (= (type name) HySymbol)) (if (not (= (type name) HySymbol))
(macro-error name "defnr takes a name as first argument")) (macro-error name "defnr takes a name as first argument"))
`(setv ~name (fnr ~lambda-list ~@body))) `(setv ~name (fnr ~lambda-list ~@body)))
(defmacro/g! loop [bindings &rest body]
(defmacro loop [bindings &rest body]
;; Use inside functions like so: ;; Use inside functions like so:
;; (defun factorial [n] ;; (defun factorial [n]
;; (loop [[i n] ;; (loop [[i n]
@ -84,13 +85,7 @@
;; If recur is used in a non-tail-call position, None is returned, which ;; If recur is used in a non-tail-call position, None is returned, which
;; causes chaos. Fixing this to detect if recur is in a tail-call position ;; causes chaos. Fixing this to detect if recur is in a tail-call position
;; and erroring if not is a giant TODO. ;; and erroring if not is a giant TODO.
(with-gensyms [recur-fn] (let [[fnargs (map (fn [x] (first x)) bindings)]
(let [[fnargs (map (fn [x] (first x)) bindings)] [initargs (map second bindings)]]
[initargs (map second bindings)] `(do (defnr ~g!recur-fn [~@fnargs] ~@body)
[new-body (recursive-replace 'recur recur-fn body)]] (~g!recur-fn ~@initargs))))
`(do
(import [hy.contrib.loop [--trampoline--]])
(def ~recur-fn
(--trampoline-- (fn [~@fnargs]
~@new-body)))
(~recur-fn ~@initargs)))))