Here is more code. You should run this code, then examine
it to understand it. All this code is beautiful purely functional code :)
There is one trick I will explain, very useful in functional code.
The tindex function returns the sequence number of an element
given a path, if the types are all the same, this is just the index
into the flattened array. It is, in fact, the compact linear representation
of the path.
The tindex function is quite simple. You add up all the
elements in the tree branches to the left of the chosen
one, then you add that the tindex of the chosen branch
with the tail of the path. the formula looks like:
return Sum(i=0,j-1) (pcount branch-i) + tindex branch-j path-tail
But there's a minor nastiness here: this formula isn't tail recursive.
The recursive call to tindex is inside the return expression.
To be a tail call, it must be right after the word "return".
So we do a trick:
// return the index position of a given path in a given type
fun tindex (t: typecode) (i:path) =
{
fun aux (t: typecode) (i:path) (index:int) =>
match t,i with
| Primitive _, Empty => index
| Tuple ?ts, Cons (Choice ?i, ?tail) =>
aux ts.i tail$
fold_left (fun (acc:int) (x:typecode) => acc + pcount x) index (take i
ts)
| Array (_,?t), Cons (Choice ?i,?tail) =>
aux t tail (index + pcount t * i)
endmatch
;
return aux t i 0;
We make a tail recursive function inside the main one,
and we add the return value as a parameter and pass
it DOWN the recursion until we bottom out, whence it gets
returned. Check in the "aux" function and see that the
recursive calls are all in tail position (right after the =>).
the index is returned when we bottom out (hit a primitive
and at the same time the path is Empty)
//////////////
// Type descriptors.
// First cut, doesn't handle recursion!
class Desc
{
union typecode =
| Primitive of string // for now, just the name of a primitive type eg "int"
etc
| Tuple of list[typecode] // a tuple of various types
| Array of int * typecode // an array
;
instance Str[typecode] {
fun str : typecode -> string =
| Primitive ?s => s
| Tuple Empty => "()"
| Tuple (Cons (?h, ?t)) =>
"(" +
fold_left (fun (acc:string) (x:typecode) => acc + "," + x.str) (h.str)
t
+ ")"
| Array (?n, ?t) => str t + "^" + Str::str n
;
}
// example:
var ex1 = Array (3, Tuple ( Primitive "int", Primitive "string").list );
println$ ex1;
union selector =
| Choice of int // pick one of the tree nodes
;
typedef path = list[selector];
// Return the component of type t designated by the given path
fun component (t: typecode) (i: path) =>
match t,i with
| ?t, Empty => t
// | Primitive _, _ => fail "ERROR" // fail doesn't unify properly at the
moment
| Tuple ?ts, Cons (Choice ?i, ?tail) => component ts.i tail
| Array (_,?t), Cons (Choice _, ?tail) => component t tail
endmatch
;
instance Str[selector] {
fun str: selector -> string =
| Choice ?i => i.str
;
}
// example:
var apath = (Choice 1).list;
println$ "Path="+ apath.str;
println$ "Component=" + str (component ex1 apath);
// Symbolic calculator
union formula =
| Int of int
| Psize of string
| Add of formula * formula
| Sub of formula * formula
| Mul of formula * formula
| Mod of formula * formula
| Div of formula * formula
| Neg of formula
;
// Math operations with some easy simplifications
fun fadd : formula * formula -> formula =
| Int ?x, Int ?y => Int (x+y)
| Int 0, ?y => y
| ?x, Int 0 => x
| ?x, ?y => Add (x,y)
;
fun fsub : formula * formula -> formula =
| Int ?x, Int ?y => Int (x - y)
| Int 0, ?y => Neg y
| ?x, Int 0 => x
| ?x, ?y => Sub (x,y)
;
fun fmul : formula * formula -> formula =
| Int ?x , Int ?y => Int (x * y)
| Int 0, ?y => Int 0
| ?x, Int 0 => Int 0
| Int 1, ?y => y
| ?x, Int 1 => x
| ?x, ?y => Mul (x,y)
;
fun fdiv : formula * formula -> formula =
| Int ?x , Int ?y => Int (x / y)
| Int 0, ?y => Int 0
| ?x, Int 1 => x
| ?x, ?y => Div (x,y)
;
fun fmod : formula * formula -> formula =
| Int ?x , Int ?y => Int (x % y)
| Int 0, ?y => Int 0
| ?x, Int 1 => Int 0
| ?x, ?y => Mod (x,y)
;
fun fneg : formula -> formula =
| Int ?x => Int (- x)
| Neg ?x => x
| ?x => Neg x
;
instance Str[formula] {
// precedence of a formula, higher is tighter binding, 100 is atom
fun precedence : formula -> int =
| Int _ => 100
| Psize _ => 100
| Add _ => 20
| Sub _ => 20
| Mul _ => 40
| Mod _ => 40
| Div _ => 40
| Neg _ => 80
;
// Emit pretty print of formula in a precedence context
fun paren (ctx:int) (sub:formula) =>
let ?s = rawstr sub in
if precedence sub < ctx
then "(" + s + ")"
else s
endif
;
// pretty print a formula
fun rawstr: formula -> string =
| Int ?i => i.str
| Psize ?t => "#" + t.str
| Add (?a,?b) => paren 20 a + "+" + paren 20 b
| Sub (?a,?b) => paren 20 a + "-" + paren 21 b
| Mul (?a,?b) => paren 40 a + "*" + paren 40 b
| Mod (?a,?b) => paren 40 a + "%" + paren 41 b
| Div (?a,?b) => paren 40 a + "/" + paren 41 b
| Neg ?a => "-" + paren 80 a
;
// virtual dispatch
fun str (x:formula) => rawstr x;
}
// Return a formula for the size of a type.
fun tsize : typecode -> formula =
| Primitive ?s => Psize s
| Tuple Empty => Int 0
| Tuple ?ts => fold_left (fun (acc:formula) (x:typecode) => fadd (acc,tsize
x)) (Int 0) ts
| Array (?n,?t) => fmul (Int n, tsize t)
;
// example
println$ "Symbolic Size of ex1=" + ex1.tsize.str;
// Return a count of the number of primitive elements in a type
fun pcount : typecode -> int =
| Primitive _ => 1
| Tuple Empty => 0
| Tuple ?ts => fold_left (fun (acc:int) (x:typecode) => acc + pcount x) 0 ts
| Array (?n,?t) => n * pcount t
;
println$ "Number of primitives in ex1=" + ex1.pcount.str;
// return the index position of a given path in a given type
fun tindex (t: typecode) (i:path) =
{
fun aux (t: typecode) (i:path) (index:int) =>
match t,i with
| Primitive _, Empty => index
| Tuple ?ts, Cons (Choice ?i, ?tail) =>
aux ts.i tail$
fold_left (fun (acc:int) (x:typecode) => acc + pcount x) index (take i
ts)
| Array (_,?t), Cons (Choice ?i,?tail) =>
aux t tail (index + pcount t * i)
endmatch
;
return aux t i 0;
}
println$ tindex ex1 (Choice 0, Choice 0).list;
println$ tindex ex1 (Choice 0, Choice 1).list;
println$ tindex ex1 (Choice 1, Choice 0).list;
println$ tindex ex1 (Choice 1, Choice 1).list;
println$ tindex ex1 (Choice 2, Choice 0).list;
println$ tindex ex1 (Choice 2, Choice 1).list;
} // endclass
//////////////
--
john skaller
skal...@users.sourceforge.net
http://felix-lang.org
------------------------------------------------------------------------------
Master Java SE, Java EE, Eclipse, Spring, Hibernate, JavaScript, jQuery
and much more. Keep your Java skills current with LearnJavaNow -
200+ hours of step-by-step video tutorials by Java experts.
SALE $49.99 this month only -- learn more at:
http://p.sf.net/sfu/learnmore_122612
_______________________________________________
Felix-language mailing list
Felix-language@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/felix-language
