diff options
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/interp/buildom.boot | 6 | ||||
| -rw-r--r-- | src/interp/i-coerce.boot | 10 | ||||
| -rw-r--r-- | src/interp/i-util.boot | 53 |
4 files changed, 17 insertions, 63 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index e482a465..a7bdf83f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,16 @@ 2009-01-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/buildom.boot (UnionEqual): Don't call orderUnionEntries. + (coerceUn2E): Likewise. + (mkUnionFunList): Likewise. + * interp/i-coerce.boot (coerceUnion2Branch): Likewise. + (coerceBranch2Union): Likewise. + ($newCompilerUnionFlag): Remove. + (orderUnionEntries): Likewise. + (mkPredList): Remove dead code. + +2009-01-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/c-util.boot (updateCapsuleDirectory): Record constant makers too. (replaceSimpleFunctions): Fold simple constant form makers. diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index c54958ad..c1bf3d0a 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.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 @@ -178,7 +178,6 @@ Union(:args) == UnionEqual(x, y, dom) == ["Union",:branches] := dom.0 - branches := orderUnionEntries branches predlist := mkPredList branches same := false for b in stripUnionTags branches for p in predlist while not same repeat @@ -193,7 +192,6 @@ UnionPrint(x, dom) == coerceUn2E(x, dom.0) coerceUn2E(x,source) == ["Union",:branches] := source - branches := orderUnionEntries branches predlist := mkPredList branches byGeorge := byJane := GENSYM() for b in stripUnionTags branches for p in predlist repeat @@ -367,8 +365,6 @@ mkEnumerationFunList(nam,["Enumeration",:SL],e) == mkUnionFunList(op,form is ["Union",:listOfEntries],e) == first listOfEntries is [":",.,.] => mkNewUnionFunList(op,form,e) - -- following call to order is a bug, but needs massive recomp to fix - listOfEntries:= orderUnionEntries listOfEntries nargs := #listOfEntries --1. create representations of subtypes predList:= mkPredList listOfEntries diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 4a145952..1ca27f51 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.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 @@ -994,8 +994,7 @@ thisUnionBranch?(pred,val) == eval ["LET",[["#1",MKQ val]],pred] coerceUnion2Branch(object) == - [.,:unionDoms] := objMode object - doms := orderUnionEntries unionDoms + [.,:doms] := objMode object predList:= mkPredList doms doms := stripUnionTags doms val' := objValUnwrap object @@ -1010,9 +1009,8 @@ coerceUnion2Branch(object) == objNew(objVal object,targetType) coerceBranch2Union(object,union) == - -- assumes type is a member of unionDoms - unionDoms := CDR union - doms := orderUnionEntries unionDoms + -- assumes type is a member of doms + doms := CDR union predList:= mkPredList doms doms := stripUnionTags doms p := position(objMode object,doms) diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot index aafc33d1..73fe7ce2 100644 --- a/src/interp/i-util.boot +++ b/src/interp/i-util.boot @@ -145,59 +145,8 @@ makeInitialModemapFrame() == isCapitalWord x == (y := PNAME x) and and/[UPPER_-CASE_-P y.i for i in 0..MAXINDEX y] -$newCompilerUnionFlag := true - -orderUnionEntries l == - $newCompilerUnionFlag => l - first l is [":",.,.] => l -- new style Unions - [a,b]:= - split(l,nil,nil) where - split(l,a,b) == - l is [x,:l'] => - (STRINGP x => split(l',[x,:a],b); split(l',a,[x,:b])) - [a,b] - [:orderList a,:orderList b] - mkPredList listOfEntries == - $newCompilerUnionFlag => - [['EQCAR,"#1",i] for arg in listOfEntries for i in 0..] - first listOfEntries is [":",.,.] => -- new Tagged Unions - [['EQCAR,"#1",MKQ tag] for [.,tag,.] in listOfEntries] - --1. generate list of type-predicate pairs from union specification - initTypePredList:= - [selTypePred for x in listOfEntries] where - selTypePred() == - STRINGP x => [x,'EQUAL,"#1",x] - [x,:GETL(opOf x,"BasicPredicate")] - typeList:= ASSOCLEFT initTypePredList - initPredList:= ASSOCRIGHT initTypePredList - hasDuplicatePredicate:= - fn initPredList where - fn x == - null x => false - first x and member(first x,rest x) => true - fn rest x - --if duplicate predicate, kill them all - if hasDuplicatePredicate then initPredList:= [nil for x in initPredList] - nonEmptyPredList:= [p for p in initPredList | p^=nil] - numberWithoutPredicate:= #listOfEntries-#nonEmptyPredList - predList:= - numberWithoutPredicate=0 and not hasDuplicatePredicate => initPredList - numberWithoutPredicate=1 and null LAST initPredList and - [STRINGP x for x in rest REVERSE listOfEntries] => - allButLast:= rest REVERSE initPredList - NREVERSE [['NULL,MKPF(allButLast,"OR")],:allButLast] - --otherwise, generate a tagged-union - --we have made an even number of REVERSE operations, therefore - --the original order is preserved. JHD 25.Sept.1983 - tagPredList:= [["EQCAR","#1",i] for i in 1..numberWithoutPredicate] - [addPredIfNecessary for p in initPredList] where - addPredIfNecessary() == - p => p - [u,:tagPredList]:= tagPredList - u - predList - + [['EQCAR,"#1",i] for arg in listOfEntries for i in 0..] --% |