| Good Afternoon Ladies and Gentlemen,
I am trying to translate the following into arc. The macrolet conversion is where I am having difficulties. (defmacro! ichain-intercept (&rest body)
`(let ((,g!indir-env this))
(setq this
(lambda (&rest ,g!temp-args)
(block ,g!intercept
(macrolet ((intercept (v)
`(return-from
,',g!intercept
,v)))
(prog1
(apply ,g!indir-env
,g!temp-args)
,@body)))))))
;This is what I have for arc
;Indirection chain intercept
(mac ichain-intercept body
(w/uniq (indir-env temp-args intercept)
`(with (,indir-env this)
(assign this
(fn ,temp-args
(point ,intercept
(mac intercept (v)
`(,',intercept
,v)
(do1
(apply ,indir-env
,temp-args)
,@body))))))))
;indirection chain intercept test
(assign ici-test1
(alet (acc 0)
(ichain-intercept
(when (< acc 0)
(prn "Acc went negative")
(= acc 0)
(intercept acc)))
(fn (n)
(= acc (inc acc n)))))
;The test results should be
(ici-test1 -8)
Acc went negative
0
(ici-test1 3)
3
Help is much appreciated. Here is other examples I have had success with in chapter 6, which I hope is useful for others like me who are learning arc. ;Anaphoric let
(mac alet (args . body)
`(with ,args
(assign this ,(last body))
,@(butlast body)
(fn params
(apply this params))))
;Alet finite state machine
(mac alet-fsm states
`(do
(assign ,@states)
(mac state (s)
`(assign this ,s))))
;Testings alet finite state machine
(assign tes
(alet (acc 0)
(alet-fsm
going-up
(fn (n)
(if (is n 'invert)
(state going-down)
(= acc (inc acc n))))
going-down
(fn (n)
(if (is n 'invert)
(state going-up)
(= acc ( inc acc (* n -1))))))))
;Indirection Chain Before
(mac ichain-before body
(w/uniq (indir-env temp-args)
`(with (,indir-env this)
(assign this
(fn ,temp-args
,@body
(apply ,indir-env
,temp-args))))))
;Indirection chain test 1
(assign icb-test1
(alet (acc 0)
(ichain-before
(prn "Changing from " acc))
(fn (n)
(= acc (inc acc n)))))
;Test values (icb-test1 2) , (icb-test1 2)
;Indirection chain test 2
(assign icb-test2
(alet (acc 0)
(ichain-before
(prn "A"))
(ichain-before
(prn "B"))
(ichain-before
(prn "C"))
(fn (n)
(= acc (inc acc n)))))
; Test values (icb-test 2)
;indirection chain before test3
(assign icb-test3
(alet (acc 0)
(fn (n)
(ichain-before
(prn "Hello World" ))
(= acc (inc acc n)))))
;start test with (start-icbt3)
(def start-icbt3 ()
(for x 0 (< x 5) (++ x)
(do
(prn "Invocation "x)
(icb-test3 x)
(sleep 1))))
;Indirection chain after
(mac ichain-after body
(w/uniq (indir-env temp-args)
`(with (,indir-env this)
(assign this
(fn ,temp-args
(do1
(apply ,indir-env
,temp-args)
,@body))))))
;Indirection after test 1
(assign ica-test1
(alet (acc 0)
(ichain-before
(prn "Changing from " acc))
(ichain-after
(prn "Changing to " acc))
(fn (n)
(= acc (inc acc n)))))
;test values (ica-test1 7), (ica-test1 7)
;Indirection chain intercept-1
(mac ichain-intercept% body
(w/uniq (indir-env temp-args)
`(with (,indir-env this)
(assign this
(fn ,temp-args
(point intercept
(do1
(apply ,indir-env
,temp-args)
,@body)))))))
;Indirection chain Intercept% test1
(assign ici%-test1
(alet (acc 0)
(ichain-intercept%
(when (< acc 0)
(prn "Acc went negative")
(= acc 0)
(intercept acc)))
(fn (n)
(= acc (inc acc n)))))
;test values (ici%-test1 3) ,(ici%-test1 6) ,(ici%-test1 -20)
(mac alet-hotpatch% (args . body)
`(with ,args
(assign this ,(last body))
,@(butlast body)
(fn args
(if (is car.args 'hotpatch)
(assign this cadr.args)
(apply this args)))))
;alet hotpatch% test 1
(assign ahp%test1
(alet-hotpatch% (acc 0)
(fn (n)
(= acc (inc acc n)))))
;test values (ahp%test1 3) , (ahp%test1 3)
;(ahp%test1 'hotpatch (let acc 0 ( fn (n) (= acc (inc acc (*2 n))))))
;(ahp%test1 2) (ahp%test1 5)
;Destructured lambda
(mac dfn ds
(w/uniq (it)
`(with (it nil)
(fn it
(case (car it)
,@ds)))))
(mac alet-hotpatch (args . body)
`(with ,args
(assign this ,(last body))
,@(butlast body)
(dfn
hotpatch (assign this cadr.it)
(this car.it))))
;alet hotpatch test 1
(assign ahp
(alet-hotpatch (acc 0)
(fn (n)
(= acc (inc acc n)))))
;test values
;(ahp 3) , (ahp 3)
;(ahp 'hotpatch (let acc 100 ( fn (n) (= acc (inc acc (*2 n))))))
;(ahp 3) , (ahp 3)
|