Skip to content
GitLab
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
c3c51c6d
Commit
c3c51c6d
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2004-05-23 11:00:56 by afrisch] Simplify idents
Original author: afrisch Date: 2004-05-23 11:00:57+00:00
parent
b6bd8da3
Changes
9
Hide whitespace changes
Inline
Side-by-side
compile/compile.ml
View file @
c3c51c6d
...
...
@@ -125,7 +125,7 @@ and compile_branch env tail br =
vars
=
Env
.
add
x
(
Stack
env
.
stack_size
)
env
.
vars
;
stack_size
=
env
.
stack_size
+
1
}
)
env
(
Patterns
.
fv
_list
br
.
Typed
.
br_pat
)
in
)
env
(
Patterns
.
fv
br
.
Typed
.
br_pat
)
in
(
br
.
Typed
.
br_pat
,
compile
env
tail
br
.
Typed
.
br_body
)
...
...
@@ -159,7 +159,7 @@ let compile_eval env e = [ Push (compile_expr env e); Pop ]
let
compile_let_decl
env
decl
=
let
pat
=
decl
.
Typed
.
let_pat
in
let
(
env
,
code
)
=
enter_globals
env
(
Patterns
.
fv
_list
pat
)
in
let
(
env
,
code
)
=
enter_globals
env
(
Patterns
.
fv
pat
)
in
(
env
,
(
Push
(
compile_expr
env
decl
.
Typed
.
let_body
))
::
(
Split
pat
)
::
code
)
let
compile_rec_funs
env
funs
=
...
...
driver/cduce.ml
View file @
c3c51c6d
...
...
@@ -275,6 +275,7 @@ let run rule ppf ppf_err input =
with
exn
->
catch_exn
ppf_err
exn
;
false
let
topinput
=
run
Parser
.
top_phrases
let
script
=
run
Parser
.
prog
ifdef
ML_INTERFACE
then
let
check_ml
cu
id
out_dir
out
=
...
...
driver/cduce.mli
View file @
c3c51c6d
val
toplevel
:
bool
ref
val
verbose
:
bool
ref
val
script
:
Format
.
formatter
->
Format
.
formatter
->
char
Stream
.
t
->
bool
val
topinput
:
Format
.
formatter
->
Format
.
formatter
->
char
Stream
.
t
->
bool
val
dump_env
:
Format
.
formatter
->
unit
...
...
misc/custom.ml
View file @
c3c51c6d
...
...
@@ -40,8 +40,21 @@ module String : T with type t = string = struct
type
t
=
string
let
dump
=
Format
.
pp_print_string
let
check
s
=
()
let
equal
:
t
->
t
->
bool
=
(
=
)
let
compare
:
t
->
t
->
int
=
Pervasives
.
compare
let
rec
compare_string_aux
s1
s2
l
=
if
(
l
==
0
)
then
0
else
let
l
=
pred
l
in
let
c1
=
Char
.
code
(
String
.
unsafe_get
s1
l
)
and
c2
=
Char
.
code
(
String
.
unsafe_get
s2
l
)
in
if
c1
!=
c2
then
c2
-
c1
else
compare_string_aux
s1
s2
l
let
compare
s1
s2
=
let
l1
=
String
.
length
s1
and
l2
=
String
.
length
s2
in
if
l1
!=
l2
then
l2
-
l1
else
compare_string_aux
s1
s2
l1
let
equal
x
y
=
compare
x
y
=
0
let
hash
=
Hashtbl
.
hash
let
serialize
=
Serialize
.
Put
.
string
let
deserialize
=
Serialize
.
Get
.
string
...
...
schema/schema_parser.mli
View file @
c3c51c6d
...
...
@@ -4,11 +4,13 @@
open
Schema_types
open
Schema_xml
(*
(** parse a schema from a PXP source *)
val parse_schema: Pxp_types.source -> schema
(** parse a schema from a PXP node *)
val schema_of_node: pxp_node -> schema
*)
(** shortand for "parse_schema (Pxp_types.from_file <fname>)" *)
val
schema_of_file
:
string
->
schema
...
...
types/ident.ml
View file @
c3c51c6d
module
U
=
Encodings
.
Utf8
module
Id
=
Pool
.
Make
(
U
)
module
IdPool
=
Weak
.
Make
(
U
)
let
id_pool
=
IdPool
.
create
17
module
Id
=
struct
include
U
let
mk
=
IdPool
.
merge
id_pool
let
value
x
=
x
end
type
id
=
U
.
t
let
ident
=
Id
.
mk
let
to_string
id
=
U
.
to_string
(
Id
.
value
id
)
let
print
ppf
id
=
Format
.
fprintf
ppf
"%s"
(
to_string
id
)
module
IdSet
=
SortedList
.
Make
(
Id
)
module
IdMap
=
IdSet
.
Map
module
Env
=
Map
.
Make
(
Id
)
type
id
=
Id
.
t
type
'
a
id_map
=
'
a
IdMap
.
map
type
fv
=
IdSet
.
t
let
ident
=
Id
.
mk
let
to_string
id
=
U
.
to_string
(
Id
.
value
id
)
let
print
ppf
id
=
Format
.
fprintf
ppf
"%s"
(
to_string
id
)
module
Label
=
Ns
.
QName
...
...
types/patterns.ml
View file @
c3c51c6d
...
...
@@ -27,8 +27,7 @@ and node = {
id
:
int
;
mutable
descr
:
descr
;
accept
:
Types
.
Node
.
t
;
fv
:
fv
;
fv_list
:
id
list
;
fv
:
fv
}
and
descr
=
Types
.
t
*
fv
*
d
...
...
@@ -36,7 +35,6 @@ and node = {
let
id
x
=
x
.
id
let
descr
x
=
x
.
descr
let
fv
x
=
x
.
fv
let
fv_list
x
=
x
.
fv_list
let
accept
x
=
Types
.
internalize
x
.
accept
let
printed
=
ref
[]
...
...
@@ -83,9 +81,7 @@ let counter = State.ref "Patterns.counter" 0
let
dummy
=
(
Types
.
empty
,
IdSet
.
empty
,
Dummy
)
let
make
fv
=
incr
counter
;
{
id
=
!
counter
;
descr
=
dummy
;
accept
=
Types
.
make
()
;
fv
=
fv
;
fv_list
=
fv
;
}
{
id
=
!
counter
;
descr
=
dummy
;
accept
=
Types
.
make
()
;
fv
=
fv
}
let
define
x
((
accept
,
fv
,_
)
as
d
)
=
(* assert (x.fv = fv); *)
...
...
@@ -146,7 +142,6 @@ module Node = struct
l
:=
SMemo
.
add
n
.
id
!
l
;
Types
.
Node
.
serialize
t
n
.
accept
;
IdSet
.
serialize
t
n
.
fv
;
Serialize
.
Put
.
list
Id
.
serialize
t
n
.
fv_list
;
serialize_descr
t
n
.
descr
)
and
serialize_descr
s
(
_
,_,
d
)
=
...
...
@@ -193,10 +188,8 @@ module Node = struct
with
Not_found
->
let
accept
=
Types
.
Node
.
deserialize
t
in
let
fv
=
IdSet
.
deserialize
t
in
let
fv_list
=
Serialize
.
Get
.
list
Id
.
deserialize
t
in
incr
counter
;
let
n
=
{
id
=
!
counter
;
descr
=
dummy
;
accept
=
accept
;
fv
=
fv
;
fv_list
=
fv_list
}
in
let
n
=
{
id
=
!
counter
;
descr
=
dummy
;
accept
=
accept
;
fv
=
fv
}
in
l
:=
DMemo
.
add
id
n
!
l
;
n
.
descr
<-
deserialize_descr
t
;
n
...
...
@@ -1058,7 +1051,7 @@ struct
if Types.is_empty (Types.cap t td) then t else
Types.diff t td in*)
let
t'
=
Types
.
diff
t
(
Types
.
descr
(
accept
p
))
in
(
t'
,
(
p'
,
(
fv
_list
p
,
e
))
::
brs
)
(
t'
,
(
p'
,
(
fv
p
,
e
))
::
brs
)
)
(
t
,
[]
)
brs
in
let
pl
=
Array
.
map
(
fun
x
->
[
x
])
(
Array
.
of_list
brs
)
in
...
...
types/patterns.mli
View file @
c3c51c6d
...
...
@@ -24,11 +24,6 @@ val constant: id -> Types.const -> descr
val
id
:
node
->
int
val
descr
:
node
->
descr
val
fv
:
node
->
fv
val
fv_list
:
node
->
id
list
(* fv_list retains the original order of fv, which can
change during serialization/deserialization --> issue
with compilation *)
(* Pattern matching: static semantics *)
...
...
web/examples/build.cd
View file @
c3c51c6d
...
...
@@ -11,7 +11,7 @@ type Example = <example code=Latin1 title=Latin1>Latin1
(** Command line **)
let input =
match argv with
match argv
[]
with
| [ s ] -> s
| _ -> raise "Please specify an input file on the command line"
...
...
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