diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/c-util.boot | 25 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-eval.boot | 24 |
3 files changed, 41 insertions, 10 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index d5e78051..e8e11234 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -40,7 +40,7 @@ module c_-util where clearReplacement: %Symbol -> %Thing replaceSimpleFunctions: %Form -> %Form foldExportedFunctionReferences: %List -> %List - diagnoseUknownType: (%Mode,%Env) -> %Form + diagnoseUnknownType: (%Mode,%Env) -> %Form --% @@ -432,7 +432,7 @@ isKnownCategory(c,e) == --TRACE isKnownCategory ++ Returns non-nil if `t' is a known type in the environement `e'. -diagnoseUknownType(t,e) == +diagnoseUnknownType(t,e) == atom t => t in '($ constant) => t t' := assoc(t,getDomainsInScope e) => t' @@ -445,21 +445,34 @@ diagnoseUknownType(t,e) == '"is not known to name a type"],nil) [ctor,:args] := t ctor = "Mapping" => - for t' in args repeat diagnoseUknownType(t',e) + for t' in args repeat diagnoseUnknownType(t',e) t ctor = "Record" => - for [.,.,t'] in args repeat diagnoseUknownType(t',e) + for [[.,n,t'],:fields] in tails args repeat + diagnoseUnknownType(t',e) + for [.,=n,.] in fields repeat + stackSemanticError(['"Field", :bright n, + '"declared more than once."], nil) t ctor = "Union" => if args is [[":",:.],:.] then - for [.,.,t'] in args repeat diagnoseUknownType(t',e) + for [[.,n,t'],:fields] in tails args repeat + diagnoseUnknownType(t',e) + for [.,=n,.] in fields repeat + stackSemanticError(['"Field", :bright n, + '"declared more than once."], nil) else - for t' in args repeat diagnoseUknownType(t',e) + for t' in args repeat diagnoseUnknownType(t',e) t ctor = "Enumeration" => for t' in args repeat IDENTP t' => nil stackSemanticError(['"Enumerators must be symbols."], nil) + -- Make sure we don't have repeated symbolic values + for [sym,:syms] in tails args repeat + MEMQ(sym,syms) => + stackSemanticError(['"Symbolic value ", :bright sym, + '"is listed twice"], nil) t ctor = "[||]" => t ctor in $BuiltinConstructorNames => t -- ??? check Record and Union fields diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index f14ba01d..817517ef 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1849,7 +1849,7 @@ modeEqualSubst(m1,m,e) == compCat(form is [functorName,:argl],m,e) == fn:= GETL(functorName,"makeFunctionList") or return nil - diagnoseUknownType(form,e) + diagnoseUnknownType(form,e) [funList,e]:= FUNCALL(fn,form,form,e) catForm:= ["Join",'(SetCategory),["CATEGORY","domain",: diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 91499994..527a36c3 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -1,5 +1,7 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -120,6 +122,13 @@ evaluateType0 form == IDENTP form and (constructor? form or form in $BuiltinConstructorNames) => throwEvalTypeMsg("S2IE0003",[form,form]) +++ Check for duplicate fields in a Union or Record domain form. +checkRecordOrUnionFields body == + for [[.,n,.],:fields] in tails body repeat + for field in fields | field is [.,=n,.] repeat + throwKeyedMsg("S2IL0030",[n]) + body + evaluateType form == -- Takes a parsed, unabbreviated type and evaluates it, replacing -- type valued variables with their values, and calling bottomUp @@ -142,11 +151,20 @@ evaluateType form == [op,:[evaluateType arg for arg in argl]] op='Union => argl and first argl is [x,.,.] and member(x,'(_: Declare)) => - [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]] + [op, : checkRecordOrUnionFields + [[":",sel,evaluateType type] for ['_:,sel,type] in argl]] [op,:[evaluateType arg for arg in argl]] op='Record => - [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]] - op='Enumeration => form + [op, : checkRecordOrUnionFields + [['_:,sel,evaluateType type] for ['_:,sel,type] in argl]] + op='Enumeration => + -- only symbols, and they must not be repeated. + for arg in argl repeat + IDENTP arg => nil + throwKeyedMsg("S2IL0031",nil) + for [arg,:args] in tails argl repeat + MEMQ(arg,args) => throwKeyedMsg("S2IL0032",[arg]) + form evaluateFormAsType form IDENTP form and niladicConstructorFromDB form => evaluateType [form] IDENTP form and (constructor? form or form in $BuiltinConstructorNames) => |