And here is the final instalment of phase 1, which does the last
required calculation: mapping an index to a path, i.e. reverse
tree navigation.
You will notice the algorithm is very suboptimal for arrays,
and still not so hot even for tuple. The real Ocaml code doing
this in the compiler pre-calculates all the shape functions,
and handles arrays with multiply, add, divide and modulo,
rather than repeated additions.
So the next phase will be to look at optimisation,
and also enrich the typecode type a bit so it can
handle pointers, and perhaps recursion.
Also we may start integration by replacing the "Primitive"
constructor argument with an actual pointer to a Felix
RTTI object. Then, if we replace "array index' with
"byte array offset" we are doing raw address calculations.
Then to implement, say, copying an object, we know the size,
we know the primitive subobjects. but we cannot copy the
primitives .. because the RTTI object doesn't have a "slot"
for copy constructor. So we will add one!
Our trick in the end is to close the recursion, that is,
the typecode objects will not just link to the existing RTTI
objects .. they will BE the RTTI objects.
///////////////
// 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
;
fun subcomponent (t: typecode) (j:int) => component t (Choice j).list;
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;
// Now the tricky one: convert the sequence number back to a path.
// The method is easy enough. Start at the root, calculate the size
// of the first branch. If the index is less than that, the first
// path component is set to 0, and we go down the branch. If not,
// add on the size of the next path and repeat until the condition
// is satisfied.
//
// This is a typical code that requires a fast exit from a fold.
// So a nonfunctional code is better.
fun ix2path (t:typecode) (ix:int) : path =
{
fun aux (t:typecode) (var ix:int) (p:path) : path =
{
match t,ix with
| Primitive _, 0 => return rev p;
| _ =>
var choice = 0;
var t0 = subcomponent t choice;
var sz = pcount t0;
while ix >= sz do
++choice;
t0 = subcomponent t choice;
ix -= sz;
sz = pcount t0;
done
return aux t0 ix (Cons ((Choice choice), p));
endmatch;
}
return aux t ix Empty[selector];
}
for var ix in 0 upto 5 do
println$ "index=" + ix.str + ", path=" + (ix2path ex1 ix).str;
done
} // endclass
///////////////
--
john skaller
skal...@users.sourceforge.net
http://felix-lang.org
------------------------------------------------------------------------------
Master Visual Studio, SharePoint, SQL, ASP.NET, C# 2012, HTML5, CSS,
MVC, Windows 8 Apps, JavaScript and much more. Keep your skills current
with LearnDevNow - 3,200 step-by-step video tutorials by Microsoft
MVPs and experts. ON SALE this month only -- learn more at:
http://p.sf.net/sfu/learnmore_122712
_______________________________________________
Felix-language mailing list
Felix-language@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/felix-language
