From ad0d6445de436a1c7c04cfe14316d620cb9202b3 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 3 Jan 2009 10:26:16 +0000 Subject: 2009-01-03 Gabriel Dos Reis * Makefile.pamphlet (AXIOM_SRC_TARGETS): Add all-databases. src/ChangeLog 2009-01-03 Gabriel Dos Reis * lisp/core.lisp.in (|%algebraSystemIsComplete|): New. (|%basicSystemIsComplete|): Use it. * interp/wi1.boot (setqSingle): Use maximalSuperType. (coerceSubset): Simplify. (compCoerce1): Tidy. * interp/i-resolv.boot (resolveTCat): Use superType. * interp/lisplib.boot (findConstructorSlotNumber): Use isSubset. (sigsMatch): Likewise. (findDomainSlotNumber): Likewise. * interp/define.boot (compSubDomain1): Reject for complex subdomain predicate. Support paramterized subdomains. * interp/daase.lisp (interpOpen): Read superdomain slot. (getdatabase): Remove adhoc hardcoded superdomain info. Return superdomain info stored in database. (localnrlib): Read superdomain info. (write-interpdb): Write superdomain info. (database): Add superdomain slot. * interp/g-util.boot (superType): New. (maximalSuperType): Rework. Support parameterized subdomains. (noteSubDomainInfo): New. (isSubDomain): Rework. * interp/c-util.boot (isSubset): Rework. * interp/g-opt.boot (optEQ): Remove. * interp/g-cndata.boot (getImmediateSuperDomain): Remove. (maximalSuperType): Move to g-util.boot. * interp/types.boot (%Constructor): New type specifier. (%Instantiation): Likewise. * interp/compiler.boot (primitiveType): Don't return $NegativeInteger. (maxSuperType): Remove. (hasType): Use maximalSuperType. (satisfies): New. (coerceSubset): Use it. Simplify. * interp/wi2.boot (smallIntegerStep): Use maximalSuperType. * interp/sys-constants.boot ($AtVariables): New. ($NegativeInteger): Remove. ($NonPositiveInteger): Likewise. ($CategoryNames): Category is not a category. * interp/property.lisp: Remove Subsets property settings. * interp/i-coerce.boot (coerceSubDomain): Simplify. (coerceImmediateSubDomain): Remove. (getSubDomainPredicate): Simplify. * interp/category.boot (SourceLevelSubset): Use isSubDomain. (MachineLevelSubset): Likewise. * interp/modemap.boot (mergeModemap): Likewise. (isSuperDomain): Remove. (augModemapsFromDomain): Support parameterized subdomains. * interp/i-util.boot (isSubDomain): Move to g-util.boot. * Makefile.pamphlet (all-databases): New target. * interp/Makefile.pamphlet ($(AXIOMSYS)): Push :open-axiom-algebra-system onto *FEATURES*. * etc/Makefile.in (all-databases): New target. --- src/interp/compiler.boot | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) (limited to 'src/interp/compiler.boot') diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 6885ba74..bc56663c 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -407,7 +407,7 @@ primitiveType x == INTEGERP x => x=0 => $NonNegativeInteger x>0 => $PositiveInteger - true => $NegativeInteger + $Integer FLOATP x => $DoubleFloat nil @@ -458,10 +458,6 @@ mkUnion(a,b) == b is ["Union",:l] => ["Union",:union([a],l)] ["Union",a,b] -maxSuperType(m,e) == - typ:= get(m,"SuperDomain",e) => maxSuperType(typ,e) - m - hasType(x,e) == fn get(x,"condition",e) where fn x == @@ -822,7 +818,7 @@ setqSingle(id,val,m,E) == eval or return nil where eval() == T:= comp(val,m'',E) => T - not get(id,"mode",E) and m'' ^= (maxm'':=maxSuperType(m'',E)) and + not get(id,"mode",E) and m'' ^= (maxm'':=maximalSuperType m'') and (T:=comp(val,maxm'',E)) => T (T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) => assignError(val,T.mode,id,m'') @@ -1458,17 +1454,18 @@ coerceEasy(T,m) == T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) => [T.expr,m,T.env] +satisfies(val,pred) == + pred=false or pred=true => pred + eval ["LET",[["#1",val]],pred] coerceSubset: (%Triple,%Mode) -> %Maybe %Triple coerceSubset([x,m,e],m') == isSubset(m,m',e) => [x,m',e] - m is ['SubDomain,=m',:.] => [x,m',e] - (pred:= LASSOC(opOf m',get(opOf m,'SubDomain,e))) and INTEGERP x and - -- obviously this is temporary - eval substitute(x,"#1",pred) => [x,m',e] - (pred:= isSubset(m',maxSuperType(m,e),e)) and INTEGERP x -- again temporary - and eval substitute(x,"*",pred) => - [x,m',e] + isDomainForm(m,e) and isSubDomain(m,m') => [x,m',e] + INTEGERP x => + -- obviously this is temporary + satisfies(x,isSubDomain(m',maximalSuperType m)) => [x,m',e] + nil nil coerceHard: (%Triple,%Mode) -> %Maybe %Triple @@ -1554,10 +1551,10 @@ compCoerce1(x,m',e) == T:=[T.expr,m1,T.env] T':= coerce(T,m') => T' T':= coerceByModemap(T,m') => T' - pred:=isSubset(m',T.mode,e) => - gg:=GENSYM() - pred:= substitute(gg,"*",pred) - code:= ['PROG1,["%LET",gg,T.expr], ['check_-subtype,pred,MKQ m',gg]] + pred := isSubset(m',T.mode,e) => + gg := GENSYM() + pred := substitute(gg,"#1",pred) + code := ['PROG1,["%LET",gg,T.expr], ['check_-subtype,pred,MKQ m',gg]] [code,m',T.env] coerceByModemap([x,m,e],m') == -- cgit v1.2.3