#lang scheme
;; {{{ Grammaire du langage
;; Le langage interprete est defini par la grammaire suivante :
;; meval-scheme := expression
;;   expression := variable
;;              |  constante  | (QUOTE donnee)                    ; citation
;;              |  (COND clause *)                                ; conditionnelle
;;              |  (IF condition consequence [alternant])         ; alternative
;;              |  (BEGIN expression*)                            ; sequence
;;              |  (LET (liaison*) corps)                         ; bloc
;;              |  (fonction argument*)                           ; application
;;    condition := expression
;;  consequence := expression
;;    alternant := expression
;;       clause := (condition expressin*)
;;              |  (ELSE expression*)
;;     fonction := expression
;;     argument := expression
;;    constante := nombre | chaine | booleen | caractere
;;       donnee := constante
;;              |  symbole
;;              |  (donnee*)
;;      liaison := (variable expression)
;;        corps := definition* expression expression*
;;   definition := (DEFINE (nom-fonction variable*) corps)
;; nom-fonction := variable
;;     variable := tous les symboles de Scheme autres que les mots-cles
;;      symbole := tous les symboles de Scheme
;;   }}} Grammaire du langage

;; {{{ Utilitaire generaux
;;
;; Necessaires pour l'auto-amorcage (on pourrait egalement les placer
;; dans l'environnement initial)

;; Signaler une erreur et abandonner l'evaluation
(define (scheme-erreur fn message donnee)
  (error "meval-scheme" fn message donnee))

;; cadr: LISTE[alpha]/au moins 2 termes/ -> alpha
;; (cadr L) rend le second terme de la liste "L"
(define (cadr L)
  (car (cdr L)))

;; cddr: LISTE[alpha]/au moins 2 termes/ ->LISTE[alpha]
;; (cddr L) rend la liste "L" privee de ses deux premiers termes
(define (cddr L)
  (cdr (cdr L)))

;; caddr: LISTE[alpha]/au moins 3 termes/ -> alpha
;; (caddr L) rend le troisieme terme de la liste "L"
(define (caddr L)
  (car (cdr (cdr L))))

;; cdddr: LISTE[alpha]/au moins 3 termes/ -> LISTE[alpha]
;; (cdddr L) rend la liste "L" privee de ses trois premiers termes
(define (cdddr L)
  (cdr (cdr (cdr L))))

;; cadddr: LISTE[alpha]/au moins 4 termes/ -> alpha
;; (cadddr L) rend le quatrieme terme de la liste "L"
(define (cadddr L)
  (car (cdr (cdr (cdr L)))))

;; length: LISTE[alpha] -> entier
;; (length L) rend la longueur de la liste "L"
(define (length L)
  (if (pair? L)
	  (+ 1 (length (cdr L)))
	  0))

;; meval-scheme-map: (alpha -> beta) * LISTE[alpha] -> LISTE[beta]
;; (meval-scheme-map f L) rend la liste des valeurs de "f" appliquee
;; aux termes de la liste "L"
(define (meval-scheme-map f L)
  (if (pair? L)
	  (cons (f (car L)) (meval-scheme-map f (cdr L)))
	  '()))

;; member: alpha * LISTE[alpha] -> LISTE[alpha] + #f
;; (member e L) rend le suffixe de "L" debutant par la premiere
;; occurence de "e" ou #f si "e" n'apparait pas dans "L"
(define (member e L)
  (if (pair? L)
	  (if (equal? e (car L))
		  L
		  (member e (cdr L)))
	  #f))

;; rang: alpha * LISTE[alpha] -> entier
;; (rang e L) rend le rang de l'element donne dans la liste "L"
;; (ou on sait que l'element apparait). Le premier element a pour rang 1.
(define (rang e L)
  (if (equal? e (car L))
	  1
	  (+ 1 (rang e (cdr L)))))

;; }}} Utilitaire generaux

;; {{{ Barriere-syntaxique
;;
;; Ces fonctions permettent de manipuler les differentes expression syntaxiques
;; dont Scheme est forme. Pour chacune de ces differentes formes syntaxiques, on
;; trouve le reconnaisseur et les accesseurs.

;; variable?: Expression -> bool
(define (variable? expr)
  (if (symbol? expr)
	  (cond ((equal? expr 'cond)   #f)
			((equal? expr 'else)   #f)
			((equal? expr 'if)     #f)
			((equal? expr 'quote)  #f)
			((equal? expr 'begin)  #f)
			((equal? expr 'let)    #f)
			((equal? expr 'let*)   #f)
			((equal? expr 'define) #f)
			((equal? expr 'or)     #f)
			((equal? expr 'and)    #f)
			(else                  #t))
	  #f))

;; citation?: Expression -> bool
(define (citation? expr)
  (cond ((number? expr)  #t)
		((char? expr)    #t)
		((string? expr)  #t)
		((boolean? expr) #t)
		((pair? expr)    (equal? (car expr) 'quote))
		(else            #f)))

;; conditionnelle?: Expression -> bool
(define (conditionnelle? expr)
  (if (pair? expr)
	  (equal? (car expr) 'cond)
	  #f))

;; conditionnelle-clauses: Conditionnelle -> LISTE[Clause]
(define (conditionnelle-clauses cond)
  (cdr cond))

;; alternative?: Expression -> bool
(define (alternative? expr)
  (if (pair? expr)
	  (equal? (car expr) 'if)
	  #f))

;; alternative-condition: Alternative -> Expression
(define (alternative-condition alt)
  (cadr alt))

;; alternative-consequence: Alternative -> Expression
(define (alternative-consequence alt)
  (caddr alt))

;; alternative-alternant: Alternative -> Expression
(define (alternative-alternant alt)
  (if (pair? (cdddr alt))
	  (cadddr alt)
	  #f))

;; sequence?: Expression -> bool
(define (sequence? expr)
  (if (pair? expr)
	  (equal? (car expr) 'begin)
	  #f))

;; sequence-exprs: Expression -> LISTE[Expression]
(define (sequence-exprs expr)
  (cdr expr))

;; bloc?: Expression -> bool
(define (bloc? expr)
  (if (pair? expr)
	  (equal? (car expr) 'let)
	  #f))

;; bloc-liaisons: Bloc -> LISTE[Liaison]
(define (bloc-liaisons bloc)
  (cadr bloc))

;; bloc-corps: Bloc -> Corps
(define (bloc-corps bloc)
  (cddr bloc))

;; application?: Expression -> bool
(define (application? expr)
  (pair? expr))

;; application-fonction: Application -> Expression
(define (application-fonction app)
  (car app))

;; application-arguments: Application -> LISTE[Expression]
(define (application-arguments app)
  (cdr app))

;; clause-condition: Clause -> Expression
(define (clause-condition clause)
  (car clause))

;; clause-expressions: Clause -> LISTE[Expression]
(define (clause-expressions clause)
  (cdr clause))

;; liaison-variable: Liaison -> Variable
(define (liaison-variable liaison)
  (car liaison))

;; liaison-expr: Liaison -> Expression
(define (liaison-expr liaison)
  (cadr liaison))

;; definition?: Corps -> bool
;; (definition? corps) rend #t ssi le premier elements de "corps" est une definition
(define (definition? corps)
  (if (pair? corps)
	  (equal? (car corps) 'define)
	  #f))

;; definition-nom-fonction: Definition -> Variable
(define (definition-nom-fonction def)
  (car (cadr def)))

;; definition-variables: Definition -> LISTE[Variable]
(define (definition-variables def)
  (cdr (cadr def)))

;; definition-corps: Definition -> Corps
(define (definition-corps def)
  (cddr def))

;; }}} Barriere-syntaxique

;; {{{ Evaluateur

;; meval-scheme: Expression -> Valeur
;; (meval-scheme e) rend la valeur de l'expression "e"
(define (meval-scheme e)
  (evaluation e (env-initial)))

;; evaluation: Expression * Environnement -> Valeur
;; (evaluation expr env) rend la valeur de l'expression "expr" dans l'environnement "env"
(define (evaluation expr env)
  ;; (discrimine l'expression et invoque l'evaluateur specialise)
  (cond
   ((variable? expr) (variable-val expr env))
   ((citation? expr) (citation-val expr))
   ((alternative? expr) (alternative-eval
						 (alternative-condition expr)
						 (alternative-consequence expr)
						 (alternative-alternant expr) env))
   ((conditionnelle? expr) (conditionnelle-eval
							(conditionnelle-clauses expr) env))
   ((sequence? expr) (sequence-eval (sequence-exprs expr) env))
   ((bloc? expr) (bloc-eval (bloc-liaisons expr)
							(bloc-corps expr) env))
   ((application? expr) (application-eval
						 (application-fonction expr)
						 (application-arguments expr) env))
   (else
	(scheme-erreur 'evaluation "pas un programme" expr))))

;; alternative-eval: Expression3 * Environnement -> Valeur
;; (alternative-eval condition consequence alternant env) rend la valeur de
;; l'expression "(if condition consequence alternant)" dans l'environnement "env"
(define (alternative-eval condition consequence alternant env)
  (if (evaluation condition env)
	  (evaluation consequence env)
	  (evaluation alternant env)))

;; conditionnelle-eval: LISTE[Clause] -> Expression
;; (conditionnelle-eval clauses env) rend la valeur, dans l'environnement "env",
;; de l'expression "(cond c1 c2 ... cn)".
(define (conditionnelle-eval clauses env)
  (evaluation (cond-expansion clauses) env))

;; cond-expansion: LISTE[Clause] -> Expression
;; (cond-expansion clauses) rend l'expression, ecrite avec des alternatives,
;; equivalente a l'expression "(cond c1 c2 .. cn)".
(define (cond-expansion clauses)
  (if (pair? clauses)
	  (let ((first-clause (cadr clauses)))
		(if (equal? (clause-condition first-clause) 'else)
			(cons 'begin (clause-expressions first-clause))
			(cons 'if
				  (cons
				   (clause-condition first-clause)
				   (cons
					(cons 'begin (clause-expressions first-clause))
					(let ((seq (cond-expansion (cdr clauses))))
					  (if (pair? seq)
						  (list seq)
						  seq)))))))
	  '()))

;; sequence-eval: LISTE[Expression] * Environnement -> Valeur
;; (sequence-eval exprs env) rend la valeur, dans l'environnement "env",
;; de l'expression "(begin e1 ... en)". (Il faut evaluer tour a tour les
;; expressions et rendre la valeur de la derniere expression.)
(define (sequence-eval exprs env)
  ;; sequence-eval+: LISTE[Expression]/non vide/ -> Valeur
  ;; meme fonction, sachant que la liste "exprs" n'est pas vide et en globalisant
  ;; la variable "env"
  (define (sequence-eval+ exprs)
	(if (pair? (cdr exprs))
		(begin (evaluation (car exprs) env)
			   (sequence-eval+ (cdr exprs)))
		(evaluation (car exprs) env)))
  ;; expression de (sequence-eval exprs env):
  (if (pair? exprs)
	  (sequence-eval+ exprs)
	  #f))

;; application-eval: Expression * LISTE[Expression] * Environnement -> Valeur
;; (application-eval exp-fn args env) rend la valeur de l'invocation de
;; l'expression "exp-fn" aux arguments "args" dans l'environnement "env"
(define (application-eval exp-fn args env)
  ;; eval-env : Expression -> Valeur
  ;; (eval-env expr) rend la valeur de "expr" dans l'environnement "env"
  (define (eval-env expr)
	(evaluation expr env))
  ;;expression de (application-eval exp-fn args env) :
  (let ((f (evaluation exp-fn env)))
	(if (invocable? f)
		(invocation f (meval-scheme-map eval-env args))
		(scheme-erreur 'application-eval
					   "pas une fonction" f))))

;; bloc-eval: LISTE[Liaison] * Corps * Environnement -> Valeur
;; (bloc-eval liaisons corps env) rend la valeur, dans l'environnement "env"
;; de l'expression "(let liaisons corps)"
(define (bloc-eval liaisons corps env)
  (corps-eval corps (env-add-liaisons liaisons env)))

;; corps-eval: Corps * Environnement -> Valeur
;; (corps-eval corps env) rend la valeur de "corps" dans l'environnement "env"
(define (corps-eval corps env)
  (let ((def-exp (corps-separation-defs-exps corps)))
	(let ((defs (car def-exp))
		  (exps (cadr def-exp)))
	  (sequence-eval exps (env-enrichissement env defs)))))

;; corps-separation-defs-exps: Corps -> COUPLE[LISTE[Definition] LISTE[Expression]]
;; (corps-separation-defs-exps corps) rend un couple dont le premier elements est
;; la liste des definitions du corps "corps" et le second element est la liste des
;; expressions de ce corps
(define (corps-separation-defs-exps corps)
  (if (definition? (car corps))
	  (let ((def-exp-cdr
			  (corps-separation-defs-exps (cdr corps))))
		(cons (cons (car corps)
					(car def-exp-cdr))
			  (cdr def-exp-cdr)))
	  (list '() corps)))

;; }}} Evaluateur

;; {{{ Barriere-interpretation

;; Un programme Scheme comme LISP decrit deux sortes d'objets: les valeurs non fonctionnelles
;; (entier, bool, liste...) et les valeurs fonctionnelles

;;   {{{ Valeurs-non-fonctionnelles

;; citation-val: Citation -> Valeur/non fonctionnelle/
;; (citation-val cit) rend la valeur de la citation "cit"
(define (citation-val cit)
  (if (pair? cit)
	  (cadr cit)
	  cit))

;;   }}} Valeur-non-fonctionnelles

;;   {{{ Valeur-fonctionnelles

;; Il y a deux type de fonctions, les fonctions predefinies (reconnues par primitive? en Scheme
;; et special-form-p en LISP) et les fonctions du programme en cours d'evaluation (creer par
;; fonction-creation)

;; invocable?: Valeur -> bool
;; (invocable? val) rend vrai ssi "val" est un fonction (primitive ou definie)
(define (invocable? val)
  (if (primitive? val)
	  #t
	  (fonction? val)))

;; invocation: Invocable * LISTE[Valeur] -> Valeur
;; (invocation f args) rend la valeur de l'application de "f" aux elements de "vals"
(define (invocation f args)
  (if (primitive? f)
	  (primitive-invocation f args)
	  (fonction-invocation f args)))

;;     {{{ Primitives

;; Une primitive est implantee par un 4-uplet :
;; - le premier element est le symbole *primitive* (pour les reconnaitre)
;; - le second element est la fonction du Scheme sous-jacent qui implante la primitive,
;; - le troisieme element est un comparateur (= ou >=)
;; - le quatrieme element est un entier naturel, ces deux derniers elements permettant
;;   de specifier l'arite de la primitive.

;; primitive?: Valeur -> bool
;; (primitive? val) rend vrai ssi "val" est une fonction primitive
(define (primitive? val)
  (if (pair? val)
	  (equal? (car val) '*primitive*)
	  #f))

;; primitive-creation: N-UPLET[(Valeur... -> Valeur)(num * num -> bool) num] -> Primitive
;; (primitive-creation f-c-n) rend la primitive implantee par la fonction (du Scheme sous-jacent)
;; "f", le premier element de "f-c-n", et dont l'arite est specifier par le
;; comparateur "c", deuxieme element de "f-c-n" et l'entier "n", le troisieme element
(define (primitive-creation f-c-n)
  (cons '*primitive* f-c-n))

;; primitive-invocation: Primitive * LISTE[Valeur] -> Valeur
;; (primitive-invocation p args) rend la valeur de l'application de la primitive "p" aux element
;; de args
(define (primitive-invocation p args)
  (let ((n       (length args))
		(f       (cadr p))
		(compare (caddr p))
		(arite   (cadddr p)))
	(if (compare n arite)
		(cond
		 ((= n 0) (f))
		 ((= n 1) (f (car args)))
		 ((= n 2) (f (car args) (cadr args)))
		 ((= n 3) (f (car args) (cadr args) (caddr args)))
		 ((= n 4) (f (car args) (cadr args) (caddr args) (cadddr args)))
		 (else
		  (scheme-erreur 'primitive-invocation
						 "limite implantation (arite quelconque < 5)" args)))
		(scheme-erreur 'primitive-invocation
					   "arite incorrecte" args))))

;;     }}} Primitives

;;     {{{ Fonction-meta-definies

;; Une fonction definie est implantee par un 4-uplet:
;; - le premier element est le symbole *fonction* (pour les reconnaitre)
;; - le second element est la liste des variables de la definition de la fonction
;; - le troisieme element est le corps de la definition de la fonction
;; - le dernier element est l'environnement ou est definie la fonction

;; fonction?: Valeur -> bool
;; (fonction? val) rend vrai ssi "val" est une fonction meta-definie
(define (fonction? val)
  (if (pair? val)
	  (equal? (car val) '*fonction*)
	  #f))

;; fonction-invocation: Fonction * LISTE[Valeur] -> Valeur
;; (fonction-invocation f args) rend la valeur de l'application de la fonction
;; meta-definie "f" aux element de "args"
(define (fonction-invocation f args)
  (let ((variables (cadr f))
		(corps     (caddr f))
		(env       (cadddr f)))
	(corps-eval corps (env-extension env variables args))))

;; fonction-creation: Definition * Environnement -> Fonction
;; (fonction-creation definition env) rend la fonction definie par "definition" dans
;; l'environnement "env"
(define (fonction-creation definition env)
  (list '*fonction*
		(definition-variables definition)
		(definition-corps definition)
		env))

;;     }}} Fonctions-meta-definies
;;  }}} Valeurs-fonctionnelles
;; }}} Barriere-interpretation

;; {{{ Environnement-H (barriere de haut niveau)

;; variable-val: Variable * Environnement -> Valeur
;; (variable-val var env) rend la valeur de la variable "var" dans l'environnement "env"
(define (variable-val var env)
  (if (env-non-vide? env)
	  (let ((bloc (env-1er-bloc env)))
		(let ((variables (blocActivation-variables bloc)))
		  (if (member var variables)
			  (blocActivation-val bloc var)
			  (variable-val var (env-reste env)))))
	  (scheme-erreur 'variable-val "variable inconnue" var)))

;; env-extension: Environnement * LISTE[Variable] * LISTE[Valeur] -> Environnement
;; (env-extension env vars vals) rend l'environnement "env" etendu avec un bloc
;; d'activation liant les variables "vars" aux valeurs "vals"
(define (env-extension env vars vals)
  (if (= (length vars) (length vals))
	  (let ((bloc (blocActivation-creation vars)))
		(begin
		  (blocActivation-mettre-valeurs! bloc vals)
		  (env-add bloc env)))
	  (scheme-erreur 'env-extension
					 "arite incorrecte" (list vars vals))))

;; env-add-liaisons: LISTE[Liaison] * Environnement -> Environnement
;; (env-add-liaisons liaisons env) rend l'environnement obtenu en ajoutant a l'environnement
;; "env", les liaisons "liaisons"
(define (env-add-liaisons liaisons env)
  ;; eval-env: Expression -> Valeur
  ;; (eval-env exp) rend la valeur de "exp" dans l'environnement "env"
  (define (eval-env exp)
	(evaluation exp env))
  ;; expression de (env-add-liaisons env) :
  (env-extension
   env
   (meval-scheme-map liaison-variable liaisons)
   (meval-scheme-map eval-env
					 (meval-scheme-map liaison-expr liaisons))))

;; env-enrichissement: Environnement * LISTE[Definition] -> Environnement
;; (env-enrichissement env defs) rend l'environnement "env" etendu avec un bloc
;; d'activation pour les definitions fonctionnelles "defs"
(define (env-enrichissement env defs)
  (let ((noms (meval-scheme-map definition-nom-fonction defs)))
	(let ((bloc (blocActivation-creation noms)))
	  (let ((env-plus (env-add bloc env)))
		(define (fonction-creation-env-plus definition)
		  (fonction-creation definition env-plus))
		(begin
		  (blocActivation-mettre-valeurs!
		   bloc
		   (meval-scheme-map fonction-creation-env-plus defs))
		  env-plus)))))

;;   {{ Environnement-B (barriere de bas niveau)

;; Les environnement sont representes par la structure de donnees
;; LISTE[BlocActivation]

;; env-vide: -> Environnement
;; (env-vide) rend l'environnement vide
(define (env-vide) '())

;; env-non-vide?: Environnement -> bool
;; (env-non-vide? env) rend #t ssi l'environnement "env" n'est pas vide
(define (env-non-vide? env)
  (pair? env))

;; env-add: Environnement * BlocActivation -> Environnement
;; (env-add bloc env) rend l'environnement obtenu en ajoutant devant
;; l'environnement "env" le bloc d'activation "bloc"
(define (env-add bloc env)
  (cons bloc env))

;; env-1er-bloc: Environnement -> BlocActivation
;; (env-1er-bloc env) rend le premier bloc (le dernier dans la liste) d'activation
;; de l'environnement "env"
;; ERREUR lorsque l'environnement donnee est vide
(define (env-1er-bloc env)
  (car env))

;; env-reste: Environnement -> Environnement
;; (env-reste env) rend l'environnement obtenu en supprimant le premier bloc d'activation
;; de l'environnement "env"
;; ERREUR lorsque l'environnement donnee est vide
(define (env-reste env)
  (cdr env))

;;     {{{ Bloc d'activation

;; Les blocs d'activation sont representes par la structure de donnees:
;; VECTEUR[LISTE[Variables] Valeur ...]

;; blocActivation-variables: BlocActivation -> LISTE[Variable]
;; (blocActivation-variables bloc) rend la liste des variables definies
;; dans le bloc d'activation "bloc"
(define (blocActivation-variables bloc)
  (vector-ref bloc 0))

;; blocActivation-val: BlocActivation * Variable -> Valeur
;; (blocActivation-val bloc var) rend la valeur de la variable "var" dans le bloc
;; d'activation "bloc"
;; HYPOTHESE: "var" est une variable definie dans le "bloc"
(define (blocActivation-val bloc var)
  (let ((i (rang var (blocActivation-variables bloc))))
	(vector-ref bloc i)))

;; blocActivation-creation: LISTE[Variable] -> BlocActivation
;; (blocActivation-creation vars) rend un bloc d'activation contenant la liste des variables
;; "vars" avec la place qu'il faut pour les valeurs de ces variables, cette place n'etant pas
;; remplie
(define (blocActivation-creation vars)
  (let ((bloc (make-vector (+ 1 (length vars)))))
	(begin
	  (vector-set! bloc 0 vars)
	  bloc)))

;; blocActivation-mettre-valeurs!: BlocActivation * LISTE[Valeur] -> Rien
;; (blocActivation-mettre-valeurs! bloc vals) affecte les valeurs "vals" (donnees sous forme de
;; liste) dans le bloc d'activation "bloc".
(define (blocActivation-mettre-valeurs! bloc vals)
  ;; remplir!: entier * LISTE[Valeur] -> Rien
  ;; (remplir! i vals) remplit les cases du vecteur "bloc" a partir de l'indice "i", avec les valeurs
  ;; de la liste "vals" (et dans le meme ordre)
  (define (remplir! i vals)
	(if (pair? vals)
		(begin
		  (vector-set! bloc i (car vals))
		  (remplir! (+ i 1) (cdr vals)))
                null))
  (remplir! 1 vals))

;;     }}} Bloc d'activation
;;   }}} Environnement-B (barriere de bas niveau

;;   {{{ Environnement-initial

;; L'environnement initial est compose des primitives.
;; Pour faciliter la description des differentes primitives (et par manque de temps :D)
;; on les ecrira sous forme d'une liste de description de primitive.
;; Une element du type DescriptionPrimitive est une description d'une primitive. C'est
;; une liste dont :
;; - le premier element est la variable representant la primitive consideree
;; - les trois autres elements sont les trois elements qui decrivent
;; l'implantation de la primitive (la fonction Scheme, le comparateur, et l'arite)

;; env-initial -> Environnement
;; (env-initial) rend l'environnement initial (l'environnement qui contient toutes les primitives.
(define (env-initial)
  (env-extension
   (env-vide)
   (meval-scheme-map car (descriptions-primitives))
   (meval-scheme-map primitive-creation
					 (meval-scheme-map cdr
									   (descriptions-primitives)))))

;; description-primitive: Variable * (Valeur ... -> Valeur) * (num * num -> bool) * num -> DescriptionPrimitive
;; (description-primitive var f comparator arite) rend la description de la primitive designee par "var" implantee
;; dans Scheme par "f" et dont l'arite est definie par "comparator" et "arite"
(define (description-primitive var f comparator arite)
  (list var f comparator arite))

;; descriptions-primitives: -> LISTE[DescriptionPrimitive]
;; (descriptions-primitives) rend la liste des descriptions de toutes les primitives
(define (descriptions-primitives)
  (cons (description-primitive 'car             car              =   1)
  (cons (description-primitive 'cdr             cdr              =   1)
  (cons (description-primitive 'cons            cons             =   2)
  (cons (description-primitive 'list            list             >=  0)
  (cons (description-primitive 'vector-length   vector-length    =   1)
  (cons (description-primitive 'vector-ref      vector-ref       =   2)
  (cons (description-primitive 'vector-set!     vector-set!      =   3)
  (cons (description-primitive 'make-vector     make-vector      =   1)
  (cons (description-primitive 'pair?           pair?            =   1)
  (cons (description-primitive 'symbol?         symbol?          =   1)
  (cons (description-primitive 'number?         number?          =   1)
  (cons (description-primitive 'string?         string?          =   1)
  (cons (description-primitive 'boolean?        boolean?         =   1)
  (cons (description-primitive 'vector?         vector?          =   1)
  (cons (description-primitive 'char?           char?            =   1)
  (cons (description-primitive 'equal?          equal?           =   2)
  (cons (description-primitive '+               +                >=  0)
  (cons (description-primitive '-               -                =   2)
  (cons (description-primitive '*               *                >=  0)
  (cons (description-primitive '/               /                =   2)
  (cons (description-primitive '=               =                =   2)
  (cons (description-primitive '<               <                =   2)
  (cons (description-primitive '>               >                =   2)
  (cons (description-primitive '<=              <=               =   2)
  (cons (description-primitive '>=              >=               =   2)
  (cons (description-primitive 'remainder      remainder         =   2)
  (cons (description-primitive 'display        display           =   1)
  (cons (description-primitive 'newline        newline           =   0)
  (cons (description-primitive 'read           read              =   0)
  (cons (description-primitive 'error          error             >=  2)
		(list))))))))))))))))))))))))))))))))

;;   }}} Environnement-initial
;; }}} Environnement-H (barriere de haut niveau)