Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
cduce
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
19
Issues
19
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
cduce
cduce
Commits
36e1499d
Commit
36e1499d
authored
Aug 19, 2014
by
Pietro Abate
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Minor change to pretty printing functions
parent
29929a5d
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
91 additions
and
42 deletions
+91
-42
compile/compile.ml
compile/compile.ml
+16
-0
compile/compile.mli
compile/compile.mli
+1
-0
compile/lambda.ml
compile/lambda.ml
+13
-13
compile/lambda.mli
compile/lambda.mli
+3
-1
driver/cduce.ml
driver/cduce.ml
+7
-4
runtime/eval.ml
runtime/eval.ml
+3
-3
runtime/value.ml
runtime/value.ml
+6
-6
runtime/value.mli
runtime/value.mli
+2
-1
types/ident.ml
types/ident.ml
+8
-0
types/types.ml
types/types.ml
+1
-1
typing/typed.ml
typing/typed.ml
+12
-13
typing/typer.ml
typing/typer.ml
+18
-0
typing/typer.mli
typing/typer.mli
+1
-0
No files found.
compile/compile.ml
View file @
36e1499d
...
...
@@ -12,6 +12,22 @@ type env = {
global_size
:
int
}
let
pp_vars
ppf
vars
=
Ident
.
pp_env
Lambda
.
Print
.
pp_vloc
ppf
vars
let
pp_gamma
ppf
gamma
=
Ident
.
pp_idmap
Types
.
Print
.
pp_node
ppf
gamma
let
pp_xi
ppf
xi
=
Ident
.
pp_idmap
Var
.
Set
.
pp
ppf
xi
let
pp_env
ppf
env
=
Format
.
fprintf
ppf
"{vars=%a,sigma=%a,gamma=%a,xi=%a}"
pp_vars
env
.
vars
Lambda
.
Print
.
pp_sigma
env
.
sigma
pp_gamma
env
.
gamma
pp_xi
env
.
xi
let
global_size
env
=
env
.
global_size
let
mk
cu
=
{
...
...
compile/compile.mli
View file @
36e1499d
...
...
@@ -8,6 +8,7 @@ val global_size: env -> int
val
empty
:
Compunit
.
t
->
env
val
empty_toplevel
:
env
val
pp_env
:
Format
.
formatter
->
env
->
unit
val
find
:
id
->
env
->
var_loc
val
find_slot
:
id
->
env
->
int
...
...
compile/lambda.ml
View file @
36e1499d
...
...
@@ -95,7 +95,7 @@ module Print = struct
(
Encodings
.
Utf8
.
to_string
name
)
pp_vloc
value
let
rec
pp_
lambda_
sigma
ppf
=
let
rec
pp_sigma
ppf
=
let
pp_aux
ppf
=
Utils
.
pp_list
(
fun
ppf
(
t1
,
t2
)
->
Format
.
fprintf
ppf
"(%a -> %a)"
...
...
@@ -105,32 +105,32 @@ module Print = struct
in
function
|
List
ll
->
Types
.
Tallying
.
CS
.
pp_sl
ppf
ll
|
Comp
(
s1
,
s2
)
->
Format
.
fprintf
ppf
"Comp(%a,%a)"
pp_
lambda_sigma
s1
pp_lambda
_sigma
s2
|
Sel
(
x
,
iface
,
s
)
->
Format
.
fprintf
ppf
"Sel(%a,%a,%a)"
pp_vloc
x
pp_aux
iface
pp_
lambda_
sigma
s
|
Comp
(
s1
,
s2
)
->
Format
.
fprintf
ppf
"Comp(%a,%a)"
pp_
sigma
s1
pp
_sigma
s2
|
Sel
(
x
,
iface
,
s
)
->
Format
.
fprintf
ppf
"Sel(%a,%a,%a)"
pp_vloc
x
pp_aux
iface
pp_sigma
s
|
Identity
->
Format
.
fprintf
ppf
"Id"
and
pp
_lambda
ppf
=
function
and
pp
ppf
=
function
|
Var
v
->
Format
.
fprintf
ppf
"Var(%a)"
pp_vloc
v
|
TVar
(
v
,
sigma
)
->
Format
.
fprintf
ppf
"TVar(%a,%a)"
pp_vloc
v
pp_
lambda_
sigma
sigma
|
Apply
(
e1
,
e2
)
->
Format
.
fprintf
ppf
"Apply(%a,%a)"
pp
_lambda
e1
pp_lambda
e2
|
TVar
(
v
,
sigma
)
->
Format
.
fprintf
ppf
"TVar(%a,%a)"
pp_vloc
v
pp_sigma
sigma
|
Apply
(
e1
,
e2
)
->
Format
.
fprintf
ppf
"Apply(%a,%a)"
pp
e1
pp
e2
|
PolyAbstraction
(
va
,
l
,
b
,
i
,
sigma
)
->
Format
.
fprintf
ppf
"PolyAbstraction(%a,,%a,,%a)"
pp_vloc_array
va
pp_lbranches
b
pp_
lambda_
sigma
sigma
Format
.
fprintf
ppf
"PolyAbstraction(%a,,%a,,%a)"
pp_vloc_array
va
pp_lbranches
b
pp_sigma
sigma
|
Abstraction
(
va
,
l
,
b
,
i
)
->
Format
.
fprintf
ppf
"Abstraction(%a,,%a,,)"
pp_vloc_array
va
pp_lbranches
b
|
Check
(
_
)
->
Format
.
fprintf
ppf
"Check"
|
Const
(
v
)
->
Format
.
fprintf
ppf
"Const(%a)"
Value
.
Print
.
pp
_value
v
|
Pair
(
e1
,
e2
)
->
Format
.
fprintf
ppf
"Pair(%a, %a)"
pp
_lambda
e1
pp_lambda
e2
|
Const
(
v
)
->
Format
.
fprintf
ppf
"Const(%a)"
Value
.
Print
.
pp
v
|
Pair
(
e1
,
e2
)
->
Format
.
fprintf
ppf
"Pair(%a, %a)"
pp
e1
pp
e2
|
String
(
_
)
->
Format
.
fprintf
ppf
"String"
|
Match
(
e
,
brs
)
->
Format
.
fprintf
ppf
"Match(%a, %a)"
pp
_lambda
e
pp_lbranches
brs
|
Op
(
str
,
le
)
->
Format
.
fprintf
ppf
"Op(%s, (%a))"
str
(
Utils
.
pp_list
pp
_lambda
)
le
|
Match
(
e
,
brs
)
->
Format
.
fprintf
ppf
"Match(%a, %a)"
pp
e
pp_lbranches
brs
|
Op
(
str
,
le
)
->
Format
.
fprintf
ppf
"Op(%s, (%a))"
str
(
Utils
.
pp_list
pp
)
le
|
_
->
()
and
pp_lbranches
ppf
brs
=
Format
.
fprintf
ppf
"{accept_chars=%b; brs_disp=<disp>; brs_rhs=[| %a |]; brs_stack_pos=%d}"
brs
.
brs_accept_chars
pp_patrhs
brs
.
brs_rhs
brs
.
brs_stack_pos
and
pp_patrhs
ppf
arr
=
Array
.
iter
(
function
|
Auto_pat
.
Match
(
i
,
e
)
->
Format
.
fprintf
ppf
"(%d, %a)"
i
pp
_lambda
e
|
_
->
()
)
arr
Array
.
iter
(
function
|
Auto_pat
.
Match
(
i
,
e
)
->
Format
.
fprintf
ppf
"(%d, %a)"
i
pp
e
|
_
->
()
)
arr
let
string_of_lambda
=
Utils
.
string_of_formatter
pp
_lambda
let
string_of_lambda
=
Utils
.
string_of_formatter
pp
end
compile/lambda.mli
View file @
36e1499d
...
...
@@ -77,6 +77,8 @@ type code_item =
type
code
=
code_item
list
module
Print
:
sig
val
pp_lambda
:
Format
.
formatter
->
expr
->
unit
val
pp
:
Format
.
formatter
->
expr
->
unit
val
pp_sigma
:
Format
.
formatter
->
sigma
->
unit
val
pp_vloc
:
Format
.
formatter
->
var_loc
->
unit
val
string_of_lambda
:
expr
->
string
end
driver/cduce.ml
View file @
36e1499d
...
...
@@ -62,7 +62,9 @@ let dump_env ppf tenv cenv =
Ns
.
InternalPrinter
.
dump
;
Format
.
fprintf
ppf
"Values:@."
;
Typer
.
iter_values
tenv
(
fun
x
t
->
dump_value
ppf
x
t
(
get_global_value
cenv
x
))
(
fun
x
t
->
dump_value
ppf
x
t
(
get_global_value
cenv
x
));
Format
.
fprintf
ppf
"TEnv:%a@."
Typer
.
pp_env
tenv
;
Format
.
fprintf
ppf
"CEnv:%a@."
Compile
.
pp_env
cenv
let
directive_help
ppf
=
Format
.
fprintf
ppf
...
...
@@ -248,13 +250,14 @@ let debug ppf tenv cenv = function
|
Not_found
->
Format
.
fprintf
ppf
"Empty@."
)
|
`Typed
e
->
Format
.
fprintf
ppf
"[DEBUG:typed]@."
;
let
r
,
_
=
Typer
.
type_expr
tenv
e
in
Format
.
fprintf
ppf
"%a@."
Typed
.
Print
.
pp_typed
r
let
r
,
env
=
Typer
.
type_expr
tenv
e
in
Format
.
fprintf
ppf
"%a@."
Typed
.
Print
.
pp
r
;
Format
.
fprintf
ppf
"%a@."
Typer
.
pp_env
tenv
|
`Lambda
e
->
Format
.
fprintf
ppf
"[DEBUG:lambda]@."
;
let
r
,
_
=
Typer
.
type_expr
tenv
e
in
let
lambdaexpr
,
lsize
=
Compile
.
compile_expr
cenv
r
in
Format
.
fprintf
ppf
"%a@."
Lambda
.
Print
.
pp
_lambda
lambdaexpr
Format
.
fprintf
ppf
"%a@."
Lambda
.
Print
.
pp
lambdaexpr
let
flush_ppf
ppf
=
Format
.
fprintf
ppf
"@."
...
...
runtime/eval.ml
View file @
36e1499d
...
...
@@ -63,17 +63,17 @@ let eval_var env locals = function
let
tag_op_resolved
=
Obj
.
tag
(
Obj
.
repr
(
OpResolved
((
fun
_
->
assert
false
)
,
[]
)))
let
tag_const
=
Obj
.
tag
(
Obj
.
repr
(
Const
(
Obj
.
magic
0
)))
let
pp_lambda_env
ppf
env
locals
=
let
pp_lambda_env
ppf
(
env
,
locals
)
=
let
aux
a
=
let
l
=
Array
.
to_list
a
in
let
sl
=
List
.
mapi
(
fun
i
v
->
Format
.
fprintf
Format
.
str_formatter
"%d : %a
@."
i
Value
.
Print
.
pp_value
v
;
Format
.
fprintf
Format
.
str_formatter
"%d : %a
"
i
Value
.
Print
.
pp
v
;
Format
.
flush_str_formatter
()
)
l
in
String
.
concat
","
sl
in
Format
.
fprintf
ppf
"
env = {%s}; locals = {%s
}"
(
aux
env
)
(
aux
locals
)
Format
.
fprintf
ppf
"
{env = {%s}; locals = {%s}
}"
(
aux
env
)
(
aux
locals
)
let
apply_sigma
sigma
=
function
|
Value
.
Pair
(
v1
,
v2
,
sigma'
)
->
Value
.
Pair
(
v1
,
v2
,
Value
.
comp
sigma
sigma'
)
...
...
runtime/value.ml
View file @
36e1499d
...
...
@@ -325,11 +325,11 @@ module Print = struct
in
Utils
.
pp_list
f
ppf
l
let
rec
pp
_value
ppf
=
function
let
rec
pp
ppf
=
function
|
Pair
(
v1
,
v2
,
sigma
)
->
Format
.
fprintf
ppf
"(%a,%a,%a)"
pp
_value
v1
pp
_value
v2
pp
v1
pp
v2
pp_sigma
sigma
|
Xml
(
_
,_,_,
sigma
)
->
Format
.
fprintf
ppf
"Xml(%a)"
pp_sigma
sigma
|
XmlNs
(
_
,_,_,_,
sigma
)
->
Format
.
fprintf
ppf
"XmlNs(%a)"
pp_sigma
sigma
...
...
@@ -348,12 +348,12 @@ module Print = struct
|
String_utf8
(
_
,_,
s
,_
)
->
Format
.
fprintf
ppf
"
\"
%s
\"
"
(
Encodings
.
Utf8
.
get_str
s
)
|
Concat
(
v1
,
v2
,
sigma
)
->
Format
.
fprintf
ppf
"Concat(%a, %a, %a)"
pp
_value
v1
pp
_value
v2
pp
v1
pp
v2
pp_sigma
sigma
|
Absent
->
Format
.
fprintf
ppf
"Absent"
let
string_of_value
=
Utils
.
string_of_formatter
pp
_value
let
string_of_value
=
Utils
.
string_of_formatter
pp
end
...
...
runtime/value.mli
View file @
36e1499d
...
...
@@ -34,7 +34,8 @@ val failwith': string -> 'a (* "failwith" for CDuce exceptions *)
val
tagged_tuple
:
string
->
t
list
->
t
module
Print
:
sig
val
pp_value
:
Format
.
formatter
->
t
->
unit
val
pp
:
Format
.
formatter
->
t
->
unit
val
pp_sigma
:
Format
.
formatter
->
sigma
->
unit
val
string_of_value
:
t
->
string
end
...
...
types/ident.ml
View file @
36e1499d
...
...
@@ -20,3 +20,11 @@ module LabelMap = LabelSet.Map
type
label
=
Ns
.
Label
.
t
type
'
a
label_map
=
'
a
LabelMap
.
map
let
pp_env
f
ppf
env
=
let
f
ppf
(
e
,
v
)
=
Format
.
fprintf
ppf
"%a:%a"
print
e
f
v
in
Utils
.
pp_list
~
delim
:
(
"<"
,
">"
)
~
sep
:
";"
f
ppf
(
Env
.
bindings
env
)
let
pp_idmap
f
ppf
map
=
let
f
ppf
(
e
,
v
)
=
Format
.
fprintf
ppf
"%a:%a"
print
e
f
v
in
Utils
.
pp_list
~
delim
:
(
"<"
,
">"
)
~
sep
:
";"
f
ppf
(
IdMap
.
get
map
)
types/types.ml
View file @
36e1499d
...
...
@@ -2199,7 +2199,7 @@ struct
|
[
h
]
->
(
pr_e
pri
)
ppf
h
|
_
->
opar
ppf
~
level
:
pri_op
pri
;
loop
l
;
loop
(
List
.
rev
l
)
;
cpar
ppf
~
level
:
pri_op
pri
...
...
typing/typed.ml
View file @
36e1499d
...
...
@@ -101,15 +101,16 @@ module Print = struct
|
Types
.
String
(
_
,
_
,
s
,
_
)
->
Format
.
fprintf
ppf
"
\"
%s
\"
"
(
Encodings
.
Utf8
.
to_string
s
)
|
_
->
assert
false
let
rec
pp
_typed
ppf
e
=
let
rec
pp
ppf
e
=
Format
.
fprintf
ppf
"{typ: %a; descr= %a}"
Types
.
Print
.
pp_type
e
.
exp_typ
pp_
typed_
aux
e
pp_aux
e
and
pp_
typed_
aux
ppf
e
=
and
pp_aux
ppf
e
=
match
e
.
exp_descr
with
|
Forget
(
e
,
_
)
->
Format
.
fprintf
ppf
"Forget(%a)"
pp_typed
e
|
Check
(
_
,
e
,
_
)
->
Format
.
fprintf
ppf
"Check(%a)"
pp_typed
e
|
Subst
(
e
,
sl
)
->
Format
.
fprintf
ppf
"%a @@ %a"
pp
e
Types
.
Tallying
.
CS
.
pp_sl
sl
|
Forget
(
e
,
_
)
->
Format
.
fprintf
ppf
"Forget(%a)"
pp
e
|
Check
(
_
,
e
,
_
)
->
Format
.
fprintf
ppf
"Check(%a)"
pp
e
|
TVar
(
id
,
name
)
->
Format
.
fprintf
ppf
"TVar(%s,%s)"
(
string_of_int
(
Upool
.
int
id
))
...
...
@@ -123,20 +124,18 @@ module Print = struct
(
string_of_int
(
Upool
.
int
id
))
(
Encodings
.
Utf8
.
to_string
name
)
|
Apply
(
e1
,
e2
)
->
Format
.
fprintf
ppf
"(%a).(%a)"
pp
_typed
e1
pp_typed
e2
Format
.
fprintf
ppf
"(%a).(%a)"
pp
e1
pp
e2
|
Abstraction
(
abstr
)
->
Format
.
fprintf
ppf
"Abstraction(%a)"
pp_abst
abstr
|
Cst
(
cst
)
->
pp_const
ppf
cst
|
Pair
(
e1
,
e2
)
->
Format
.
fprintf
ppf
"(%a, %a)"
pp
_typed
e1
pp_typed
e2
Format
.
fprintf
ppf
"(%a, %a)"
pp
e1
pp
e2
|
String
(
_
,
_
,
s
,
_
)
->
Format
.
fprintf
ppf
"
\"
%s
\"
"
(
Encodings
.
Utf8
.
to_string
s
)
|
Match
(
e
,
b
)
->
Format
.
fprintf
ppf
"Match(%a,%a)"
pp_typed
e
pp_branches
b
|
Subst
(
e
,
s
)
->
Format
.
fprintf
ppf
"Subst(%a,[%a])"
pp_typed
e
Types
.
Tallying
.
CS
.
pp_sl
s
Format
.
fprintf
ppf
"Match(%a,%a)"
pp
e
pp_branches
b
|
Op
(
s
,
i
,
l
)
->
Format
.
fprintf
ppf
"(%s, %d, %a)"
s
i
(
Utils
.
pp_list
pp
_typed
)
l
Format
.
fprintf
ppf
"(%s, %d, %a)"
s
i
(
Utils
.
pp_list
pp
)
l
|
_
->
assert
false
and
pp_abst
ppf
abstr
=
...
...
@@ -178,7 +177,7 @@ module Print = struct
pp_fv
br
.
br_vars_empty
Patterns
.
pp_node
br
.
br_pat
Types
.
Print
.
pp_type
br
.
br_body
.
exp_typ
pp
_typed
br
.
br_body
pp
br
.
br_body
in
Utils
.
pp_list
f
ppf
brs
...
...
@@ -191,5 +190,5 @@ module Print = struct
let
pp_aux
ppf
(
x
,
s
)
=
Format
.
fprintf
ppf
"%a : %a"
Ident
.
print
x
Var
.
Set
.
pp
s
in
Utils
.
pp_list
~
sep
:
";"
pp_aux
ppf
(
Ident
.
IdMap
.
get
m
)
let
string_of_typed
=
Utils
.
string_of_formatter
pp
_typed
let
string_of_typed
=
Utils
.
string_of_formatter
pp
end
typing/typer.ml
View file @
36e1499d
...
...
@@ -56,6 +56,24 @@ type t = {
keep_ns
:
bool
}
let
pp_env
ppf
env
=
(*
let pp_item ppf = function
|Type t | Val t -> Types.Print.pp_type ppf t
|ECDuce _ -> Format.fprintf ppf "ECDuce"
|ESchema _ -> Format.fprintf ppf "ESchema"
|ENamespace _ -> Format.fprintf ppf "ENamespace"
|_ -> ()
in
*)
Format
.
printf
"{gamma=%a; delta=%a}"
(
Ident
.
pp_idmap
Types
.
Print
.
pp_node
)
env
.
gamma
Var
.
Set
.
pp
env
.
delta
(*
(Ident.pp_env pp_item) env.ids
*)
;;
(* Namespaces *)
let
set_ns_table_for_printer
env
=
...
...
typing/typer.mli
View file @
36e1499d
...
...
@@ -13,6 +13,7 @@ exception Error of string
exception
Warning
of
string
*
Types
.
t
val
empty_env
:
t
val
pp_env
:
Format
.
formatter
->
t
->
unit
val
register_types
:
string
->
t
->
unit
(* Register types of the environment for the pretty-printer *)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a 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