aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog11
-rw-r--r--src/interp/buildom.boot6
-rw-r--r--src/interp/i-coerce.boot10
-rw-r--r--src/interp/i-util.boot53
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..]
--%