anchor.diff:  
   
   
  -(defmacro dolist/separator ((var list separator) &body body)
  -  (let ((vsep (gensym))
  -        (esep (gensym)))
  -    `(loop
  -       :with ,esep = ,separator
  -       :for ,var :in ,list
  -       :for ,vsep = "" :then ,esep
  -       :do (princ ,vsep) (locally ,@body))))
  -
  -
  -(defun unparse-tree (stat)
  -  (macrolet ((with-parens (item)
  -               (let ((vitem (gensym)))
  -                 `(let ((,vitem ,item))
  -                    (if (atom ,vitem)
  -                        (unparse-tree ,vitem)
  -                        (progn
  -                          (princ "(")
  -                          (unparse-tree ,vitem)
  -                          (princ ")")))))))
  -    (etypecase stat
  -      ((or integer nombre symbol)
  -       (princ stat))
  -      (token
  -       (ecase (token-kind stat)
  -         (tok-chaine         (princ (token-text stat)))
  -         (tok-identificateur (princ (identificateur-nom stat)))
  -         (tok-nombre         (princ (nombre-valeur stat)))
  -         (tok-numero         (princ (numero-valeur stat)))
  -         (tok-commentaire    (princ (token-text stat)))))
  -      (cons
  -       (ecase (first stat)
  -
  -         ((:neg) (princ "-")    (with-parens (second stat)))
  -
  -         ((:non) (princ "NON ") (with-parens (second stat)))
  -
  -         ((:moins :plus :fois :divise :puissance :concat
  -                  :lt :le :gt :ge :eg :ne)
  -          (with-parens (second stat))
  -          (princ (case (first stat)
  -                   (:moins "-")
  -                   (:plus  "+")
  -                   (:fois  "*")
  -                   (:divise "/")
  -                   (:puissance "^")
  -                   (:concat "!")
  -                   (:lt "<")
  -                   (:le "<=")
  -                   (:gt ">")
  -                   (:ge ">=")
  -                   (:eg "=")
  -                   (:ne "#")))
  -          (with-parens (third stat)))
  -
  -         (:xi
  -          (princ "SI ")
  -          (unparse-tree (second stat))
  -          (princ " ALORS ")
  -          (unparse-tree (third stat))
  -          (princ " SINON ")
  -          (unparse-tree (fourth stat)))
  -
  -         ((:ou :et)
  -          (dolist/separator (item (rest stat) (case (first stat)
  -                                                (:ou " OU ")
  -                                                (:et " ET ")))
  -            (unparse-tree item)))
  -
  -         ((:commentaire :terminer :pause :aller-en :retour :retour-en :resultat
  -                        :liberer :chaine :tableau
  -                        :lire :garer :charger :supprimer :executer)
  -          (princ (case (first stat)
  -                   (:commentaire "")
  -                   (:terminer   "TERMINER")
  -                   (:pause      "PAUSE")
  -                   (:aller-en   "ALLER EN ")
  -                   (:retour     "RETOUR")
  -                   (:resultat   "RESULTAT ")
  -                   (:retour-en  "RETOUR EN ")
  -                   (:liberer    "LIBERER ")
  -                   (:chaine     "CHAINE ")
  -                   (:tableau    "TABLEAU ")
  -                   (:lire       "LIRE ")
  -                   (:garer      "GARER ")
  -                   (:charger    "CHARGER ")
  -                   (:supprimer  "SUPPRIMER ")
  -                   (:executer   "EXECUTER ")))
  -          (dolist/separator (item (rest stat) ",")
  -            (unparse-tree item)))
  -
  -         ((:adecl :aval :aref)
  -          (princ (identificateur-nom (second stat)))
  -          (princ "[")
  -          (unparse-tree (third stat))
  -          (when (cdddr stat)
  -            (princ ",")
  -            (unparse-tree (fourth stat)))
  -          (princ "]"))
  -
  -         ((:vval :vref)
  -          (princ (identificateur-nom (second stat))))
  -
  -         ((:fonction :appel)
  -          (princ (identificateur-nom (second stat)))
  -          (princ "(")
  -          (dolist/separator (item (cddr stat) ",")
  -            (unparse-tree item))
  -          (princ ")"))
  -         
  -         (:decl-procedure
  -          (princ "PROCEDURE ")
  -          (princ (identificateur-nom (second stat)))
  -          (princ "(")
  -          (dolist/separator (item (third stat) ",")
  -            (unparse-tree item))
  -          (princ ")")
  -          (when (fourth stat)
  -            (princ " LOCAL ")
  -            (dolist/separator (item (fourth stat) ",")
  -              (unparse-tree item))))
  -         
  -
  -         (:affectation
  -          (unparse-tree (second stat))
  -          (princ "_")
  -          (unparse-tree (third stat)))
  -
  -
  -         (:afficher
  -          (if (second stat)
  -              (progn (princ "AFFICHER[")
  -                     (dolist/separator (item (second stat) ",")
  -                       (ecase (first (second item))
  -                         (:rep-1     )
  -                         (:rep       (princ (numero-valeur (second (second item)))))
  -                         (:rep-var   (princ "*")))
  -                       (ecase (first item)
  -                         (:spec-chaine
  -                          (unparse-tree (third item)))
  -                         ((:spec-slash :spec-space :spec-cr :spec-nl)
  -                          (princ (case (first item)
  -                                   (:spec-slash "/")
  -                                   (:spec-space "X")
  -                                   (:spec-cr    "C")
  -                                   (:spec-nl    "L"))))
  -                         ((:spec-f :spec-e)
  -                          (princ (case (first item)
  -                                   (:spec-f "F")
  -                                   (:spec-e "E")))
  -                          (princ (third item))
  -                          (princ ".")
  -                          (princ (fourth item)))
  -                         (:spec-u
  -                          (princ "U"))))
  -                     (princ "]"))
  -              (princ "AFFICHER "))
  -          (dolist/separator (item (cddr stat) ",")
  -            (unparse-tree item)))
  -
  -
  -         (:si
  -          (princ "SI ")
  -          (unparse-tree (second stat))
  -          (princ " ALORS ")
  -          (unparse-tree (third stat))
  -          (when (cdddr stat)
  -            (princ " SINON ")
  -            (unparse-tree (fourth stat))))
  -
  -         ((:faire-jusqu-a :faire-tant-que) ;; lino ident init pas jusqua|tantque)
  -          (princ "FAIRE ")
  -          (unparse-tree (second stat))
  -          (princ " POUR ")
  -          (unparse-tree (third stat))
  -          (princ "_")
  -          (unparse-tree (fourth stat))
  -          (unless (= 1 (fifth stat))
  -            (princ " PAS ")
  -            (unparse-tree (fifth stat)))
  -          (princ (case (first stat)
  -                   (:faire-jusqu-a  " JUSQUA ")
  -                   (:faire-tant-que " TANT QUE ")))
  -          (unparse-tree (sixth stat)))
  -
  -         
  -         (:debut
  -          (loop
  -            :for item :in (cddr stat)
  -            :initially (princ "BEGIN ") (unparse-tree (second stat))
  -            :do (princ ";") (unparse-tree item)
  -            :finally (princ " END"))))))))
  -
  -
  -(defun unparse-slist (parse-tree)
  -  (with-output-to-string (*standard-output*)
  -    (with-standard-io-syntax
  -     (cond
  -       ((null parse-tree))              ; nothing to do
  -       ((atom parse-tree)
  -        (format *error-output* "~&ERREUR: JE TROUVE UN ATOME: ~S~%" parse-tree))
  -       ((eq (car parse-tree) :liste-instructions)
  -        (dolist/separator (item (cdr parse-tree) ";")
  -          (unparse-tree item)))
  -       ((eq (car parse-tree) :ligne-programme)
  -        (princ (numero-valeur (cadr parse-tree)))
  -        (unless (and (listp (caddr parse-tree))
  -                     (eql ':commentaire (caaddr parse-tree)))
  -          (princ " "))
  -        (dolist/separator (item (cddr parse-tree) ";")
  -          (unparse-tree item)))
  -       (t
  -        (format *error-output* "~&ERREUR: JE TROUVE UNE LISTE INVALIDE: ~S~%" parse-tree))))))
  -
  -
   (defun generate-slist (slist final)    ; generate bytes for a statement list
     (if slist
         (generate-statement (car slist) (generate-slist (cdr slist) final))
  
positive.code: ;;;;AUTHORS
  ;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
  ;;;;MODIFICATIONS
  ;;;;    2005-08-25 <PJB> Created.
  ;;;;BUGS
  ;;;;    LIRE must take into account the type of the variable.
  
negative.code:   (cond
      ((null parse-tree) (list 0 #()))           ; nothing to do
      ((atom parse-tree)
       (error 'lse-error
              :format-control "INTERNE: UN ATOME ~S DANS L'ARBRE SYNTAXIQUE."
              :format-arguments (list parse-tree)))
      ((eq (car parse-tree) :liste-instructions)
       (list 0 (compile-slist (cdr parse-tree) BC::TERMINER)))
      ((eq (car parse-tree) :ligne-programme)
       (list (numero-valeur (cadr parse-tree)) (compile-slist (cddr parse-tree) BC::NEXT-LINE)))
      (t
       (error 'lse-error
              :format-control "INTERNE: UNE LISTE INVALIDE ~S DANS L'ARBRE SYNTAXIQUE."
              :format-arguments (list parse-tree)))))
  
  
  ;; zebu:
  