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
cduce
cduce
Commits
5b582d33
Commit
5b582d33
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-11-20 11:41:50 by szach] added support and help for #print_{schema,type}
Original author: szach Date: 2003-11-20 11:41:50+00:00
parent
710ae61e
Changes
1
Hide whitespace changes
Inline
Side-by-side
driver/cduce.ml
View file @
5b582d33
...
...
@@ -68,6 +68,8 @@ let dump_env ppf =
Format
.
fprintf
ppf
"Namespace prefixes:@
\n
%a"
Typer
.
dump_ns
!
typing_env
;
Format
.
fprintf
ppf
"Namespace prefixes used for pretty-printing:@.%t"
Ns
.
InternalPrinter
.
dump
;
Format
.
fprintf
ppf
"Schemas: %s@."
(
String
.
concat
" "
(
Typer
.
get_schema_names
()
));
Format
.
fprintf
ppf
"Values:@."
;
Typer
.
iter_values
!
typing_env
(
fun
x
t
->
dump_value
ppf
x
t
(
get_global_value
x
))
...
...
@@ -75,12 +77,14 @@ let dump_env ppf =
let
directive_help
ppf
=
Format
.
fprintf
ppf
"Toplevel directives:
#quit;; quit the interpreter
#env;; dump current environment
#reinit_ns;; reinitialize namespace processing
#help;; shows this help message
#dump_value <expr>;; dump an XML-ish representation of the resulting
value of a given expression
#quit;; quit the interpreter
#env;; dump current environment
#reinit_ns;; reinitialize namespace processing
#help;; shows this help message
#dump_value <expr>;; dump an XML-ish representation of the resulting
value of a given expression
#print_schema <name>;;
#print_type <name>;;
"
let
rec
print_exn
ppf
=
function
...
...
@@ -272,6 +276,7 @@ let rec collect_types ppf accu = function
Typer
.
enter_types
(
Typer
.
type_defs
!
typing_env
accu
)
!
typing_env
;
rest
let
flush_stdout
()
=
Format
.
fprintf
Format
.
std_formatter
"@."
let
rec
phrases
ppf
phs
=
match
phs
with
|
{
descr
=
Ast
.
FunDecl
_
}
::
_
->
...
...
@@ -287,7 +292,6 @@ let rec phrases ppf phs = match phs with
|
{
descr
=
Ast
.
Using
(
x
,
cu
)
}
::
rest
->
Librarian
.
import
cu
;
Librarian
.
run
Value
.
nil
cu
;
typing_env
:=
Typer
.
enter_cu
x
cu
!
typing_env
;
phrases
ppf
rest
|
{
descr
=
Ast
.
EvalStatement
e
}
::
rest
->
...
...
@@ -305,6 +309,18 @@ let rec phrases ppf phs = match phs with
|
{
descr
=
Ast
.
Directive
`Env
}
::
rest
->
dump_env
ppf
;
phrases
ppf
rest
|
{
descr
=
Ast
.
Directive
(
`Print_schema
schema
)
}
::
rest
->
Schema_common
.
print_schema
ppf
(
Typer
.
get_schema
schema
);
flush_stdout
()
;
phrases
ppf
rest
|
{
descr
=
Ast
.
Directive
(
`Print_type
name
)
}
::
rest
->
Typer
.
dump_type
Format
.
std_formatter
!
typing_env
name
;
flush_stdout
()
;
phrases
ppf
rest
|
{
descr
=
Ast
.
Directive
(
`Print_schema_type
schema_ref
)
}
::
rest
->
Typer
.
dump_schema_type
Format
.
std_formatter
schema_ref
;
flush_stdout
()
;
phrases
ppf
rest
|
{
descr
=
Ast
.
Directive
`Reinit_ns
}
::
rest
->
Typer
.
set_ns_table_for_printer
!
typing_env
;
phrases
ppf
rest
...
...
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