no title   macro


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/runtime/init.xtm

Implementation

(macro
 quasiquote
 (lambda (l)
   (define (mcons f l r)
     (if (and (pair? r)
              (eq? (car r) 'quote)
              (eq? (car (cdr r)) (cdr f))
              (pair? l)
              (eq? (car l) 'quote)
              (eq? (car (cdr l)) (car f)))
         (if (or (procedure? f) (number? f) (string? f))
             f
             (list 'quote f))
         (if (eqv? l vector)
             (apply l (eval r))
             (list 'cons l r)
             )))
   (define (mappend f l r)
     (if (or (null? (cdr f))
             (and (pair? r)
                  (eq? (car r) 'quote)
                  (eq? (car (cdr r)) '())))
         l
         (list 'append l r)))
   (define (foo level form)
     (cond ((not (pair? form))
            (if (or (procedure? form) (number? form) (string? form))
                form
                (list 'quote form))
            )
           ((eq? 'quasiquote (car form))
            (mcons form ''quasiquote (foo (+ level 1) (cdr form))))
           (#t (if (zero? level)
                   (cond ((eq? (car form) 'unquote) (car (cdr form)))
                         ((eq? (car form) 'unquote-splicing)
                          (error "Unquote-splicing wasn't in a list:"
                                 form))
                         ((and (pair? (car form))
                               (eq? (car (car form)) 'unquote-splicing))
                          (mappend form (car (cdr (car form)))
                                   (foo level (cdr form))))
                         (#t (mcons form (foo level (car form))
                                    (foo level (cdr form)))))
                   (cond ((eq? (car form) 'unquote)
                          (mcons form ''unquote (foo (- level 1)
                                                     (cdr form))))
                         ((eq? (car form) 'unquote-splicing)
                          (mcons form ''unquote-splicing
                                 (foo (- level 1) (cdr form))))
                         (#t (mcons form (foo level (car form))
                                    (foo level (cdr form)))))))))
   (foo 0 (car (cdr l)))))


Back to Index

Similar Entries

  • BTree_walk_inorder    xtlang
  • LFO_OPT_NOTEDUR    scheme
  • PARAM_NOISE_AMP    scheme
  • PARAM_NOISE_AMP    scheme
  • PARAM_NOISE_AMP    scheme
  • PARAM_Notch    scheme
  • PARAM_Notch    scheme
  • PmEvent_note_off_p    xtlang
  • PmEvent_note_on_p    xtlang
  • Widget_find_inorder    xtlang
  • Widget_walk_inorder    xtlang
  • active_notes    xtlang
  • active_notes    xtlang
  • aiProcess_FixInfacingNormals    scheme
  • aiProcess_GenNormals    scheme
  • aiProcess_GenSmoothNormals    scheme
  • ai_build_node    xtlang
  • ai_find_matching_node    xtlang
  • analogueVec_note    xtlang
  • analogue_note    xtlang
  • basic_note    xtlang
  • binomial    macro
  • cerberus_get_noisetype    xtlang
  • cerberus_note    xtlang
  • cerberus_sub_noise_cc    xtlang
  • cl:delete-if-not    scheme
  • cl:notany    scheme
  • cl:notevery    scheme
  • cl:remove-if-not    scheme
  • close-note-gate    scheme
  • cpvnormalize    xtlang
  • create_fbo_no_depth    xtlang
  • create_fbo_no_depth_rect    xtlang
  • dl_noise_amp    xtlang
  • dl_noise_amp    xtlang
  • dlogue_note    xtlang
  • dv_draw_title    xtlang
  • find_node    xtlang
  • fleet_connect_to_nodes    xtlang
  • fleet_message_all_nodes_sync    xtlang
  • fleet_message_node_sync    xtlang
  • fmsynth_note    xtlang
  • generate_tri_normals    xtlang
  • get_noise_amp    xtlang
  • get_noise_type    xtlang
  • get_noisetype    xtlang
  • gl_print_error_no_msg    xtlang
  • godot_node_path_destroy    xtlang
  • godot_node_path_new    xtlang
  • godot_variant_new_node_path    xtlang
  • gui_find_leaf_inorder    xtlang
  • gui_set_monokai_color_theme    xtlang
  • gui_set_monokai_opensans_theme    xtlang
  • homo-play-midi-note    scheme
  • homo-play-midi-note    scheme
  • impc:compiler:print-cannot-expand-non-generic-error    scheme
  • impc:compiler:print-could-not-resolve-generic-type-error    scheme
  • impc:compiler:print-could-not-resolve-type-error    scheme
  • impc:compiler:print-could-not-resolve-types    scheme
  • impc:compiler:print-could-not-resolve-types_find-expr    scheme
  • impc:compiler:print-no-redefinitions-error    scheme
  • impc:compiler:print-no-retval-error    scheme
  • impc:compiler:print-no-scheme-stub-notification    scheme
  • impc:compiler:print-no-valid-forms-for-generic-error    scheme
  • impc:compiler:print-not-during-aot-error    scheme
  • impc:compiler:print-variable-not-marked-as-free-error    scheme
  • impc:ti:bitwise-not-to-eor    scheme
  • impc:ti:get-mono-name    macro
  • impc:ti:not    scheme
  • impc:ti:type-normalize    scheme
  • instrument_find_note    xtlang
  • make_mono    xtlang
  • midi-note-off    scheme
  • midi-note-on    scheme
  • midi_note_off    xtlang
  • midi_note_off    xtlang
  • midi_note_off    xtlang
  • midi_note_on    xtlang
  • midi_note_on    xtlang
  • midi_note_on    xtlang
  • no title    unknown
  • no title    unknown
  • no title    unknown
  • no title    unknown
  • no title    unknown
  • node_reply_function    xtlang
  • node_reply_loop    xtlang
  • node_reply_loop_stop    xtlang
  • node_reply_socket_init    xtlang
  • nof    macro
  • nonblocking_read_loop    xtlang
  • nonblocking_read_loop    xtlang
  • nonblocking_read_loop    xtlang
  • nonblocking_read_loop    xtlang
  • normal    xtlang
  • note-active    xtlang
  • note-activity    xtlang
  • note-grad    xtlang
  • note-pitch    xtlang
  • peppino    scheme
  • peppino    scheme
  • play-midi-note    scheme
  • play-midi-note    scheme
  • play-note    scheme
  • reload_ignore_cache    xtlang
  • sampler-parse-midinote-filename    scheme
  • sampler_note    xtlang
  • sampler_note_linear    xtlang
  • saw_synth_note_c    xtlang
  • saw_synth_note_c    xtlang
  • scientific-pitch-notation-to-midi-number    scheme
  • set_monophonic    xtlang
  • set_noise_amp    xtlang
  • set_noise_type    xtlang
  • start-note    scheme
  • stop-note    scheme
  • sub_noise_cc    xtlang
  • sys:with-noisy-compiler    macro
  • t:notype?    scheme
  • vnormalise    xtlang
  • vnormalise    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_notequal    xtlang
  • xtm_play_note    xtlang
  • xtm_point_along_path_norm    xtlang
  • xtm_release_note    xtlang
  • xtm_start_note    xtlang
  • xtm_stop_note    xtlang
  • xtmdoc-strip-arg-type-annotations    scheme
  • xtmfrag_nolight    scheme