[nem-pl] status
olszta at tey.pl
olszta at tey.pl
Mon Nov 10 14:36:36 CET 2003
Hej,
poprawilem komplikator, zeby dzialal pod Windami -- ten co sciagnalem
w piatek bardzo usilnie chce przypisac null do boola, poprawka polega
na odcinaniu kodu po kazdym CE_RAISE.
Poza tym sprobuje dodac asercje i ew. cos pomyslec o dostepie do klas
z frameworku.
Ciagle bez internetu, od znajomych wysylam to ;-(
Pozdro
Pawel
-------------- next part --------------
(*
* Copyright (c) 2003 The University of Wroclaw.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the University may not be used to endorse or promote
* products derived from this software without specific prior
* written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
* NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
* PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
* LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
open Nemerle.Collections;
open Nemerle.Compiler;
open Nemerle.Compiler.Tyops;
open Nemerle.Compiler.Typedtree;
namespace Nemerle.Compiler {
module CGflat {
// string in tree for fast concatenation
variant String_tree {
| ST_leaf { data : string; }
| ST_node { left : String_tree; right : String_tree; }
}
variant CS_code {
| CS_simple { val : String_tree; }
| CS_complex { pre : String_tree; val : String_tree; }
}
is_complex (c : CS_code) : bool {
match (c) { CS_complex => true | _ => false }
}
add_st (s1 : String_tree, s2 : String_tree) : String_tree
{ ST_node (s1, s2) }
add_st (s1 : string, s2 : String_tree) : String_tree
{ ST_node (ST_leaf (s1), s2) }
add_st (s1 : String_tree, s2 : string) : String_tree
{ ST_node (s1, ST_leaf (s2)) }
`++` (s1 : String_tree, s2 : String_tree) : String_tree =
extern "Nemerle.Compiler.CGflat.add_st";
`++` (s1 : string, s2 : String_tree) : String_tree =
extern "Nemerle.Compiler.CGflat.add_st";
`++` (s1 : String_tree, s2 : string) : String_tree =
extern "Nemerle.Compiler.CGflat.add_st";
class_type (c : CM_class) : CG_type
{ CT_ref (c.ns + c.name) }
csref (c : CS_code) : String_tree {
match (c) {
| CS_simple (s) => s
| CS_complex (_, s) => s
}
}
mono (e : CS_code, rf : String_tree) : CS_code {
match (e) {
| CS_simple (_) => CS_simple (rf)
| CS_complex (p, _) => CS_complex (p, rf)
}
}
tmp () : string
{ "_N_t" + string_of_int (Util.next_id ()) }
is_dummy_type (t : CG_type) : bool {
match (t) {
| CT_void => true
| CT_unreached => true
| _ => false
}
}
st_concat (sep : string, nodes : list (String_tree)) : String_tree {
match (nodes) {
| Nil => ST_leaf ("")
| Cons (x, Nil) => x
| Cons (x, xs) => x ++ sep ++ st_concat (sep, xs)
}
}
s_concat (sep : string, nodes : list (string)) : String_tree {
match (nodes) {
| Nil => ST_leaf ("")
| Cons (x, xs) => ST_leaf (x) ++ sep ++ s_concat (sep, xs)
}
}
flat_ty (t : CG_type) : String_tree
{
def s =
match (t) {
| CT_ref (n) => n
| CT_void => "void"
| CT_object => "object"
| CT_bool => "bool"
| CT_unreached => "unreached"
| CT_tuple (n) => "Nemerle.Tuple" + string_of_int (n)
| CT_fun (n) => "Nemerle.Func" + string_of_int (n)
};
ST_leaf (s);
}
operator_name (_ : string) : string =
extern "Nemerle.Compiler.CS_glue.operator_name";
// only for short strings (like function name)
st_flatten (s : String_tree) : string {
match (s) {
| ST_leaf (x) => x
| ST_node (l, r) => st_flatten (l) + st_flatten (r)
}
}
flat_call (pref : String_tree, es : list (CG_expr)) : CS_code
{
def es' = List.map (flat, es);
def (pre, es) =
if (List.exists (is_complex, es')) {
mutable pre <- ST_leaf ("");
def f (x : CG_expr, fx : CS_code) : CS_code
{
def (p, r) = make_complex (fx);
def n = tmp ();
def df = flat_ty (type_of (x)) ++ " " ++ n ++ " = " ++ r ++ ";\n";
pre <- pre ++ p ++ df;
CS_simple (ST_leaf (n))
}
// r needs to be in def, since computing it triggers pre update
def r = List.map2 (f, es, es');
(Some (pre), r)
} else (None (), es');
def opname = operator_name (st_flatten (pref));
def body =
if (opname == "")
pref ++ "(" ++ st_concat (", ", List.map (csref, es)) ++ ")"
else
match (List.map (csref, es)) {
| Cons (e1, Cons (e2, Nil)) =>
"(" ++ e1 ++ " " ++ opname ++ " " ++ e2 ++ ")"
| Cons (e, Nil) =>
"(" + opname + " " ++ e ++ ")"
| _ => Util.ice ()
};
match (pre) {
| None => CS_simple (body)
| Some (x) => CS_complex (x, body)
};
}
make_complex (ex : CS_code) : String_tree * String_tree {
match (ex) {
| CS_complex (x, y) => (x, y)
| CS_simple (x) => (ST_leaf (""), x)
}
}
quote (s : string) : string =
extern "Nemerle.Compiler.CS_glue.quote";
is_raise (ex : CG_expr) : bool {
match (ex) {
| CE_raise (_) => true
| CE_sequence (seq) => List.exists (is_raise, seq)
| _ => false
}
}
pretty_print_list (exs : list(CG_expr), acc : string) : string {
match (exs) {
| Nil => acc
| Cons (ex, rest) => pretty_print_list (rest, acc + pretty_print (ex))
}
}
pretty_print (ex : CG_expr) : string {
match (ex) {
| CE_ref (decl) => "CE_ref; "
| CE_global_ref (decl) => "CE_global_ref; "
| CE_ctor_ref (klass) => "CE_ctor_ref; "
| CE_field_ref (obj, fld) => "CE_field_ref; "
| CE_method_ref (obj, meth) => "CE_method_ref; "
| CE_tuple_ref (obj, pos) => "CE_tuple_ref; "
| CE_call (func, parms) => "CE_call; "
| CE_assign (target, source) =>
pretty_print (target) + " = " + pretty_print (source) + "; "
| CE_let (name, body) =>
"let " + name.name + " = " + pretty_print (name.val) + " in " + pretty_print (body) + "; "
| CE_has_type (expr, ty) => "CE_has_type; "
| CE_raise (exn) => "CE_raise; "
| CE_if (ty, cond, e_then, e_else) =>
"if (" + pretty_print (cond) + ") " + pretty_print (e_then) + " else " + pretty_print (e_else) + "; "
| CE_true => "CE_true; "
| CE_false => "CE_false; "
| CE_try_with => "CE_try_with; "
| CE_try_finally => "CE_try_finally; "
| CE_literal => "CE_literal; "
| CE_this => "CE_this; "
| CE_skip => "CE_skip; "
| CE_cast (expr, ty) => "CE_cast; "
| CE_sequence (body) => "{ " + pretty_print_list (body, "") + " }; "
| CE_tuple_ctor (exprs) => "CE_tuple_ctor; "
| CE_none => "CE_none"
}
}
flat (ex : CG_expr) : CS_code {
match (ex) {
| CE_ref (d) => CS_simple (ST_leaf (d.name))
| CE_global_ref (m) =>
def n = if (m.extern_name != "") m.extern_name else m.name;
CS_simple (ST_leaf (n))
| CE_field_ref (e, f) =>
def e = flat (e);
mono (e, csref (e) ++ "." ++ f.name)
| CE_tuple_ref (e, n) =>
def e = flat (e);
mono (e, csref (e) ++ ".field" ++ string_of_int (n + 1))
| CE_call (e, es) =>
match (flat (e)) {
| CS_simple (s) => flat_call (s, es)
| _ => Util.ice ()
}
| CE_assign (e1, e2) =>
def (p1, r1) = make_complex (flat (e1));
def (p2, r2) = make_complex (flat (e2));
CS_complex (p1 ++ p2, r1 ++ " = " ++ r2)
| CE_let (v, e) =>
match (v.val) {
| CE_none =>
def (p, r) = make_complex (flat (e));
CS_complex (flat_ty (v.ty) ++ " " ++ v.name ++ ";\n" ++ p, r)
| _ =>
def (p, r) = make_complex (flat (v.val));
def pref =
if (is_dummy_type (v.ty))
p ++ side_effect_run (r)
else
p ++ flat_ty (v.ty) ++ " " ++ v.name ++ " = " ++ r ++ ";\n";
def (p, r) = make_complex (flat (e));
CS_complex (pref ++ p, r)
}
| CE_has_type (e, t) =>
def e = flat (e);
mono (e, "(" ++ csref (e) ++ " is " ++ flat_ty (t) ++ ")")
| CE_raise (x) =>
def (p, r) = make_complex (flat (x));
CS_complex (p ++ "throw " ++ r ++ ";\n", ST_leaf ("null"))
(*
| CE_if (_, CE_true, e, _) =>
Message.debug ("In if (true), subexpr is: " + pretty_print (e));
flat (e)
| CE_if (_, CE_false, _, e) =>
Message.debug ("In if (false), subexpr is: " + pretty_print (e));
flat (e)
*)
(* NOTE:pawel:08/11/2003: added code to skip unnecessary (and sometimes
compilation breaking) tmpname assignments after throw, see is_raise *)
| CE_if (t, c, e1', e2') =>
def (p1, c) = make_complex (flat (c));
def (p2, e1) = make_complex (flat (e1'));
def (p3, e2) = make_complex (flat (e2'));
if (is_dummy_type (t))
CS_complex (p1 ++
"if (" ++ c ++ ") {\n" ++
p2 ++
side_effect_run (e1) ++
"} else {\n" ++
p3 ++
side_effect_run (e2) ++
"}\n", ST_leaf ("null"))
else {
def tmpname = tmp ();
def df = flat_ty (t) ++ " " ++ tmpname ++ ";\n";
CS_complex (p1 ++ df ++
"if (" ++ c ++ ") {\n" ++
(if (is_raise (e1')) p2 else (p2 ++ tmpname ++ " = " ++ e1 ++ ";\n")) ++
"} else {\n" ++
(if (is_raise (e2')) p3 else (p3 ++ tmpname ++ " = " ++ e2 ++ ";\n")) ++
"}\n", ST_leaf (tmpname))
}
| CE_true => CS_simple (ST_leaf ("true"))
| CE_false => CS_simple (ST_leaf ("false"))
| CE_try_with (e1', v, e2') =>
def (p1, e1) = make_complex (flat (e1'));
def (p2, e2) = make_complex (flat (e2'));
def t = type_of (e1');
if (is_dummy_type (t))
CS_complex ("try {\n" ++
p1 ++
side_effect_run (e1) ++
"} catch (" ++ flat_ty (v.ty) ++ " " ++ v.name ++ ") {\n" ++
p2 ++
side_effect_run (e2) ++
"}\n", ST_leaf ("null"))
else {
def tmpname = tmp ();
def df = flat_ty (t) ++ " " ++ tmpname ++ ";\n";
CS_complex (df ++
"try {\n" ++
p1 ++
tmpname ++ " = " ++ e1 ++ ";\n" ++
"} catch (" ++ flat_ty (v.ty) ++ " " ++ v.name ++ ") {\n" ++
p2 ++
tmpname ++ " = " ++ e2 ++ ";\n" ++
"}\n", ST_leaf (tmpname))
}
| CE_try_finally (e1', e2') =>
def (p1, e1) = make_complex (flat (e1'));
def (p2, e2) = make_complex (flat (e2'));
def t = type_of (e1');
if (is_dummy_type (t))
CS_complex ("try {\n" ++
p1 ++
side_effect_run (e1) ++
"} finally {\n" ++
p2 ++
side_effect_run (e2) ++
"}\n", ST_leaf ("null"))
else {
def tmpname = tmp ();
def df = flat_ty (t) ++ " " ++ tmpname ++ ";\n";
CS_complex (df ++
"try {\n" ++
p1 ++
tmpname ++ " = " ++ e1 ++ ";\n" ++
"} finally {\n" ++
p2 ++
side_effect_run (e2) ++
"}\n", ST_leaf (tmpname))
}
| CE_literal (l) =>
def s =
match (l) {
| L_void => "null"
| L_null => "null"
| L_int (k) => string_of_int (k)
| L_string (s) => "\"" + quote (s) + "\""
| L_float (v) => Util.ice ("FIXME: cgfloat")
};
CS_simple (ST_leaf (s))
| CE_this => CS_simple (ST_leaf ("this"))
| CE_skip => CS_simple (ST_leaf ("null"))
| CE_cast (e, CT_void) => flat (e) // C# doesn't like (void)foo
| CE_cast (e, t) =>
def e = flat (e);
mono (e, "((" ++ flat_ty (t) ++ ")" ++ csref (e) ++ ")")
| CE_sequence (Nil) => CS_simple (ST_leaf ("null"))
| CE_sequence (body) =>
def cutoff_after_raise (e : list (CG_expr), acc : list (CG_expr)) : list (CG_expr) {
match (e) {
| Nil => acc
| Cons (CE_raise (expr), _) => List.append (acc, Cons (CE_raise (expr), Nil ()))
| Cons (expr, rest) => cutoff_after_raise (rest, List.append (acc, Cons (expr, Nil ())))
}
}
def serialize (e : CG_expr) : String_tree
{
def (pre, r) = make_complex (flat (e));
pre ++ side_effect_run (r)
}
def concat (acc : String_tree, es : list (CG_expr)) : CS_code {
match (es) {
| Cons (x, Nil) =>
def (pre, r) = make_complex (flat (x));
CS_complex (acc ++ pre, r)
| Cons (CE_skip, xs) =>
concat (acc, xs)
| Cons (x, xs) =>
concat (acc ++ serialize (x), xs)
| Nil => CS_simple (ST_leaf ("null"))
}
}
concat (ST_leaf (""), cutoff_after_raise (body, Nil ()))
| CE_tuple_ctor (es) =>
flat_call (ST_leaf ("new Nemerle.Tuple") ++ string_of_int (List.length (es)), es)
| CE_ctor_ref (c) =>
if (c.extern_name == "")
Util.ice ("empty extern name " + c.ns + ":" + c.name)
else
CS_simple (ST_leaf ("new " + c.extern_name))
| CE_method_ref (e, f) =>
def e = flat (e);
mono (e, csref (e) ++ "." ++ f.name)
| CE_none => Util.ice ()
}
}
type_of (ex : CG_expr) : CG_type {
match (ex) {
| CE_ref (d) => d.ty
| CE_global_ref (CM_field f) => f.ty
| CE_field_ref (_, f) => f.ty
| CE_tuple_ref => CT_object ()
| CE_call (CE_global_ref (CM_method m), _) => m.ret_type
| CE_call (CE_method_ref (_, m), _) => m.ret_type
| CE_call (CE_ctor_ref (c), _) => class_type (c)
| CE_call => Util.ice ()
| CE_assign => CT_void ()
| CE_let (_, b) => type_of (b)
| CE_has_type => CT_bool ()
| CE_raise (_) => CT_unreached ()
| CE_if (t, _, _, _) => t
| CE_true => CT_bool ()
| CE_false => CT_bool ()
| CE_try_with (e, _, _) => type_of (e)
| CE_try_finally (e, _) => type_of (e)
| CE_literal (l) =>
match (l) {
| L_void => CT_void ()
| L_null => CT_object ()
| L_int => CT_ref ("int")
| L_string => CT_ref ("string")
| L_float => CT_ref ("float")
}
| CE_this => CT_object () // cheat a bit
| CE_skip => CT_void ()
| CE_cast (_, t) => t
| CE_sequence (b) => type_of (List.last (b))
| CE_tuple_ctor (es) => CT_tuple (List.length (es))
// can't tell
| CE_none => Util.ice ()
// these are supported only as part of call
| CE_global_ref (CM_method) => Util.ice ()
| CE_ctor_ref => Util.ice ()
| CE_method_ref => Util.ice ()
}
}
write_string (s : string) : void = extern "CS_glue.write_string";
print_st (s : String_tree) : void {
match (s) {
| ST_leaf (d) => write_string (d)
| ST_node (l, r) => { print_st (l); print_st (r) }
}
}
side_effect_run (x : String_tree) : String_tree {
match (x) {
| ST_leaf (s) =>
if (s == "null") ST_leaf ("")
else x ++ ";\n"
| _ => x ++ ";\n"
}
}
flat_member (m : CG_member) : void {
match (m) {
| CM_class m =>
def k =
match (m.kind) {
| CK_class => "class"
| CK_struct => "struct"
| CK_interface => "interface"
};
def inh =
match (m.inheritance) {
| Nil => ST_leaf ("")
| _ => " : " ++ st_concat (", ", List.map (flat_ty, m.inheritance))
};
print_st (s_concat (" ", m.attrs) ++ " " ++ k ++
" " ++ m.name ++ inh ++ " {\n");
List.iter (flat_member, m.decls);
print_st (ST_leaf ("} // end of ") ++ k ++ " " ++ m.name ++ "\n")
| CM_field m =>
print_st (s_concat (" ", m.attrs) ++ " " ++ flat_ty (m.ty) ++
" " ++ m.name ++ ";\n")
| CM_method m =>
def mkparm (v : CG_val) : String_tree {
flat_ty (v.ty) ++ " " ++ v.name
}
def rett =
match (m.ret_type) {
| CT_unreached => ST_leaf ("")
| _ => flat_ty (m.ret_type)
};
print_st (s_concat (" ", m.attrs) ++ " " ++ rett ++ "\n" ++
m.name ++ "(" ++ st_concat (", ", List.map (mkparm, m.parms)) ++ ")");
match (m.body) {
| CE_none => print_st (ST_leaf (";\n"))
| _ =>
def (pref, r) = make_complex (flat (m.body));
def ret =
if (is_dummy_type (m.ret_type))
side_effect_run (r)
else
if (is_dummy_type (type_of (m.body)))
side_effect_run (r) ++ "return null;\n"
else
"return " ++ r ++ ";\n";
print_st ("\n{\n" ++
pref ++
ret ++
"} // end of fun " ++ m.name ++ "\n")
}
}
}
run (decls : list (CM_class)) : void
{
def flat_top_member (x : CM_class) : void {
if (x.ns != "") {
print_st (ST_leaf ("namespace " + CSglue.get_ns (x.ns) + " {\n"));
flat_member (x);
print_st (ST_leaf ("} // end ns\n"))
} else flat_member (x)
}
List.iter (flat_top_member, decls);
}
} // end module
} // end namespace
-------------- next part --------------
#
# Copyright (c) 2003 The University of Wroclaw.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# 3. The name of the University may not be used to endorse or promote
# products derived from this software without specific prior
# written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
# NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
include ../config.mak
lib_src = lib/core.n option.n list.n tree.n
n_src = \
$(lib_src) \
ast.n \
parsetree.n \
typedtree.n \
util.n \
csglue.n \
env.n \
passes.n \
scan_globals.n \
tyvars.n \
tyinfo.n \
tyutil.n \
extensions.n \
tyexpr.n \
cgtree.n \
cgexpr.n \
cgflat.n
cs_src = lexer.cs main.cs parser.cs
all_src = $(n_src) $(cs_src)
all_cs = out.cs $(cs_src)
NEFLAGS = --debug
CSFLAGS = /nowarn:162 -debug+
COMPILE = csc.exe $(CSFLAGS)
all: ncc.exe
# Do compiler bootstrap, compare results from stage2 and stage3,
# generate ncc3.exe binary to be put in release for bootstrap.
# Finally run testsuite.
boot: ncc.exe
rm -f out.cs
ncc.exe $(n_src)
$(COMPILE) -o ncc2.exe $(all_cs)
mv out.cs out2.cs
ncc2.exe $(n_src)
cmp -s out2.cs out.cs
$(COMPILE) -o ncc3.exe $(all_cs)
mv out.cs out3.cs
$(MAKE) testsuite
sync:
mv ../boot/ncc.exe ../boot/ncc-old.exe
cp ncc3.exe ../boot/ncc.exe
ncc.exe: $(all_src)
../boot/ncc.exe $(n_src)
$(COMPILE) /out:ncc.exe $(all_cs)
mv -f out.cs out1.cs
../config.mak:
$(MAKE) -C .. config.mak
.PHONY: t
t: testsuite
testsuite:
$(MAKE) -C t
parser.cs: parser.jay
jay -v -t -c parser.jay < `jay -p`/skeleton.cs > parser.cs
perl -p -i -e 's/(public void yyerror )/virtual $$1/' parser.cs
install: ncc.exe
if test ! -d $(BINDIR) ; then mkdir -p $(BINDIR) ; fi
$(INSTALL) -m 755 ncc.exe $(BINDIR)/ncc.exe
$(INSTALL) -m 755 ncc $(BINDIR)/ncc
clean:
rm -f out.cs out[0-9].cs parser.cs *.exe y.output
More information about the devel-pl
mailing list