[Nickle] nickle: Branch 'master' - 2 commits
Keith Packard
keithp at keithp.com
Sun Feb 26 16:33:20 PST 2012
compile.c | 29 ++++++++++
execute.c | 13 ++++
expr.c | 27 +++++++++
gram.y | 9 +++
lex.l | 2
nickle.h | 15 +++++
opcode.h | 2
test/Makefile.am | 3 -
test/is_type.5c | 29 ++++++++++
type.c | 151 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
value.h | 2
11 files changed, 279 insertions(+), 3 deletions(-)
New commits:
commit b1f691286f2aae54839a3b4e969d318e646c70c8
Author: Keith Packard <keithp at keithp.com>
Date: Mon Feb 27 13:28:08 2012 +1300
Typecheck switch expressions
Make sure switch expression and case expresssions are all type compatible.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/compile.c b/compile.c
index f648f8b..b2c2adf 100644
--- a/compile.c
+++ b/compile.c
@@ -3616,8 +3616,17 @@ _CompileStat (ObjPtr obj, ExprPtr expr, Bool last, CodePtr code)
{
if (c->tree.left->tree.left)
{
- if (expr->base.tag == SWITCH)
+ if (expr->base.tag == SWITCH) {
obj = _CompileExpr (obj, c->tree.left->tree.left, True, c, code);
+ if (!TypeCombineBinary(expr->tree.left->base.type, EQ,
+ c->tree.left->tree.left->base.type)) {
+ CompileError (obj, expr, "Incompatible types, left '%T', right '%T', for case comparison",
+ expr->tree.left->base.type,
+ c->tree.left->tree.left->base.type,
+ EQ);
+ expr->base.type = typePoly;
+ }
+ }
NewInst (obj, expr->base.tag == SWITCH ? OpCase : OpTagCase,
case_inst[icase], expr);
icase++;
commit d70e73e96b53142e4273565e63e10ebd2fa8d1d5
Author: Keith Packard <keithp at keithp.com>
Date: Mon Feb 27 12:32:52 2012 +1300
Add is_type and has_member built-ins
These provide the ability to do run-time type comparisons without
needing full introspection in the language.
Signed-off-by: Keith Packard <keithp at keithp.com>
diff --git a/compile.c b/compile.c
index c0c6c65..f648f8b 100644
--- a/compile.c
+++ b/compile.c
@@ -2975,6 +2975,18 @@ _CompileExpr (ObjPtr obj, ExprPtr expr, Bool evaluate, ExprPtr stat, CodePtr cod
}
expr->base.type = typePoly;
break;
+ case ISTYPE:
+ obj = _CompileExpr (obj, expr->type.left, evaluate, stat, code);
+ BuildInst (obj, OpIsType, inst, stat);
+ inst->isType.type = expr->type.type;
+ expr->base.type = typePrim[rep_bool];
+ break;
+ case HASMEMBER:
+ obj = _CompileExpr (obj, expr->tree.left, evaluate, stat, code);
+ BuildInst (obj, OpHasMember, inst, stat);
+ inst->atom.atom = expr->tree.right->atom.atom;
+ expr->base.type = typePrim[rep_bool];
+ break;
case EXPR:
/* reposition statement reference so top-level errors are nicer*/
obj = _CompileExpr (obj, expr->tree.left, evaluate, expr, code);
@@ -4626,6 +4638,12 @@ InstDump (InstPtr inst, int indent, int i, int *branch, int maxbranch)
case OpUnFunc:
FilePrintf (FileStdout, "%s", ObjUnFuncName (inst->unfunc.func));
break;
+ case OpIsType:
+ FilePrintf (FileStdout, "%T", inst->isType.type);
+ break;
+ case OpHasMember:
+ FilePrintf (FileStdout, "%A", inst->atom.atom);
+ break;
default:
break;
}
diff --git a/execute.c b/execute.c
index c127cb9..0354080 100644
--- a/execute.c
+++ b/execute.c
@@ -1386,6 +1386,19 @@ ThreadsRun (Value thread, Value lex)
case OpUnwind:
ThreadUnwind (thread, inst->unwind.twixt, inst->unwind.catch);
break;
+ case OpIsType:
+ value = ValueIsType(value, inst->isType.type) ? TrueVal : FalseVal;
+ break;
+ case OpHasMember:
+ if (ValueTag(value) != rep_struct)
+ value = FalseVal;
+ else {
+ if (StructMemType(value->structs.type, inst->atom.atom))
+ value = TrueVal;
+ else
+ value = FalseVal;
+ }
+ break;
case OpEnd:
SetSignalFinished ();
break;
diff --git a/expr.c b/expr.c
index 5e9e0f0..515f9b7 100644
--- a/expr.c
+++ b/expr.c
@@ -76,11 +76,25 @@ ExprDeclMark (void *object)
ed->expr.ticks = ed->expr.sub_ticks = 0;
}
+static void
+ExprTypeMark (void *object)
+{
+ ExprType *et = object;
+
+ MemReference (et->expr.namespace);
+ MemReference (et->expr.type);
+ MemReference (et->left);
+ MemReference (et->type);
+ if (!profiling)
+ et->expr.ticks = et->expr.sub_ticks = 0;
+}
+
DataType ExprTreeType = { ExprTreeMark, 0, "ExprTreeType" };
DataType ExprConstType = { ExprConstMark, 0, "ExprConstType" };
DataType ExprAtomType = { ExprAtomMark, 0, "ExprAtomType" };
DataType ExprCodeType = { ExprCodeMark, 0, "ExprCodeType" };
DataType ExprDeclType = { ExprDeclMark, 0, "ExprDeclType" };
+DataType ExprTypeType = { ExprTypeMark, 0, "ExprTypeType" };
static void
ExprBaseInit (Expr *e, int tag)
@@ -177,6 +191,19 @@ NewExprDecl (int tag, DeclListPtr decl, Class class, Type *type, Publish publish
RETURN (e);
}
+Expr *
+NewExprType (int tag, ExprPtr left, Type *type)
+{
+ ENTER ();
+ Expr *e;
+
+ e = ALLOCATE (&ExprTypeType, sizeof (ExprType));
+ ExprBaseInit (e, tag);
+ e->type.left = left;
+ e->type.type = type;
+ RETURN (e);
+}
+
/*
* LALR grammars like to build things right to left, but
* sometimes we like the resulting data structure to be left to right
diff --git a/gram.y b/gram.y
index d99bfc5..a0fa78a 100644
--- a/gram.y
+++ b/gram.y
@@ -155,6 +155,7 @@ ParseNewSymbol (Publish publish, Class class, Type *type, Atom name);
%token <value> COMMENT_CONST
%token <value> VOIDVAL BOOLVAL
%token DARROW
+%token ISTYPE HASMEMBER
%nonassoc POUND
%right COMMA
@@ -1474,6 +1475,14 @@ simpleexpr : simpleexpr assignop simpleexpr %prec ASSIGN
{ $$ = NewExprTree(OS, $1, $3); }
| simpleexpr OP opt_actuals CP %prec CALL
{ $$ = NewExprTree (OP, $1, $3); }
+ | ISTYPE OP simpleexpr COMMA type CP %prec CALL
+ {
+ TypePtr type = $5;
+ ParseCanonType (type, False);
+ $$ = NewExprType (ISTYPE, $3, type);
+ }
+ | HASMEMBER OP simpleexpr COMMA NAME CP %prec CALL
+ { $$ = NewExprTree (HASMEMBER, $3, NewExprAtom($5, 0, False)); }
| simpleexpr DOT NAME
{ $$ = NewExprTree(DOT, $1, NewExprAtom ($3, 0, False)); }
| simpleexpr ARROW NAME
diff --git a/lex.l b/lex.l
index 147ab45..91e2698 100644
--- a/lex.l
+++ b/lex.l
@@ -392,6 +392,8 @@ raise { yylval.ints = RAISE; return RAISE; }
protected { yylval.publish = publish_protected; return PROTECTED; }
public { yylval.publish = publish_public; return PUBLIC; }
extend { yylval.publish = publish_extend; return EXTEND; }
+is_type { yylval.ints = ISTYPE; return ISTYPE; }
+has_member { yylval.ints = HASMEMBER; return HASMEMBER; }
";" { yylval.ints = SEMI; return SEMI; }
"," { yylval.ints = COMMA; return COMMA; }
"$" { yylval.ints = DOLLAR; return DOLLAR; }
diff --git a/nickle.h b/nickle.h
index cab7f37..cd2aba0 100644
--- a/nickle.h
+++ b/nickle.h
@@ -249,6 +249,12 @@ typedef struct _exprDecls {
Publish publish;
} ExprDecl;
+typedef struct _exprType {
+ ExprBase expr;
+ ExprPtr left;
+ Type *type;
+} ExprType;
+
typedef union _expr {
ExprBase base;
ExprTree tree;
@@ -256,6 +262,7 @@ typedef union _expr {
ExprAtom atom;
ExprCode code;
ExprDecl decl;
+ ExprType type;
} Expr;
Expr *NewExprTree (int tag, Expr *left, Expr *right);
@@ -264,7 +271,7 @@ Expr *NewExprConst (int tag, Value val);
Expr *NewExprAtom (Atom atom, SymbolPtr symbol, Bool privateFound);
Expr *NewExprCode (CodePtr code, ExprPtr name);
Expr *NewExprDecl (int tag, DeclListPtr decl, Class class, Type *type, Publish publish);
-
+Expr *NewExprType (int tag, Expr *left, Type *type);
Expr *ExprRehang (Expr *expr, Expr *right);
@@ -529,6 +536,11 @@ typedef struct _instFarJump {
BranchMod mod;
} InstFarJump;
+typedef struct _instIsType {
+ InstBase inst;
+ TypePtr type;
+} InstIsType;
+
typedef union _inst {
InstBase base;
InstBox box;
@@ -554,6 +566,7 @@ typedef union _inst {
InstTagCase tagcase;
InstUnwind unwind;
InstFarJump farJump;
+ InstIsType isType;
} Inst;
/*
diff --git a/opcode.h b/opcode.h
index 9a329f0..8f7aa0c 100644
--- a/opcode.h
+++ b/opcode.h
@@ -83,6 +83,8 @@ typedef enum _OpCode {
OpAssign,
OpAssignOp,
OpAssignFunc,
+ OpIsType,
+ OpHasMember,
OpEnd,
OpDrop
} __attribute__ ((packed)) OpCode;
diff --git a/test/Makefile.am b/test/Makefile.am
index d0ccb6d..3a6dcce 100644
--- a/test/Makefile.am
+++ b/test/Makefile.am
@@ -11,7 +11,8 @@ check_SCRIPTS=\
signal.5c \
round.5c \
math.5c \
- factorial.5c
+ factorial.5c \
+ is_type.5c
noinst_PROGRAMS=math-tables
diff --git a/test/is_type.5c b/test/is_type.5c
new file mode 100644
index 0000000..222e921
--- /dev/null
+++ b/test/is_type.5c
@@ -0,0 +1,29 @@
+int errors = 0;
+
+void check (poly value, string type, bool got, bool want) {
+ if (got != want) {
+ printf ("is_type(%v, %s) = %v. should be %v\n",
+ value, type, got, want);
+ errors++;
+ }
+}
+
+typedef struct { string a; } super_type;
+typedef super_type + struct { string b; } sub_type;
+super_type super_value = { .a = "a value" };
+sub_type sub_value = { .a = "a value", .b = "b value" };
+
+check(super_value, "super_type", is_type(super_value, super_type), true);
+check(super_value, "sub_type", is_type (super_value, sub_type), false);
+check(sub_value, "super_type", is_type (sub_value, super_type), true);
+check(sub_value, "sub_type", is_type (sub_value, sub_type), true);
+
+real real_value = pi;
+real int_value = 12;
+
+check(real_value, "real", is_type (real_value, real), true);
+check(real_value, "int", is_type (real_value, int), false);
+check(int_value, "real", is_type (int_value, real), true);
+check(int_value, "int", is_type(int_value, int), true);
+
+exit (errors);
diff --git a/type.c b/type.c
index 33c77fc..3542854 100644
--- a/type.c
+++ b/type.c
@@ -1404,6 +1404,157 @@ TypeCompatibleAssign (TypePtr a, Value b)
return False;
}
+/*
+ * Check to see if 'b' is a subtype of 'a'
+ */
+
+Bool
+ValueIsType (Value b, TypePtr a)
+{
+ int adim, bdim;
+ int n;
+
+ if (!a || !b)
+ return True;
+
+ if (a->base.tag == type_types)
+ {
+ TypeElt *elt;
+ for (elt = a->types.elt; elt; elt = elt->next)
+ if (ValueIsType (b, elt->type))
+ return True;
+ return False;
+ }
+
+ if (TypePoly (a))
+ return True;
+
+ switch (a->base.tag) {
+ case type_prim:
+ if (a->prim.prim == ValueTag(b))
+ return True;
+ if (Numericp (a->prim.prim) && Numericp (ValueTag(b)))
+ {
+ if (a->prim.prim >= ValueTag(b))
+ return True;
+ }
+ break;
+ case type_name:
+ return ValueIsType (b, TypeNameType(a));
+ case type_ref:
+ if (ValueIsRef(b))
+ {
+ if (RefValueGet (b))
+ return ValueIsType (RefValueGet (b), a->ref.ref);
+ else
+ return TypeIsSupertype (RefType(b), a->ref.ref);
+ }
+ break;
+ case type_func:
+ if (ValueIsFunc(b))
+ {
+ if (TypeIsSupertype (b->func.code->base.type, a->func.ret))
+ {
+ ArgType *aarg = a->func.args, *barg = b->func.code->base.args;
+
+ while (aarg || barg)
+ {
+ if (!barg || !aarg)
+ return False;
+ if (barg->varargs != aarg->varargs)
+ return False;
+ if (!TypeIsSupertype (aarg->type, barg->type))
+ return False;
+ aarg = aarg->next;
+ barg = barg->next;
+ }
+ return True;
+ }
+ }
+ break;
+ case type_array:
+ if (ValueIsArray(b))
+ {
+ adim = TypeCountDimensions (a->array.dimensions);
+ bdim = b->array.ndim;
+ if (adim == 0 || adim == bdim)
+ {
+ if (TypePoly (a->array.type))
+ return True;
+ if (TypePoly (ArrayType(&b->array)))
+ {
+ int i;
+
+ for (i = 0; i < ArrayNvalues(&b->array); i++)
+ {
+ Value v = ArrayValueGet (&b->array, i);
+ if (v &&
+ !ValueIsType (v, a->array.type))
+ {
+ return False;
+ }
+ }
+ return True;
+ }
+ else
+ return TypeIsSupertype (ArrayType(&b->array), a->array.type);
+ }
+ }
+ break;
+ case type_hash:
+ if (ValueIsHash (b))
+ {
+ if (TypePoly (a->hash.type))
+ return True;
+ if (TypePoly (b->hash.type))
+ {
+ HashValue h;
+ Value *e = BoxElements (b->hash.elts);
+
+ for (h = 0; h < b->hash.hashSet->size; h++)
+ {
+ if (!ValueIsType (HashEltValue(e), a->hash.type))
+ {
+ return False;
+ }
+ if (!ValueIsType (HashEltKey (e), a->hash.keyType))
+ {
+ return False;
+ }
+ HashEltStep (e);
+ }
+ return True;
+ }
+ else
+ return (TypeIsSupertype (b->hash.type, a->hash.type) &&
+ TypeIsSupertype (b->hash.keyType, a->hash.keyType));
+ }
+ case type_struct:
+ case type_union:
+ if ((ValueIsStruct(b) && a->base.tag == type_struct) ||
+ (ValueIsUnion(b) && a->base.tag == type_union))
+ {
+ StructType *st = a->structs.structs;
+ for (n = 0; n < st->nelements; n++)
+ {
+ Type *bt;
+
+ bt = StructMemType (b->structs.type, StructTypeAtoms(st)[n]);
+ if (!bt)
+ break;
+ if (!TypeIsSupertype (bt, BoxTypesElements(st->types)[n]))
+ break;
+ }
+ if (n == st->nelements)
+ return True;
+ }
+ break;
+ default:
+ break;
+ }
+ return False;
+}
+
Type *
TypeCanon (Type *type)
{
diff --git a/value.h b/value.h
index 28119b6..8b7b538 100644
--- a/value.h
+++ b/value.h
@@ -530,6 +530,8 @@ Type *TypeCombineFunction (Type *type);
Type *TypeCombineArray (Type *array, int ndim, Bool lvalue);
/* can assign value 'v' to variable of type 'dest' */
Bool TypeCompatibleAssign (Type *dest, Value v);
+/* is value 'v' a subtype of 't' */
+Bool ValueIsType (Value b, TypePtr a);
/* super is a supertype of sub */
Bool TypeIsSupertype (Type *super, Type *sub);
/* a is a supertype of b or b is a supertype of a */
More information about the Nickle
mailing list