macros.scm 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114
  1. #!/usr/bin/guile \
  2. -e main -s
  3. !#
  4. ;; syntax-rules literals (pattern template)
  5. ;; there are an equal number of patterns and templates
  6. ;; the first matching pattern is used
  7. ;;patters can be made of:
  8. ;;lists, improper lists, vectors, identifiers, and datums.
  9. (define-syntax when
  10. (syntax-rules ()
  11. ((when condition exp ...)
  12. (if condition
  13. (begin exp ...)))))
  14. ;; this macro will match (let1 (foo 'bar))
  15. (define-syntax let1
  16. (syntax-rules ()
  17. ((_ (var val) exp ...)
  18. (let ((var val)) exp ...))))
  19. ;; this will not match (let1 (foo 'bar))
  20. (define-syntax let1
  21. (syntax-rules ()
  22. ((_ (var val) exp exp* ...)
  23. (let ((var val)) exp* ...))))
  24. ;; making a print macro to print out a newline at the end of the
  25. ;; display statement
  26. ;; works
  27. (define-syntax print
  28. (syntax-rules ()
  29. ((print exp)
  30. (display (string-append exp "\n")))))
  31. ;; works
  32. (define-syntax print
  33. (syntax-rules ()
  34. ((_ exp)
  35. (display (string-append exp "\n")))))
  36. ;; works
  37. (define-syntax print
  38. (syntax-rules ()
  39. ((_ exp)
  40. (display (string-append exp "\n")))
  41. ((print exp exp2)
  42. (display (string-append exp exp2 "\n")))))
  43. ;; works
  44. (define-syntax print
  45. (syntax-rules ()
  46. ((_ exp)
  47. (display (string-append exp "\n")))
  48. ((print exp exp2)
  49. (display (string-append exp exp2 "\n")))
  50. ((print exp exp2 ...)
  51. (display (string-append exp exp2 ... "\n")))))
  52. (define-syntax print
  53. (syntax-rules ()
  54. ((_ exp)
  55. (display (string-append exp "\n")))
  56. ((print exp ...)
  57. (display (string-append exp ... "\n")))))
  58. ;; a macro that calls two different functions, depending on the number
  59. ;; of arguments.
  60. (define-syntax distance
  61. (syntax-rules ()
  62. ((distance x y)
  63. (distance-x-y x y))
  64. ((distance x y z)
  65. (distance-x-y-z x y z))))
  66. ;; doesn't work
  67. (define-syntax playing
  68. (syntax-rules (cool bear frozen)
  69. ((playing (cool exp (bear exp2 (frozen exp3))))
  70. (+ 5 2))))
  71. ;;works
  72. (define-syntax playing
  73. (syntax-rules (cool )
  74. ((playing (cool))
  75. (+ 5 2))))
  76. ;; works
  77. (define-syntax playing
  78. (syntax-rules (cool bear)
  79. ((playing (cool (bear (anything))))
  80. (+ 5 2))))
  81. ;; works
  82. (define-syntax playing
  83. (syntax-rules (cool bear)
  84. ((playing exp (cool (bear)))
  85. (+ 5 2 exp))))
  86. (define-syntax my-define-record-type
  87. (syntax-rules ()
  88. ((my-define-record-type type
  89. constructor
  90. constructor?
  91. (fieldname var1) ...)
  92. (define-record-type type
  93. (constructor fieldname ...)
  94. constructor?
  95. (fieldname var1) ... ))))