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
82118c7e
Commit
82118c7e
authored
Jul 11, 2012
by
mb0
Browse files
Up.
parent
3a080889
Changes
11
Hide whitespace changes
Inline
Side-by-side
detail/codegen/c0/runtime.c
View file @
82118c7e
...
...
@@ -29,9 +29,9 @@ __obj __FALSE = __WRAP(&__unwrapped_FALSE);
void
__fatal
(
char
*
fmt
,
...)
{
va_list
ap
;
va_start
(
ap
,
fmt
);
fprintf
(
stderr
,
"
ERROR:
"
);
fprintf
(
stderr
,
"
FATAL:[
"
);
vfprintf
(
stderr
,
fmt
,
ap
);
fprintf
(
stderr
,
"
\n
"
);
fprintf
(
stderr
,
"
]
\n
"
);
va_end
(
ap
);
abort
();
}
...
...
@@ -120,11 +120,38 @@ __obj __not (__obj a_) {
__obj
__raise
(
__obj
o
)
{
printf
(
"raising: "
);
__println
(
o
);
__fatal
(
"
<error>
"
);
__fatal
(
"
Unhandled exception
"
);
return
(
o
);
}
__obj
__unconsume
(
__obj
s
)
{
__obj
__consume8
(
__obj
s
)
{
__LOCAL
(
blob
,
__RECORD_SELECT
(
s
,
___blob
));
__char
*
buf
=
blob
->
blob
.
blob
;
__word
sz
=
blob
->
blob
.
sz
;
if
(
sz
==
0
)
__fatal
(
"end-of-blob"
);
__char
x
=
*
buf
;
__LOCAL0
(
v
);
__BV_BEGIN
(
v
,
8
);
__BV_INIT
(
x
);
__BV_END
(
v
,
8
);
__LOCAL0
(
blobb
);
__BLOB_BEGIN
(
blobb
);
__BLOB_INIT
(
buf
+
1
,
sz
-
1
);
__BLOB_END
(
blobb
);
__LOCAL0
(
ss
);
__RECORD_BEGIN_UPDATE
(
ss
,
s
);
__RECORD_UPDATE
(
___blob
,
blobb
);
__RECORD_END_UPDATE
(
ss
);
__LOCAL0
(
a
);
__RECORD_BEGIN
(
a
,
2
);
__RECORD_ADD
(
___1
,
v
);
__RECORD_ADD
(
___2
,
ss
);
__RECORD_END
(
a
,
2
);
return
(
a
);
}
__obj
__unconsume8
(
__obj
s
)
{
__LOCAL
(
blob
,
__RECORD_SELECT
(
s
,
___blob
));
__char
*
buf
=
blob
->
blob
.
blob
;
__word
sz
=
blob
->
blob
.
sz
;
...
...
@@ -144,20 +171,71 @@ __obj __unconsume (__obj s) {
return
(
a
);
}
__obj
__consume
(
__obj
s
)
{
__obj
__consume
16
(
__obj
s
)
{
__LOCAL
(
blob
,
__RECORD_SELECT
(
s
,
___blob
));
__char
*
buf
=
blob
->
blob
.
blob
;
__word
sz
=
blob
->
blob
.
sz
;
if
(
sz
==
0
)
__fatal
(
"<end-of-blob>"
);
__char
x
=
*
buf
;
if
(
sz
<
2
)
__fatal
(
"end-of-blob"
);
uint16_t
x1
=
buf
[
0
];
uint16_t
x2
=
buf
[
1
]
<<
8
;
__LOCAL0
(
v
);
__BV_BEGIN
(
v
,
8
);
__BV_INIT
(
x
);
__BV_END
(
v
,
8
);
__BV_BEGIN
(
v
,
16
);
__BV_INIT
(
(
x1
|
x2
)
&
0xffff
);
__BV_END
(
v
,
16
);
__LOCAL0
(
blobb
);
__BLOB_BEGIN
(
blobb
);
__BLOB_INIT
(
buf
+
1
,
sz
-
1
);
__BLOB_INIT
(
buf
+
2
,
sz
-
2
);
__BLOB_END
(
blobb
);
__LOCAL0
(
ss
);
__RECORD_BEGIN_UPDATE
(
ss
,
s
);
__RECORD_UPDATE
(
___blob
,
blobb
);
__RECORD_END_UPDATE
(
ss
);
__LOCAL0
(
a
);
__RECORD_BEGIN
(
a
,
2
);
__RECORD_ADD
(
___1
,
v
);
__RECORD_ADD
(
___2
,
ss
);
__RECORD_END
(
a
,
2
);
return
(
a
);
}
__obj
__unconsume16
(
__obj
s
)
{
__LOCAL
(
blob
,
__RECORD_SELECT
(
s
,
___blob
));
__char
*
buf
=
blob
->
blob
.
blob
;
__word
sz
=
blob
->
blob
.
sz
;
__LOCAL0
(
blobb
);
__BLOB_BEGIN
(
blobb
);
__BLOB_INIT
(
buf
-
2
,
sz
+
2
);
__BLOB_END
(
blobb
);
__LOCAL0
(
ss
);
__RECORD_BEGIN_UPDATE
(
ss
,
s
);
__RECORD_UPDATE
(
___blob
,
blobb
);
__RECORD_END_UPDATE
(
ss
);
__LOCAL0
(
a
);
__RECORD_BEGIN
(
a
,
2
);
__RECORD_ADD
(
___1
,
__UNIT
);
__RECORD_ADD
(
___2
,
ss
);
__RECORD_END
(
a
,
2
);
return
(
a
);
}
__obj
__consume32
(
__obj
s
)
{
__LOCAL
(
blob
,
__RECORD_SELECT
(
s
,
___blob
));
__char
*
buf
=
blob
->
blob
.
blob
;
__word
sz
=
blob
->
blob
.
sz
;
if
(
sz
<
4
)
__fatal
(
"end-of-blob"
);
uint32_t
x1
=
buf
[
0
];
uint32_t
x2
=
buf
[
1
]
<<
8
;
uint32_t
x3
=
buf
[
2
]
<<
16
;
uint32_t
x4
=
buf
[
3
]
<<
24
;
__LOCAL0
(
v
);
__BV_BEGIN
(
v
,
32
);
__BV_INIT
((
x1
|
x2
|
x3
|
x4
)
&
0xffffffff
);
__BV_END
(
v
,
32
);
__LOCAL0
(
blobb
);
__BLOB_BEGIN
(
blobb
);
__BLOB_INIT
(
buf
+
2
,
sz
-
2
);
__BLOB_END
(
blobb
);
__LOCAL0
(
ss
);
__RECORD_BEGIN_UPDATE
(
ss
,
s
);
...
...
@@ -171,6 +249,26 @@ __obj __consume (__obj s) {
return
(
a
);
}
__obj
__unconsume32
(
__obj
s
)
{
__LOCAL
(
blob
,
__RECORD_SELECT
(
s
,
___blob
));
__char
*
buf
=
blob
->
blob
.
blob
;
__word
sz
=
blob
->
blob
.
sz
;
__LOCAL0
(
blobb
);
__BLOB_BEGIN
(
blobb
);
__BLOB_INIT
(
buf
-
4
,
sz
+
4
);
__BLOB_END
(
blobb
);
__LOCAL0
(
ss
);
__RECORD_BEGIN_UPDATE
(
ss
,
s
);
__RECORD_UPDATE
(
___blob
,
blobb
);
__RECORD_END_UPDATE
(
ss
);
__LOCAL0
(
a
);
__RECORD_BEGIN
(
a
,
2
);
__RECORD_ADD
(
___1
,
__UNIT
);
__RECORD_ADD
(
___2
,
ss
);
__RECORD_END
(
a
,
2
);
return
(
a
);
}
__obj
__slice
(
__obj
tok_
,
__obj
offs_
,
__obj
sz_
)
{
__word
tok
=
tok_
->
bv
.
vec
;
__int
offs
=
offs_
->
z
.
value
;
...
...
detail/codegen/c0/runtime.h
View file @
82118c7e
...
...
@@ -368,9 +368,13 @@ static inline void __resetHeap() {
hp
=
&
heap
[
__RT_HEAP_SIZE
];
}
__obj
__consume
(
__obj
);
__obj
__consume8
(
__obj
);
__obj
__unconsume8
(
__obj
);
__obj
__consume16
(
__obj
);
__obj
__unconsume16
(
__obj
);
__obj
__consume32
(
__obj
);
__obj
__unconsume32
(
__obj
);
__obj
__slice
(
__obj
,
__obj
,
__obj
);
__obj
__unconsume
(
__obj
);
__obj
__concat
(
__obj
,
__obj
);
__obj
__equal
(
__obj
,
__obj
);
__obj
__and
(
__obj
,
__obj
);
...
...
detail/cps/cps-opt.sml
View file @
82118c7e
...
...
@@ -298,7 +298,7 @@ structure FreeVars = struct
in
set
k
env
end
)
ds
val
_
=
merge'
()
(*
XXX:
val _ = merge'()
*)
val
_
=
merge'
()
val
env
=
visitTerm
(
env
,
body
)
val
env
=
...
...
detail/cps/from-core.sml
View file @
82118c7e
...
...
@@ -35,8 +35,12 @@ end = struct
fun
mk
()
=
let
open
Core
.
Exp
val
slice
=
get
"slice"
val
consume
=
get
"consume"
val
unconsume
=
get
"unconsume"
val
consume8
=
get
"consume8"
val
unconsume8
=
get
"unconsume8"
val
consume16
=
get
"consume16"
val
unconsume16
=
get
"unconsume16"
val
consume32
=
get
"consume32"
val
unconsume32
=
get
"unconsume32"
val
andd
=
get
"and"
val
concat
=
get
"^"
val
==
=
get
"=="
...
...
@@ -157,29 +161,73 @@ end = struct
(
slice
,
[
tok
,
offs
,
sz
],
body
)
end
(*
val consume s = %consume(s) *)
val
consume
=
(*
val consume
8
s = %consume
8
(s) *)
val
consume
8
=
let
val
s
=
fresh
"s"
val
prim
C
onsume
=
get
"%consume"
val
body
=
PRI
(
prim
C
onsume
,
[
s
])
val
prim
c
onsume
8
=
get
"%consume
8
"
val
body
=
PRI
(
prim
c
onsume
8
,
[
s
])
in
(
consume
,
[
s
],
body
)
(
consume
8
,
[
s
],
body
)
end
(*
val unconsume s = %unconsume(s) *)
val
unconsume
=
(*
val unconsume
8
s = %unconsume
8
(s) *)
val
unconsume
8
=
let
val
s
=
fresh
"s"
val
primUnconsume
=
get
"%unconsume"
val
body
=
PRI
(
primUnconsume
,
[
s
])
val
primUnconsume
8
=
get
"%unconsume
8
"
val
body
=
PRI
(
primUnconsume
8
,
[
s
])
in
(
unconsume
,
[
s
],
body
)
(
unconsume8
,
[
s
],
body
)
end
(*
val consume16 s = %consume16(s) *)
val
consume16
=
let
val
s
=
fresh
"s"
val
primconsume16
=
get
"%consume16"
val
body
=
PRI
(
primconsume16
,
[
s
])
in
(
consume16
,
[
s
],
body
)
end
(*
val unconsume16 s = %unconsume16(s) *)
val
unconsume16
=
let
val
s
=
fresh
"s"
val
primUnconsume16
=
get
"%unconsume16"
val
body
=
PRI
(
primUnconsume16
,
[
s
])
in
(
unconsume16
,
[
s
],
body
)
end
(*
val consume32 s = %consume32(s) *)
val
consume32
=
let
val
s
=
fresh
"s"
val
primconsume32
=
get
"%consume32"
val
body
=
PRI
(
primconsume32
,
[
s
])
in
(
consume32
,
[
s
],
body
)
end
(*
val unconsume32 s = %unconsume32(s) *)
val
unconsume32
=
let
val
s
=
fresh
"s"
val
primUnconsume32
=
get
"%unconsume32"
val
body
=
PRI
(
primUnconsume32
,
[
s
])
in
(
unconsume32
,
[
s
],
body
)
end
in
[
slice
,
consume
,
unconsume
,
consume8
,
unconsume8
,
consume16
,
unconsume16
,
consume32
,
unconsume32
,
andd
,
not
,
==
,
...
...
detail/cps/mk-cps-pass.sml
View file @
82118c7e
...
...
@@ -10,9 +10,22 @@ functor MkCPSPass (Core: CPSCORE) = struct
structure
CM
=
CompilationMonad
val
dumpFreeVars
=
ref
false
val
clicks
=
Stats
.
newCounter
(
"cps."
^
Core
.
name
^
".clicks"
)
fun
dumpPre
(
os
,
cps
)
=
Pretty
.
prettyTo
(
os
,
CPS
.
PP
.
term
cps
)
val
dumpFreeVars
=
fn
cps
=>
if
!dumpFreeVars
then
let
open
Layout
Pretty
in
FreeVars
.
run
cps
;
align
[
str
"freevars="
,
indent
2
(
FreeVars
.
layout
())]
end
else
Layout
.
str
""
fun
dumpPre
(
os
,
cps
)
=
Pretty
.
prettyTo
(
os
,
Layout
.
align
[
CPS
.
PP
.
term
cps
,
dumpFreeVars
cps
])
fun
dumpPost
(
os
,
t
)
=
let
open
Layout
Pretty
fun
prettyPass
(
cps
,
clicks
)
=
...
...
@@ -21,7 +34,8 @@ functor MkCPSPass (Core: CPSCORE) = struct
[
str
"cps."
,
str
Core
.
name
,
str
".clicks"
,
str
"="
,
str
(
Int
.
toString
clicks
)],
CPS
.
PP
.
term
cps
,
align
[
str
"census="
,
indent
2
(
Census
.
layout
())]]
align
[
str
"census="
,
indent
2
(
Census
.
layout
())],
dumpFreeVars
cps
]
in
Pretty
.
prettyTo
(
os
,
prettyPass
t
)
end
...
...
detail/desugar/desugar-decode-syntax.sml
View file @
82118c7e
...
...
@@ -20,8 +20,6 @@ structure DesugarDecode = struct
end
val
tok
=
Atom
.
atom
"tok"
val
consume
=
Atom
.
atom
"consume"
val
unconsume
=
Atom
.
atom
"unconsume"
val
slice
=
Atom
.
atom
"slice"
val
return
=
Atom
.
atom
"return"
...
...
@@ -34,6 +32,8 @@ structure DesugarDecode = struct
fun
consumeTok
()
=
let
val
tok
=
freshTok
()
val
tokSz
=
Int
.
toString
(
!granularity
)
val
consume
=
Atom
.
atom
(
"consume"
^tokSz
)
val
consume
=
Exp
.
ID
(
VarInfo
.
lookup
...
...
@@ -43,6 +43,8 @@ structure DesugarDecode = struct
end
fun
unconsumeTok
()
=
let
val
tokSz
=
Int
.
toString
(
!granularity
)
val
unconsume
=
Atom
.
atom
(
"unconsume"
^tokSz
)
val
unconsume
=
Exp
.
ID
(
VarInfo
.
lookup
...
...
detail/desugar/inline-decode-patterns.sml
View file @
82118c7e
...
...
@@ -115,7 +115,33 @@ structure ASTSubst = struct
map
(
renameExp
sigma
)
es
)
|
RECORDexp
fs
=>
RECORDexp
(
map
(
renameField
sigma
)
fs
)
|
UPDATEexp
fs
=>
UPDATEexp
(
map
(
renameFieldOpt
sigma
)
fs
)
|
SEQexp
es
=>
SEQexp
(
map
(
renameSeqexp
sigma
)
es
)
|
SEQexp
es
=>
let
fun
visitSeqexp
sigma
e
=
case
e
of
MARKseqexp
e
=>
visitSeqexp
sigma
(
#tree
e
)
|
ACTIONseqexp
e
=>
ACTIONseqexp
(
renameExp
sigma
e
)
|
BINDseqexp
(
x
,
e
)
=>
(*
{x} was renamed so we just have to
* substitute it here *)
BINDseqexp
(
Subst
.
apply
sigma
x
,
renameExp
sigma
e
)
fun
previsit
(
t
,
sigma
)
=
case
t
of
MARKseqexp
t
=>
previsit
(
#tree
t
,
sigma
)
|
BINDseqexp
(
x
,
e
)
=>
let
val
x'
=
copy
x
val
sigma
=
extend
sigma
x'
x
in
sigma
end
|
_
=>
sigma
val
sigma
=
foldl
previsit
sigma
es
in
SEQexp
(
map
(
visitSeqexp
sigma
)
es
)
end
|
FNexp
(
xs
,
e
)
=>
let
val
xs'
=
copyAll
xs
...
...
@@ -152,17 +178,6 @@ structure ASTSubst = struct
and
renameCase
sigma
(
pat
,
e
)
=
(
pat
,
renameExp
sigma
e
)
and
renameField
sigma
(
f
,
e
)
=
(
f
,
renameExp
sigma
e
)
and
renameFieldOpt
sigma
(
f
,
eOpt
)
=
(
f
,
Option
.
map
(
renameExp
sigma
)
eOpt
)
and
renameSeqexp
sigma
t
=
case
t
of
MARKseqexp
t
=>
renameSeqexp
sigma
(
#tree
t
)
|
ACTIONseqexp
e
=>
ACTIONseqexp
(
renameExp
sigma
e
)
|
BINDseqexp
(
x
,
e
)
=>
let
val
x'
=
copy
x
val
sigma
=
extend
sigma
x'
x
in
BINDseqexp
(
x'
,
renameExp
sigma
e
)
end
end
end
...
...
@@ -180,7 +195,6 @@ end = struct
open
T
val
map
=
ref
ds
val
varmap
=
!
SymbolTables
.
varTable
fun
inline
(
x
,
exp
)
=
case
Map
.
find
(
!map
,
x
)
of
NONE
=>
...
...
detail/parser/mk-ast.sml
View file @
82118c7e
...
...
@@ -132,22 +132,24 @@ functor MkAst (Core: AST_CORE) = struct
seq
[
str
"type"
,
space
,
syn_bind
t
,
space
,
ty
tyexp
]
|
DATATYPEdecl
(
t
,
decls
)
=>
align
[
seq
[
str
"type"
,
space
,
con_bind
t
],
[
seq
[
str
"
data
type"
,
space
,
con_bind
t
],
indent
3
(
alignPrefix
(
map
condecl
decls
,
"| "
))]
|
DECODEdecl
(
n
,
ps
,
Sum
.
INL
e
)
=>
align
[
seq
[
str
"fn "
,
var_bind
n
,
space
,
decodepats
ps
],
indent
1
(
block
e
)]
align
[
seq
[
str
"val"
,
space
,
var_bind
n
,
space
,
decodepats
ps
,
is
],
indent
3
(
exp
e
)]
|
DECODEdecl
(
n
,
ps
,
Sum
.
INR
ges
)
=>
align
[
seq
[
str
"
fn "
,
var_bind
n
,
space
,
decodepats
ps
],
indent
1
(
align
[
str
"
val"
,
space
,
var_bind
n
,
space
,
decodepats
ps
,
is
],
indent
3
(
align
Prefix
(
map
(
fn
(
e1
,
e2
)
=>
align
[
seq
[
exp
e1
,
str
":"
],
indent
1
(
block
e2
)])
ges
))]
seq
[
exp
e1
,
is
,
space
,
exp
e2
])
ges
,
"| "
))]
|
LETRECdecl
d
=>
recdecl
d
and
decodepats
ps
=
...
...
@@ -205,51 +207,54 @@ functor MkAst (Core: AST_CORE) = struct
|
STRlit
s
=>
str
s
|
VEClit
s
=>
seq
[
str
"'"
,
str
s
,
str
"'"
]
and
block
t
=
align
[
seq
[
lb
,
exp
t
],
rb
]
and
exp
t
=
case
t
of
MARKexp
t'
=>
exp
(
#tree
t'
)
|
LETRECexp
(
ds
,
e
)
=>
align
[
align
(
map
recdecl
ds
),
exp
e
]
align
[
align
[
str
"let"
,
indent
3
(
align
(
map
recdecl
ds
))],
align
[
str
"in"
,
indent
3
(
exp
e
)]]
|
IFexp
(
iff
,
thenn
,
elsee
)
=>
align
[
seq
[
str
"if"
,
space
,
lp
,
exp
iff
,
rp
],
indent
1
(
block
thenn
),
str
"else"
,
indent
1
(
block
elsee
)]
align
[
align
[
seq
[
str
"if"
,
space
,
exp
iff
],
indent
3
(
align
[
str
"then"
,
indent
3
(
exp
thenn
)])],
align
[
str
"else"
,
indent
3
(
exp
elsee
)]]
|
CASEexp
(
e
,
cs
)
=>
align
[
seq
[
str
"case"
,
space
,
lp
,
exp
e
,
rp
],
(
indent
1
(
align
[
seq
[
lb
,
align
(
map
casee
cs
)],
rb
]))]
[
seq
[
str
"case"
,
space
,
exp
e
,
str
"of"
],
indent
3
(
alignPrefix
(
map
casee
cs
,
"| "
))]
|
BINARYexp
(
e1
,
opid
,
e2
)
=>
seq
[
exp
e1
,
space
,
infixop
opid
,
space
,
exp
e2
]
|
APPLYexp
(
e1
,
[
e2
as
APPLYexp
_])
=>
seq
[
exp
e1
,
space
,
lp
,
exp
e2
,
rp
]
|
APPLYexp
(
e1
,
es
)
=>
seq
[
exp
e1
,
args
(
map
exp
es
)]
seq
[
infixop
opid
,
space
,
exp
e1
,
space
,
exp
e2
]
|
APPLYexp
(
e1
,
es
)
=>
seq
[
exp
e1
,
space
,
seq
(
separate
(
map
exp
es
,
" "
))]
|
RECORDexp
fs
=>
listex
"{"
"}"
","
(
map
field
fs
)
|
SELECTexp
f
=>
seq
[
str
"$"
,
field_use
f
]
|
UPDATEexp
fs
=>
seq
[
str
"@"
,
listex
"{"
"}"
","
(
map
fieldOpt
fs
)]
|
LITexp
l
=>
lit
l
|
SEQexp
ss
=>
align
(
separateRight
(
map
seqexp
ss
,
";"
))
|
SEQexp
ss
=>
align
[
align
[
str
"do"
,
indent
3
(
align
(
separateRight
(
map
seqexp
ss
,
";"
)))],
str
"end"
]
|
IDexp
id
=>
var_use
id
|
CONexp
con
=>
con_use
con
|
FNexp
(
xs
,
e
)
=>
seq
[
args
(
map
var_bind
xs
),
indent
1
(
block
e
)]
and
args
x
=
seq
[
space
,
listex
""
""
","
x
]
|
FNexp
(
xs
,
e
)
=>
seq
[
str
"
\\
"
,
args
xs
,
str
"."
,
exp
e
]
and
infixop
t
=
case
t
of
MARKinfixop
t'
=>
infixop
(
#tree
t'
)
|
OPinfixop
opid
=>
op_id
opid
and
recdecl
(
n
,
args
,
e
)
=
and
args
xs
=
seq
(
separate
(
map
var_bind
xs
,
" "
))
and
recdecl
(
f
,
xs
,
e
)
=
align
[
seq
[
str
"fn "
,
var_bind
n
,
space
,
seq
(
separate
(
map
var_bind
args
,
", "
))],
indent
1
(
block
e
)]
[
str
"val"
,
space
,
var_bind
f
,
space
,
args
xs
,
space
,
str
"="
],
indent
3
(
exp
e
)]
and
seqexp
t
=
case
t
of
...
...
@@ -265,8 +270,8 @@ functor MkAst (Core: AST_CORE) = struct
and
casee
(
p
,
e
)
=
align
[
seq
[
pat
p
,
str
":"
],
indent
1
(
block
e
)]
[
seq
[
pat
p
,
space
,
str
":"
],
indent
3
(
exp
e
)]
and
def
(
nameAndArgs
,
body
)
=
align
[
nameAndArgs
,
indent
2
body
]
...
...
detail/semantic/primitives.sml
View file @
82118c7e
...
...
@@ -89,10 +89,20 @@ structure Primitives = struct
flow
=
noFlow
},
{
name
=
"false"
,
ty
=
VEC
(
CONST
1
),
flow
=
noFlow
},
{
name
=
"consume"
,
ty
=
MONAD
(
VEC
size
,
stateA
,
stateA'
),
{
name
=
"consume
8
"
,
ty
=
MONAD
(
VEC
size
,
stateA
,
stateA'
),
flow
=
BD
.
meetVarZero
(
bvar
size
)
o
BD
.
meetVarImpliesVar
(
bvar
stateA'
,
bvar
stateA
)},
{
name
=
"unconsume"
,
ty
=
MONAD
(
UNIT
,
stateB
,
stateB'
),
{
name
=
"unconsume8"
,
ty
=
MONAD
(
UNIT
,
stateB
,
stateB'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateB'
,
bvar
stateB
)},
{
name
=
"consume16"
,
ty
=
MONAD
(
VEC
size
,
stateA
,
stateA'
),
flow
=
BD
.
meetVarZero
(
bvar
size
)
o
BD
.
meetVarImpliesVar
(
bvar
stateA'
,
bvar
stateA
)},
{
name
=
"unconsume16"
,
ty
=
MONAD
(
UNIT
,
stateB
,
stateB'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateB'
,
bvar
stateB
)},
{
name
=
"consume32"
,
ty
=
MONAD
(
VEC
size
,
stateA
,
stateA'
),
flow
=
BD
.
meetVarZero
(
bvar
size
)
o
BD
.
meetVarImpliesVar
(
bvar
stateA'
,
bvar
stateA
)},
{
name
=
"unconsume32"
,
ty
=
MONAD
(
UNIT
,
stateB
,
stateB'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateB'
,
bvar
stateB
)},
{
name
=
"slice"
,
ty
=
MONAD
(
freshVar
(),
stateC
,
stateC'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateC'
,
bvar
stateC
)},
...
...
@@ -177,10 +187,20 @@ structure Primitives = struct
flow
=
BD
.
meetVarZero
(
bvar
s17
)
o
BD
.
meetVarZero
(
bvar
s18
)
o
BD
.
meetVarZero
(
bvar
s19
)},
{
name
=
"%consume"
,
ty
=
MONAD
(
VEC
size
,
stateJ
,
stateJ'
),
{
name
=
"%consume8"
,
ty
=
MONAD
(
VEC
size
,
stateJ
,
stateJ'
),
flow
=
BD
.
meetVarZero
(
bvar
size
)
o
BD
.
meetVarImpliesVar
(
bvar
stateJ'
,
bvar
stateJ
)},
{
name
=
"%unconsume8"
,
ty
=
MONAD
(
UNIT
,
stateK
,
stateK'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateK'
,
bvar
stateK
)},
{
name
=
"%consume16"
,
ty
=
MONAD
(
VEC
size
,
stateJ
,
stateJ'
),
flow
=
BD
.
meetVarZero
(
bvar
size
)
o
BD
.
meetVarImpliesVar
(
bvar
stateJ'
,
bvar
stateJ
)},
{
name
=
"%unconsume16"
,
ty
=
MONAD
(
UNIT
,
stateK
,
stateK'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateK'
,
bvar
stateK
)},
{
name
=
"%consume32"
,
ty
=
MONAD
(
VEC
size
,
stateJ
,
stateJ'
),
flow
=
BD
.
meetVarZero
(
bvar
size
)
o
BD
.
meetVarImpliesVar
(
bvar
stateJ'
,
bvar
stateJ
)},
{
name
=
"%unconsume"
,
ty
=
MONAD
(
UNIT
,
stateK
,
stateK'
),
{
name
=
"%unconsume
32
"
,
ty
=
MONAD
(
UNIT
,
stateK
,
stateK'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateK'
,
bvar
stateK
)},
{
name
=
"%slice"
,
ty
=
MONAD
(
freshVar
(),
stateL
,
stateL'
),
flow
=
BD
.
meetVarImpliesVar
(
bvar
stateL'
,
bvar
stateL
)}
...
...
examples/x86/cli-println.c
View file @
82118c7e
/* vim:cindent:ts=2:sw=2:expandtab */
#include
<dis.h>
int
main
(
int
argc
,
char
**
argv
)
{
...
...
@@ -10,12 +12,13 @@ int main (int argc, char** argv) {
int
x
=
fscanf
(
stdin
,
"%x"
,
&
c
);
switch
(
x
)
{
case
EOF
:
break
;
goto
done
;
case
0
:
__fatal
(
"invalid input, should be in hex form: '0f 0b ..'"
);
}
blob
[
i
]
=
c
&
0xff
;
}
done:
__decode
(
__decode__
,
blob
,
i
,
&
insn
);