;;; Exercice 1. ;;; Notes: ;;; - Capture des arguments avec args ;;; - Iteration avec for-each (define (p . args) (for-each display args) (display "\n")) ;; ou bien (newline) ;;; Notes: ;;; - Forme alternative de définition de fonction ;;; - Définition récursive d'une boucle avec let ;;; - Application de fonction avec apply (define (multimap fn . args) (define (map1 f lst) (if (not (pair? lst)) '() (cons (f (car lst)) (map1 f (cdr lst))))) (define (mmap args) (if (member #f (map1 pair? args)) '() (cons (apply fn (map1 car args)) (mmap (map1 cdr args))))) (mmap args)) ;;; Notes: ;;; - Analyse des cas possibles ;;; - Non-liste, liste vide et liste non-vide ;;; - Parcours récursif ;;; - Construction de liste ;;; - Forme conditionnelle à plus de 2 branches (define (flatten x) (cond ((pair? x) (append (flatten (car x)) (flatten (cdr x)))) ((null? x) '()) (else (list x)))) ;;; Exercice 2. ;;; Définition des constructions supportées par read simplifié ;;; ;;; Tokens: ;;; INT -> string->number, ;;; PAREN -> paren ;;; SYMBOL -> string->symbol, ;;; SPACES -> skip ;;; Rules: ;;; INT -> int ;;; LIST -> '( ... ) ;;; SYMBOL -> symbol (define lparen (list 'lparen)) ;; objets uniques (define rparen (list 'rparen)) (define (digit? c) (and (char>=? c #\0) (char<=? c #\9))) (define (digit->number c) (- (char->integer c) 48)) (define (space? c) (or (eof-object? c) (char=? c #\space) (char=? c #\newline) (char=? c #\tab))) (define (delimiter? c) (or (space? c) (char=? c #\() (char=? c #\)))) (define (paren? c) (or (eq? c #\() (eq? c #\)))) (define (read-integer port v) (let ((c (peek-char port))) (cond ((eof-object? c) v) ((digit? c) (read-integer port (+ (* 10 v) (digit->number (read-char port))))) (else v)))) (define (read-symbol port v) (let ((c (peek-char port))) (cond ((delimiter? c) (string->symbol (list->string (reverse v)))) (else (read-symbol port (cons (read-char port) v)))))) (define (read-paren port) (let ((c (peek-char port))) (cond ((paren? c) (if (char=? #\( (read-char port)) lparen rparen)) (else (raise "Error: non-paren character"))))) (define (*read-token port) (let ((c (peek-char port))) (cond ((eof-object? c) c) ((space? c) (read-char port) (*read-token port)) ((digit? c) (read-integer port 0)) ((paren? c) (read-paren port)) (else (read-symbol port '()))))) (define (read port) (define _t (*read-token port)) (define (peek-token) _t) (define (read-token) (let ((t _t)) (set! _t (*read-token port)) t)) (define (read-datums) (let loop ((l '()) (t (begin (read-token) (peek-token)))) (cond ((eof-object? t) (raise "Error missing ')'")) ((eq? t rparen) (read-token) l) (else (loop (append l (list (read-datum))) (peek-token)))))) (define (read-datum) (let ((t (peek-token))) (cond ((or (eof-object? t) (fixnum? t) (symbol? t)) (read-token)) ((eq? t lparen) (read-datums)) (else (raise "Error: Invalid token"))))) (read-datum)) (pp (call-with-input-string "" read)) (pp (call-with-input-string "123" read)) (pp (call-with-input-string "(1 2 3)" read)) (pp (call-with-input-string "(a b c)" read)) ;;; Exercice 3. ;;; File: "miniscm.scm" ;;; Translation of AST to machine code (define (translate ast) (comp-function "_main" ast)) (define (comp-function name expr) (gen-function name (comp-expr expr 0 '((argc . 1))))) (define (comp-expr expr fs cte) ;; fs = frame size ;; cte = compile time environment (cond ((number? expr) (gen-literal expr)) ((symbol? expr) (let ((x (assoc expr cte))) (if x (let ((index (cdr x))) (gen-parameter (+ fs index))) (error "undefined variable" expr)))) ((and (list? expr) (= (length expr) 3) (eq? (list-ref expr 0) 'let)) (let ((binding (list-ref (list-ref expr 1) 0))) (gen-let (comp-expr (list-ref binding 1) fs cte) (comp-expr (list-ref expr 2) (+ fs 1) (cons (cons (list-ref binding 0) (- (+ fs 1))) cte))))) ((and (list? expr) (= (length expr) 3) (member (list-ref expr 0) '(+ - * / bitwise-and bitwise-ior bitwise-xor))) (gen-bin-op (case (list-ref expr 0) ((+) "add") ((-) "sub") ((*) "imul") ((/) "idiv") ((bitwise-and) "and") ((bitwise-ior) "or") ((bitwise-xor) "xor")) (comp-expr (list-ref expr 2) fs cte) (comp-expr (list-ref expr 1) (+ fs 1) cte))) ((and (list? expr) (= (length expr) 3) (member (list-ref expr 0) '(arithmetic-shift))) (let ((opnd2 (comp-expr (list-ref expr 2) fs cte)) (opnd1 (comp-expr (list-ref expr 1) (+ fs 1) cte)) (reg-lbl (gen-label "REG")) (neg-lbl (gen-label "NEG")) (end-lbl (gen-label "END"))) (gen opnd1 " pushl %eax\n" opnd2 " movl %eax, %ecx\n" " popl %eax\n" ;; If shift amount greater or equal to 32 ;; the result should be 0 " cmp $32, %ecx\n" " movl $0, %edx\n" " cmovge %edx, %eax\n" " jge " end-lbl "\n" ;; If shift amount less or equal to -32, ;; -1 if opnd1 is negative, ;; 0 otherwise " cmp $-32, %ecx\n" " jg " reg-lbl "\n" " cmp $0, %eax\n" " movl $0, %ecx\n" " movl $-1, %eax\n" " cmovge %ecx, %eax\n" " jmp " end-lbl "\n" reg-lbl ":\n" ;; Check if the shift amount is negative " cmp $0, %ecx\n" " jl " neg-lbl "\n" ;; Positive shift " sall %cl, %eax\n" " jmp " end-lbl "\n" ;; Negative shift neg-lbl ":\n" " xorl $-1, %ecx\n" " incl %ecx\n" " sarl %cl, %eax\n" end-lbl ":\n" ))) ((and (list? expr) (= (length expr) 2) (member (list-ref expr 0) '(integer-length))) (let ((opnd (comp-expr (list-ref expr 1) fs cte)) (loop-lbl (gen-label "LOOP")) (start-lbl (gen-label "START")) (end-lbl (gen-label "END"))) (gen opnd " movl %eax, %ecx\n" ;; Test the most significant bit " cmpl $0, %eax\n" " jge " start-lbl "\n" ;; Find the inverse if negative and ;; add 1 for symmetry with positive case " xor $-1, %ecx\n" start-lbl ":\n" " movl $0, %eax\n" loop-lbl ":\n" " testl %ecx, %ecx\n" " jz " end-lbl "\n" " sarl $1, %ecx\n" " inc %eax\n" " jmp " loop-lbl "\n" end-lbl ":\n" ))) (else (error "comp-expr cannot handle expression")))) ;;; Code generation for x86-32 using GNU as syntax (define gen list) (define gen-label (let ((_i 0)) (lambda (prefix) (let ((i _i)) (set! _i (+ i 1)) (string-append prefix (number->string i)))))) (define (gen-function name code) (gen " .text\n" ".globl " name "\n" name ":\n" code " ret\n")) (define (gen-bin-op oper opnd1 opnd2) (gen opnd1 ;; This is slow: ;; " addl $-4, %esp\n" ;; " movl %eax, (%esp)\n" ;; This is faster: " pushl %eax\n" opnd2 " " oper "l (%esp), %eax\n" " addl $4, %esp\n")) (define (gen-let val body) (gen val " pushl %eax\n" body " addl $4, %esp\n")) (define (gen-parameter i) (gen " movl " (* 4 i) "(%esp), %eax\n")) (define (gen-literal n) (gen " movl $" n ", %eax\n")) ;; Main program: (define (main source-filename) (let ((ast (parse source-filename))) (let ((code (translate ast))) (with-output-to-file (string-append (path-strip-extension source-filename) ".s") (lambda () (print code))))))