_THE DYLAN PROGRAMMING LANGUAGE_
by Tamme D. Bowen and Kelly M. Hall

Example 1: 

(a)

IsClass :: ClassName -> ClassList -> Boolean
IsClass (cl:ClassName) ([]:ClassList) = False
IsClass cl (c::cs) =
   if cl = c.name then True else IsClass cl cs

(b) 

GetSlots :: ClassName -> ClassList -> SlotList
GetSlots (cl:ClassName) ([]:ClassList) = error "class not found"
GetSlots cl (c::cs) =
   if cl = c.name then c.sl also GetSlots cl cs

(c)

GetKids :: ClassName -> ClassList -> ClassList
GetKids (cl:ClassName) ([]:ClassList) = error "class not found"
GetKids cl (c::cs) =
   if cl = c.name then c.subclasses else GetKids cl cs

(d) 
GetSupers :: ClassName -> ClassList ->  ClassList -> ClassList 
GetSupers (cl:ClassName) ([]:ClassList) = (CC:ClassList) = []
GetSupers cl (c::cs) CC =
   if element cl = c.subclasses 
     then unique ((cl.name::GetSupers cl cs CC)@(GetSupers c.name CC CC))
     else GetSupers cl cs CC

(e)

GetSubs :: ClassName -> ClassList ->  ClassList -> ClassList 
GetSubs (cl:ClassName) ([]:ClassList) = (CC:ClassList) = []
GetSubs cl (c::cs) CC =
   if cl = c.name
      then unique (direct @ indirect)
      else GetSupers cl cs CC
where direct = c.subclasses
and   indirect = fold '@' (map (\x. GetSubs x CC CC) c.subclasses)


Example 2: 

(a)

NewClass :: ClassName -> ClassList -> SlotList -> ClassList -> ClassList 
NewClass (n:ClassName) (pl:ClassList) (sl:SlotsList) (C:ClassList) =
   if IsClass n C
      then NewClass n pl sl (remove n C)
      else if fold and (map (\x. IsClass x C) pl)
           then FixLinks n pl (n,pl,sl)::C
           else error "superclass does not exist"
(b)

FixLinks :: ClassName -> ClassList -> ClassList -> ClassList 
FixLinks (n:ClassName) ([]:ClassList) (CC:ClassList) = CC
FixLinks n (p::ps) CC = FixLinks n ps (Update n p CC)

Update :: ClassName -> ClassName -> ClassList -> ClassList 
Update (n:ClassName) (p:ClassName) ([]:ClassList) = error
Update n p (c:cs) =
   if p = c.name
     then (c.name, c.sl, n::c.subclasses)::CS
     else c::(Update n p cs)

(c)

Make :: ClassName -> ClassList -> Instance
Make (n:ClassName) (CL:ClassList) =
   if IsClass n CL
   then BuildRecord unique (localslots @ superslots)
   else error "class not found"
where localslots = GetSlots n CL
and   superslots = fold '@' (map GetSlots (GetSupers n CL))



Example 3: 



(a) 

IsGF :: FunNames -> GFList -> Boolean
IsGF (n:FunName) ([]:FGList) = False
IsGF n (g:gs) =
    if n = g.name then True else IsGF n gs

(b)

AddMethod :: FunName -> ParamList -> Key -> GFList -> GFList
AddMethod (n:FunName) (pl:ParamList) (key:Key) ([]GFList) = []
AddMethod n pl key (g:gs) =
   if n = g.name
       then ((g.name),(pl.key)::(g.methods)) :: gs
       else g :: AddMethod n pl key gs

(c)

RemoveMethod :: FunName -> ParamList -> GFList -> GFList
RemoveMethod (n:FunName) (pl:ParamList) ([]GFList) = error
RemoveMethod n pl key (g:gs) =
   if n = g.name
       then (g.name,(RMAux pl g.methods)) :: gs
       else g :: RemoveMethod n pl key gs

RMAux :: ParamList -> MethodList -> MethodList 
RMAux (n:ParamList) ([]:MethodList) = error
RMAux pl key (m:ms) =
   if foreach i in pl (pl.i.type = m.pl.i.type)
       then ms
       else m :: RMAux pl ms

(d)

NewGF :: FunName -> GFList -> GFList
NewGF (n:FunName) (GF:GFList) =
   if IsGF n GF
      then NewGF n (RemoveGF n GF)
      else (n,[]) :: GF

(e)

RemoveGF :: FunName -> GFList -> GFList
RemoveGF (n:FunName) ([]:GFList) = error
RemoveGF n (g:gs) =
   if n = g.name      then gs
     else g:: RemoveGF n gs

(f)

ApplyGF :: FunName -> ParamList -> GFList -> Object
ApplyGF (n:FunName) (pl:ParamList) ([]:GFList) = error
ApplyGF n pl (g:gs) =
   if n = g.name
      then SchemeApply (SpecificMethod pl g.methods) pl
      else ApplyGF n pl gs


Example 4:

NewMethod (n:FunName) (pl:ParamList) (l:Expr) (GF:GFList) (SE:Env) =
let key = MkUniqueKey GF in
if IsGF n GF
  then (AddMethod n pl key GF) , (bind key l SE)
  else NewMethod n pl l (AddMethod n [] Nil GF)


Example 5: 

(define-method newtons-sqrt (x)
   (bind-methods ((sqrt1 (guess)
                   (if (close? guess)
                       guess
                       (sqrt1 (improve guess))))
                   (close? (guess)
                       (< (abs (- (* guess guess) x)) 0.0001))
                   (improve (guess)
                       (/ (+ guess (/ x guess)) 2)))
  (sqrt1 1)))