Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Tanzeem Haque
gdsl-toolkit
Commits
0d215ed7
Commit
0d215ed7
authored
Jul 06, 2012
by
Axel Simon
Browse files
fix performance bug in size constraint merge
parent
03c3d2d0
Changes
3
Hide whitespace changes
Inline
Side-by-side
detail/semantic/inference.sml
View file @
0d215ed7
...
...
@@ -131,7 +131,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
(*
define a second traversal that is a full inference of the tree *)
(*
local helper function to infer types for a binding group*)
val
maxIter
=
1
val
maxIter
=
2
fun
checkUsages
printWarn
(
sym
,
env
)
=
let
(*
val _ = TextIO.print ("***** usages of " ^ SymbolTable.getString(!SymbolTables.varTable, sym) ^ "\n")*)
...
...
detail/semantic/typing/environment.sml
View file @
0d215ed7
...
...
@@ -1189,6 +1189,8 @@ end = struct
fun
forceNoInputs
(
sym
,
env
)
=
case
Scope
.
lookup
(
sym
,
env
)
of
(_,
COMPOUND
{
ty
=
SOME
(
t
,
bFun
),
width
,
uses
})
=>
let
val
t
=
case
t
of
(
MONAD
(
r
,
inp
,
out
))
=>
inp
|
t
=>
t
fun
onlyInputs
((
true
,
v
),
vs
)
=
v
::
vs
|
onlyInputs
((
false
,
v
),
vs
)
=
vs
val
bVars
=
texpBVarset
onlyInputs
(
t
,[])
...
...
@@ -1283,8 +1285,6 @@ end = struct
fun
meetGeneral
(
env1
,
env2
,
directed
)
=
let
(*
val (e1Str', si) = topToStringSI (env1,TVar.emptyShowInfo)
val (e2Str', si) = topToStringSI (env2,si)*)
val
substs
=
unify
(
env1
,
env2
,
emptySubsts
)
(*
val (scs, cons) = env1
...
...
@@ -1299,6 +1299,12 @@ end = struct
val
(
env1
,
env2
)
=
mergeUses
(
env1
,
env2
)
(*
val (e1Str,si) = kappaToStringSI (env1, TVar.emptyShowInfo)
val (e2Str,si) = kappaToStringSI (env2, si)
val (sStr,si) = showSubstsSI (substs,si)
val kind = if directed then "directed" else "equalizing"
val _ = TextIO.print ("**** meet " ^ kind ^ ":\n" ^ e1Str ^ "++++ intersected with\n" ^ e2Str)*)
val
(
_
,
state1
)
=
env1
val
(
_
,
state2
)
=
env2
val
sCons
=
SC
.
merge
(
Scope
.
getSize
state1
,
Scope
.
getSize
state2
)
...
...
@@ -1307,12 +1313,6 @@ end = struct
val
(
ei
,
bFunFlow
,
env
)
=
applySubsts
(
substs
,
emptyExpandInfo
,
BD
.
empty
,
directed
,
env1
,
env2
)
(*
val (e1Str,si) = kappaToStringSI (env1, si)
val (e2Str,si) = kappaToStringSI (env2, si)
val (sStr,si) = showSubstsSI (substs,si)
val kind = if directed then "directed" else "equalizing"
val _ = TextIO.print ("**** meet " ^ kind ^ ":\n" ^ e1Str' ^ "++++ intersected with\n" ^ e2Str')*)
val
bVars1
=
Scope
.
getBVars
env1
val
bVars2
=
Scope
.
getBVars
env2
val
bVars
=
BD
.
union
(
bVars1
,
bVars2
)
...
...
detail/semantic/typing/size-constraint.sml
View file @
0d215ed7
...
...
@@ -186,9 +186,26 @@ end = struct
in
List
.
foldl
gV
TVar
.
empty
scs
end
fun
diff
(
scs1
,
scs2
)
=
let
fun
cmp
({
terms
=(_,
v1
)
::
_,
const
=_},{
terms
=(_,
v2
)
::
_,
const
=_})
=
TVar
.
compare
(
v1
,
v2
)
|
cmp
_
=
raise
SizeConstraintBug
fun
genDiff
(
sc1
::
scs1
,
sc2
::
scs2
)
=
(
case
cmp
(
sc1
,
sc2
)
of
LESS
=>
sc1
::
genDiff
(
scs1
,
sc2
::
scs2
)
|
GREATER
=>
genDiff
(
sc1
::
scs1
,
scs2
)
|
EQUAL
=>
genDiff
(
scs1
,
scs2
)
)
|
genDiff
(
scs1
,
_)
=
scs1
in
genDiff
(
scs1
,
scs2
)
end
fun
merge
(
scs1
,
scs2
)
=
let
val
scs1
=
diff
(
scs1
,
scs2
)
fun
m
([],
scs
)
=
scs
|
m
(
eq
::
eqs
,
scs
)
=
case
add
(
eq
,
scs
)
of
RESULT
(_,
scs
)
=>
m
(
eqs
,
scs
)
...
...
@@ -215,6 +232,8 @@ end = struct
fun
renameVar
sc
=
case
lookupVarSC
(
v1
,
sc
)
of
f1
=>
addTermToSC
(
f1
,
v2
,
addTermToSC
(
~f1
,
v1
,
sc
))
val
renamed
=
List
.
map
renameVar
withVar
val
renamed
=
List
.
filter
(
fn
{
terms
=
ts
,
const
}
=>
not
(
List
.
null
ts
))
renamed
in
merge
(
renamed
,
retained
)
end
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment