| Jan Skibinski 2006-04-06, 7:04 pm |
|
Parametrically Polymorphic Datatype Definition
Summary
This document describes a simple mechanism that extends the well-known
monomorphic datatype definition into a parametrically polymorphic one.
After short motivational discussion the concepts of a polymorphic
datatype and of a polymorphic type-case deconstructor are presented,
followed by two skeletal examples of a generic tree and its reduction
to a concrete integer tree.
The reference implementation of polymorphic datatype definition,
type-case de-constructor and fully working examples of trees are
embedded within modules produced by my-module framework, which has been
presented previously on com.lang.scheme forum. The modularized version
serves the dual purpose: it is used in my-module environment on its own
rights and it helps testing it. The implementation has been tested and
works portably on Mzscheme and Petite Chez Scheme platforms.
Nevertheless, this code can be re-implemented on any platform, with
or without modularization. A list of few required changes is shown
in section 5.
Irrespectively of the modularity issue the polymorphic definitions
maintain high degree of separation from the rest of environment. There
are no references to a global registry, user types may be defined
locally and the type constructors and the type predicates are only
exposed when needed.
It is worth to note that a somewhat similar, although more complex,
problem of type classes has been handled in [4], from which I have
borrowed the idea of constructor dispatching.
Contents:
1. The motivation
2. The concept
3. A sketch of modularized Tree
4. A sketch of modularized Integer-Tree
5. Porting issues
Implementation:
1. module-datatype
2. module-tree
3. module-integer-tree
1=2E The motivation
Many wonderful ideas, which are presented in EOPL[1] and PLAI[2]
books,
are centered around define-datatype, a.k.a define-type construct. In
essence, the construct lets us define our own recursive datatypes with
variants, which can be furnished with type constraints, and whose roles
are:
+ clarification of datatype definition
+ runtime contract verification
+ static type checking if a type-checker is available
and is employed, as shown in [3], and other papers.
For example, the following recursive definition of datatype Tree
(define-type Tree
[leaf (datum number?)]
[branch (left Tree?) (right Tree?)])
declares a binary tree structure, with numerical data stored in its
leaves. Verification of data is performed during the tree construction;
an error is signaled when a datum fails to pass the predicate test
(number? datum).
Accompanying define-type is the type-case construct, which serves
as the type de-constructor, as in this definition of procedure
tree-sum:
(define (tree-sum atree)
(type-case Tree atree
[(leaf datum) datum]
[(branch left right)
(+ (tree-sum left) (tree-sum right))]))
This powerful mechanism has one significant shortcoming though, which
is
best explained by the following tree-map example:
(define (tree-map f atree)
(type-case Tree atree
[(leaf datum) (Leaf (f datum))]
[(branch left right)
(Branch (tree-map f left) (tree-map f right))]))
This tree-map works fine -- as long as the function f maps numbers to
numbers:
f :: number -> number
Any other type of mapping, such as
f :: number -> string
would lead to failure, since no newly generated leaf of destination
tree would ever pass the predicate test (number? datum). There are
two naive workarounds for this problem:
+ Redefine tree definition using any-type? predicate, instead of
number?
predicate
+ Define N tree types such as Number-Tree, String-Tree, etc.
and N*N corresponding tree-map functions: tree-map-number->string,
tree-map-string->number, etc.
Neither solution seems right for obvious reasons. We need to extend the
define-type and type-case definitions to allow for what is known as a
parametric polymorphism.
2=2E The concept
Using Haskell notation, the datatype definition of the example tree
discussed above is of this form:
data NumberTree =3D Leaf Number | Branch NumberTree NumberTree
or better yet
data Tree Number =3D Leaf Number | Branch (Tree Number) (Tree Number)
which leads to generalization into trees parameterized by a type
variable 'a
data Tree a =3D Leaf a | Branch (Tree a) (Tree a)
The equivalent datatype definition in Scheme will be of this form:
(define tree
(datatype (tree a?)
[leaf (datum a?)]
[branch (left (tree? a?)) (right (tree? a?))]))
In Haskell notation the symbol 'a represents a parametric type
variable, while Scheme version deals with a parametric contract
predicate a -> Bool, which I abbreviated to a? for readability.
[Compared to original define-datatype, the polymorphic datatype shown
here is a lambda expression, not a definition. As such it may be used
locally in let-expressions but to form a full definition it has to
be bound explicitly to a name, such as 'tree.]
The above example uses only one generic predicate, but nothing
prevents us from introducing two or more such predicates, as in this
example of a contrived fancy tree, which stores two kinds of data
in leaves and in branches[5]
Haskell:
data FancyTree a b =3D
FancyLeaf a
| FancyBranch b (FancyTree a b) (FancyTree a b)
Scheme:
(define fancy-tree
(datatype (fancy-tree a? b?)
[leaf (a-datum a?)]
[branch (b-datum b?)
(left (fancy-tree? a? b?))
(right (fancy-tree? a? b?))]))
[A side note: Haskell variants are global and they cannot be
reused in different datatypes. Hence a need for some new labels, such
as FancyLeaf and FancyBranch if FancyTree is to stay on the equal
footing
with Tree.
Some Scheme implementations of define-datatype follow this tradition
as
well by publicizing the datatype constructors as independent entities.
In my view the pollution of the global namespace should be kept at the
absolute minimum. For this reason this implementation of
define-datatype keeps all data local within a single definition of
datatype and exposes them only on demand. Modularization of course
helps to keep such private information well hidden.]
As a consequence of this new datatype design, it is easy to define a
parametric version of tree-map procedure. Compared to its Haskell
counterpart its signature is a bit more complicated
Haskell:
treeMap :: (a -> b) -> Tree a -> Tree b
Scheme:
tree-map :: a? -> b? -> ((a -> b) -> Tree a -> Tree b)
The Scheme version of tree-map accepts two additional arguments, the
generic predicates a? and b?. Haskell does not need this, since all
typing information is statically resolvable. In contrary, Scheme
executes contracts in runtime only, so we must attach them explicitly
to datatype definition.
The Scheme implementation of the tree-map curries these first two
arguments
(define (tree-map a? b?)
(lambda (f t)
(type-case (tree a?) t
[
(leaf x)
((leaf b?) (f x))
][
(branch left right)
((branch b?)
((tree-map a? b?) f left)
((tree-map a? b?) f right))
])))
which allows for easy specialization to some concrete types, as in:
((tree-map number? string?) number->string a-numeric-tree)
The datatype definition is generic enough to handle both, the concrete
monomorphic cases and polymorphic ones. For example, the monomorphic
numeric-tree datatype could have been defined without referring to
generic type predicates
(define numeric-tree
(datatype (numeric-tree)
[leaf (datum number?)]
[branch (left (numeric-tree?)) (right (numeric-tree?))]))
but then such definition would have had the same limitation as the
original one, discussed before. Compared to the original definition
this form is a bit more complicated due to extra parentheses around
predicates. But such price is worth to pay for the extra functionality;
i=2Ee., for the parametric polymorphism support.
3=2E A sketch of modularized Tree
The following is a skeleton of the module-tree, as implemented in
my-module framework, which I have previously described on this forum.
Following this section is a specialization of module-tree to
module-integer-tree.
(my-module module-tree
(provide:
datatype? ;; a -> Bool
tree ;; a? -> Tree a
tree? ;; a? -> (b -> Bool)
leaf ;; a? -> (a -> Tree a)
branch ;; a? -> (Tree a -> Tree a -> Tree a)
tree-height ;; a? -> (Tree a -> Integer)
tree-size ;; a? -> (Tree a -> Integer)
tree-map ;; (a? -> b?) -> ((a -> b) -> Tree a -> Tree b)
fringe ;; a? -> (Tree a -> List a)
tree->list ;; a? -> (Tree a -> S-expression a)
)
(require:
(module-datatype
datatype?
type-predicate
constructor
))
(define-syntax* datatype (from module-datatype datatype))
(define-syntax* type-case (from module-datatype type-case))
;; Parametric tree
;; tree :: a? -> Tree a
(define tree
(datatype (tree a?)
[
leaf (datum a?)
][
branch (left (tree? a?)) (right (tree? a?))
]))
;; Parametric tree predicate
;; tree? :: a? -> (b -> Bool)
;; Example: ((tree? symbol?) ((leaf symbol?) 'hello)) =3D=3D> #t
(define (tree? a?) (type-predicate (tree a?)))
;; Parametric leaf constructor
;; leaf :: a? -> (a -> Tree a)
;; Example: ((leaf symbol?) 'hello) =3D=3D> (tree . #<procedure> )
;; Example: ((leaf symbol?) 12) =3D=3D> Error
(define (leaf a?) (constructor (tree a?) 'leaf))
;; Parametric branch constructor
;; branch :: a? -> (Tree a -> Tree a -> Tree a)
;; Example: ((branch symbol?)
;; ((leaf symbol?) 'hello) ((leaf symbol?) 'world))
;; =3D=3D> (tree . #<procedure> )
(define (branch a?) (constructor (tree a?) 'branch))
;; Parametric tree-map
;; tree-map :: a? -> b? -> ((a -> b) -> Tree a -> Tree b)
;; Example: ((tree-map symbol? string?) symbol->string a-symbol-tree)
;; =3D=3D> (tree . #<procedure> ) representing a-numeric-tree
(define (tree-map a? b?)
(lambda (f t)
(type-case (tree a?) t
[
(leaf x)
((leaf b?) (f x))
][
(branch left right)
((branch b?)
((tree-map a? b?) f left)
((tree-map a? b?) f right))
])))
;; Parametric tree-size
;; tree-size :: a? -> (Tree a -> Integer)
(define (tree-size a?)
(lambda (t)
(type-case (tree a) t
[
(leaf x) 1
][
(branch left right)
(+ ((tree-size a?) left)
((tree-size a?) right))
])))
;; etc.
)
4=2E A sketch of modularized Integer-Tree
The parameterized Tree from the module-Tree can be further specialized
by partially applying functions of the former to the type predicate
integer? (in most cases) or integer? integer? in case of tree-map.
(my-module module-integer-tree
(provide:
tree ;; Integer-Tree
tree? ;; a -> Bool
Leaf ;; Integer -> Integer-Tree
Branch ;; Integer-Tree -> Integer-Tree -> Integer-Tree
tree-height ;; Integer-Tree -> Integer
tree-size ;; Integer-Tree -> Integer
tree-map ;; (Integer -> Integer) -> Integer-Tree -> Integer-Tree
fringe ;; Integer-Tree -> Integer-List
scale-tree ;; Integer -> Integer-Tree -> Integer-Tree
tree->list ;; Integer-Tree -> Integer-S-expression
leaf-sum ;; Integer-Tree -> Integer
)
(require:
(module-tree
(tree parametric-tree)
(tree? parametric-tree?)
(leaf parametric-leaf)
(branch parametric-branch)
(tree-height parametric-tree-height)
(tree-size parametric-tree-size)
(tree-map parametric-tree-map)
(fringe parametric-fringe)
(tree->list parametric-tree->list)
))
(define tree (parametric-tree integer?))
(define tree? (parametric-tree? integer?))
(define Leaf (parametric-leaf integer?))
(define Branch (parametric-branch integer?))
(define tree-height (parametric-tree-height integer?))
(define tree-size (parametric-tree-size integer?))
(define tree-map (parametric-tree-map integer? integer?))
(define fringe (parametric-fringe integer?))
(define tree->list (parametric-tree->list integer?))
(define-syntax* type-case (from module-datatype type-case))
;; Sum of values stored in tree leaves
(define (leaf-sum t)
(type-case (parametric-tree integer?) t
((leaf datum) datum)
((branch left right)
(+ (leaf-sum left) (leaf-sum right)))))
(define (scale-tree factor t)
(type-case (parametric-tree integer?) t
((leaf datum) (Leaf (* factor datum)))
((branch left right)
(Branch (scale-tree factor left) (scale-tree factor right)))))
;; etc.
)
5=2E Porting issues
There are basically three porting issues of module-datatype, easily
fixable:
1=2E Transformers 'datatype and 'type-case can be directly converted
to syntax by replacing 'define by 'define-syntax.
2=2E In addition, the transformers refer to helper functions via a
construct
like this:
(from module-datatype a-helper)
Replace (from module-datatype a-helper) by a-helper.
3=2E The module-datatype imports several functions from other modules
defined in my environment:
any->string
every
duplicates
=E2=89=A3
For your convenience this code is copied at the bottom of this page.
To port examples in module-tree and module-integer-tree few choices are
available - depending whether you wish to use host modules or stick to
the top level. For example, the 'datytype and 'type-case macros can
be made visible within the top level, or hidden as in original design.
In either case, just follow the advice given above.
References:
[1] Daniel P. Friedman, Mitchell Wand, Christopher T. Haynes
Essentials of programming languages, second edition
[2] Shriram Krishnamurthi, Programming Languages: Application
and Interpretation
[3] Gary T. Leavens, Curtis Clifton, and Brian Dorn,
A Type Notation for Scheme
[4] Message from Andre van Tonder to comp.lang.scheme,
'Typeclass envy', Feb 13 2004, 12:25 pm
[5] Paul Hudak, The Haskell School of Expression
;; IMPLEMENTATION
#|
file: "define-type.scm"
author: "Jan Skibinski"
contact: [: base-64 translate-string: "asO5dz16cWndz16YGfbh07F2Pft"
to: ascii]
copyright: at the bottom of the page
version: 0.1
description:
|#
(my-module module-datatype
(provide:
;; Transformers
datatype ;; (datatype (type parameter ...)
;; [variant (arg predicate) ...] ...)
type-case ;; (type-case (type parameter ...) object
;; [(variant arg ...) expression] ...)
;; Datatype queries
datatype? ;; a -> Bool
type-name ;; Datatype -> Symbol
type-variants ;; Datatype -> List Symbol
type-predicate ;; Datatype -> (a -> Bool)
constructor ;; Datatype -> Symbol -> Constructor
;; Helpers referenced by the transformers
datatype-static-validate ;; static validator
type-case-static-validate ;; static validator
type-case-dynamic-validate ;; dynamic validator
)
(require:
(macro-support any->string)
(module-hof every duplicates)
(module-set =E2=89=A3)
)
;; True if object represents datatype
;; (datatype? (tree symbol?)) =3D=3D> #t
(define (datatype? object)
(and
(list? object)
(if (assq 'datatype object) #t #f)
))
;; Type name stored in datatype
;; example: (type-name (tree symbol?)) =3D=3D> tree
(define (type-name datatype)
(cadr (assq 'datatype datatype)))
;; An associative list of type constructors stored in datatype
;; example: (type-constructors (tree symbol?))
;; =3D=3D>((leaf . #<procedure> ) (branch . #<procedure> ))
(define (type-constructors datatype)
(cdr (assq 'type-constructors datatype)))
;; A datatype predicate stored in datatype
;; example: (type-predicate (tree symbol?)) =3D=3D> #<procedure>
(define (type-predicate datatype)
(cadr (assq 'type-predicate datatype)))
;; A list of variant names stored in datatype
;; example: (type-variants (tree symbol?)) =3D=3D> (leaf branch)
(define (type-variants datatype)
(cdr (assq 'type-variants datatype)))
;; A constructor for datatype variant
;; example: (constructor (tree symbol?) 'leaf)
(define (constructor datatype selector)
(define (error* . items)
(error 'constructor
(any->string items)))
(cond
[
(not (datatype? datatype))
(error* datatype "is not a datatype")
][
(not (symbol? selector))
(error* selector "is not a symbol")
][
(not (assq selector (type-constructors datatype)))
(error*
selector
"is not valid variant selector for"
(type-name datatype) "datatype."
"Valid selectors are"
(type-variants datatype)
)
][
else
(cdr (assq selector (type-constructors datatype)))
]))
;; Transformer datatype
;; Defines new type with at least one named variant. This effectively
;; produces a structure with encoded information, such as datatype
;; name, its predicate, list of variant names and an associative list
;; of variant names coupled with constructor procedures.
(define (datatype stx)
(syntax-case stx ()
[
;; Start clause
(datatype (type parm ...) (name (field field?) ...) ...)
(syntax (datatype "test" (type parm ...)
((name (field field?) ...) ...) (name ...)))
][
(datatype "test" (type parm ...)
((name (field field?) ...) ...) variants)
((from module-datatype datatype-static-validate)
(syntax-object->datum (syntax type))
(syntax-object->datum (syntax variants)))
(syntax
(lambda (parm ...)
(list
(list 'datatype 'type 'parm ...)
(list 'type-predicate
(lambda (object)
(and
(pair? object)
(eq? (car object) 'type))))
(cons 'type-variants 'variants)
(list 'type-constructors
(cons 'name
(lambda (field ...)
(define (error* x)
(error 'type (string-append
"violated contract in the "
(symbol->string x) " field")))
(cond
[
(not (field? field))
(error* 'field)
]
...
[
else
(cons 'type
(lambda variants
(name field ...)))
]))) ...)))
)
]))
(define (datatype-static-validate type variants)
(define (error* . items)
(error 'datatype
(any->string items)))
(cond
[
(not (symbol? type))
(syntax (error* "type name:" type "is not an identifier"))
][
(null? variants)
(syntax (error* "set of variants:" variants "is empty"))
][
(not (every symbol? variants))
(syntax (error* "some members of variants:" variants
"are not identifiers"))
][
(member type variants)
(syntax (error* "type:" type
"is equal to one of its variants:" variants))
][
(not (null? (duplicates variants)))
(syntax (error* "variants:" variants "contain duplicates"))
][
else #t
]))
;; Transformer type-case.
;; Deconstructs an object constructed by one of the
;; constructors of the specified type. Accepts a known type, a holder
;; for an object of such type, and a sequence of clauses for each
;; variant of the type.
(define (type-case stx)
(syntax-case stx ()
[
(type-case (type parm ...) object [(name field ...) exp] ...)
(syntax
(type-case "test" (type parm ...) object
[(name field ...) exp] ... (name ...)))
][ ;; Testing internal consistency of the type-case form
(type-case "test" (type parm ...) object
[(name field ...) exp] ... variants)
((from module-datatype type-case-static-validate)
(syntax-object->datum (syntax type))
(syntax-object->datum (syntax object))
(syntax-object->datum (syntax (parm ...)))
(syntax-object->datum (syntax variants)))
(syntax
(if ((from module-datatype type-case-dynamic-validate)
(type parm ...) object 'type 'variants)
((cdr object) (lambda (field ...) exp) ...)
))
]))
(define (type-case-static-validate type object parms variants)
(define (error* . items)
(error 'type-case
(any->string items)))
(cond
[
(not (symbol? object))
(syntax (error* "object:" object "is not an identifier"))
][
(not (symbol? type))
(syntax (error* "type:" type "is not an identifier"))
][
(not (every symbol? parms))
(syntax (error* "some of the parameters in" parms
"are not identifiers"))
][
(null? variants)
(syntax (error* "set of variants is empty"))
][
(not (every symbol? variants))
(syntax (error* "some of the variants in" variants
"are not identifiers"))
][
(member type variants)
(syntax (error* "type:" type
"is equal to one of its variants" variants))
][
(not (null? (duplicates variants)))
(syntax (error* "variants:" variants "contain duplicates"))
][
else #t
]))
(define (type-case-dynamic-validate datatype object type-name
maybe-variants)
(define (error* . items)
(error 'type-case
(any->string items)))
(if (not (datatype? datatype))
(error* type-name "is not a datatype")
(let ((variants (type-variants datatype)))
(cond
[
(not ((type-predicate datatype) object))
(error* "object" object
"is not of the type" type-name)
][
(not (equal? variants maybe-variants))
(cond
[
(not (=E2=89=A3 variants maybe-variants))
(error*
"set of type-case variants"
maybe-variants
"is not exactly equivalent to"
"the set of type variants"
variants
"of the datatype"
type-name)
][
else
(error*
"type-case variants"
maybe-variants
"are not ordered exactly as type variants"
variants )
])
][
else #t
]))))
)
;(run module-tree)
;;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3
D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
;; module-tree
;; Example of a parametricly polymorphic datatype
;; data Tree a =3D Leaf a | Branch (Tree a) (Tree a)
;; In what follows, the following shortcut is employed:
;; a? =3D=3D> (a -> Bool)
;;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3
D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
(my-module module-tree
(provide:
datatype? ;; a -> Bool
tree ;; a? -> Tree a
tree? ;; a? -> (b -> Bool)
leaf ;; a? -> (a -> Tree a)
branch ;; a? -> (Tree a -> Tree a -> Tree a)
tree-height ;; a? -> (Tree a -> Integer)
tree-size ;; a? -> (Tree a -> Integer)
tree-map ;; a? -> b? -> ((a -> b) -> Tree a -> Tree b)
fringe ;; a? -> (Tree a -> List a)
tree->list ;; a? -> (Tree a -> S-expression a)
)
(require:
(module-datatype
datatype?
type-predicate
constructor
))
(define-syntax* datatype (from module-datatype datatype))
(define-syntax* type-case (from module-datatype type-case))
;; Haskell style:
;; data Tree a =3D Leaf a | Branch (Tree a) (Tree a)
;;
;; Parametric tree
;; tree :: a? -> Tree a
(define tree
(datatype (tree a?)
[
leaf (datum a?)
][
branch (left (tree? a?)) (right (tree? a?))
]))
;; Parametric tree predicate
;; tree? :: a? -> (b -> Bool)
;; ((tree? symbol?) 3) =3D=3D> #f
;; ((tree? symbol?) ((leaf symbol?) 'hello))
(define (tree? a?) (type-predicate (tree a?)))
;; Parametric leaf constructor
;; leaf :: a? -> (a -> Tree a)
;; ((leaf symbol?) 'hello) =3D=3D> (tree . #<procedure> )
;; ((leaf symbol?) 12) =3D=3D> Error
(define (leaf a?)
(constructor (tree a?) 'leaf))
;; Parametric branch constructor
;; branch :: a? -> (Tree a -> Tree a -> Tree a)
;; ((branch symbol?) ((leaf symbol?) 'hello) ((leaf symbol?) 'world))
(define (branch a?)
(constructor (tree a?) 'branch))
;; Parametric tree-map
;; tree-map :: a? -> b? -> ((a -> b) -> Tree a -> Tree b)
;; ((tree-map symbol? string?) symbol->string a-tree)
(define (tree-map a? b?)
(lambda (f t)
(type-case (tree a?) t
[
(leaf x)
((leaf b?) (f x))
][
(branch left right)
((branch b?)
((tree-map a? b?) f left)
((tree-map a? b?) f right))
])))
;; Parametric tree->list (or rather tree to S-expression)
;; tree->list :: a? -> (Tree a -> S-expression a)
;; ((tree->list symbol?) a-tree)
(define (tree->list a?)
(lambda (t)
(type-case (tree a?) t
[
(leaf x) x
][
(branch x y)
(list ((tree->list a?) x) ((tree->list a?) y))
])))
;; Parametric tree->string
;; tree->string :: a? -> (Tree a -> String)
(define (tree->string a?)
(lambda (t)
(type-case (tree a?) t
[
(leaf x)
(string-append "(leaf " (any->string x) ")")
][
(branch x y)
(string-append "(branch "
((tree->string a?) x)
((tree->string a?) y) ")")
])))
;; Parametric fringe; that is, a list
;; whose elements are the leaves of the tree
;; arranged in left-to-right order.
;; fringe :: a? -> (Tree a -> List a)
;; ((fringe symbol?) a-tree)
(define (fringe a?)
(lambda(t)
(type-case (tree a?) t
((leaf x) (list x))
((branch left right)
(append
((fringe a?) left)
((fringe a?) right))))))
;; Parametric tree-height
;; tree-height :: a? -> (Tree a -> Integer)
(define (tree-height a?)
(lambda (t)
(type-case (tree a?) t
[
(leaf x) 0
][
(branch left right)
(+ 1 (max
((tree-height a?) left)
((tree-height a?) right)))
])))
;; Parametric tree-size
;; tree-size :: a? -> (Tree a -> Integer)
(define (tree-size a?)
(lambda (t)
(type-case (tree a?) t
[
(leaf x) 1
][
(branch left right)
(+ ((tree-size a?) left)
((tree-size a?) right))
])))
(run:
(tell*
(show
("Datatype (tree symbol?)" (tree symbol?))
("Example symbol tree" a-tree)
("Symbol tree to string" (st->string a-tree))
("Fringe of a tree" (st-fringe a-tree ))
("Map symbol tree to number tree then make a list"
(nt->list (snt-map symbol->number a-tree)))
("Tree height" (st-height a-tree))
("Tree size" (st-size a-tree))
)
where
(st-branch (branch symbol?))
(st-leaf (leaf symbol?))
(st->list (tree->list symbol?))
(st->string (tree->string symbol?))
(nt->list (tree->list number?))
(st-fringe (fringe symbol?))
(st-height (tree-height symbol?))
(st-size (tree-size symbol?))
(symbol->number (lambda(x)(string-length
(symbol->string x))))
(snt-map (tree-map symbol? number?))
(a-tree (st-branch
(st-branch
(st-leaf 'hello)
(st-leaf 'from)
)
(st-branch
(st-leaf 'nested)
(st-leaf 'world)
)))
)))
;;(run module-tree)
;; Module-integer-tree
;; Specialization and simplification of module-tree
;;
;; In Haskell notation: this module specializes this datatype
definition:
;; data Tree a =3D Leaf a | Branch (Tree a) (Tree a)
;; to this one:
;; data Tree Integer =3D Leaf Integer
;; | Branch (Tree Integer) (Tree Integer)
;; or to what can be simplified as:
;; data Integer-Tree =3D Leaf Integer
;; | Branch Integer-Tree Integer-Tree
(my-module module-integer-tree
(provide:
tree ;; Integer-Tree
tree? ;; a -> Bool
Leaf ;; Integer -> Integer-Tree
Branch ;; Integer-Tree -> Integer-Tree -> Integer-Tree
tree-height ;; Integer-Tree -> Integer
tree-size ;; Integer-Tree -> Integer
tree-map ;; (Integer -> Integer) ->
;; Integer-Tree -> Integer-Tree
fringe ;; Integer-Tree -> Integer-List
scale-tree ;; Integer -> Integer-Tree -> Integer-Tree
tree->list ;; Integer-Tree -> Integer-S-expression
leaf-sum ;; Integer-Tree -> Integer
)
(require:
(module-tree
(tree parametric-tree)
(tree? parametric-tree?)
(leaf parametric-leaf)
(branch parametric-branch)
(tree-height parametric-tree-height)
(tree-size parametric-tree-size)
(tree-map parametric-tree-map)
(fringe parametric-fringe)
(tree->list parametric-tree->list)
))
(define tree (parametric-tree integer?))
(define tree? (parametric-tree? integer?))
(define Leaf (parametric-leaf integer?))
(define Branch (parametric-branch integer?))
(define tree-height (parametric-tree-height integer?))
(define tree-size (parametric-tree-size integer?))
(define tree-map (parametric-tree-map integer? integer?))
(define fringe (parametric-fringe integer?))
(define tree->list (parametric-tree->list integer?))
(define-syntax* type-case (from module-datatype type-case))
;; Sum of values stored in tree leaves
(define (leaf-sum t)
(type-case (parametric-tree integer?) t
((leaf datum) datum)
((branch left right)
(+ (leaf-sum left) (leaf-sum right)))))
(define (scale-tree factor t)
(type-case (parametric-tree integer?) t
((leaf datum) (Leaf (* factor datum)))
((branch left right)
(Branch
(scale-tree factor left)
(scale-tree factor right)))))
(run:
(tell
(show
("Tree definition" tree)
("Tree to list" (tree->list a-tree))
("Fringe of a tree" (fringe a-tree))
("Tree height" (tree-height a-tree))
("Tree size" (tree-size a-tree))
("Sum of leaves" (leaf-sum a-tree))
("Scale tree" (tree->list (scale-tree 10 a-tree)))
("Scale tree via mapping" (tree->list
(tree-map (=E2=8C=98 * 10) a-tree)))
("Map tree to string tree" (tree->list
((parametric-tree-map integer? string?)
number->string a-tree)))
)
where
(a-tree
(Branch
(Branch
(Leaf 11)
(Branch
(Leaf 121)
(Leaf 122)
)
)
(Branch
(Leaf 21)
(Leaf 22)
)))
))
)
;; (run module-integer-tree)
;; ((from module-integer-tree Leaf) 13)
#|
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D Copy of code imported from other mo=
dules =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
3D=3D=3D
;; Function (any->string any)
;; Converts any object to a string. Handles standard Scheme objects,
;; such as strings, symbols, numbers, lists, booleans, pairs, vectors;
;; our OO objects from the module "object"; and the objects from
;; the "define-type" module.
(define (any->string u)
(define (intersperse delimiter xs)
(cond
((<=3D (length xs) 1) xs)
(else (cons (car xs)
(cons delimiter (intersperse delimiter (cdr xs)))))))
(cond
((string? u) u)
((symbol? u) (symbol->string u))
((number? u) (number->string u))
((boolean? u) (if #t "true" "false"))
((char? u) (string u))
;((object? u) (: u as-string))
((list? u) (string-append "("
(apply string-append
(intersperse " "
(map any->string u))) ")"))
((pair? u) (string-append "("
(any->string (car u))
" . "
(any->string (cdr u))
")"))
((vector? u) (string-append "#"
(any->string (vector->list u))))
((procedure? u) "#<procedure>")
((port? u) "#<port>")
(else (error u "Unsupported any->string conversion"))
))
;; Does every member of the list satisfy the pred?
;; every :: (a -> boolean) -> (List a) -> boolean
(define (every pred? list)
(or (null? list)
(and (pair? list)
(pred? (car list))
(every pred? (cdr list)))))
;; A list of duplicates found in list xs
;;(duplicates '(1 3 1 2 5 2)) =3D=3D> (1 2)
(define (duplicates xs)
(define (collect xs zs)
(cond
((null? xs) (reverse zs))
((member (car xs) zs) (collect (cdr xs) zs))
((member (car xs) (cdr xs))
(collect (cdr xs) (cons (car xs) zs)))
(else (collect (cdr xs) zs))))
(collect xs '()))
;; (=E2=89=A3 xs ys)
;; True if two sets xs and ys are equal (strictly equivalent)
;; (=E2=89=A3 '(1 2) '(1 2)) =3D=3D> #t
;; =E2=89=A3 :: Set a =E2=86=92 Set a =E2=86=92 boolean ;;;(=E2=89=A3 is U=
nicode 2263)
(define (=E2=89=A3 xs ys)
(define (=E2=8A=86 xs ys)
(every (lambda(y) (member y ys)) xs))
(and (=E2=8A=86 xs ys) (=E2=8A=86 ys xs)))
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
Copyright (C) Jan Skibinski (2006). All Rights Reserved.
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|#
|