anchor.diff: -;;;; nix operating system project
  -;;;; list processor environment
  -;;;; Copyright (c) 2006-2007 Sven Klose <pixel@copei.de>
  +;;;; TRE environment
  +;;;; Copyright (c) 2006-2008 Sven Klose <pixel@copei.de>
   ;;;;
   ;;;; BACKQUOTE expansion
   ;;;;
  
positive.code: 
  ;;; BACKQUOTE evaluation
  
  ;; BACKQUOTE-expand argument list with decremented sublevel.
  (%set-atom-fun %quasiquote-subexpand
    #'((%gstype %gsbq %gsbqsub)
        (cons (cons %gstype
                    (%backquote (cdr (car %gsbq)) (- %gsbqsub 1)))
              (%backquote-1 (cdr %gsbq) %gsbqsub))))
  
  ;; Expand QUASIQUOTE.
  (%set-atom-fun %backquote-quasiquote
    #'((%gsbq %gsbqsub)
      (cond
        ; No sublevel. Insert evaluated QUASIQUOTE value.
        ((= %gsbqsub 0)
            (cons (copy-tree (eval (car (cdr (car %gsbq)))))
                  (%backquote-1 (cdr %gsbq) %gsbqsub)))
  
        (t  (%quasiquote-subexpand 'QUASIQUOTE %gsbq %gsbqsub)))))
  
  ;; Expand QUASIQUOTE-SPLICE.
  (%set-atom-fun %backquote-quasiquote-splice
    #'((%gsbq %gsbqsub)
      (cond
        ; No sublevel. Splice evaluated QUASIQUOTE-SPLICE expression.
        ((= %gsbqsub 0)
            (#'((%gstmp)
                 (cond
                   ; Ignore NIL evaluation.
                   ((not %gstmp)
                        (%backquote (cdr %gsbq) %gsbqsub))
                   ((atom %gstmp)
                        (%error "QUASIQUOTE-SPLICE: list expected"))
                   (t   (%nconc (copy-tree %gstmp)
                        (%backquote-1 (cdr %gsbq) %gsbqsub)))))
                (eval (car (cdr (car %gsbq))))))
  
        (t  (%quasiquote-subexpand 'QUASIQUOTE-SPLICE %gsbq %gsbqsub)))))
  
  ;; Expand BACKQUOTE arguments.
  (%set-atom-fun %backquote-1
    #'((%gsbq %gsbqsub)
      (cond
        ; Return atom as is.
        ((atom %gsbq)
  
negative.code:       ; Return element if it's not a cons.
        ((atom (car %gsbq))
            (cons (car %gsbq)
                  (%backquote-1 (cdr %gsbq))))
  
        ; Do QUASIQUOTE expansion.
        ((eq (car (car %gsbq)) 'QUASIQUOTE)
            (%backquote-quasiquote %gsbq))
  
        ; Do QUASIQUOTE-SPLICE expansion.
        ((eq (car (car %gsbq)) 'QUASIQUOTE-SPLICE)
            (%backquote-quasiquote-splice %gsbq))
  
        ; Expand sublist and rest.
        (t  (cons (%backquote (car %gsbq))
                  (%backquote-1 (cdr %gsbq)))))))
  
  ;; Expand BACKQUOTE, check for nested BACKQUOTE first.
  (%set-atom-fun %backquote
    #'((%gsbq)
      (cond
        ; Return atom as is.
        ((atom %gsbq)
  