Last active
December 14, 2015 22:49
-
-
Save tkych/5161100 to your computer and use it in GitHub Desktop.
Coursera, Programming-Languages, Week8, OOP vs FP,
Generic function model OOP by CLOS
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;;; Last modified : 2013-03-14 22:00:40 tkych | |
;; Coursera, Programming-Languages, Week8, OOP vs FP | |
;; Generic function model OOP by CLOS | |
;; CL-REPL> (load "oop-fp-clos-example.lisp") | |
;;==================================================================== | |
;; Adding Operations or Variants | |
;;==================================================================== | |
;; Note: | |
;; 1. In class name, '<' and '>' is just style convention. | |
;; 2. To define functions print-object, make-~ is just style convention. | |
;; 3. Changed method name eval -> eval-exp . | |
(defclass <exp> () ()) | |
(defclass <value> (<exp>) ()) | |
(defgeneric eval-exp (exp)) | |
(defgeneric to-string (exp)) | |
(defgeneric has-zero (exp)) | |
(defclass <int> (<value>) ((i :reader i :initarg :i))) | |
(defmethod print-object ((int <int>) stream) | |
(print-unreadable-object (int stream) | |
(format stream "INT: ~A" (i int)))) | |
(defun make-int (i) (make-instance '<int> :i i)) | |
(defmethod eval-exp ((int <int>)) int) | |
(defmethod to-string ((int <int>)) (princ-to-string (i int))) | |
(defmethod has-zero ((int <int>)) (zerop (i int))) | |
(defclass <negate> (<exp>) ((e :reader e :initarg :e))) | |
(defmethod print-object ((n <negate>) stream) | |
(print-unreadable-object (n stream) | |
(format stream "NEGATE: ~A" (e n)))) | |
(defun make-negate (e) (make-instance '<negate> :e e)) | |
(defmethod eval-exp ((n <negate>)) (make-int (- (i (eval-exp (e n)))))) | |
(defmethod to-string ((n <negate>)) (format nil "(-~D)" (e n))) | |
(defmethod has-zero ((n <negate>)) (zerop (e n))) | |
(defclass <add> (<exp>) | |
((e1 :reader e1 :initarg :e1) | |
(e2 :reader e2 :initarg :e2))) | |
(defmethod print-object ((a <add>) stream) | |
(print-unreadable-object (a stream) | |
(format stream "ADD: ~A, ~A" (e1 a) (e2 a)))) | |
(defun make-add (e1 e2) | |
(make-instance '<add> :e1 e1 :e2 e2)) | |
(defmethod eval-exp ((a <add>)) | |
(make-int (+ (i (eval-exp (e1 a))) (i (eval-exp (e2 a)))))) | |
(defmethod to-string ((a <add>)) | |
(format nil "(~D + ~D)" (to-string (e1 a)) (to-string (e2 a)))) | |
(defmethod has-zero ((a <add>)) | |
(or (zerop (e1 a)) (zerop (e2 a)))) | |
;;-------------------------------------------------------------------- | |
;; New Variant | |
;;-------------------------------------------------------------------- | |
;; OOP is easy to add a new variant. | |
(defclass <mult> (<exp>) | |
((e1 :reader e1 :initarg :e1) | |
(e2 :reader e2 :initarg :e2))) | |
(defmethod print-object ((m <mult>) stream) | |
(print-unreadable-object (m stream) | |
(format stream "MULT: ~A, ~A" (e1 m) (e2 m)))) | |
(defun make-mult (e1 e2) | |
(make-instance '<mult> :e1 e1 :e2 e2)) | |
(defmethod eval-exp ((m <mult>)) | |
(make-int (* (i (eval-exp (e1 m))) (i (eval-exp (e2 m)))))) | |
(defmethod to-string ((m <mult>)) | |
(format nil "(~D * ~D)" (to-string (e1 m)) (to-string (e2 m)))) | |
(defmethod has-zero ((m <mult>)) | |
(or (zerop (e1 m)) (zerop (e2 m)))) | |
;;-------------------------------------------------------------------- | |
;; New Operation | |
;;-------------------------------------------------------------------- | |
;; Generic function model OOP is easy to add a new operation, too. | |
(defgeneric no-neg-constants (exp)) | |
(defmethod no-neg-constants ((int <int>)) | |
(if (< (i int) 0) | |
(make-negate (make-int (- (i int)))) | |
int)) | |
(defmethod no-neg-constants ((n <negate>)) | |
(make-negate (no-neg-constants (e n)))) | |
(defmethod no-neg-constants ((a <add>)) | |
(make-add (no-neg-constants (e1 a)) (no-neg-constants (e2 a)))) | |
(defmethod no-neg-constants ((m <mult>)) | |
(make-mult (no-neg-constants (e1 m)) (no-neg-constants (e2 m)))) | |
;;==================================================================== |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment