ctrl.scm 1.1 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546
  1. (module (arguile base ctrl))
  2. (use ((srfi srfi-1) #:select (append-map lset-difference))
  3. (arguile guile)
  4. (arguile base mac)
  5. (arguile base fn)
  6. (ice-9 control))
  7. (re-export abort (call/cc . c/cc) (call/ec . c/ec))
  8. (export-syntax do = aif it & $>)
  9. (mac do ((_ e1 ...) #'(begin e1 ...)))
  10. ;;; TODO: check if var is a free variable, and if so, define it
  11. (mac =
  12. ((_ var val) #'(set! var val))
  13. ((_ var val rest ...) #'(do (set! var val) (= rest ...))))
  14. (mac aif x
  15. ((_ test then else)
  16. (let-syn it (datum->syntax x 'it)
  17. #'(let it test (if it then else)))))
  18. (mac & ((_ e1 ...) #'(and e1 ...)))
  19. (defp c/prmt call-with-prompt)
  20. (defp c/vals call-with-values)
  21. (defp tag default-prompt-tag)
  22. (defp vals values)
  23. (defp =? _=)
  24. (defp 0? zero?)
  25. (defp 1? (n) (=? 1 n))
  26. (defp ~ not)
  27. (defp nil? null?)
  28. (defp flatn append-map)
  29. (defp &map and-map)
  30. (defp set\ lset-difference)
  31. (mac $>
  32. ((_ exp) #'(c/prmt (tag) (fn () exp) hdlr))
  33. ((_ exp hdlr) #'(c/prmt (tag) (fn () exp) hdlr))
  34. ((_ tag expr hdlr) #'(c/prmt (tag) (fn () exp) hdlr)))
  35. (def hdlr (cont f)
  36. ($> (tag) (f cont) hdlr))