Skip to content

Try curry #82

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Feb 8, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -48,5 +48,6 @@ ocaml/man
jscomp/bench/*.js
*.bak
.vscode
*.jsx
osc
jscomp/pre_load.js
2 changes: 1 addition & 1 deletion jscomp/compiler.mllib
Original file line number Diff line number Diff line change
Expand Up @@ -73,7 +73,7 @@ js_fun_env
js_pass_flatten_and_mark_dead
js_pass_scope
js_call_info

js_pass_debug
js_of_lam_float_record
js_of_lam_record
js_of_lam_tuple
Expand Down
2 changes: 1 addition & 1 deletion jscomp/config_util.ml
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ let find_cmj file =
-> Lazy.force v
| exception Not_found
->
Ext_log.warn __LOC__ "@[%s not found @]@." file ;
Ext_log.warn __LOC__ "@[%s not found @]" file ;
Js_cmj_format.dummy (); (* FIXME *)
end
end
41 changes: 21 additions & 20 deletions jscomp/ext_log.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,41 +21,42 @@



type ('a,'b) logging =
('a -> 'b, Format.formatter, unit, unit, unit, unit) format6 -> 'a -> 'b

let err str f v =
Format.fprintf Format.err_formatter ("%s " ^^ f) str v
type 'a logging = ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a

let ierr b str f v =
let err str f =
Format.fprintf Format.err_formatter ("%s " ^^ f) str

let ierr b str f =
if b then
Format.fprintf Format.err_formatter ("%s " ^^ f) str v
Format.fprintf Format.err_formatter ("%s " ^^ f) str
else
Format.ifprintf Format.err_formatter ("%s " ^^ f) str v
Format.ifprintf Format.err_formatter ("%s " ^^ f) str

let warn str f v =
Format.fprintf Format.err_formatter ("WARN: %s " ^^ f) str v
let warn str f =
Format.fprintf Format.err_formatter ("WARN: %s " ^^ f ^^ "@.") str



let iwarn b str f v =
let iwarn b str f =
if b then
Format.fprintf Format.err_formatter ("WARN: %s " ^^ f) str v
Format.fprintf Format.err_formatter ("WARN: %s " ^^ f) str
else
Format.ifprintf Format.err_formatter ("WARN: %s " ^^ f) str v
Format.ifprintf Format.err_formatter ("WARN: %s " ^^ f) str

let dwarn str f v =
(* TODO: add {[@.]} later for all *)
let dwarn str f =
if Lam_current_unit.is_same_file () then
Format.fprintf Format.err_formatter ("WARN: %s " ^^ f) str v
Format.fprintf Format.err_formatter ("WARN: %s " ^^ f ^^ "@.") str
else
Format.ifprintf Format.err_formatter ("WARN: %s " ^^ f) str v
Format.ifprintf Format.err_formatter ("WARN: %s " ^^ f ^^ "@.") str

let info str f v =
Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str v
let info str f =
Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str

let iinfo b str f v =
let iinfo b str f =
if b then
Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str v
Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str
else
Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str v
Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str

26 changes: 11 additions & 15 deletions jscomp/ext_log.mli
Original file line number Diff line number Diff line change
Expand Up @@ -29,18 +29,14 @@
*)


type ('a,'b) logging = ('a -> 'b, Format.formatter, unit, unit, unit, unit) format6 -> 'a -> 'b

(* FIXM: below does not work
{[
err __LOC__ "hi"
]}

*)
val err : string -> ('a,'b) logging
val ierr : bool -> string -> ('a,'b) logging
val warn : string -> ('a,'b) logging
val iwarn : bool -> string -> ('a,'b) logging
val dwarn : string -> ('a,'b) logging
val info : string -> ('a,'b) logging
val iinfo : bool -> string -> ('a,'b) logging

type 'a logging = ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a


val err : string -> 'a logging
val ierr : bool -> string -> 'a logging
val warn : string -> 'a logging
val iwarn : bool -> string -> 'a logging
val dwarn : string -> 'a logging
val info : string -> 'a logging
val iinfo : bool -> string -> 'a logging
26 changes: 25 additions & 1 deletion jscomp/js_config.ml
Original file line number Diff line number Diff line change
Expand Up @@ -97,8 +97,32 @@ let runtime_set = String_set.of_list [
"caml_utils.js";
"caml_exceptions.js";
(* "caml_io.js"; *)
"curry.js";
"caml_curry.js";
"caml_file.js";
"caml_lexer.js";
"caml_string.js"
]


let prim = "Caml_primitive"

let exceptions = "Caml_exceptions"

let io = "Caml_io"

let sys = "Caml_sys"

let lex_parse = "Caml_lexer"

let obj_runtime = "Caml_obj_runtime"

let array = "Caml_array"

let format = "Caml_format"

let string = "Caml_string"

let float = "Caml_float"

let oo = "Caml_oo"
let curry = "Caml_curry"
25 changes: 25 additions & 0 deletions jscomp/js_config.mli
Original file line number Diff line number Diff line change
Expand Up @@ -30,4 +30,29 @@ val set_env : env -> unit
val runtime_set : String_set.t
val stdlib_set : String_set.t

val prim : string

val exceptions : string

val io : string

val oo : string

val sys : string

val lex_parse : string

val obj_runtime : string

val array : string

val format : string

val string : string

val float : string

val curry : string



144 changes: 88 additions & 56 deletions jscomp/js_dump.ml
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,8 @@ module L = struct
let define = "define"
let break = "break"
let strict_directive = "'use strict';"

let curry = "curry" (* curry arbitrary args *)
end
let return_indent = (String.length L.return / Ext_pp.indent_length)

Expand Down Expand Up @@ -393,12 +395,27 @@ and
| Call (e, el, info) ->
let action () =
P.group f 1 (fun _ ->
let () =
match info with
| {arity = NA } -> ipp_comment f (Some "!")
| _ -> () in
let cxt = expression 15 cxt f e in
P.paren_group f 1 (fun _ -> arguments cxt f el ) )
match info, el with
| {arity = Full }, _
| _, [] ->
let cxt = expression 15 cxt f e in
P.paren_group f 1 (fun _ -> arguments cxt f el )

| _ , _ ->
(* ipp_comment f (Some "!") *)
P.string f Js_config.curry;
P.string f L.dot;
let len = List.length el in
if 1 <= len && len <= 8 then
begin
P.string f (Printf.sprintf "app%d" len);
P.paren_group f 1 (fun _ -> arguments cxt f (e::el))
end
else
begin
P.string f L.curry;
P.paren_group f 1 (fun _ -> arguments cxt f [ e ; E.arr Mutable el])
end)
in
if l > 15 then P.paren_group f 1 action
else action ()
Expand Down Expand Up @@ -1300,46 +1317,46 @@ let exports cxt f (idents : Ident.t list) =
outer_cxt


let node_program f ( {program ; modules ; } : J.deps_program) =
let cxt = Ext_pp_scope.empty in
(* Node style *)
let requires cxt f (modules : (Ident.t * string) list ) =
P.newline f ;
(* the context used to print the following program *)
let outer_cxt, reversed_list, margin =
List.fold_left
(fun (cxt, acc, len) (id,s) ->
let str, cxt = str_of_ident cxt id in
cxt, ((str,s) :: acc), (max len (String.length str))
)
(cxt, [], 0) modules in
P.force_newline f ;
Ext_list.rev_iter (fun (s,file) ->
P.string f L.var;
P.space f ;
P.string f s ;
P.nspace f (margin - String.length s + 1) ;
P.string f L.eq;
P.space f;
P.string f L.require;
P.paren_group f 0 @@ (fun _ ->
pp_string f ~utf:true ~quote:(best_string_quote s) file );
semi f ;
P.newline f ;
) reversed_list;
outer_cxt
in

let cxt = requires cxt f modules in
(* Node style *)
let requires cxt f (modules : (Ident.t * string) list ) =
P.newline f ;
(* the context used to print the following program *)
let outer_cxt, reversed_list, margin =
List.fold_left
(fun (cxt, acc, len) (id,s) ->
let str, cxt = str_of_ident cxt id in
cxt, ((str,s) :: acc), (max len (String.length str))
)
(cxt, [], 0) modules in
P.force_newline f ;
Ext_list.rev_iter (fun (s,file) ->
P.string f L.var;
P.space f ;
P.string f s ;
P.nspace f (margin - String.length s + 1) ;
P.string f L.eq;
P.space f;
P.string f L.require;
P.paren_group f 0 @@ (fun _ ->
pp_string f ~utf:true ~quote:(best_string_quote s) file );
semi f ;
P.newline f ;
) reversed_list;
outer_cxt

let program f cxt ( x : J.program ) =
let () = P.force_newline f in
let cxt = statement_list true cxt f program.block in
let cxt = statement_list true cxt f x.block in
let () = P.force_newline f in
exports cxt f program.exports
exports cxt f x.exports

let node_program f ( x : J.deps_program) =
let cxt = requires ( Ext_pp_scope.empty) f x.modules in
program f cxt x.program


let amd_program f
( {program ; modules ; _} : J.deps_program)
( x : J.deps_program)
=
P.newline f ;
let cxt = Ext_pp_scope.empty in
Expand All @@ -1352,7 +1369,7 @@ let amd_program f
P.string f L.comma ;
P.space f;
pp_string f ~utf:true ~quote:(best_string_quote s) s;
) modules ;
) x.modules ;
P.string f "]";
P.string f L.comma;
P.newline f;
Expand All @@ -1365,33 +1382,30 @@ let amd_program f
P.string f L.comma;
P.space f ;
ident cxt f id
) cxt modules
) cxt x.modules
in
P.string f ")";
P.brace_vgroup f 1 @@ (fun _ ->
let v = P.brace_vgroup f 1 @@ (fun _ ->
let () = P.string f L.strict_directive in
let () = P.newline f in
let cxt = statement_list true cxt f program.block in
(* FIXME AMD : use {[ function xx ]} or {[ var x = function ..]} *)
P.newline f;
P.force_newline f;
ignore (exports cxt f program.exports));
program f cxt x.program
) in
P.string f ")";
v
;;

let pp_program ( program : J.deps_program) (f : Ext_pp.t) =
let pp_deps_program ( program : J.deps_program) (f : Ext_pp.t) =
begin
P.string f "// Generated CODE, PLEASE EDIT WITH CARE";
P.newline f;
P.string f L.strict_directive;
P.newline f ;
(match Js_config.get_env () with
ignore (match Js_config.get_env () with
| Browser ->
ignore (node_program f program)
(node_program f program)
| NodeJS ->
begin match Sys.getenv "OCAML_AMD_MODULE" with
| exception Not_found ->
ignore (node_program f program)
(node_program f program)
(* amd_program f program *)
| _ -> amd_program f program
end ) ;
Expand All @@ -1403,7 +1417,25 @@ let pp_program ( program : J.deps_program) (f : Ext_pp.t) =
P.newline f;
P.flush f ()
end
let dump_program
(program : J.deps_program)

let dump_program (x : J.program) oc =
ignore (program (P.from_channel oc) Ext_pp_scope.empty x )

let dump_deps_program
x
(oc : out_channel) =
pp_program program (P.from_channel oc)
pp_deps_program x (P.from_channel oc)

let string_of_block block
=
let buffer = Buffer.create 50 in
begin
let f = P.from_buffer buffer in
let _scope = statement_list true Ext_pp_scope.empty f block in
P.flush f ();
Buffer.contents buffer
end




Loading