DEM - A simple Demeter system

The paper, "Chris Houser, Manual and compiler for the terse and modular lagnuage DEM, ACM SIGPLAN Notices, V.31(12), Dec 96, 41-51", describes DEM a Demeter subset with a 100 line Perl program that compiles it into C++. It operates strictly in batch mode.

Here is a less than 200 line Common Lisp version that can be used for incremental development as well a batch compiler. An earlier version with the capabilites of the Perl version is 125 lines.

Rather than parsing the DEM syntax, it uses two terse macros, define-class and define-event. Each generate the appropriate Lisp class or methods, respectively, based on the Lisp compiler's current knowledge of the class definitions it has seen. When a class is redefined the appropriate methods are also redefined.

(define-class name supers slots)
Define a class.
name
Name of the class.
supers
Names of superclasses of the class.
slots.
List of slots.

Each slot has the form (name type) where name is a symbol naming the slot, and type is either a symbol naming a Common Lisp type or a list of the form `(list ,type) representing a list of elements of that type. You only get lists, sorry .

(define-event name args flowspecs fragments)
Defines an event. This generates a group of methods for a generic function.
name
Name of the generic function.
args
Additional arguments to the generic function. There is an implied first argument of self.
flowspecs
A list of flow specifications.
fragments
A list of method fragments.

Aflowspec is a list of the form (from to ins outs). See the Dem paper. From and to are class names. Ins and outs are lists of filters. A filter is a list of the form (source label target).

A fragment defines a method for a particular class. It is a list of the form (name qualifier body) where name is the name of a class. The qualifier can be either

And body is the body of the method. It can refer to slots as lexical variables.

Class and event information is kept on simple global data structures that are independent of CLOS. This makes it easy to port to other lisp or object dialects.

Original DEM code
 
Sketch App shapes mode
Shape x# y# X# Y#
Box Shape
Line Shape a# b#
Text Shape string

Mode sketch next:Mode
Gesture Mode shape origin:point
Drag Mode shapes knob# last:point
Gather Mode points xx# yy# XX# YY#

draw()
Sketch -> Shape - :mode:
Line = move(x,y); line(X,Y); arrow(a, 0); arrow(b,1);
Box  = move(x,y); line(x,Y): line(X, Y); line(X, y); line(x,y);
Text = move(x,y); text(string);

Lisp version 
 
(define-class App () ())
(define-class Sketch (App)
   ((shapes (list Shape)) (mode Mode)))
(define-class Shape  () 
   ((x1 fixnum) (y1 fixnum) (x2 fixnum) (y2 fixnum)))
(define-class Box (Shape) ())
(define-class Line (Shape) 
   ((a fixnum) (b fixnum)))
(define-class Text (Shape)
   ((string string)))

(define-class Mode () ((sketch Sketch) (next Mode)))
(define-class Gesture (Mode) ((shape Shape) (origin Point)))
(define-class Drag (Mode) ((shapes (list Shape)) (knob fixnum)))
(define-class Gather (Mode) 
   ((points (list point))
	   (x1 fixnum) 
     (y1 fixnum)
     (x2 fixnum) 
     (y2 (fixum))))

(define-event draw ()
  (((Sketch) (Shape) () ((* mode *))))
  (
   (Line = (progn (move x1 y1) (line x2 y2) 
                         (arrow a 0) (arrow b 1)))
   (Box = (progn (move x1 y1) (line x1 y2) 
                        (line x2 y2) (line x2 y1)
                        (line x1 y1)))
   (Text = (progn (move x1 y1) (text string)))
   ))

Generated software 

(PROGN
  (DEFCLASS GATHER (MODE)
    ((POINTS :TYPE LIST :INITARG POINTS)
     (X1 :TYPE FIXNUM :INITARG X1)
     (Y1 :TYPE FIXNUM :INITARG Y1)
     (X2 :TYPE FIXNUM :INITARG X2)
     (Y2 :TYPE FIXUM :INITARG Y2)))
  (DEFCLASS DRAG (MODE)
    ((SHAPES :TYPE LIST :INITARG SHAPES)
     (KNOB :TYPE FIXNUM :INITARG KNOB)))
  (DEFCLASS GESTURE (MODE)
    ((SHAPE :TYPE SHAPE :INITARG SHAPE)
     (ORIGIN :TYPE POINT :INITARG ORIGIN)))
  (DEFCLASS MODE ()
    ((SKETCH :TYPE SKETCH :INITARG SKETCH)
     (NEXT :TYPE MODE :INITARG NEXT)))
  (DEFCLASS TEXT (SHAPE)
    ((STRING :TYPE STRING :INITARG STRING)))
  (DEFCLASS LINE (SHAPE)
    ((A :TYPE FIXNUM :INITARG A)
     (B :TYPE FIXNUM :INITARG B)))
  (DEFCLASS BOX (SHAPE) NIL)
  (DEFCLASS SHAPE ()
    ((X1 :TYPE FIXNUM :INITARG X1)
     (Y1 :TYPE FIXNUM :INITARG Y1)
     (X2 :TYPE FIXNUM :INITARG X2)
     (Y2 :TYPE FIXNUM :INITARG Y2)))
  (DEFCLASS SKETCH (APP)
    ((SHAPES :TYPE LIST :INITARG SHAPES)
     (MODE :TYPE MODE :INITARG MODE)))
  (DEFCLASS APP () NIL)
  (FMAKUNBOUND 'DRAW)
  (DEFMETHOD DRAW ((SELF TEXT))
    (WITH-SLOTS (X1 Y1 X2 Y2 STRING)
                SELF
      (PROGN (MOVE X1 Y1) (TEXT STRING))))
  (DEFMETHOD DRAW ((SELF BOX))
    (WITH-SLOTS (X1 Y1 X2 Y2)
                SELF
      (PROGN (MOVE X1 Y1)
             (LINE X1 Y2)
             (LINE X2 Y2)
             (LINE X2 Y1)
             (LINE X1 Y1))))
  (DEFMETHOD DRAW ((SELF LINE))
    (WITH-SLOTS (X1 Y1 X2 Y2 A B)
                SELF
      (PROGN (MOVE X1 Y1)
             (LINE X2 Y2)
             (ARROW A 0)
             (ARROW B 1))))
  (DEFMETHOD DRAW ((SELF SKETCH))
    (WITH-SLOTS (SHAPES MODE) SELF (MAPC #'DRAW SHAPES))))

Ken Anderson