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
A
alphaLib
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
POTTIER Francois
alphaLib
Commits
f0547a17
Commit
f0547a17
authored
Feb 03, 2017
by
POTTIER Francois
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
First draft of type & term printer for F.
parent
2b2335fa
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
161 additions
and
2 deletions
+161
-2
demos/system-F-type/Main.ml
demos/system-F-type/Main.ml
+2
-2
demos/system-F-type/PPrintAux.ml
demos/system-F-type/PPrintAux.ml
+60
-0
demos/system-F-type/Print.ml
demos/system-F-type/Print.ml
+99
-0
No files found.
demos/system-F-type/Main.ml
View file @
f0547a17
...
...
@@ -4,7 +4,7 @@ open F
open
FTypeChecker
let
identity
:
raw_term
=
TeTyAbs
(
"A"
,
TeAbs
(
"x"
,
Ty
Arrow
(
TyVar
"A"
,
TyVar
"A"
)
,
TeVar
"x"
))
TeTyAbs
(
"A"
,
TeAbs
(
"x"
,
Ty
Var
"A"
,
TeVar
"x"
))
let
identity
:
nominal_term
=
import_term
KitImport
.
empty
identity
...
...
@@ -16,4 +16,4 @@ let ty : raw_typ =
export_typ
KitExport
.
empty
ty
let
()
=
printf
"Success.
\n
%!"
printf
"Success.
\n
This term has type %a.
\n
%!"
(
PPrintAux
.
adapt
Print
.
typ
)
ty
demos/system-F-type/PPrintAux.ml
0 → 100644
View file @
f0547a17
open
PPrint
(* -------------------------------------------------------------------------- *)
(* A block with indentation. *)
let
indentation
=
2
let
block
opening
contents
closing
=
group
(
opening
^^
nest
indentation
(
contents
)
^^
closing
)
let
oblock
opening
contents
=
block
opening
contents
empty
(* -------------------------------------------------------------------------- *)
(* Parentheses with indentation. *)
(* We allow breaking a parenthesized thing into several lines by leaving the
opening and closing parentheses alone on a line and indenting the content. *)
let
parens
d
=
block
lparen
(
break
0
^^
d
)
(
break
0
^^
rparen
)
(* -------------------------------------------------------------------------- *)
(* Lambda-calculus application. *)
let
app
d1
d2
=
(* The following definition would reject a large argument on a line of
its own, indented: *)
(* group (d1 ^^ nest indentation (break 1 ^^ d2)) *)
(* However, that would be redundant with the fact that large arguments
are usually parenthesized, and we already break lines and indent
within the parentheses. So, the following suffices: *)
group
(
d1
^^
space
^^
d2
)
(* -------------------------------------------------------------------------- *)
(* Running a buffer printer in a fresh buffer, and sending the result to an
output channel. *)
let
run
(
oc
:
out_channel
)
(
print
:
Buffer
.
t
->
'
a
->
unit
)
(
x
:
'
a
)
=
let
b
=
Buffer
.
create
1024
in
print
b
x
;
Buffer
.
output_buffer
oc
b
(* -------------------------------------------------------------------------- *)
(* Printing a document into an output channel, with fixed parameters. *)
let
output
(
oc
:
out_channel
)
(
d
:
document
)
=
run
oc
(
PPrintEngine
.
ToBuffer
.
pretty
0
.
9
80
)
d
let
adapt
(
f
:
'
a
->
document
)
:
out_channel
->
'
a
->
unit
=
fun
oc
x
->
output
oc
(
f
x
)
demos/system-F-type/Print.ml
0 → 100644
View file @
f0547a17
open
PPrint
open
PPrintAux
open
F
let
arrow
=
string
"->"
let
forall
=
string
"forall"
let
rec
typ0
ty
=
match
ty
with
|
TyVar
x
->
string
x
|
TyArrow
_
|
TyProduct
_
|
TyForall
_
->
parens
(
typ
ty
)
and
typ1
ty
=
match
ty
with
|
TyProduct
(
ty1
,
ty2
)
->
typ0
ty1
^/^
star
^/^
typ1
ty2
|
_
->
typ0
ty
and
typ2
ty
=
match
ty
with
|
TyArrow
(
ty1
,
ty2
)
->
typ1
ty1
^/^
arrow
^/^
typ2
ty2
|
_
->
typ1
ty
and
typ3
ty
=
match
ty
with
|
TyForall
(
x
,
ty
)
->
forall
^/^
string
x
^^
dot
^/^
typ3
ty
|
_
->
typ2
ty
and
typ
ty
=
typ3
ty
let
rec
term0
t
=
match
t
with
|
TeVar
x
->
string
x
|
TeAbs
_
|
TeApp
_
|
TeLet
_
|
TeTyAbs
_
|
TeTyApp
_
|
TePair
_
|
TeProj
_
->
parens
(
term
t
)
and
term1
t
=
match
t
with
|
TeApp
(
t1
,
t2
)
->
app
(
term1
t1
)
(
term0
t2
)
|
TeTyApp
(
t1
,
ty2
)
->
app
(
term1
t1
)
(
brackets
(
typ
ty2
))
|
TeProj
(
i
,
t
)
->
app
(
string
(
Printf
.
sprintf
"proj%d"
i
))
(
term0
t
)
|
_
->
term0
t
and
term2
t
=
match
t
with
|
TePair
(
t1
,
t2
)
->
term1
t1
^^
comma
^/^
term2
t2
|
_
->
term1
t
and
term3
t
=
match
t
with
|
TeAbs
(
x
,
ty
,
t
)
->
oblock
(
backslash
^^
string
x
^^
colon
^^
typ
ty
^^
dot
)
(
term3
t
)
|
TeLet
(
x
,
t1
,
t2
)
->
block
(
string
"let"
^/^
string
x
^/^
equals
)
(
term
t1
)
(
string
"in"
)
^/^
term
t2
|
TeTyAbs
(
a
,
t
)
->
oblock
(
backslash
^^
backslash
^^
string
a
^^
dot
)
(
term3
t
)
|
_
->
term2
t
and
term
t
=
term3
t
let
term
(
oc
:
out_channel
)
(
t
:
(
string
,
string
)
term
)
:
unit
=
output
oc
(
term
t
)
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