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
9799b6f6
Commit
9799b6f6
authored
Jul 10, 2012
by
Axel Simon
Browse files
fix fixpoint algorithm
parent
3b78007b
Changes
2
Hide whitespace changes
Inline
Side-by-side
detail/semantic/inference.sml
View file @
9799b6f6
...
...
@@ -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
=
5
val
maxIter
=
3
fun
calcSubset
printWarn
env
=
let
fun
checkUsage
sym
(
s
,
unstable
)
=
...
...
@@ -171,16 +171,23 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
symsStr
]))
end
val
substs
=
E
.
subseteq
(
envCall
,
envFun
)
handle
(
S
.
UnificationFailure
str
)
=>
S
.
emptySubsts
val
affectedSyms
=
E
.
affectedFunctions
(
substs
,
envCall
)
val
affectedSyms
=
E
.
affectedFunctions
(
substs
,
env
)
(*
val (sStr, si) = S.showSubstsSI (substs, TVar.emptyShowInfo)
val _ = TextIO.print ("subset: subst=:" ^ sStr ^ ", unstable: " ^
List.foldl (fn (sym, res) => res ^ ", " ^ SymbolTable.getString
(!SymbolTables.varTable, sym)) "" (E.SymbolSet.listItems affectedSyms) ^ "\n")*)
val
_
=
raiseWarning
(
substs
,
affectedSyms
)
in
E
.
SymbolSet
.
union
(
unstable
,
affectedSyms
)
if
E
.
SymbolSet
.
isEmpty
affectedSyms
then
unstable
else
E
.
SymbolSet
.
add
(
unstable
,
sym
)
end
handle
(
S
.
UnificationFailure
str
)
=>
E
.
SymbolSet
.
add
(
unstable
,
sym
)
fun
checkUsages
(
sym
,
unstable
)
=
let
val
usages
=
E
.
getUsages
(
sym
,
env
)
val
_
=
TextIO
.
print
(
"***** checking subset of "
^
Int
.
toString
(
List
.
length
usages
)
^
" usages of "
^
SymbolTable
.
getString
(
!
SymbolTables
.
varTable
,
sym
)
^
"
\n
"
)
(*
val _ = TextIO.print ("***** checking subset of " ^ Int.toString (List.length usages) ^ " usages of " ^ SymbolTable.getString(!SymbolTables.varTable, sym) ^ "\n")
*)
val
unstable
=
List
.
foldl
(
checkUsage
sym
)
unstable
usages
in
unstable
...
...
@@ -230,7 +237,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
fun
calcUsages
(
sym
,
env
)
=
let
val
usages
=
E
.
getUsages
(
sym
,
env
)
val
_
=
TextIO
.
print
(
"***** re-eval of "
^
Int
.
toString
(
List
.
length
usages
)
^
" usages of "
^
SymbolTable
.
getString
(
!
SymbolTables
.
varTable
,
sym
)
^
"
\n
"
)
(*
val _ = TextIO.print ("***** re-eval of " ^ Int.toString (List.length usages) ^ " usages of " ^ SymbolTable.getString(!SymbolTables.varTable, sym) ^ "\n")
*)
val
env
=
List
.
foldl
(
checkUsage
sym
)
env
usages
in
env
...
...
@@ -240,7 +247,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
end
fun
calcFixpoint
curIter
env
=
case
calcSubset
(
curIter
=
maxIter
)
env
of
unstable
=>
case
calcSubset
(
curIter
>
0
)
env
of
unstable
=>
if
E
.
SymbolSet
.
isEmpty
unstable
then
env
else
if
curIter<maxIter
then
calcFixpoint
(
curIter+
1
)
(
calcIteration
(
unstable
,
env
))
...
...
@@ -264,7 +271,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
(
Error
.
errorAt
(
errStrm
,
s
,
[
"no typing found for "
,
symsStr
,
"
\
n\
t
pass --inference-iterations="
,
"
\t
pass --inference-iterations="
,
Int
.
toString
(
maxIter+
1
),
" to try a little harder"
]);
env
)
end
...
...
examples/x86-ng.d
View file @
9799b6f6
...
...
@@ -36,6 +36,8 @@ val decode = do
p64
end
val
complement
v
=
not
v
val
set
-
opndsz
=
update
@
{
opndsz
=
'1'
}
val
set
-
repne
=
update
@
{
repne
=
'1'
}
val
set
-
rep
=
update
@
{
rep
=
'1'
}
...
...
@@ -87,6 +89,10 @@ val /66 [] = continue
val
/
f2
[]
=
continue
val
/
f3
[]
=
continue
val
/
rex
-
p
[
'
0100
w
:
1
r
:
1
x
:
1
b
:
1
'
]
=
update
@
{
rex
=
'1'
,
rexw
=
w
,
rexb
=
b
,
rexx
=
x
,
rexr
=
r
}
val
clear
-
rex
=
update
@
{
rex
=
'0'
,
rexw
=
'0'
,
rexb
=
'0'
,
rexr
=
'0'
,
rexx
=
'0'
}
val
/
legacy
-
p
[
0x2e
]
=
do
clear
-
rex
;
set
-
CS
end
val
/
legacy
-
p
[
0x36
]
=
do
clear
-
rex
;
set
-
SS
end
val
/
legacy
-
p
[
0x3e
]
=
do
clear
-
rex
;
set
-
DS
end
...
...
@@ -96,10 +102,6 @@ val /legacy-p [0x65] = do clear-rex; set-GS end
val
/
legacy
-
p
[
0x67
]
=
do
clear
-
rex
;
set
-
addrsz
end
val
/
legacy
-
p
[
0xf0
]
=
do
clear
-
rex
;
set
-
lock
end
val
/
rex
-
p
[
'
0100
w
:
1
r
:
1
x
:
1
b
:
1
'
]
=
update
@
{
rex
=
'1'
,
rexw
=
w
,
rexb
=
b
,
rexx
=
x
,
rexr
=
r
}
val
clear
-
rex
=
update
@
{
rex
=
'0'
,
rexw
=
'0'
,
rexb
=
'0'
,
rexr
=
'0'
,
rexx
=
'0'
}
val
p
/
vex
/
0
f
[
0xc4
'
r
:
1
x
:
1
b
:
1
00001
' '
w
:
1
v
:
4
l
:
1
00
'
]
=
do
update
@
{
rex
=
'1'
,
...
...
@@ -1146,8 +1148,6 @@ val vexw1? = do
return
(
w
==
'1'
)
end
val
complement
v
=
not
v
val
opndsz
?
=
query
$
opndsz
val
addrsz
?
=
query
$
addrsz
val
repne
?
=
query
$
repne
...
...
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