home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Unsorted BBS Collection
/
thegreatunsorted.tar
/
thegreatunsorted
/
programming
/
misc_programming
/
dylan.asc
< prev
next >
Wrap
Text File
|
1995-02-02
|
5KB
|
168 lines
_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)))