diff --git a/scheme/meval-scheme.scm b/scheme/meval-scheme.scm index 3967fc5..5dc63b3 100644 --- a/scheme/meval-scheme.scm +++ b/scheme/meval-scheme.scm @@ -397,4 +397,42 @@ ;; - 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. \ No newline at end of file +;; 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 +