Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

bug fixes + disabling unstable features

  • Loading branch information...
commit 257ce6de9765fae4f4094315a30723aea7394b39 1 parent 22d1815
@pikatchu authored
View
7 compiler/emit.ml
@@ -592,7 +592,6 @@ and find_function env acc fty f =
fdec
and apply env acc xl tail fk (fty, f) argl =
- let fid = f in
let f = find_function env acc fty f in
let argl = build_args acc argl in
let ret, argl =
@@ -765,7 +764,11 @@ and expr bb env acc (ty, x) e =
let v = IMap.find y acc in
let v =
match uop with
- | Euminus -> build_neg v "" env.builder
+ | Euminus ->
+ (match ty with
+ | Tprim Tint -> build_neg v "" env.builder
+ | Tprim Tfloat -> build_fneg v "" env.builder
+ | _ -> assert false)
in
IMap.add x v acc
| Epartial ((Tfun (k, tyl1, [rty]), f), el) -> (* TODO return list *)
View
4 compiler/estNormalizePatterns.ml
@@ -124,6 +124,7 @@ module Normalize = struct
end
+(*
module RemoveOption = struct
let is_option al =
@@ -188,6 +189,7 @@ module RemoveOption = struct
end
+*)
module RemoveUnderscore = struct
@@ -234,7 +236,7 @@ and module_ t md =
and def t df =
let body = List.map (block t) df.df_body in
let df = { df with df_body = body } in
- let df = RemoveOption.def df in
+(* let df = RemoveOption.def df in *)
df
and block t bl =
View
2  compiler/lexer.mll
@@ -220,7 +220,7 @@ and interface o c pp = parse
interface o c pp lexbuf }
| "(**" { o (Lexing.lexeme lexbuf) ;
interface o (c+1) true lexbuf }
- | tprivate { interface o c false lexbuf }
+(* | tprivate { interface o c false lexbuf } *)
| vprivate { interface o c false lexbuf }
| "(*" { interface o (c+1) false lexbuf }
| '(' { if pp then o (Lexing.lexeme lexbuf) ;
View
8 compiler/llstOfEst.ml
@@ -98,7 +98,7 @@ module VEnv = struct
let empty = {
pointers = Pointer.empty;
is_tagged = ISet.empty;
- is_null = ISet.singleton Naming.none;
+ is_null = ISet.empty;
values = IMap.empty;
types = IMap.empty ;
is_rec = ISet.empty ;
@@ -294,7 +294,7 @@ and make_variant t tag (_, tyl) (types, acc) =
let types = IMap.add tag ty types in
let acc = Llst.Dtype (tag, ty) :: acc in
types, acc
- else if tag = Naming.some
+ else if false (* tag = Naming.some *)
then (match tyl with
[x] ->
let types = IMap.add tag x types in
@@ -466,11 +466,11 @@ and equation t is_last ret (idl, e) acc =
let acc = ([tag], tag_value) :: acc in
let acc = add_casts xl vl acc in
acc
- else if x = Naming.some
+ else (* if x = Naming.some
then
let v = ty_id (List.hd vl) in
(idl, Llst.Eid (Llst.Tid Naming.toption, snd v)) :: acc
- else
+ else *)
let vl = ty_idl vl in
let xl = match IMap.find x t.types with
| Llst.Tptr (Llst.Tstruct tyl) ->
View
4 compiler/main.ml
@@ -167,8 +167,6 @@ let _ =
List.iter (output_interface o) !module_l ; exit 0
else () ;
let base = if !lib = "" then !oname else make_libname !lib in
- if !lib = "" && !root = ""
- then (Printf.fprintf stderr "Root node missing !\n" ; exit 2) ;
let ast = List.fold_left parse [] !module_l in
let ast = if !no_stdlib then ast else parse ast Global.stdlib in
let root_id, nast = Naming.program !root ast in
@@ -185,6 +183,8 @@ let _ =
let ist = IstOfStast.program benv stast in
let ist = ExtractFuns.program ist in
let ist = IstTail.program ist in
+ if !lib = "" && !root = ""
+ then (Printf.fprintf stderr "Root node missing !\n" ; exit 2) ;
if !eval
then (Eval.program root_id ist; exit 0);
if !dump_ist then
View
5 compiler/naming.ml
@@ -61,14 +61,12 @@ let bool = prim_type "bool"
let float = prim_type "float"
let string = prim_type "string"
let tobs = prim_type "obs"
-let toption = prim_type "option"
let array = prim_type "array"
let malloc = prim_value "malloc"
let ifree = prim_value "free"
let vassert = prim_value "assert"
let eunit = prim_value "()"
-let call = prim_value "call"
let bnot = prim_value "not"
let alength = prim_array "length"
@@ -79,9 +77,6 @@ let aget = prim_array "get"
let aset = prim_array "set"
let aswap = prim_array "swap"
-let some = prim_cstr "Some"
-let none = prim_cstr "None"
-
let prim_types = !prim_types
let prim_values = !prim_values
let prim_cstrs = !prim_cstrs
View
2  compiler/neast.ml
@@ -212,6 +212,8 @@ module SubType = struct
let rec type_expr (p1, ty1) (p2, ty2) =
match ty1, ty2 with
+ | Tvar _, Tany
+ | Tany, Tvar _ -> ()
| Tvar _, Tvar _ -> ()
| Tvar _, _ -> Error.too_general p1 p2
| Tapply (_, tyl1), Tapply (_, tyl2) ->
View
1  compiler/neastCheck.ml
@@ -46,7 +46,6 @@ end = struct
let predef = [
Naming.tobs, 1;
- Naming.toption, 1;
]
let add_predef acc (x, y) =
View
2  compiler/stastCheck.ml
@@ -350,8 +350,6 @@ module Env = struct
let rec make mdl =
let t = List.fold_left module_ IMap.empty mdl in
- let option = [Naming.none, 0 ; Naming.some, 1] in
- let t = IMap.add Naming.toption option t in
t
and module_ t md =
View
7 compiler/typing.ml
@@ -269,18 +269,11 @@ module Env = struct
let tassert = tfun [tprim Tbool] [tprim Tunit]
- let tsome =
- let tmp = Ident.tmp() in
- tfun [tvar tmp] [tapply Naming.toption [tvar tmp]]
-
- let tnone = tapply Naming.toption [tany]
let tnot = tfun [tprim Tbool] [tprim Tbool]
let tabs = tfun [tprim Tint] [tprim Tint]
let rec make mdl =
let env = IMap.empty in
- let env = IMap.add Naming.some tsome env in
- let env = IMap.add Naming.none tnone env in
let env = IMap.add Naming.vassert tassert env in
let env = IMap.add Naming.bnot tnot env in
let env = List.fold_left module_ env mdl in
View
2  stdlib/Makefile
@@ -16,6 +16,7 @@ SOURCES =\
debug.c
LML_SOURCES =\
+ option.lml\
pervasives.lml\
array.lml \
print.lml \
@@ -23,6 +24,7 @@ LML_SOURCES =\
math.lml \
thread.lml\
share.lml\
+ closure.lml\
list.lml
OBJECTS = $(SOURCES:.c=.o)
View
2  stdlib/list.lml
@@ -54,7 +54,7 @@ module List = struct
| [] -> acc
| x :: rl -> fold_right f rl (f x acc)
- val release: ('a -> unit) obs * 'a t -> unit
+ val release: ('a -> unit) * 'a t -> unit
let release f l =
match l with
| [] -> ()
View
6 stdlib/share.c
@@ -18,11 +18,11 @@ share_t* share_clone(share_t* x){
return x ;
}
-void* share_release(share_t* x){
+void** share_release(share_t* x){
__sync_fetch_and_sub(&x->counter, 1) ;
if (x->counter == 1){
- void* res = x-> value ;
- free(x) ;
+ void** res = malloc(sizeof(lvalue));
+ *res = x->value ;
return res ;
}
return NULL ;
View
4 stdlib/share.lml
@@ -5,7 +5,7 @@ module Share = struct
val c_make: 'a #-> 'a t = "share_make"
val c_clone: 'a t obs #-> 'a t = "share_clone"
- val c_release: 'a t #-> 'a option = "share_release"
+ val c_release: 'a t #-> 'a Option.t = "share_release"
val visit: 'a t obs #-> 'a obs = "share_visit"
val make: 'a -> 'a t
@@ -14,7 +14,7 @@ module Share = struct
val clone: 'a t obs -> 'a t
let clone x = c_clone x
- val release: 'a t -> 'a option
+ val release: 'a t -> 'a Option.t
let release x = c_release x
end
View
60 test/parsort.lml
@@ -5,6 +5,35 @@ module TestParsort = struct
| Empty
| Cons of int * t
+ val length: t obs * int -> int
+ let length t acc =
+ match t with
+ | Empty -> acc
+ | Cons n t -> length t (acc+1)
+
+ val copy: t obs -> t
+ let copy t =
+ match t with
+ | Empty -> Empty
+ | Cons n t -> Cons n (copy t)
+
+ val ff: t -> unit
+ let ff t =
+ match t with
+ | Empty -> ()
+ | Cons _ t -> ff t
+
+ val to_array: int Array.t * t * int -> int Array.t
+ let to_array t l i =
+ match l with
+ | Empty -> t
+ | Cons n l -> t.(i) <- n ; to_array t l (i+1)
+
+ val from_array: int Array.t obs * t * int -> t
+ let from_array t acc i =
+ if i < 0 then acc
+ else from_array t (Cons t.(i) acc) (i-1)
+
val rev_append: t * t -> t
let rev_append l1 l2 =
match l1 with
@@ -35,22 +64,29 @@ module TestParsort = struct
| Cons x Empty -> n, l1, l2
| Cons x (Cons y rl) -> split (n+1) (Cons x l1) (Cons y l2) rl
- val sort: t -> t
- let sort l =
+ val c_sort: t #-> t
+ let c_sort l =
+ let res = msort l in
+ res
+
+ val msort: t -> t
+ let msort l =
match l with
| Empty -> Empty
| Cons _ Empty as l -> l
| Cons x rl as l ->
let length1, l1, l2 = split 0 Empty Empty l in
- if length1 > 100000
- then
- let l1 = Future.make c_sort l1 in
- let l2 = Future.make c_sort l2 in
- merge Empty (Future.wait l1) (Future.wait l2)
- else merge Empty (sort l1) (sort l2)
+ merge Empty (msort l1) (msort l2)
- val c_sort: t #-> t
- let c_sort l = sort l
+ val sort: t -> t
+ let sort l =
+ let length1, l1, l2 = split 0 Empty Empty l in
+ if false
+ then
+ let l1 = Future.make c_sort l1 in
+ let l2 = msort l2 in
+ merge Empty (Future.wait l1) l2
+ else merge Empty (msort l1) (msort l2)
val make: t * int -> t
let make acc n =
@@ -68,10 +104,10 @@ module TestParsort = struct
let loop n acc =
if n <= 0
then acc
- else loop (n-1) (acc + sum 0 (sort (make Empty 2000000)))
+ else loop (n-1) (acc + sum 0 (sort (make Empty 100000)))
val main: unit -> unit
let main _ =
- Print.int (loop 1 0)
+ Print.int (loop 1 0)
end
Please sign in to comment.
Something went wrong with that request. Please try again.