├── .gitignore ├── test ├── defns │ ├── exportAssignment.d.ts │ ├── module.d.ts │ ├── enum.d.ts │ ├── extmodule.d.ts │ ├── importDecls.d.ts │ ├── interface.d.ts │ ├── ambient.d.ts │ └── decls.d.ts ├── collapsed.png ├── expanded.png ├── jsoo │ ├── index.html │ └── test_lib.ml ├── interface_index.ts ├── makefile ├── index.html ├── index.css ├── test.ts ├── jsserver.ml └── test_ml.ml ├── .merlin ├── src ├── unit_tests.mli ├── print.mli ├── DefinitelyMaybeTyped.mldylib ├── DefinitelyMaybeTyped.mllib ├── DefinitelyMaybeTyped.mlpack ├── summary.mli ├── ts.ml ├── convert.mli ├── META ├── parser.mli ├── summary.ml ├── ast.mli ├── convert.ml ├── print.ml ├── unit_tests.ml └── parser.ml ├── .ocamlinit ├── README.md ├── _oasis ├── Makefile ├── _tags ├── app └── otypescript.ml └── myocamlbuild.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *~ 3 | .*.swp 4 | -------------------------------------------------------------------------------- /test/defns/exportAssignment.d.ts: -------------------------------------------------------------------------------- 1 | export = an_identifier; 2 | 3 | -------------------------------------------------------------------------------- /test/defns/module.d.ts: -------------------------------------------------------------------------------- 1 | declare module A.b.c { 2 | var a; 3 | } 4 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | S src 2 | S test 3 | B _build 4 | PKG js_of_ocaml 5 | EXT js 6 | -------------------------------------------------------------------------------- /src/unit_tests.mli: -------------------------------------------------------------------------------- 1 | val test_typescript : OUnit.test 2 | val run : unit -> unit 3 | 4 | -------------------------------------------------------------------------------- /test/defns/enum.d.ts: -------------------------------------------------------------------------------- 1 | export declare enum Yo { 2 | red=0, 3 | green=1, 4 | blue 5 | } 6 | -------------------------------------------------------------------------------- /test/collapsed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andrewray/DefinitelyMaybeTyped/HEAD/test/collapsed.png -------------------------------------------------------------------------------- /test/expanded.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andrewray/DefinitelyMaybeTyped/HEAD/test/expanded.png -------------------------------------------------------------------------------- /src/print.mli: -------------------------------------------------------------------------------- 1 | module Make(O : sig val out : string -> unit end) : sig 2 | val print_ast : Ast.declarationElement list option -> unit 3 | end 4 | -------------------------------------------------------------------------------- /src/DefinitelyMaybeTyped.mldylib: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: 0deb74a2c4fbfc8c156a31215cfe3c31) 3 | DefinitelyMaybeTyped 4 | # OASIS_STOP 5 | -------------------------------------------------------------------------------- /src/DefinitelyMaybeTyped.mllib: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: 0deb74a2c4fbfc8c156a31215cfe3c31) 3 | DefinitelyMaybeTyped 4 | # OASIS_STOP 5 | -------------------------------------------------------------------------------- /src/DefinitelyMaybeTyped.mlpack: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: 05d809dd74be8ef27c0066451d061b51) 3 | Ast 4 | Ts 5 | Parser 6 | Print 7 | Summary 8 | Convert 9 | Unit_tests 10 | # OASIS_STOP 11 | -------------------------------------------------------------------------------- /src/summary.mli: -------------------------------------------------------------------------------- 1 | module type S = sig 2 | val ast : Ast.declarationElement list option -> unit 3 | end 4 | 5 | module Make(Show : sig 6 | val show : int -> string -> string -> unit 7 | end) : S 8 | 9 | module Print : S 10 | -------------------------------------------------------------------------------- /test/defns/extmodule.d.ts: -------------------------------------------------------------------------------- 1 | export = a; 2 | import a = require("b"); 3 | 4 | declare module "test" { 5 | 6 | var a : b; 7 | function a(b:c):d; 8 | 9 | import hello = require("balloon"); // stray semi 10 | 11 | export = toto; 12 | 13 | } 14 | 15 | -------------------------------------------------------------------------------- /src/ts.ml: -------------------------------------------------------------------------------- 1 | (* hacks *) 2 | type typeReference 3 | type typeQuery 4 | type typeLiteral 5 | 6 | (* predefined types *) 7 | type any = Js.Unsafe.any 8 | type number = float 9 | type string = Js.js_string Js.t 10 | type boolean = bool Js.t 11 | type void = unit 12 | -------------------------------------------------------------------------------- /test/jsoo/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | TypeScript Testing 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /test/defns/importDecls.d.ts: -------------------------------------------------------------------------------- 1 | // externalImportDeclaration 2 | import an_identifer = require( "a_stringLiteral" ); 3 | 4 | export import an_identifer = require( "a_stringLiteral" ); 5 | 6 | import an_identifier = A.b.C.d; 7 | 8 | export import an_identifier = A.Module.path; 9 | -------------------------------------------------------------------------------- /.ocamlinit: -------------------------------------------------------------------------------- 1 | #use "topfind" 2 | #require "mparser" 3 | #require "monad-custom" 4 | #require "deriving-ocsigen.syntax" 5 | #require "unix" 6 | #require "oUnit" 7 | 8 | #directory "_build" 9 | #load "ast.cmo" 10 | #load "parser.cmo" 11 | #load "unit_tests.cmo" 12 | #load "convert.cmo" 13 | 14 | -------------------------------------------------------------------------------- /src/convert.mli: -------------------------------------------------------------------------------- 1 | type out = string -> unit 2 | 3 | val mangler : unit -> (string -> string) 4 | val ml_name : string -> string 5 | 6 | val merge_interfaces : Ast.declarationElement list -> Ast.declarationElement list 7 | 8 | val interfaceDeclaration : out -> Ast.interfaceDeclaration -> unit 9 | val declarationElement : out -> Ast.declarationElement -> unit 10 | 11 | val convert : out -> Ast.declarationElement list -> unit 12 | -------------------------------------------------------------------------------- /test/interface_index.ts: -------------------------------------------------------------------------------- 1 | // Indexed interface 2 | interface A { 3 | [index : string] : string 4 | } 5 | 6 | // Extend A with appropriate properties 7 | // all properties must have the same type as the indexer. 8 | interface A { 9 | a : string; 10 | b : string; 11 | c : string; 12 | } 13 | 14 | // you cannot, it seems, have functions 15 | //interface A { 16 | // d(a:number) : string; 17 | //} 18 | 19 | var x : A = {a:"a", b:"b", c:"c" }; 20 | var y = x["x"] 21 | 22 | 23 | -------------------------------------------------------------------------------- /test/makefile: -------------------------------------------------------------------------------- 1 | all: server.byte test_ml.js test.js 2 | 3 | server.byte: server.ml 4 | ocamlfind ocamlc -linkpkg -package findlib,cohttp.lwt server.ml -o server.byte 5 | 6 | test.js: test.ts 7 | tsc -d test.ts 8 | 9 | test_ml.byte: test_ml.ml 10 | ocamlfind c -o test_ml.byte -syntax camlp4o \ 11 | -package js_of_ocaml,js_of_ocaml.syntax \ 12 | -linkpkg test_ml.ml 13 | 14 | test_ml.js: test_ml.byte 15 | js_of_ocaml test_ml.byte 16 | 17 | clean: 18 | - rm test.js test.d.ts test_ml.js *.cmo *.cmi *.byte *~ 19 | -------------------------------------------------------------------------------- /src/META: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: 783930c41411b2d2ad87575061fea123) 3 | version = "1.1.1" 4 | description = "Convert Typescript definitions to OCaml" 5 | requires = 6 | "mparser.pcre bisect monad-custom deriving.syntax oUnit js_of_ocaml" 7 | archive(byte) = "DefinitelyMaybeTyped.cma" 8 | archive(byte, plugin) = "DefinitelyMaybeTyped.cma" 9 | archive(native) = "DefinitelyMaybeTyped.cmxa" 10 | archive(native, plugin) = "DefinitelyMaybeTyped.cmxs" 11 | exists_if = "DefinitelyMaybeTyped.cma" 12 | # OASIS_STOP 13 | 14 | -------------------------------------------------------------------------------- /test/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | TypeScript Testing 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /test/defns/interface.d.ts: -------------------------------------------------------------------------------- 1 | export interface A { 2 | a : B; 3 | b : typeof a; 4 | c : any; 5 | d : number; 6 | e : boolean; 7 | f : void; 8 | g? : string; 9 | new(a : number) : any; 10 | h : (a,b) => c; 11 | (a,b) : x; 12 | [ ident : number ] : A; 13 | [ ident : string ] : A; 14 | i : { x; y }; 15 | ctr : new () => A; 16 | } 17 | 18 | export interface B extends A { 19 | w : { a : b; c : d; } []; 20 | x : B.t []; 21 | //y : typeof s.s []; // hmmm...this seems like it should work 22 | z : any [][]; 23 | f(public a : any, private b? : any) : any; 24 | g?(a:"hello",b?:"goofy",...hi : any[]); 25 | h : (a, b) => any; 26 | //new (b,c:boolean) : Object;// => any; 27 | } 28 | 29 | 30 | -------------------------------------------------------------------------------- /test/defns/ambient.d.ts: -------------------------------------------------------------------------------- 1 | // Variables 2 | declare var a : any; 3 | export declare var b; 4 | declare var c : (a,b,c:"hi",d?:"bye",...anon) => string; 5 | declare var d : new (a,b?) => number; 6 | declare var e : { x:boolean; y:void; } 7 | declare var f : typeof a; 8 | declare var g : any[]; 9 | declare var h : { 10 | [ x : number ] : A.b[]; 11 | [ y : string ] : {x}[]; 12 | z : new (a,b) => c; 13 | f(a):b; 14 | f?(a):b; 15 | new(a : number) : any; 16 | (a,b) : c; 17 | l? : T; 18 | }; 19 | 20 | // Functions 21 | declare function a(b) : c; 22 | export declare function a(b) : c; 23 | 24 | // Class 25 | export declare class A { } 26 | declare class B { 27 | //[ x : number ] : b; XXX doesnt work ??? 28 | private a : b; 29 | static a(a):a; 30 | constructor(); 31 | } 32 | 33 | -------------------------------------------------------------------------------- /test/index.css: -------------------------------------------------------------------------------- 1 | #listContainer{ 2 | margin-top:15px; 3 | } 4 | 5 | #expList ul, li { 6 | list-style: none; 7 | margin:0; 8 | padding:0; 9 | cursor: pointer; 10 | } 11 | #expList p { 12 | margin:0; 13 | display:block; 14 | } 15 | #expList p:hover { 16 | background-color:#121212; 17 | } 18 | #expList li { 19 | line-height:140%; 20 | text-indent:0px; 21 | background-position: 1px 8px; 22 | padding-left: 20px; 23 | background-repeat: no-repeat; 24 | } 25 | 26 | /* Collapsed state for list element */ 27 | #expList .collapsed { 28 | background-image: url(collapsed.png); 29 | } 30 | /* Expanded state for list element 31 | /* NOTE: This class must be located UNDER the collapsed one */ 32 | #expList .expanded { 33 | background-image: url(expanded.png); 34 | } 35 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | DefinitelyMaybeTyped 2 | ==================== 3 | 4 | [TypeScript](http://www.typescriptlang.org) adds a static typing scheme to JavaScript. 5 | [DefinitelyTyped](https://github.com/borisyankov/DefinitelyTyped) provides a large repository 6 | of TypeScript definition files for JavaScript libraries. 7 | 8 | The burning question is *can TypeScript definitions be _usefully_ converted to OCaml for use with 9 | js\_of\_ocaml?* 10 | 11 | There are three parts to this 12 | 13 | 1. Parse the TypeScript definition files 14 | 2. Define a mapping from the TypeScript to OCaml type system. 15 | 3. As automatically as possible do the conversion 16 | 17 | # Status 18 | 19 | A rough and ready parser which can successfully parse the whole DefinitelyType 20 | repository. 21 | 22 | Starting to consider how to convert to ocaml. 23 | 24 | ### Known issues 25 | 26 | * Terrible error localisation 27 | 28 | -------------------------------------------------------------------------------- /test/jsoo/test_lib.ml: -------------------------------------------------------------------------------- 1 | let w : Lib._Object Js.t = Js.Unsafe.variable "window" 2 | 3 | let log s = Firebug.console##log(s) 4 | let olog s = log (Js.string s) 5 | 6 | (* check some Object methods *) 7 | 8 | let () = log (w##toString(())) 9 | 10 | let () = log (w##toLocaleString(())) 11 | 12 | let hasProp s = 13 | if w##hasOwnProperty(Js.string s) = Js._true then 14 | log (Js.string ("has property " ^ s)) 15 | else 16 | log (Js.string ("does not have property " ^ s)) 17 | 18 | let () = hasProp "Intl" 19 | let () = hasProp "blah" 20 | 21 | (* String *) 22 | 23 | let str : Lib._String Js.t = Obj.magic (Js.string "hello world") 24 | 25 | let () = log str 26 | let () = log (str##substring(6.,11.)) 27 | let () = olog (string_of_float (str##length)) 28 | 29 | (* Math *) 30 | 31 | (*let math : Lib._Math Js.t = (Js.Unsafe.variable "window")##_Math*) 32 | let math = Lib._Math (* via a hack to lib.ml *) 33 | 34 | let () = olog (string_of_float (math##sqrt(4.))) 35 | let () = olog (string_of_float (math##_E)) 36 | 37 | (* Date *) 38 | 39 | let date : Lib._Date Js.t = (Js.Unsafe.variable "window")##_Date 40 | 41 | (* object literal for date object, not implemented *) 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /_oasis: -------------------------------------------------------------------------------- 1 | OASISFormat: 0.4 2 | Name: DefinitelyMaybeTyped 3 | Version: 1.1.1 4 | Synopsis: Convert Typescript definitions to OCaml 5 | Description: Convert Typescript definitions to OCaml 6 | 7 | Authors: Andy Ray 8 | Maintainers: Andy Ray 9 | Homepage: https://github.com/ujamjar/DefinitelyMaybeTyped 10 | License: ISC 11 | Plugins: META (0.4) 12 | BuildTools: ocamlbuild 13 | 14 | Library DefinitelyMaybeTyped 15 | Path: src 16 | Findlibname: otypescript 17 | Pack: true 18 | Modules: Ast, Ts, Parser, Print, Summary, Convert, Unit_tests 19 | BuildDepends: mparser.pcre,bisect,monad-custom,deriving.syntax,oUnit,js_of_ocaml 20 | XMETARequires: mparser.pcre,bisect,monad-custom,deriving.syntax,oUnit,js_of_ocaml 21 | 22 | Executable otypescript 23 | Path: app 24 | MainIs: otypescript.ml 25 | Custom: true 26 | CompiledObject: best 27 | Install: false 28 | BuildDepends: otypescript 29 | 30 | SourceRepository master 31 | Type: git 32 | Location: https://github.com/ujamjar/DefinitelyMaybeTyped.git 33 | Browser: https://github.com/ujamjar/DefinitelyMaybeTyped 34 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean 2 | 3 | all: setup.data 4 | ocaml setup.ml -build 5 | 6 | setup.ml: 7 | oasis setup 8 | 9 | setup.data: setup.ml 10 | ocaml setup.ml -configure 11 | 12 | install: all 13 | ocaml setup.ml -install 14 | 15 | uninstall: 16 | ocamlfind remove otypescript 17 | 18 | ####################################################### 19 | #ts: 20 | # tsc -d test/test.ts 21 | # 22 | #js: 23 | # ocamlbuild -use-ocamlfind jsserver.byte 24 | # ocamlbuild -use-ocamlfind test_ml.byte 25 | # js_of_ocaml -pretty -debuginfo -sourcemap test_ml.byte -o test/test_ml.js 26 | # 27 | #lib.ml: 28 | # ./otypescript.byte -i ../forks/DefinitelyTyped/_infrastructure/tests/typescript/0.9.7/lib.d.ts 29 | # 30 | #test_lib.byte: lib.ml test_lib/test_lib.ml 31 | # ocamlbuild -use-ocamlfind test_lib.byte 32 | # 33 | #test_lib.js: test_lib.byte 34 | # js_of_ocaml test_lib.byte 35 | ####################################################### 36 | 37 | bisect: 38 | bisect-report -I _build -html cov bisect*.out 39 | 40 | bisect-clean: 41 | - rm -fr cov 42 | - rm bisect*.out 43 | 44 | ####################################################### 45 | 46 | clean: bisect-clean 47 | - rm -fr *~ 48 | - rm -fr test/*~ 49 | - rm test/test.d.ts test/test.js test/test_ml.js test/test.map 50 | ocaml setup.ml -clean 51 | 52 | -------------------------------------------------------------------------------- /test/test.ts: -------------------------------------------------------------------------------- 1 | /// 2 | 3 | interface vec_i { 4 | x:number; 5 | y:number; 6 | } 7 | 8 | // 1st pass, merge interfaces - even though z is declared later, it 9 | // is needed here. 10 | var myvec_1 : vec_i = { x:2, y:3, z:0 } 11 | 12 | class vec { 13 | // public parameters create public properties 14 | constructor(public x : number, public y : number) { } 15 | add(z:number) : void { 16 | this.x = this.x + z; 17 | this.y = this.y + z; 18 | } 19 | add2(v:vec_i) : void { 20 | this.x = this.x + v.x; 21 | this.y = this.y + v.y; 22 | } 23 | } 24 | 25 | interface vec_i { 26 | z : number; 27 | } 28 | 29 | interface luminance { 30 | brigthness : string; 31 | } 32 | 33 | interface combined extends vec_i, luminance { 34 | xxx : boolean; 35 | } 36 | 37 | interface Y { 38 | a : string; 39 | (b:string) : string; 40 | } 41 | 42 | var myvec_i : vec_i = { x:2, y:3, z:4 }; 43 | var myvec = new vec(0,1); 44 | myvec.add2(myvec_i); 45 | 46 | 47 | function prepareList() { 48 | $('#expList').find('li:has(ul)') 49 | .click( function(event) { 50 | if (this == event.target) { 51 | $(this).toggleClass('expanded'); 52 | $(this).children('ul').toggle('medium'); 53 | } 54 | return false; 55 | }) 56 | .addClass('collapsed') 57 | .children('ul').hide(); 58 | } 59 | 60 | -------------------------------------------------------------------------------- /test/jsserver.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | open Cohttp 3 | open Cohttp_lwt_unix 4 | open Re 5 | 6 | let address = ref "127.0.0.1" 7 | let port = ref 8888 8 | let _ = Findlib.init () 9 | let filesys = ref "" 10 | 11 | let server () = 12 | 13 | let re_filesys = compile (seq [ str "/filesys/"; group (seq [ str !filesys; rep any]); eos ]) in 14 | 15 | let header typ = 16 | let h = Header.init () in 17 | let h = Header.add h "Content-Type" typ in 18 | let h = Header.add h "Server" "iocaml" in 19 | h 20 | in 21 | let header_html = header "text/html; charset=UTF-8" in 22 | let header_js = header "application/javascript; charset=UTF-8" in 23 | let header_css = header "text/css; charset=UTF-8" in 24 | let header_plain_user_charset = header "text/plain; charset=x-user-defined" in 25 | 26 | let callback conn_id req body = 27 | let uri = Request.uri req in 28 | let path = Uri.path uri in 29 | 30 | try 31 | (* send binary file *) 32 | let fname = get (exec re_filesys path) 1 in 33 | Lwt_io.eprintf "filesys: %s\n" fname >>= fun () -> 34 | Server.respond_file ~headers:header_plain_user_charset ~fname:fname () 35 | with _ -> 36 | (* send static file *) 37 | let fname = Server.resolve_file ~docroot:"." ~uri:uri in 38 | Lwt_io.eprintf "static: %s\n" fname >>= fun () -> 39 | let headers = 40 | if Filename.check_suffix fname ".css" 41 | then header_css 42 | else if Filename.check_suffix fname ".js" 43 | then header_js 44 | else header_html in 45 | Server.respond_file ~headers ~fname () 46 | 47 | in 48 | let conn_closed conn_id () = () in 49 | let config = { Server.callback; conn_closed } in 50 | Server.create ~address:!address ~port:!port config 51 | 52 | let () = Lwt_unix.run (server()) 53 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: 847fd73d704fed88bc49e97fb49634b1) 3 | # Ignore VCS directories, you can use the same kind of rule outside 4 | # OASIS_START/STOP if you want to exclude directories that contains 5 | # useless stuff for the build process 6 | true: annot, bin_annot 7 | <**/.svn>: -traverse 8 | <**/.svn>: not_hygienic 9 | ".bzr": -traverse 10 | ".bzr": not_hygienic 11 | ".hg": -traverse 12 | ".hg": not_hygienic 13 | ".git": -traverse 14 | ".git": not_hygienic 15 | "_darcs": -traverse 16 | "_darcs": not_hygienic 17 | # Library DefinitelyMaybeTyped 18 | "src/DefinitelyMaybeTyped.cmxs": use_DefinitelyMaybeTyped 19 | "src/ast.cmx": for-pack(DefinitelyMaybeTyped) 20 | "src/ts.cmx": for-pack(DefinitelyMaybeTyped) 21 | "src/parser.cmx": for-pack(DefinitelyMaybeTyped) 22 | "src/print.cmx": for-pack(DefinitelyMaybeTyped) 23 | "src/summary.cmx": for-pack(DefinitelyMaybeTyped) 24 | "src/convert.cmx": for-pack(DefinitelyMaybeTyped) 25 | "src/unit_tests.cmx": for-pack(DefinitelyMaybeTyped) 26 | : pkg_bisect 27 | : pkg_deriving.syntax 28 | : pkg_js_of_ocaml 29 | : pkg_monad-custom 30 | : pkg_mparser.pcre 31 | : pkg_oUnit 32 | # Executable otypescript 33 | : pkg_bisect 34 | : pkg_deriving.syntax 35 | : pkg_js_of_ocaml 36 | : pkg_monad-custom 37 | : pkg_mparser.pcre 38 | : pkg_oUnit 39 | : use_DefinitelyMaybeTyped 40 | : pkg_bisect 41 | : pkg_deriving.syntax 42 | : pkg_js_of_ocaml 43 | : pkg_monad-custom 44 | : pkg_mparser.pcre 45 | : pkg_oUnit 46 | : use_DefinitelyMaybeTyped 47 | : custom 48 | # OASIS_STOP 49 | -------------------------------------------------------------------------------- /test/defns/decls.d.ts: -------------------------------------------------------------------------------- 1 | /* 2 | * File which generates all the possible top level elements in a typescript definition file. 3 | * 4 | */ 5 | 6 | // AmbientDeclaration AmbientVariableDeclaration 7 | declare var a_var : number; 8 | 9 | // AmbientDeclaration AmbientModuleDeclaration 10 | declare module A_module { 11 | 12 | // AmbientVariableDeclaration 13 | var a_var : string; 14 | 15 | // AmbientFunctionDeclaration 16 | function a_function(); 17 | 18 | // AmbientClassDeclaration 19 | class A_class { 20 | } 21 | 22 | // InterfaceDeclaration 23 | interface An_interface {} 24 | 25 | // AmbientDeclaration AmbientEnumDeclaration 26 | enum An_enum { 27 | A, B, C, D 28 | } 29 | 30 | // AmbientModuleDeclaration (recursive) 31 | module A_nested_module { 32 | var a_var : string; 33 | function a_function(); 34 | class A_class {} 35 | interface An_interface {} 36 | enum An_enum { A, B, C, D } 37 | module B_nested_module {} 38 | import A = A_module 39 | } 40 | 41 | // ImportDeclaration 42 | import A = A_module 43 | 44 | } 45 | 46 | // AmbientDeclaration AmbientFunctionDeclaration 47 | declare function a_function(); 48 | 49 | // AmbientDeclaration AmbientClassDeclaration 50 | declare class A_class { 51 | 52 | // AmbientConstructorDeclaration 53 | constructor(); 54 | 55 | // AmbientPropertyMemberDeclaration AmbientPropertyMemberDeclarationTypeAnnotation 56 | public a:string; 57 | 58 | // AmbientPropertyMemberDeclaration AmbientPropertyMemberDeclarationCallSignature 59 | b(c):d; 60 | 61 | // IndexSignature 62 | [ hello : string ] : string // ';' ??? bug 63 | [ world : number ] : string // ';' ??? bug 64 | // XXX somewhere in the parsers the semi-colon is accepted ie in interfaces, 65 | // hence I have't just added the production to read it. 66 | } 67 | 68 | // AmbientDeclaration AmbientEnumDeclaration 69 | declare enum An_enum { 70 | A, B, C, D 71 | } 72 | 73 | // AmbientDeclaration AmbientExternalModuleDeclaration 74 | declare module "An_external_module" { 75 | 76 | // AmbientModuleDeclaration (recursive) 77 | module A_nested_module { 78 | var a_var : string; 79 | function a_function(); 80 | class A_class {} 81 | interface An_interface {} 82 | enum An_enum { A, B, C, D } 83 | module B_nested_module {} 84 | import A = A_module 85 | } 86 | 87 | // ExportAssignment 88 | export = A_module; 89 | 90 | // ExternalImportDeclaration 91 | import ABC = require ( "An_interface" ); 92 | 93 | } 94 | 95 | // InterfaceDeclaration 96 | interface Another_interface { 97 | 98 | // IndexSignature 99 | [ hello : string ] : string; 100 | [ world : number ] : string; 101 | 102 | } 103 | 104 | 105 | // ExportAssignment 106 | export = A_module; 107 | 108 | // InterfaceDeclaration 109 | interface An_interface { 110 | // PropertySignature 111 | some_property; 112 | a_property : string; 113 | 114 | // CallSignature 115 | a_fn() : number; 116 | some_fn(a,b,c); 117 | 118 | // ConstructSignature 119 | new(); 120 | 121 | // MethodSignature 122 | (); 123 | (a:void):number; 124 | 125 | } 126 | 127 | // ExternalImportDeclaration 128 | import ABC = require ( "An_interface" ); 129 | 130 | // ImportDeclaration 131 | import A = A_module 132 | import B = A_module.A_nested_module; 133 | 134 | -------------------------------------------------------------------------------- /test/test_ml.ml: -------------------------------------------------------------------------------- 1 | class type vec = object 2 | method x : int Js.readonly_prop 3 | method y : int Js.readonly_prop 4 | method add : int -> unit Js.meth 5 | end 6 | 7 | class type vec_i = object 8 | method x : int Js.prop 9 | method y : int Js.prop 10 | end 11 | 12 | let vec : (int -> int -> vec Js.t) Js.constr = 13 | Js.Unsafe.variable "vec" 14 | 15 | let send_to_page div_name = 16 | let doc = Dom_html.document in 17 | let pre = Dom_html.createPre doc in 18 | pre##style##borderStyle <- Js.string "inset"; 19 | pre##style##padding <- Js.string "5"; 20 | Dom.appendChild doc##body pre; 21 | (fun s -> pre##innerHTML <- Js.string (Js.to_string pre##innerHTML ^ s)) 22 | 23 | let init () = 24 | let load_from_server path = 25 | try 26 | let xml = XmlHttpRequest.create () in 27 | xml##_open(Js.string "GET", Js.string (path), Js._false); 28 | xml##overrideMimeType(Js.string "text/plain; charset=x-user-defined"); 29 | xml##send(Js.null); 30 | if xml##status = 200 then 31 | let resp = xml##responseText in 32 | let len = resp##length in 33 | let str = String.create len in 34 | for i=0 to len-1 do 35 | str.[i] <- Char.chr (int_of_float resp##charCodeAt(i) land 0xff) 36 | done; 37 | Some(str) 38 | else 39 | None 40 | with _ -> 41 | None 42 | in 43 | Sys_js.register_autoload "" load_from_server; 44 | Sys_js.set_channel_flusher stdout (send_to_page "stdout"); 45 | Sys_js.set_channel_flusher stderr (send_to_page "stderr"); 46 | Firebug.console##log(Js.string "test_ml") 47 | 48 | let summary () = 49 | (* load AST *) 50 | let f = open_in "DefinitelyMaybeTyped/out.m" in 51 | let ast : Ast.declarationElement list option = Marshal.from_channel f in 52 | let () = close_in f in 53 | 54 | let elements : (int * string * string) list ref = ref [] in 55 | let module S = Summary.Make(struct 56 | let show level t n = 57 | elements := (level,t,n) :: !elements 58 | end) in 59 | let () = S.ast ast in 60 | let elements = List.rev !elements in 61 | 62 | (* create div list container *) 63 | let doc = Dom_html.document in 64 | let div = Dom_html.createDiv doc in 65 | Dom.appendChild doc##body div; 66 | 67 | let rec build_list parent prev level elements = 68 | match elements with 69 | | [] -> [] 70 | | (l,t,n)::tl -> 71 | if level = l then begin 72 | (* add to current parent, recurse *) 73 | let il = Dom_html.createLi doc in 74 | il##innerHTML <- Js.string ("" ^ t ^ " " ^ n ^ ""); 75 | Dom.appendChild parent il; 76 | build_list parent il level tl 77 | end else if level < l then begin 78 | (* create new ul, add it to prev, recurse *) 79 | let ul = Dom_html.createUl doc in 80 | Dom.appendChild prev ul; 81 | let elements = build_list ul ul (level+1) elements in 82 | build_list parent prev level elements 83 | end else 84 | (* drop back a level *) 85 | elements 86 | in 87 | let ul = Dom_html.createUl doc in 88 | ul##id <- Js.string "expList"; 89 | Dom.appendChild div ul; 90 | let _ = build_list ul ul 0 elements in 91 | Js.Unsafe.fun_call (Js.Unsafe.variable "window.prepareList") [||] |> ignore 92 | 93 | let main _ = 94 | let () = init () in 95 | let () = summary() in 96 | let vec = jsnew vec(3,4) in 97 | let () = vec##add(2) in 98 | Js._true 99 | 100 | let _ = Dom_html.window##onload <- Dom_html.handler main 101 | 102 | 103 | -------------------------------------------------------------------------------- /app/otypescript.ml: -------------------------------------------------------------------------------- 1 | 2 | (********************************************************************************) 3 | (* file utilities *) 4 | 5 | let rec readall path = 6 | let open Unix in 7 | let h = opendir path in 8 | let rec read () = 9 | match try Some(readdir h) with _ -> None with 10 | | None -> [] 11 | | Some(x) when x<>"." && x<>".." -> (Filename.concat path x)::read() 12 | | _ -> read() 13 | in 14 | let all = read() in 15 | closedir h; 16 | all 17 | 18 | let rec findall path = 19 | let open Unix in 20 | let all = readall path in 21 | (* partition into sub-dirs and .d.ts files *) 22 | let rec classify dirs dts = function 23 | | [] -> dirs, dts 24 | | h::t -> 25 | match (stat h).st_kind with 26 | | S_DIR -> classify (h::dirs) dts t 27 | | S_REG when Filename.check_suffix h ".d.ts" -> classify dirs (h::dts) t 28 | | _ -> classify dirs dts t 29 | in 30 | let dirs, dts = classify [] [] all in 31 | List.fold_left (fun dts dir -> dts @ findall dir) dts dirs 32 | 33 | let preprocess input_name = 34 | let base = Filename.basename input_name in 35 | let output_name = Filename.concat "dump" base in 36 | let command = "cpp -P " ^ input_name ^ " " ^ output_name in 37 | Printf.printf "%s\n%!" command; 38 | Unix.system command |> ignore 39 | 40 | let with_file_in name f = 41 | let file = open_in name in 42 | try 43 | let r = f file in 44 | close_in file; 45 | r 46 | with x -> 47 | close_in file; 48 | raise x 49 | 50 | let with_file_out name f = 51 | let file = open_out name in 52 | try 53 | let r = f file in 54 | close_out file; 55 | r 56 | with x -> 57 | close_out file; 58 | raise x 59 | 60 | (********************************************************************************) 61 | (* command line *) 62 | 63 | let parse_file ?(verbose=false) name = 64 | let ast = with_file_in name (Parser.parse ~verbose:true name) in 65 | (*(if verbose then output_string stdout (Parser.to_string ast) 66 | else Summary.ast ast);*) 67 | (*Summary.Print.ast ast;*) 68 | let () = 69 | let module P = Print.Make(struct let out = print_string end) in 70 | P.print_ast ast 71 | in 72 | let base = Filename.(chop_suffix (basename name) ".d.ts") in 73 | let marshal = base ^ ".m" in 74 | let ml = base ^ ".ml" in 75 | (* marshalled ast *) 76 | (with_file_out marshal Marshal.(fun f -> to_channel f ast [])); 77 | (* output ml file *) 78 | (with_file_out ml 79 | (fun f -> 80 | match ast with 81 | | None -> () 82 | | Some(ast) -> Convert.convert (output_string f) ast)) 83 | 84 | let parse_dir dir = 85 | let open Printf in 86 | let pass, fail, exn = ref 0, ref 0, ref 0 in 87 | List.iter 88 | (fun name -> 89 | try 90 | match with_file_in name (Parser.parse name) with 91 | | Some(x) -> begin 92 | printf "pass: %s\n%!" name; 93 | incr pass 94 | end 95 | | None -> begin 96 | printf "fail: %s\n%!" name; 97 | incr fail 98 | end 99 | with _ -> begin 100 | Printf.printf "exn : %s\n%!" name; 101 | incr exn; 102 | end) 103 | (findall dir); 104 | Printf.printf "pass=%i fail=%i exn=%i\n" !pass !fail !exn 105 | 106 | let () = 107 | let open Arg in 108 | parse (align [ 109 | "-i", String(parse_file), " Parse typescript definition file"; 110 | "-d", String(parse_dir), 111 | " Find all typescript definition files in directory and parse them"; 112 | "-t", Unit(Unit_tests.run), " run unit tests"; 113 | ]) 114 | (fun _ -> failwith "anon args not allowed") 115 | "otypescript" 116 | 117 | 118 | -------------------------------------------------------------------------------- /src/parser.mli: -------------------------------------------------------------------------------- 1 | type ('a,'b) pp = ('a, 'b) MParser.t 2 | type 'a p = ('a, unit) pp 3 | 4 | val explode : string -> char list 5 | val implode : char list -> string 6 | 7 | module Comment : sig 8 | val oneline : unit p 9 | val multiline : unit p 10 | end 11 | 12 | module Token : sig 13 | val whitespace : unit p 14 | val lexeme : 'a p -> 'a p 15 | val string : string -> string p 16 | val char : char -> char p 17 | val integer : int p 18 | end 19 | 20 | module TypeScript : sig 21 | 22 | open Ast 23 | 24 | val typeParameter : typeParameter p 25 | val typeParameters : typeParameters p 26 | val predefinedType : predefinedType p 27 | 28 | val identifier : string p 29 | val stringLiteral : string p 30 | val path : path p 31 | 32 | val typeReference : typeReference p 33 | val typeArguments : type_ list p 34 | val typeQuery : path p 35 | val elementType : elementType p 36 | val arrayType : arrayType p 37 | val functionType : functionType p 38 | val constructorType : constructorType p 39 | 40 | val typeLiteral : typeLiteral p 41 | val type_ : type_ p 42 | val typeAnnotation : type_ p 43 | 44 | val propertyName : string p 45 | val propertySignature : propertySignature p 46 | 47 | val publicOrPrivate : publicOrPrivate p 48 | val requiredParameter : requiredParameter p 49 | val requiredParameterSpecialized : requiredParameterSpecialized p 50 | val optionalParameterSpecialized : optionalParameterSpecialized p 51 | val optionalParameter : optionalParameter p 52 | val optionalParameterInit : optionalParameterInit p 53 | val restParameter : restParameter p 54 | 55 | val parameter : parameter p 56 | val parameterList : parameterList p 57 | 58 | val callSignature : callSignature p 59 | val constructSignature : constructSignature p 60 | val stringOrNumber : stringOrNumber p 61 | val indexSignature : indexSignature p 62 | val methodSignature : methodSignature p 63 | 64 | val typeMember : typeMember p 65 | val typeMemberList : typeMemberList p 66 | val objectType : objectType p 67 | val exportAssignment : exportAssignment p 68 | val classOrInterfaceTypeList : classOrInterfaceTypeList p 69 | val interfaceExtendsClause : classOrInterfaceTypeList p 70 | 71 | val interfaceDeclaration : interfaceDeclaration p 72 | val importDeclaration : importDeclaration p 73 | val externalImportDeclaration : externalImportDeclaration p 74 | 75 | val ambientVariableDeclaration : ambientVariableDeclaration p 76 | val ambientFunctionDeclaration : ambientFunctionDeclaration p 77 | 78 | val ambientConstructorDeclaration : parameterList p 79 | val ambientPropertyMemberData : 'a p -> 'a ambientPropertyMemberData p 80 | val ambientPropertyMemberDeclaration : ambientPropertyMemberDeclaration p 81 | val ambientClassBodyElement : ambientClassBodyElement p 82 | val ambientClassDeclaration : ambientClassDeclaration p 83 | 84 | val ambientEnumMember : ambientEnumMember p 85 | 86 | val ambientEnumDeclaration : ambientEnumDeclaration p 87 | 88 | val ambientExternalModuleDeclaration : ambientExternalModuleDeclaration p 89 | 90 | val ambientModuleElement : ambientModuleElement p 91 | val ambientModuleElements : ambientModuleElements p 92 | val ambientModuleDeclaration : ambientModuleDeclaration p 93 | 94 | val ambientExternalModuleElement : ambientExternalModuleElement p 95 | val ambientExternalModuleElements : ambientExternalModuleElements p 96 | val ambientExternalModuleDeclaration : ambientExternalModuleDeclaration p 97 | 98 | val ambientDeclaration : ambientDeclaration p 99 | 100 | val declarationElement : declarationElement p 101 | 102 | val declarationSourceFile : declarationElement list p 103 | 104 | end 105 | 106 | (*val to_string : Ast.declarationElement list option -> string*) 107 | val sparse : 'a p -> string -> 'a 108 | val parse : ?verbose:bool -> string -> in_channel -> Ast.declarationElement list option 109 | 110 | -------------------------------------------------------------------------------- /src/summary.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open Printf 3 | 4 | module type S = sig 5 | val ast : Ast.declarationElement list option -> unit 6 | end 7 | 8 | module Make(Show : sig 9 | val show : int -> string -> string -> unit 10 | end) = struct 11 | 12 | open Show 13 | 14 | let path = String.concat "." 15 | 16 | let rec typeMember level = 17 | let show = show level in 18 | function 19 | | `PropertySignature x -> show "prop" x.psg_propertyName 20 | | `CallSignature x -> show "call" "(...)" 21 | | `ConstructSignature x -> show "new" "(...)" 22 | | `IndexSignature x -> show "index" x.ids_identifier 23 | | `MethodSignature x -> show "method" x.mts_propertyName 24 | 25 | and ambientClassBodyElement level = 26 | let show = show level in 27 | function 28 | | `AmbientConstructorDeclaration x -> show "constructor" "(...)" 29 | | `AmbientPropertyMemberDeclaration (`AmbientPropertyMemberDeclarationTypeAnnotation x) -> 30 | show "property [type]" x.apm_propertyName 31 | | `AmbientPropertyMemberDeclaration (`AmbientPropertyMemberDeclarationCallSignature x) -> 32 | show "property [call]" x.apm_propertyName 33 | | `IndexSignature x -> show "index" x.ids_identifier 34 | 35 | and ambientModuleElement level : ambientModuleElement -> unit = 36 | let show n t = show level n t in 37 | function 38 | | `AmbientVariableDeclaration (_,avd) -> show "var" avd.avd_identifier 39 | | `AmbientFunctionDeclaration (_,afn) -> show "function" afn.afn_identifier 40 | | `AmbientClassDeclaration (_,acd) -> 41 | show "class" acd.acd_identifier; 42 | List.iter (ambientClassBodyElement (level+1)) acd.acd_classBody 43 | | `AmbientEnumDeclaration (_,aed) -> show "enum" aed.aed_identifier 44 | | `AmbientModuleDeclaration (_,amd) -> 45 | show "module" (path amd.amd_identifierPath); 46 | List.iter (ambientModuleElement (level+1)) amd.amd_ambientModuleBody 47 | | `InterfaceDeclaration (_,idf) -> 48 | show "interface" idf.idf_identifier; 49 | List.iter (typeMember (level+1)) idf.idf_objectType 50 | | `ImportDeclaration (_,idl) -> show "import" idl.idl_identifier 51 | 52 | and ambientExternalModuleElement level = 53 | let show = show level in 54 | function 55 | | `AmbientModuleElement x -> 56 | ambientModuleElement (level+1) x 57 | | `ExportAssignment x -> show "export" x 58 | | `ExternalImportDeclaration x -> show "import" x.eid_identifier 59 | 60 | and ambientDeclaration level : ambientDeclaration -> unit = 61 | let show = show level in 62 | function 63 | | `AmbientVariableDeclaration (_,avd) -> show "declare var" avd.avd_identifier 64 | | `AmbientFunctionDeclaration (_,afn) -> show "declare function" afn.afn_identifier 65 | | `AmbientClassDeclaration (_,acd) -> 66 | show "declare class" acd.acd_identifier; 67 | List.iter (ambientClassBodyElement (level+1)) acd.acd_classBody 68 | | `AmbientEnumDeclaration (_,aed) -> show "declare enum" aed.aed_identifier 69 | | `AmbientModuleDeclaration (_,amd) -> 70 | show "declare module" (path amd.amd_identifierPath); 71 | List.iter (fun x -> ambientModuleElement (level+1) x) 72 | amd.amd_ambientModuleBody 73 | | `AmbientExternalModuleDeclaration (_,eamd) -> 74 | show "declare (ext) module" eamd.eamd_name; 75 | List.iter (ambientExternalModuleElement (level+1)) eamd.eamd_ambientExternalModuleElements 76 | 77 | and ast : declarationElement list option -> unit = function 78 | | None -> () 79 | | Some(ast) -> 80 | let show = show 0 in 81 | printf "summary: %i top level elements\n" (List.length ast); 82 | (* print a summary of top level values *) 83 | List.iter (function 84 | | `ExportAssignment name -> show "export" name 85 | | `InterfaceDeclaration idf -> 86 | show "interface" idf.idf_identifier; 87 | List.iter (typeMember 1) idf.idf_objectType 88 | | `ImportDeclaration idl -> show "import" idl.idl_identifier 89 | | `ExternalImportDeclaration eid -> show "import (ext)" eid.eid_identifier 90 | | `AmbientDeclaration amb -> ambientDeclaration 0 amb) 91 | ast 92 | 93 | end 94 | 95 | module Print = Make(struct 96 | let show level t n = 97 | for i=0 to level-1 do printf " " done; 98 | printf "%s %s\n" t n 99 | end) 100 | 101 | -------------------------------------------------------------------------------- /src/ast.mli: -------------------------------------------------------------------------------- 1 | type declarationElement = 2 | [ `ExportAssignment of string 3 | | `InterfaceDeclaration of interfaceDeclaration 4 | | `ImportDeclaration of importDeclaration 5 | | `ExternalImportDeclaration of externalImportDeclaration 6 | | `AmbientDeclaration of ambientDeclaration ] 7 | 8 | and path = string list 9 | 10 | and importDeclaration = 11 | { 12 | idl_identifier : string; 13 | idl_entityName : path; 14 | } 15 | 16 | and interfaceDeclaration = 17 | { 18 | idf_identifier : string; 19 | idf_typeParameters : typeParameters option; 20 | idf_interfaceExtendsClause : interfaceExtendsClause option; 21 | idf_objectType : objectType; 22 | } 23 | 24 | and typeParameter = 25 | { 26 | tpp_identifier : string; 27 | tpp_constraint : type_ option; 28 | } 29 | 30 | and typeParameters = typeParameter list 31 | 32 | and interfaceExtendsClause = typeReference list 33 | 34 | and predefinedType = 35 | [ `Any | `Number | `Boolean | `String | `Void ] 36 | 37 | and type_ = 38 | [ `PredefinedType of predefinedType 39 | | `TypeReference of typeReference 40 | | `TypeQuery of path 41 | | `TypeLiteral of typeLiteral ] 42 | 43 | and typeReference = 44 | { 45 | trf_typeName : path; 46 | trf_typeArguments : type_ list option; 47 | } 48 | 49 | and typeMember = 50 | [ `PropertySignature of propertySignature 51 | | `CallSignature of callSignature 52 | | `ConstructSignature of constructSignature 53 | | `IndexSignature of indexSignature 54 | | `MethodSignature of methodSignature ] 55 | 56 | and elementType = 57 | [ `PredefinedType of predefinedType 58 | | `TypeReference of typeReference 59 | | `TypeQuery of path 60 | | `ObjectType of objectType 61 | (*| `ArrayType of arrayType*) ] 62 | 63 | and arrayType = 64 | { 65 | arr_elementType : elementType; 66 | arr_dimensions : int; 67 | } 68 | 69 | and typeMemberList = typeMember list 70 | 71 | and objectType = typeMemberList 72 | 73 | and functionType = 74 | { 75 | fnt_typeParameters : typeParameters option; 76 | fnt_parameterList : parameterList; 77 | fnt_type : type_; 78 | } 79 | 80 | and constructorType = 81 | { 82 | cnt_typeParameters : typeParameters option; 83 | cnt_parameterList : parameterList; 84 | cnt_type : type_; 85 | } 86 | 87 | and typeLiteral = 88 | [ `ObjectType of objectType 89 | | `ArrayType of arrayType 90 | | `FunctionType of functionType 91 | | `ConstructorType of constructorType ] 92 | 93 | and propertySignature = 94 | { 95 | psg_propertyName : string; 96 | psg_optional : bool; 97 | psg_typeAnnotation : type_ option; 98 | } 99 | 100 | and callSignature = 101 | { 102 | csg_typeParameters : typeParameters option; 103 | csg_parameterList : parameterList; 104 | csg_typeAnnotation : type_ option; 105 | } 106 | 107 | and parameter = 108 | [ `RequiredParameter of requiredParameter 109 | | `RequiredParameterSpecialized of requiredParameterSpecialized 110 | | `OptionalParameter of optionalParameter 111 | | `OptionalParameterInit of optionalParameterInit 112 | | `OptionalParameterSpecialized of optionalParameterSpecialized 113 | | `RestParameter of restParameter ] 114 | 115 | and parameterList = parameter list 116 | 117 | and requiredParameter = 118 | { 119 | rpr_publicOrPrivate : publicOrPrivate option; 120 | rpr_identifier : string; 121 | rpr_typeAnnotation : type_ option; 122 | } 123 | 124 | and requiredParameterSpecialized = 125 | { 126 | rps_identifier : string; 127 | rps_specializedSignature : string; 128 | } 129 | 130 | and optionalParameterSpecialized = 131 | { 132 | ops_identifier : string; 133 | ops_specializedSignature : string; 134 | } 135 | 136 | and publicOrPrivate = [ `Public | `Private ] 137 | 138 | and optionalParameter = 139 | { 140 | opr_publicOrPrivate : publicOrPrivate option; 141 | opr_identifier : string; 142 | opr_typeAnnotation : type_ option; 143 | } 144 | 145 | and optionalParameterInit = 146 | { 147 | opi_publicOrPrivate : publicOrPrivate option; 148 | opi_identifier : string; 149 | opi_typeAnnotation : type_ option; 150 | opi_initialiser : initialiser; 151 | } 152 | 153 | and initialiser = unit (* XXX *) 154 | 155 | and exportAssignment = string 156 | 157 | and classOrInterfaceTypeList = typeReference list 158 | 159 | and restParameter = 160 | { 161 | rsp_identifier : string; 162 | rsp_typeAnnotation : type_ option; 163 | } 164 | 165 | and constructSignature = 166 | { 167 | cns_typeParameters : typeParameters option; 168 | cns_parameterList : parameterList; 169 | cns_typeAnnotation : type_ option; 170 | } 171 | 172 | and stringOrNumber = [ `String | `Number ] 173 | 174 | and indexSignature = 175 | { 176 | ids_identifier : string; 177 | ids_stringOrNumber : stringOrNumber; 178 | ids_typeAnnotation : type_; 179 | } 180 | 181 | and methodSignature = 182 | { 183 | mts_propertyName : string; (* XXX *) 184 | mts_optional : bool; 185 | mts_callSignature : callSignature; 186 | } 187 | 188 | and externalImportDeclaration = 189 | { 190 | eid_export : bool; 191 | eid_identifier : string; 192 | eid_stringLiteral : string; 193 | } 194 | 195 | and ambientDeclaration = 196 | [ `AmbientVariableDeclaration of bool * ambientVariableDeclaration 197 | | `AmbientFunctionDeclaration of bool * ambientFunctionDeclaration 198 | | `AmbientClassDeclaration of bool * ambientClassDeclaration 199 | | `AmbientEnumDeclaration of bool * ambientEnumDeclaration 200 | | `AmbientModuleDeclaration of bool * ambientModuleDeclaration 201 | | `AmbientExternalModuleDeclaration of bool * ambientExternalModuleDeclaration ] 202 | 203 | and ambientVariableDeclaration = 204 | { 205 | avd_identifier : string; 206 | avd_typeAnnotation : type_ option; 207 | } 208 | 209 | and ambientEnumDeclaration = 210 | { 211 | aed_identifier : string; 212 | aed_enumBody : ambientEnumMember list; 213 | } 214 | 215 | and ambientEnumMember = 216 | { 217 | aem_propertyName : string; 218 | aem_integerLiteral : int option; 219 | } 220 | 221 | and ambientFunctionDeclaration = 222 | { 223 | afn_identifier : string; 224 | afn_callSignature : callSignature; 225 | } 226 | 227 | and ambientClassBodyElement = 228 | [ `AmbientConstructorDeclaration of ambientConstructorDeclaration 229 | | `AmbientPropertyMemberDeclaration of ambientPropertyMemberDeclaration 230 | | `IndexSignature of indexSignature ] 231 | 232 | and ambientConstructorDeclaration = parameter list 233 | 234 | and ambientPropertyMemberDeclaration = 235 | [ `AmbientPropertyMemberDeclarationTypeAnnotation of 236 | type_ option ambientPropertyMemberData 237 | | `AmbientPropertyMemberDeclarationCallSignature of 238 | callSignature ambientPropertyMemberData ] 239 | 240 | and 'a ambientPropertyMemberData = (* deriving? *) 241 | { 242 | apm_publicOrPrivate : publicOrPrivate option; 243 | apm_static : bool; 244 | apm_propertyName : string; 245 | apm_data : 'a; 246 | } 247 | 248 | and ambientClassDeclaration = 249 | { 250 | acd_identifier : string; 251 | acd_typeParameters : typeParameters option; 252 | acd_extends : typeReference option; 253 | acd_implements : classOrInterfaceTypeList option; 254 | acd_classBody : ambientClassBodyElement list; 255 | } 256 | 257 | and ambientModuleDeclaration = 258 | { 259 | amd_identifierPath : path; 260 | amd_ambientModuleBody : ambientModuleElement list; 261 | } 262 | 263 | and ambientModuleElement = 264 | [ `AmbientVariableDeclaration of bool * ambientVariableDeclaration 265 | | `AmbientFunctionDeclaration of bool * ambientFunctionDeclaration 266 | | `AmbientClassDeclaration of bool * ambientClassDeclaration 267 | | `InterfaceDeclaration of bool * interfaceDeclaration 268 | | `AmbientEnumDeclaration of bool * ambientEnumDeclaration 269 | | `AmbientModuleDeclaration of bool * ambientModuleDeclaration 270 | | `ImportDeclaration of bool * importDeclaration ] 271 | 272 | and ambientModuleElements = ambientModuleElement list 273 | 274 | and ambientExternalModuleDeclaration = 275 | { 276 | eamd_name : string; 277 | eamd_ambientExternalModuleElements : ambientExternalModuleElements; 278 | } 279 | 280 | and ambientExternalModuleElement = 281 | [ `AmbientModuleElement of ambientModuleElement 282 | | `ExportAssignment of exportAssignment 283 | | `ExternalImportDeclaration of externalImportDeclaration ] 284 | 285 | and ambientExternalModuleElements = ambientExternalModuleElement list 286 | (*deriving (Show)*) 287 | 288 | 289 | -------------------------------------------------------------------------------- /src/convert.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type out = string -> unit 4 | 5 | module S = Set.Make(String) 6 | module M = Map.Make(String) 7 | 8 | let s_of_list l = List.fold_right S.add l S.empty 9 | let list_of_s s = S.fold (fun elt arg -> elt::arg) s [] 10 | let list_of_m m = M.fold (fun key value arg -> value::arg) m [] 11 | 12 | let not_implemented out m = out m 13 | let error = failwith 14 | 15 | (**********************************************************************************) 16 | (* keyword syntax between ocaml and javascript *) 17 | 18 | let keywords = [ 19 | "and"; "as"; "assert"; "begin"; "class"; "constraint"; "do"; "done"; "downto"; "else"; "end"; 20 | "exception"; "extern"; "external"; "for"; "fun"; "function"; "functor"; "if"; "in"; "include"; 21 | "inherit"; "inherit"; "initializer"; "lazy"; "let"; "match"; "method"; "method"; "module"; 22 | "mutable"; "new"; "object"; "of"; "open"; "open"; "or"; "private"; "rec"; "sig"; "struct"; "then"; 23 | "to"; "try"; "type"; "val"; "val"; "virtual"; "when"; "while"; "with"; 24 | ] 25 | 26 | let is_keyword = 27 | let keywords = List.fold_right S.add keywords S.empty in 28 | fun s -> 29 | try S.find s keywords |> ignore; true 30 | with Not_found -> false 31 | 32 | let ml_name name = 33 | let trailing name = if String.contains name '_' then name ^ "_" else name in 34 | if is_keyword name then name ^ "_" 35 | else if (name.[0] >= 'A' && name.[0] <= 'Z') || (name.[0] = '_') then 36 | "_" ^ trailing name 37 | else 38 | trailing name 39 | 40 | let rec mangler () = 41 | let m = ref S.empty in 42 | let rec find name idx = 43 | let name' = name ^ "_" ^ string_of_int idx in 44 | try S.find name' !m |> ignore; find name (idx+1) 45 | with _ -> 46 | m := S.add name' !m; 47 | name' 48 | in 49 | fun name -> 50 | try S.find name !m |> ignore; find name 1 51 | with _ -> 52 | m := S.add name !m; 53 | name 54 | 55 | (**********************************************************************************) 56 | (* compilation *) 57 | 58 | let merge_interfaces ast = 59 | 60 | let top_interfaces, other = 61 | List.partition (function `InterfaceDeclaration _ -> true | _ -> false) ast 62 | in 63 | (* 64 | let top_modules, _ = List.partition 65 | (function 66 | | `AmbientDeclaration 67 | { amb_ambientDeclaration = `AmbientModuleDeclaration _; _ } -> true 68 | | _ -> false) other 69 | in 70 | let module T = Set.Make(struct 71 | type t = typeReference 72 | let compare = Pervasives.compare 73 | end) in 74 | *) 75 | 76 | let rec merge_interfaces map = function 77 | | [] -> map 78 | | h::t -> begin 79 | match h with 80 | | `InterfaceDeclaration 81 | ({ idf_identifier = id; 82 | idf_typeParameters = params; 83 | idf_interfaceExtendsClause = extends; 84 | idf_objectType = obj } as idf) -> begin 85 | let map = 86 | try 87 | let e = M.find id map in 88 | assert (idf.idf_typeParameters = params); (* I believe these must match exactly *) 89 | let merge_typeReferences a b = 90 | (* XXX 7.2 Declaration Merging; 91 | the extends clauses are merged into a single set of base types *) 92 | if a <> b then failwith "not implemented; merge_typeReferences" 93 | else a 94 | in 95 | M.add id 96 | { idf with 97 | (*idf_interfaceExtendsClause = 98 | merge_typeReferences e.idf_interfaceExtendsClause extends;*) 99 | idf_objectType = obj @ e.idf_objectType; 100 | } map 101 | with 102 | | Not_found -> 103 | M.add id idf map 104 | in 105 | merge_interfaces map t 106 | end 107 | | _ -> failwith "not an interface declaration in merge interfaces" 108 | end 109 | in 110 | 111 | (* interfaces are now out of order. 112 | * could make them recursive, or fix this *) 113 | (*let intf = List.map (fun x -> `InterfaceDeclaration x) 114 | (list_of_m (merge_interfaces M.empty top_interfaces)) 115 | in*) 116 | 117 | (* get back list of interfaces in the original order *) 118 | let map = merge_interfaces M.empty top_interfaces in 119 | let rec to_list map intf = 120 | match intf with 121 | | [] -> [] 122 | | (`InterfaceDeclaration { idf_identifier=name; _ }) :: t -> begin 123 | try 124 | let x = M.find name map in 125 | let map = M.remove name map in 126 | (`InterfaceDeclaration x) :: to_list map t 127 | with Not_found -> 128 | to_list map t 129 | end 130 | | _ -> failwith "not an interface declaration in merge interfaces" 131 | in 132 | let intf = to_list map top_interfaces in 133 | 134 | intf @ other 135 | 136 | (**********************************************************************************) 137 | (* code generation *) 138 | 139 | let type_ out t = 140 | let not_implemented s = not_implemented out s in 141 | match t with 142 | | `PredefinedType p -> 143 | (match p with 144 | | `Any -> out "Ts.any" 145 | | `Number -> out "Ts.number" 146 | | `Boolean -> out "Ts.boolean" 147 | | `String -> out "Ts.string" 148 | | `Void -> out "Ts.void") 149 | | `TypeReference _ -> not_implemented "Ts.typeReference" 150 | | `TypeQuery _ -> not_implemented "Ts.typeQuery" 151 | | `TypeLiteral _ -> not_implemented "Ts.typeLiteral" 152 | 153 | let type_opt out = function 154 | | None -> out "Ts.any" 155 | | Some(t) -> type_ out t 156 | 157 | let propertySignature out mangle psg = 158 | out ("method " ^ mangle (ml_name psg.psg_propertyName) ^ " : "); 159 | type_opt out psg.psg_typeAnnotation; 160 | out " Js.prop\n" 161 | 162 | let parameter_type param = 163 | match param with 164 | | `RequiredParameter x -> x.rpr_typeAnnotation 165 | (* XXX: how are we going to deal with this properly? *) 166 | | `RequiredParameterSpecialized _ -> Some(`PredefinedType `Any) 167 | | `OptionalParameter x -> x.opr_typeAnnotation 168 | | `OptionalParameterInit _ -> error "OptionalParameterInit" 169 | (* XXX: how are we going to deal with this properly? *) 170 | | `OptionalParameterSpecialized _ -> Some(`PredefinedType `Any) 171 | (* : any[] *) 172 | | `RestParameter _ -> Some(`TypeLiteral (`ArrayType { arr_elementType = `PredefinedType `Any; 173 | arr_dimensions = 1 })) 174 | 175 | let callSignature out csg = 176 | (*assert (csg.csg_typeParameters = None);*) 177 | if csg.csg_parameterList=[] then begin 178 | out "Ts.void -> " 179 | end else begin 180 | List.iter (fun p -> 181 | let t = parameter_type p in 182 | type_opt out t; 183 | out " -> " 184 | ) csg.csg_parameterList; 185 | end; 186 | type_opt out csg.csg_typeAnnotation 187 | 188 | let methodSignature out mangle mts = 189 | out ("method " ^ mangle (ml_name mts.mts_propertyName) ^ " : "); 190 | (*out "(";*) 191 | callSignature out mts.mts_callSignature; 192 | out " Js.meth\n" 193 | 194 | let interfaceDeclaration out idf = 195 | let mangle = mangler () in 196 | let not_implemented = not_implemented out in 197 | (* assert (idf.idf_typeParameters = None); 198 | assert (idf.idf_interfaceExtendsClause = None); *) 199 | 200 | out ("(* interfaceDeclaration *)\n"); 201 | out ("class type " ^ ml_name idf.idf_identifier ^ " = object\n"); 202 | 203 | List.iter (function 204 | | `PropertySignature psg -> propertySignature out mangle psg 205 | | `CallSignature _ -> not_implemented "(* CallSignature *)\n" 206 | | `ConstructSignature _ -> not_implemented "(* ConstructSignature *)\n" 207 | | `IndexSignature _ -> not_implemented "(* IndexSignature *)\n" 208 | | `MethodSignature mts -> methodSignature out mangle mts 209 | ) idf.idf_objectType; 210 | 211 | out ("end\n") 212 | 213 | let ambientVariableDeclaration out avd = 214 | out ("(* ambientVariableDeclaration *)\n"); 215 | out ("let (" ^ ml_name avd.avd_identifier ^ " : "); 216 | type_opt out avd.avd_typeAnnotation; 217 | out ") "; 218 | out "= Js.Unsafe.variable "; 219 | out ("\"" ^ avd.avd_identifier ^ "\""); 220 | out "\n" 221 | 222 | let ambientFunctionDeclaration out afn = 223 | out ("(* ambientFunctionDeclaration *)\n"); 224 | out ("let " ^ ml_name afn.afn_identifier ^ " : "); 225 | callSignature out afn.afn_callSignature; 226 | out " = fun "; 227 | let len = List.length afn.afn_callSignature.csg_parameterList in 228 | if len=0 then begin 229 | out "() " 230 | end else begin 231 | for i=0 to len - 1 do 232 | out ("p" ^ string_of_int i ^ " "); 233 | done 234 | end; 235 | out "-> Js.Unsafe.fun_call "; 236 | out ("(Js.Unsafe.variable \"" ^ afn.afn_identifier ^ "\") "); 237 | out "[| "; 238 | for i=0 to len - 1 do 239 | out ("Js.Unsafe.inject p" ^ string_of_int i ^ "; "); 240 | done; 241 | out " |]\n" 242 | 243 | let ambientDeclaration out amb = 244 | let not_implemented = not_implemented out in 245 | match amb with 246 | | `AmbientVariableDeclaration (_,avd) -> ambientVariableDeclaration out avd 247 | | `AmbientFunctionDeclaration (_,afn) -> ambientFunctionDeclaration out afn 248 | | `AmbientClassDeclaration _ -> not_implemented "(* AmbientDeclaration *)\n" 249 | | `AmbientEnumDeclaration _ -> not_implemented "(* AmbientDeclaration *)\n" 250 | | `AmbientModuleDeclaration _ -> not_implemented "(* AmbientDeclaration *)\n" 251 | | `AmbientExternalModuleDeclaration _ -> not_implemented "(* AmbientDeclaration *)\n" 252 | 253 | let declarationElement out decl = 254 | let not_implemented = not_implemented out in 255 | match decl with 256 | | `ExportAssignment name -> not_implemented "(* ExportAssignment *)\n" 257 | | `InterfaceDeclaration idf -> interfaceDeclaration out idf 258 | | `ImportDeclaration idl -> not_implemented "(* ImportDeclaration *)\n" 259 | | `ExternalImportDeclaration eid -> not_implemented "(* ExternalImportDeclaration *)\n" 260 | | `AmbientDeclaration amb -> ambientDeclaration out amb 261 | 262 | let convert out ast = 263 | let merge = false in 264 | if merge then 265 | List.iter (declarationElement out) (merge_interfaces ast) 266 | else 267 | List.iter (declarationElement out) ast 268 | 269 | -------------------------------------------------------------------------------- /src/print.ml: -------------------------------------------------------------------------------- 1 | (* write out typescript from ast *) 2 | 3 | module Make(O : sig val out : string -> unit end) = struct 4 | open O 5 | open Ast 6 | 7 | let notimpl ?msg ?(nl=false) () = 8 | (match msg with 9 | | Some(x) -> out ("/* not implemented: " ^ x ^ " */") 10 | | None -> out "/* not implemented */"); 11 | (if nl then out "\n") 12 | 13 | let optOut ?(s="") ?(e="") f = function None -> () | Some(x) -> (out s; f x; out e) 14 | let optOutA f o = optOut ~s:"<" ~e:">" f o 15 | (*let optOutB f o = optOut ~s:"(" ~e:")" f o*) 16 | let rec sepOutBy s f = function 17 | | [] -> () 18 | | [x] -> f x 19 | | x::t -> (f x; out s; sepOutBy s f t) 20 | 21 | let rec typeReference r = 22 | sepOutBy "." out r.trf_typeName; 23 | optOutA (sepOutBy "," type_) r.trf_typeArguments 24 | 25 | and elementType = function 26 | | `PredefinedType p -> predefinedType p 27 | | `TypeReference r -> typeReference r 28 | | `TypeQuery q -> typeQuery q 29 | | `ObjectType o -> objectType o 30 | 31 | and arrayType a = 32 | elementType a.arr_elementType; 33 | for i=0 to a.arr_dimensions-1 do 34 | out "[]" 35 | done 36 | 37 | and typeQuery q = (out "typeof "; sepOutBy "." out q) 38 | 39 | and functionType f = 40 | optOutA (sepOutBy "," typeParameter) f.fnt_typeParameters; 41 | out "("; 42 | sepOutBy "," parameter f.fnt_parameterList; 43 | out ") => "; 44 | type_ f.fnt_type 45 | 46 | and constructorType c = 47 | out "new "; 48 | optOutA (sepOutBy "," typeParameter) c.cnt_typeParameters; 49 | out "("; 50 | sepOutBy "," parameter c.cnt_parameterList; 51 | out ") => "; 52 | type_ c.cnt_type 53 | 54 | and objectType o = 55 | out "{\n"; 56 | List.iter (fun t -> typeMember t; out ";\n") o; 57 | out "}" 58 | 59 | and typeParameter p = 60 | out p.tpp_identifier; 61 | optOut ~s:"extends " type_ p.tpp_constraint 62 | 63 | and constructSignature c = 64 | out "new "; 65 | optOutA (sepOutBy "," typeParameter) c.cns_typeParameters; 66 | out "("; 67 | sepOutBy "," parameter c.cns_parameterList; 68 | out ")"; 69 | optOut ~s:" : " type_ c.cns_typeAnnotation 70 | 71 | and callSignature c = 72 | optOutA (sepOutBy "," typeParameter) c.csg_typeParameters; 73 | out "("; 74 | sepOutBy "," parameter c.csg_parameterList; 75 | out ")"; 76 | optOut ~s:" : " type_ c.csg_typeAnnotation 77 | 78 | and publicOrPrivate = function `Public -> out "public " | `Private -> out "private " 79 | 80 | and requiredParameter p = 81 | optOut publicOrPrivate p.rpr_publicOrPrivate; 82 | out p.rpr_identifier; 83 | optOut ~s:" : " type_ p.rpr_typeAnnotation 84 | 85 | and requiredParameterSpecialized p = 86 | out p.rps_identifier; 87 | out " : "; 88 | out "\""; 89 | out p.rps_specializedSignature; 90 | out "\"" 91 | 92 | and optionalParameter p = 93 | optOut publicOrPrivate p.opr_publicOrPrivate; 94 | out p.opr_identifier; out "?"; 95 | optOut ~s:" : " type_ p.opr_typeAnnotation 96 | 97 | and optionalParameterSpecialized p = 98 | out p.ops_identifier; 99 | out "? : "; 100 | out "\""; 101 | out p.ops_specializedSignature; 102 | out "\"" 103 | 104 | and optionalParameterInit p = notimpl ~msg:"optionalParameterInit???" () 105 | 106 | and restParameter p = 107 | out "..."; 108 | out p.rsp_identifier; 109 | optOut ~s:" : " type_ p.rsp_typeAnnotation 110 | 111 | and propertySignature p = 112 | out p.psg_propertyName; 113 | (if p.psg_optional then out "?"); 114 | optOut ~s:" : " type_ p.psg_typeAnnotation 115 | 116 | and methodSignature m = 117 | out m.mts_propertyName; 118 | (if m.mts_optional then out "?"); 119 | callSignature m.mts_callSignature 120 | 121 | and indexSignature i = 122 | out "[ "; 123 | out i.ids_identifier; 124 | out " : "; 125 | (match i.ids_stringOrNumber with 126 | | `Number -> out "number" 127 | | `String -> out "string"); 128 | out " ] : "; 129 | type_ i.ids_typeAnnotation 130 | 131 | and parameter = function 132 | | `RequiredParameter p -> requiredParameter p 133 | | `RequiredParameterSpecialized p -> requiredParameterSpecialized p 134 | | `OptionalParameter p -> optionalParameter p 135 | | `OptionalParameterInit p -> optionalParameterInit p 136 | | `OptionalParameterSpecialized p -> optionalParameterSpecialized p 137 | | `RestParameter p -> restParameter p 138 | 139 | and typeMember = function 140 | | `PropertySignature p -> propertySignature p 141 | | `CallSignature c -> callSignature c 142 | | `ConstructSignature c -> constructSignature c 143 | | `IndexSignature i -> indexSignature i 144 | | `MethodSignature m -> methodSignature m 145 | 146 | and typeLiteral = function 147 | | `ObjectType o -> objectType o 148 | | `ArrayType a -> arrayType a 149 | | `FunctionType f -> functionType f 150 | | `ConstructorType c -> constructorType c 151 | 152 | and predefinedType = function 153 | | `Any -> out "any" 154 | | `Number -> out "number" 155 | | `Boolean -> out "boolean" 156 | | `String -> out "string" 157 | | `Void -> out "void" 158 | 159 | and type_ t = 160 | match t with 161 | | `PredefinedType x -> predefinedType x 162 | | `TypeReference r -> typeReference r 163 | | `TypeQuery q -> typeQuery q 164 | | `TypeLiteral l -> typeLiteral l 165 | 166 | let ambientVariableDeclaration (e,v) = 167 | (if e then out "export "); 168 | out "declare var "; out v.avd_identifier; 169 | (match v.avd_typeAnnotation with 170 | | None -> out " : any" 171 | | Some(t) -> (out " : "; type_ t)); 172 | out ";\n" 173 | 174 | let ambientFunctionDeclaration (e,f) = 175 | (if e then out "export "); 176 | out "declare function "; out f.afn_identifier; 177 | callSignature f.afn_callSignature; 178 | out ";\n" 179 | 180 | let ambientPropertyMemberData f d = 181 | optOut publicOrPrivate d.apm_publicOrPrivate; 182 | (if d.apm_static then out "static "); 183 | out d.apm_propertyName; out " "; 184 | f d.apm_data 185 | 186 | let ambientConstructorDeclaration d = 187 | out "constructor ("; 188 | sepOutBy "," parameter d; 189 | out ")" 190 | 191 | let ambientClassBodyElement = function 192 | | `AmbientConstructorDeclaration d -> ambientConstructorDeclaration d 193 | | `AmbientPropertyMemberDeclaration (`AmbientPropertyMemberDeclarationCallSignature d) -> 194 | ambientPropertyMemberData callSignature d 195 | | `AmbientPropertyMemberDeclaration (`AmbientPropertyMemberDeclarationTypeAnnotation d) -> 196 | ambientPropertyMemberData (optOut ~s:" : " type_) d 197 | | `IndexSignature d -> indexSignature d 198 | 199 | let ambientClassDeclaration (e,c) = 200 | (if e then out "export "); 201 | out "declare class "; out c.acd_identifier; 202 | optOutA (sepOutBy "," typeParameter) c.acd_typeParameters; 203 | optOut ~s:"extends " ~e:" " typeReference c.acd_extends; 204 | optOut ~s:"implements " (sepOutBy "," typeReference) c.acd_implements; 205 | out " {\n"; 206 | List.iter (fun e -> ambientClassBodyElement e; out ";\n") c.acd_classBody; 207 | out "}\n" 208 | 209 | let ambientEnumMember m = 210 | out m.aem_propertyName; 211 | optOut ~s:" = " (fun i -> out (string_of_int i)) m.aem_integerLiteral 212 | 213 | let ambientEnumDeclaration (e,d) = 214 | (if e then out "export "); 215 | out "enum "; out d.aed_identifier; out " {\n"; 216 | sepOutBy ",\n" ambientEnumMember d.aed_enumBody; 217 | out "\n}\n" 218 | 219 | let exportAssignment s = 220 | out "export = "; 221 | out s; 222 | out ";\n" 223 | 224 | let importDeclaration d = 225 | out "import "; 226 | out d.idl_identifier; 227 | out " = "; 228 | sepOutBy "." out d.idl_entityName; 229 | out ";\n" 230 | 231 | let externalImportDeclaration d = 232 | (if d.eid_export then out "export "); 233 | out "import "; 234 | out d.eid_identifier; 235 | out " = require(\""; 236 | out d.eid_stringLiteral; 237 | out "\");\n" 238 | 239 | let interfaceExtendsClause c = 240 | optOut ~s:"extends " ~e:" " (sepOutBy "," typeReference) c 241 | 242 | let interfaceDeclaration d = 243 | out "interface "; 244 | out d.idf_identifier; out " "; 245 | optOut ~s:"<" ~e:"> " (sepOutBy "," typeParameter) d.idf_typeParameters; 246 | interfaceExtendsClause d.idf_interfaceExtendsClause; 247 | objectType d.idf_objectType; 248 | out "\n" 249 | 250 | let rec ambientModuleElement = function 251 | | `AmbientVariableDeclaration d -> ambientVariableDeclaration d 252 | | `AmbientFunctionDeclaration d -> ambientFunctionDeclaration d 253 | | `AmbientClassDeclaration d -> ambientClassDeclaration d 254 | | `InterfaceDeclaration (_,d) -> interfaceDeclaration d 255 | | `AmbientEnumDeclaration d -> ambientEnumDeclaration d 256 | | `AmbientModuleDeclaration (_,d) -> ambientModuleDeclaration d 257 | | `ImportDeclaration (_,d) -> importDeclaration d (* XXX ??? exports *) 258 | 259 | and ambientModuleDeclaration d = 260 | out "module "; 261 | sepOutBy "." out d.amd_identifierPath; 262 | out " {\n"; 263 | List.iter ambientModuleElement d.amd_ambientModuleBody; 264 | out "}\n" 265 | 266 | let ambientExternalModuleElement = function 267 | | `ExternalImportDeclaration d -> externalImportDeclaration d 268 | | `AmbientModuleElement d -> ambientModuleElement d 269 | | `ExportAssignment d -> exportAssignment d 270 | 271 | let ambientExternalModuleDeclaration (e,d) = 272 | (if e then out "export "); 273 | out "declare module \""; 274 | out d.eamd_name; 275 | out "\" { \n"; 276 | List.iter ambientExternalModuleElement d.eamd_ambientExternalModuleElements; 277 | out "\n}\n" 278 | 279 | let ambientDeclaration d = 280 | match d with 281 | | `AmbientVariableDeclaration v -> ambientVariableDeclaration v 282 | | `AmbientFunctionDeclaration f -> ambientFunctionDeclaration f 283 | | `AmbientClassDeclaration c -> ambientClassDeclaration c 284 | | `AmbientEnumDeclaration e -> ambientEnumDeclaration e 285 | | `AmbientModuleDeclaration (_,m) -> ambientModuleDeclaration m 286 | | `AmbientExternalModuleDeclaration m -> ambientExternalModuleDeclaration m 287 | 288 | let declarationElement e = 289 | match e with 290 | | `ExportAssignment s -> exportAssignment s 291 | | `InterfaceDeclaration d -> interfaceDeclaration d 292 | | `ImportDeclaration d -> importDeclaration d 293 | | `ExternalImportDeclaration d -> externalImportDeclaration d 294 | | `AmbientDeclaration d -> ambientDeclaration d 295 | 296 | let print_ast = function 297 | | None -> out "Empty AST\n" 298 | | Some(x) -> 299 | List.iter declarationElement x 300 | 301 | end 302 | 303 | 304 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | (* OASIS_START *) 2 | (* DO NOT EDIT (digest: 196486910aff686a6ff84cda88dcaf3b) *) 3 | module OASISGettext = struct 4 | (* # 22 "src/oasis/OASISGettext.ml" *) 5 | 6 | 7 | let ns_ str = 8 | str 9 | 10 | 11 | let s_ str = 12 | str 13 | 14 | 15 | let f_ (str: ('a, 'b, 'c, 'd) format4) = 16 | str 17 | 18 | 19 | let fn_ fmt1 fmt2 n = 20 | if n = 1 then 21 | fmt1^^"" 22 | else 23 | fmt2^^"" 24 | 25 | 26 | let init = 27 | [] 28 | 29 | 30 | end 31 | 32 | module OASISExpr = struct 33 | (* # 22 "src/oasis/OASISExpr.ml" *) 34 | 35 | 36 | 37 | 38 | 39 | open OASISGettext 40 | 41 | 42 | type test = string 43 | 44 | 45 | type flag = string 46 | 47 | 48 | type t = 49 | | EBool of bool 50 | | ENot of t 51 | | EAnd of t * t 52 | | EOr of t * t 53 | | EFlag of flag 54 | | ETest of test * string 55 | 56 | 57 | 58 | type 'a choices = (t * 'a) list 59 | 60 | 61 | let eval var_get t = 62 | let rec eval' = 63 | function 64 | | EBool b -> 65 | b 66 | 67 | | ENot e -> 68 | not (eval' e) 69 | 70 | | EAnd (e1, e2) -> 71 | (eval' e1) && (eval' e2) 72 | 73 | | EOr (e1, e2) -> 74 | (eval' e1) || (eval' e2) 75 | 76 | | EFlag nm -> 77 | let v = 78 | var_get nm 79 | in 80 | assert(v = "true" || v = "false"); 81 | (v = "true") 82 | 83 | | ETest (nm, vl) -> 84 | let v = 85 | var_get nm 86 | in 87 | (v = vl) 88 | in 89 | eval' t 90 | 91 | 92 | let choose ?printer ?name var_get lst = 93 | let rec choose_aux = 94 | function 95 | | (cond, vl) :: tl -> 96 | if eval var_get cond then 97 | vl 98 | else 99 | choose_aux tl 100 | | [] -> 101 | let str_lst = 102 | if lst = [] then 103 | s_ "" 104 | else 105 | String.concat 106 | (s_ ", ") 107 | (List.map 108 | (fun (cond, vl) -> 109 | match printer with 110 | | Some p -> p vl 111 | | None -> s_ "") 112 | lst) 113 | in 114 | match name with 115 | | Some nm -> 116 | failwith 117 | (Printf.sprintf 118 | (f_ "No result for the choice list '%s': %s") 119 | nm str_lst) 120 | | None -> 121 | failwith 122 | (Printf.sprintf 123 | (f_ "No result for a choice list: %s") 124 | str_lst) 125 | in 126 | choose_aux (List.rev lst) 127 | 128 | 129 | end 130 | 131 | 132 | # 132 "myocamlbuild.ml" 133 | module BaseEnvLight = struct 134 | (* # 22 "src/base/BaseEnvLight.ml" *) 135 | 136 | 137 | module MapString = Map.Make(String) 138 | 139 | 140 | type t = string MapString.t 141 | 142 | 143 | let default_filename = 144 | Filename.concat 145 | (Sys.getcwd ()) 146 | "setup.data" 147 | 148 | 149 | let load ?(allow_empty=false) ?(filename=default_filename) () = 150 | if Sys.file_exists filename then 151 | begin 152 | let chn = 153 | open_in_bin filename 154 | in 155 | let st = 156 | Stream.of_channel chn 157 | in 158 | let line = 159 | ref 1 160 | in 161 | let st_line = 162 | Stream.from 163 | (fun _ -> 164 | try 165 | match Stream.next st with 166 | | '\n' -> incr line; Some '\n' 167 | | c -> Some c 168 | with Stream.Failure -> None) 169 | in 170 | let lexer = 171 | Genlex.make_lexer ["="] st_line 172 | in 173 | let rec read_file mp = 174 | match Stream.npeek 3 lexer with 175 | | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> 176 | Stream.junk lexer; 177 | Stream.junk lexer; 178 | Stream.junk lexer; 179 | read_file (MapString.add nm value mp) 180 | | [] -> 181 | mp 182 | | _ -> 183 | failwith 184 | (Printf.sprintf 185 | "Malformed data file '%s' line %d" 186 | filename !line) 187 | in 188 | let mp = 189 | read_file MapString.empty 190 | in 191 | close_in chn; 192 | mp 193 | end 194 | else if allow_empty then 195 | begin 196 | MapString.empty 197 | end 198 | else 199 | begin 200 | failwith 201 | (Printf.sprintf 202 | "Unable to load environment, the file '%s' doesn't exist." 203 | filename) 204 | end 205 | 206 | 207 | let rec var_expand str env = 208 | let buff = 209 | Buffer.create ((String.length str) * 2) 210 | in 211 | Buffer.add_substitute 212 | buff 213 | (fun var -> 214 | try 215 | var_expand (MapString.find var env) env 216 | with Not_found -> 217 | failwith 218 | (Printf.sprintf 219 | "No variable %s defined when trying to expand %S." 220 | var 221 | str)) 222 | str; 223 | Buffer.contents buff 224 | 225 | 226 | let var_get name env = 227 | var_expand (MapString.find name env) env 228 | 229 | 230 | let var_choose lst env = 231 | OASISExpr.choose 232 | (fun nm -> var_get nm env) 233 | lst 234 | end 235 | 236 | 237 | # 237 "myocamlbuild.ml" 238 | module MyOCamlbuildFindlib = struct 239 | (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) 240 | 241 | 242 | (** OCamlbuild extension, copied from 243 | * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild 244 | * by N. Pouillard and others 245 | * 246 | * Updated on 2009/02/28 247 | * 248 | * Modified by Sylvain Le Gall 249 | *) 250 | open Ocamlbuild_plugin 251 | 252 | type conf = 253 | { no_automatic_syntax: bool; 254 | } 255 | 256 | (* these functions are not really officially exported *) 257 | let run_and_read = 258 | Ocamlbuild_pack.My_unix.run_and_read 259 | 260 | 261 | let blank_sep_strings = 262 | Ocamlbuild_pack.Lexers.blank_sep_strings 263 | 264 | 265 | let exec_from_conf exec = 266 | let exec = 267 | let env_filename = Pathname.basename BaseEnvLight.default_filename in 268 | let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in 269 | try 270 | BaseEnvLight.var_get exec env 271 | with Not_found -> 272 | Printf.eprintf "W: Cannot get variable %s\n" exec; 273 | exec 274 | in 275 | let fix_win32 str = 276 | if Sys.os_type = "Win32" then begin 277 | let buff = Buffer.create (String.length str) in 278 | (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. 279 | *) 280 | String.iter 281 | (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) 282 | str; 283 | Buffer.contents buff 284 | end else begin 285 | str 286 | end 287 | in 288 | fix_win32 exec 289 | 290 | let split s ch = 291 | let buf = Buffer.create 13 in 292 | let x = ref [] in 293 | let flush () = 294 | x := (Buffer.contents buf) :: !x; 295 | Buffer.clear buf 296 | in 297 | String.iter 298 | (fun c -> 299 | if c = ch then 300 | flush () 301 | else 302 | Buffer.add_char buf c) 303 | s; 304 | flush (); 305 | List.rev !x 306 | 307 | 308 | let split_nl s = split s '\n' 309 | 310 | 311 | let before_space s = 312 | try 313 | String.before s (String.index s ' ') 314 | with Not_found -> s 315 | 316 | (* ocamlfind command *) 317 | let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] 318 | 319 | (* This lists all supported packages. *) 320 | let find_packages () = 321 | List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) 322 | 323 | 324 | (* Mock to list available syntaxes. *) 325 | let find_syntaxes () = ["camlp4o"; "camlp4r"] 326 | 327 | 328 | let well_known_syntax = [ 329 | "camlp4.quotations.o"; 330 | "camlp4.quotations.r"; 331 | "camlp4.exceptiontracer"; 332 | "camlp4.extend"; 333 | "camlp4.foldgenerator"; 334 | "camlp4.listcomprehension"; 335 | "camlp4.locationstripper"; 336 | "camlp4.macro"; 337 | "camlp4.mapgenerator"; 338 | "camlp4.metagenerator"; 339 | "camlp4.profiler"; 340 | "camlp4.tracer" 341 | ] 342 | 343 | 344 | let dispatch conf = 345 | function 346 | | After_options -> 347 | (* By using Before_options one let command line options have an higher 348 | * priority on the contrary using After_options will guarantee to have 349 | * the higher priority override default commands by ocamlfind ones *) 350 | Options.ocamlc := ocamlfind & A"ocamlc"; 351 | Options.ocamlopt := ocamlfind & A"ocamlopt"; 352 | Options.ocamldep := ocamlfind & A"ocamldep"; 353 | Options.ocamldoc := ocamlfind & A"ocamldoc"; 354 | Options.ocamlmktop := ocamlfind & A"ocamlmktop"; 355 | Options.ocamlmklib := ocamlfind & A"ocamlmklib" 356 | 357 | | After_rules -> 358 | 359 | (* When one link an OCaml library/binary/package, one should use 360 | * -linkpkg *) 361 | flag ["ocaml"; "link"; "program"] & A"-linkpkg"; 362 | 363 | if not (conf.no_automatic_syntax) then begin 364 | (* For each ocamlfind package one inject the -package option when 365 | * compiling, computing dependencies, generating documentation and 366 | * linking. *) 367 | List.iter 368 | begin fun pkg -> 369 | let base_args = [A"-package"; A pkg] in 370 | (* TODO: consider how to really choose camlp4o or camlp4r. *) 371 | let syn_args = [A"-syntax"; A "camlp4o"] in 372 | let (args, pargs) = 373 | (* Heuristic to identify syntax extensions: whether they end in 374 | ".syntax"; some might not. 375 | *) 376 | if Filename.check_suffix pkg "syntax" || 377 | List.mem pkg well_known_syntax then 378 | (syn_args @ base_args, syn_args) 379 | else 380 | (base_args, []) 381 | in 382 | flag ["ocaml"; "compile"; "pkg_"^pkg] & S args; 383 | flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args; 384 | flag ["ocaml"; "doc"; "pkg_"^pkg] & S args; 385 | flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args; 386 | flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args; 387 | 388 | (* TODO: Check if this is allowed for OCaml < 3.12.1 *) 389 | flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs; 390 | flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs; 391 | flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs; 392 | flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs; 393 | end 394 | (find_packages ()); 395 | end; 396 | 397 | (* Like -package but for extensions syntax. Morover -syntax is useless 398 | * when linking. *) 399 | List.iter begin fun syntax -> 400 | flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 401 | flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 402 | flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 403 | flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & 404 | S[A"-syntax"; A syntax]; 405 | end (find_syntaxes ()); 406 | 407 | (* The default "thread" tag is not compatible with ocamlfind. 408 | * Indeed, the default rules add the "threads.cma" or "threads.cmxa" 409 | * options when using this tag. When using the "-linkpkg" option with 410 | * ocamlfind, this module will then be added twice on the command line. 411 | * 412 | * To solve this, one approach is to add the "-thread" option when using 413 | * the "threads" package using the previous plugin. 414 | *) 415 | flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); 416 | flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); 417 | flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); 418 | flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); 419 | flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); 420 | flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); 421 | flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); 422 | flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); 423 | 424 | | _ -> 425 | () 426 | end 427 | 428 | module MyOCamlbuildBase = struct 429 | (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 430 | 431 | 432 | (** Base functions for writing myocamlbuild.ml 433 | @author Sylvain Le Gall 434 | *) 435 | 436 | 437 | 438 | 439 | 440 | open Ocamlbuild_plugin 441 | module OC = Ocamlbuild_pack.Ocaml_compiler 442 | 443 | 444 | type dir = string 445 | type file = string 446 | type name = string 447 | type tag = string 448 | 449 | 450 | (* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 451 | 452 | 453 | type t = 454 | { 455 | lib_ocaml: (name * dir list * string list) list; 456 | lib_c: (name * dir * file list) list; 457 | flags: (tag list * (spec OASISExpr.choices)) list; 458 | (* Replace the 'dir: include' from _tags by a precise interdepends in 459 | * directory. 460 | *) 461 | includes: (dir * dir list) list; 462 | } 463 | 464 | 465 | let env_filename = 466 | Pathname.basename 467 | BaseEnvLight.default_filename 468 | 469 | 470 | let dispatch_combine lst = 471 | fun e -> 472 | List.iter 473 | (fun dispatch -> dispatch e) 474 | lst 475 | 476 | 477 | let tag_libstubs nm = 478 | "use_lib"^nm^"_stubs" 479 | 480 | 481 | let nm_libstubs nm = 482 | nm^"_stubs" 483 | 484 | 485 | let dispatch t e = 486 | let env = 487 | BaseEnvLight.load 488 | ~filename:env_filename 489 | ~allow_empty:true 490 | () 491 | in 492 | match e with 493 | | Before_options -> 494 | let no_trailing_dot s = 495 | if String.length s >= 1 && s.[0] = '.' then 496 | String.sub s 1 ((String.length s) - 1) 497 | else 498 | s 499 | in 500 | List.iter 501 | (fun (opt, var) -> 502 | try 503 | opt := no_trailing_dot (BaseEnvLight.var_get var env) 504 | with Not_found -> 505 | Printf.eprintf "W: Cannot get variable %s\n" var) 506 | [ 507 | Options.ext_obj, "ext_obj"; 508 | Options.ext_lib, "ext_lib"; 509 | Options.ext_dll, "ext_dll"; 510 | ] 511 | 512 | | After_rules -> 513 | (* Declare OCaml libraries *) 514 | List.iter 515 | (function 516 | | nm, [], intf_modules -> 517 | ocaml_lib nm; 518 | let cmis = 519 | List.map (fun m -> (String.uncapitalize m) ^ ".cmi") 520 | intf_modules in 521 | dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis 522 | | nm, dir :: tl, intf_modules -> 523 | ocaml_lib ~dir:dir (dir^"/"^nm); 524 | List.iter 525 | (fun dir -> 526 | List.iter 527 | (fun str -> 528 | flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) 529 | ["compile"; "infer_interface"; "doc"]) 530 | tl; 531 | let cmis = 532 | List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi") 533 | intf_modules in 534 | dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] 535 | cmis) 536 | t.lib_ocaml; 537 | 538 | (* Declare directories dependencies, replace "include" in _tags. *) 539 | List.iter 540 | (fun (dir, include_dirs) -> 541 | Pathname.define_context dir include_dirs) 542 | t.includes; 543 | 544 | (* Declare C libraries *) 545 | List.iter 546 | (fun (lib, dir, headers) -> 547 | (* Handle C part of library *) 548 | flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] 549 | (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; 550 | A("-l"^(nm_libstubs lib))]); 551 | 552 | flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] 553 | (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); 554 | 555 | flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] 556 | (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); 557 | 558 | (* When ocaml link something that use the C library, then one 559 | need that file to be up to date. 560 | This holds both for programs and for libraries. 561 | *) 562 | dep ["link"; "ocaml"; tag_libstubs lib] 563 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 564 | 565 | dep ["compile"; "ocaml"; tag_libstubs lib] 566 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 567 | 568 | (* TODO: be more specific about what depends on headers *) 569 | (* Depends on .h files *) 570 | dep ["compile"; "c"] 571 | headers; 572 | 573 | (* Setup search path for lib *) 574 | flag ["link"; "ocaml"; "use_"^lib] 575 | (S[A"-I"; P(dir)]); 576 | ) 577 | t.lib_c; 578 | 579 | (* Add flags *) 580 | List.iter 581 | (fun (tags, cond_specs) -> 582 | let spec = BaseEnvLight.var_choose cond_specs env in 583 | let rec eval_specs = 584 | function 585 | | S lst -> S (List.map eval_specs lst) 586 | | A str -> A (BaseEnvLight.var_expand str env) 587 | | spec -> spec 588 | in 589 | flag tags & (eval_specs spec)) 590 | t.flags 591 | | _ -> 592 | () 593 | 594 | 595 | let dispatch_default conf t = 596 | dispatch_combine 597 | [ 598 | dispatch t; 599 | MyOCamlbuildFindlib.dispatch conf; 600 | ] 601 | 602 | 603 | end 604 | 605 | 606 | # 606 "myocamlbuild.ml" 607 | open Ocamlbuild_plugin;; 608 | let package_default = 609 | { 610 | MyOCamlbuildBase.lib_ocaml = [("DefinitelyMaybeTyped", ["src"], [])]; 611 | lib_c = []; 612 | flags = []; 613 | includes = [("app", ["src"])] 614 | } 615 | ;; 616 | 617 | let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} 618 | 619 | let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; 620 | 621 | # 622 "myocamlbuild.ml" 622 | (* OASIS_STOP *) 623 | Ocamlbuild_plugin.dispatch dispatch_default;; 624 | -------------------------------------------------------------------------------- /src/unit_tests.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open MParser 3 | open MParser_PCRE 4 | 5 | let parse_string ?(eof=true) p s = 6 | if eof then parse_string ((<<) p MParser.eof) s () 7 | else parse_string p s () 8 | 9 | let assert_parse_eq ?(eof=true) p str v = 10 | match parse_string ~eof p str with 11 | | Failed _ -> assert_failure "parse failure" 12 | | Success x -> assert_equal x v 13 | 14 | let assert_parse ?(eof=true) p str = 15 | match parse_string ~eof p str with 16 | | Failed _ -> assert_failure "parse failure" 17 | | Success _ -> assert_bool "ok" true 18 | 19 | let assert_parse_fail ?(eof=true) p str = 20 | match parse_string ~eof p str with 21 | | Failed _ -> assert_bool "ok" true 22 | | Success _ -> assert_failure "expected parse failure" 23 | 24 | let assert_parse_map ?(eof=true) p str fn = 25 | match parse_string ~eof p str with 26 | | Failed _ -> assert_failure "parse failure" 27 | | Success x -> assert_bool "map" (fn x) 28 | 29 | let parse_tests name parse l = 30 | name >::: (List.map (function 31 | | `Ok(str) -> 32 | ("OK : " ^ name ^ " '" ^ str ^ "'") >:: (fun () -> assert_parse parse str) 33 | | `Fail(str) -> 34 | ("FAIL: " ^ name ^ " '" ^ str ^ "'") >:: (fun () -> assert_parse_fail parse str) 35 | | `Eq(str,eq) -> 36 | ("EQ : " ^ name ^ " '" ^ str ^ "'") >:: (fun () -> assert_parse_eq parse str eq) 37 | | `Map(str,fn) -> 38 | ("MAP : " ^ name ^ " '" ^ str ^ "'") >:: (fun () -> assert_parse_map parse str fn) 39 | ) l) 40 | 41 | let test_typescript = 42 | let open Parser in 43 | let open Ast in 44 | let open TypeScript in 45 | "Tests" >::: [ 46 | "Token" >::: [ 47 | parse_tests "whitespace_and_comments" Token.whitespace [ 48 | `Ok ""; 49 | `Ok " "; 50 | `Ok "\t"; 51 | `Ok "\n"; 52 | `Ok "\t\r\n "; 53 | `Ok "/* aaa\nbbbb */"; 54 | `Ok "// aaa"; 55 | ]; 56 | parse_tests "string" (Token.string "hello") [ 57 | `Ok "hello "; 58 | `Fail "goodbye "; 59 | `Eq("hello ", "hello"); 60 | ]; 61 | "char" >::: [ 62 | "simple" >:: (fun ctx -> assert_parse_eq (Token.char 'a') "a" 'a'); 63 | "punct" >:: (fun ctx -> assert_parse_eq (Token.char ':') ":" ':'); 64 | "space" >:: (fun ctx -> assert_parse_eq (Token.char 'a') "a " 'a'); 65 | "fail multiple" >:: (fun ctx -> assert_parse_fail (Token.char 'a') "ab"); 66 | ]; 67 | ]; 68 | "Typescript basic" >::: [ 69 | parse_tests "identifier" identifier [ 70 | `Ok "abc"; 71 | `Ok "De"; 72 | `Ok "_fg"; 73 | `Ok "Xyz \n/* ... */ // ..."; 74 | `Ok "1hikj"; 75 | `Ok "$"; 76 | `Ok "$$"; 77 | `Ok "$_"; 78 | `Ok "_"; 79 | `Ok "__"; 80 | ]; 81 | parse_tests "path" path [ 82 | `Ok "abc"; 83 | `Ok "I.am.a.module.name"; 84 | `Eq("a.b.c ", ["a";"b";"c"]); 85 | `Fail ""; 86 | `Fail "a.b . c"; 87 | ]; 88 | parse_tests "stringLiteral" stringLiteral [ 89 | `Fail ""; 90 | `Eq("\"\"", ""); 91 | `Eq("\"str lit\"", "str lit"); 92 | `Eq("\'\'", ""); 93 | `Eq("'str lit'", "str lit"); 94 | ]; 95 | ]; 96 | "Typescript types" >::: [ 97 | parse_tests "predefinedType" predefinedType [ 98 | `Ok "number"; 99 | `Ok "any"; 100 | `Ok "boolean"; 101 | `Ok "string"; 102 | `Ok "void"; 103 | `Fail "other"; 104 | ]; 105 | parse_tests "typeQuery" typeQuery [ 106 | `Ok "typeof mytype"; 107 | `Eq("typeof a.b.c", ["a";"b";"c"]); 108 | ]; 109 | parse_tests "typeReference" typeReference [ 110 | `Fail ""; 111 | `Ok "a"; 112 | `Ok "a"; 113 | `Ok "a"; 114 | `Ok "a < b, c> "; 115 | ]; 116 | parse_tests "typeParameter" typeParameter [ 117 | `Ok "b extends c"; 118 | `Ok "b extends c.d"; 119 | ]; 120 | parse_tests "elementType" elementType [ 121 | `Map("any", function `PredefinedType _ -> true | _ -> false); 122 | `Map("number", function `PredefinedType _ -> true | _ -> false); 123 | `Map("a", function `TypeReference _ -> true | _ -> false); 124 | `Map("typeof a", function `TypeQuery _ -> true | _ -> false); 125 | `Map("{}", function `ObjectType _ -> true | _ -> false); 126 | ]; 127 | parse_tests "typeLiteral" typeLiteral [ 128 | `Map("a[][]", function `ArrayType _ -> true | _ -> false); 129 | `Map("{}", function `ObjectType _ -> true | _ -> false); 130 | `Map("() => a", function `FunctionType _ -> true | _ -> false); 131 | `Map("(b:c,d:e) => f", function `FunctionType _ -> true | _ -> false); 132 | `Map("new () => a", function `ConstructorType _ -> true | _ -> false); 133 | `Map("new (b,c:d) => e", function `ConstructorType _ -> true | _ -> false); 134 | ]; 135 | parse_tests "type" type_ [ 136 | `Map("a[][]", function `TypeLiteral _ -> true | _ -> false); 137 | `Map("{}", function `TypeLiteral _ -> true | _ -> false); 138 | `Map("() => a", function `TypeLiteral _ -> true | _ -> false); 139 | `Map("(b:c,d:e) => f", function `TypeLiteral _ -> true | _ -> false); 140 | `Map("new () => a", function `TypeLiteral _ -> true | _ -> false); 141 | `Map("new (b,c:d) => e", function `TypeLiteral _ -> true | _ -> false); 142 | `Map("a", function `TypeReference _ -> true | _ -> false); 143 | `Map("a", function `TypeReference _ -> true | _ -> false); 144 | `Map("a", function `TypeReference _ -> true | _ -> false); 145 | `Map("a < b, c> ", function `TypeReference _ -> true | _ -> false); 146 | `Map("any", function `PredefinedType _ -> true | _ -> false); 147 | `Map("string", function `PredefinedType _ -> true | _ -> false); 148 | `Map("typeof t", function `TypeQuery _ -> true | _ -> false); 149 | `Ok "any[]"; 150 | `Ok "string[]"; 151 | `Ok "number[]"; 152 | `Ok "boolean[]"; 153 | ]; 154 | parse_tests "object" objectType [ 155 | `Fail ""; 156 | `Ok "{ a }"; 157 | `Ok "{ a; }"; 158 | `Ok "{ a; b }"; 159 | `Ok "{ a; b; }"; 160 | (* MORE *) 161 | ]; 162 | parse_tests "parameter" parameter [ 163 | `Fail ""; 164 | `Map("a", function `RequiredParameter _ -> true | _ -> false); 165 | `Ok "public a"; 166 | `Ok "private a"; 167 | `Map("a?", function `OptionalParameter _ -> true | _ -> false); 168 | `Ok "private a?"; 169 | `Ok "public a?"; 170 | `Ok "a:b"; 171 | `Ok "a?:b"; 172 | `Ok "a?:b"; 173 | `Map("a:\"b\"", function `RequiredParameterSpecialized _ -> true | _ -> false); 174 | `Ok"a?:\"b\""; (* XXX *) 175 | `Map("... sommat", function `RestParameter _ -> true | _ -> false); 176 | ]; 177 | parse_tests "indexSignature" indexSignature [ 178 | `Ok "[ name : string ] : type"; 179 | `Ok "[ name : number ] : type"; 180 | `Fail "[ name : any ] : type"; 181 | `Fail "[ name : number ]"; 182 | ]; 183 | parse_tests "constructSignature" constructSignature [ 184 | `Ok "new ()"; 185 | `Ok "new ()"; 186 | `Ok "new < Isla, Skye > ( isla )"; 187 | `Ok "new ( isla : Island, harris? : Rocky )"; 188 | `Ok "new(container: HTMLElement, theme?: string): VirtualRenderer"; 189 | ]; 190 | parse_tests "callSignature" callSignature [ 191 | `Fail ""; 192 | `Ok "()"; 193 | `Ok "( a,b,c )"; 194 | `Ok "( a,b:b,c ) :d"; 195 | `Ok "( a,b:b,c ) :d"; 196 | `Eq("()", { csg_typeParameters=None; csg_parameterList=[]; csg_typeAnnotation=None }); 197 | ]; 198 | parse_tests "properySignature" propertySignature [ 199 | `Fail ""; 200 | `Ok "a"; 201 | `Ok "a:b"; 202 | `Ok "a:b"; 203 | `Ok "a:b[]"; 204 | `Ok "a:b>[][][]"; 205 | ]; 206 | parse_tests "methodSignature" methodSignature [ 207 | `Fail ""; 208 | `Ok "fn()"; 209 | `Ok "a?(b)"; 210 | `Ok "a(b):c"; 211 | `Ok "a(b):c[]"; 212 | ]; 213 | parse_tests "typeMember" typeMember [ 214 | `Map("new ()", function `ConstructSignature _ -> true | _ -> false); 215 | `Map("a()", function `MethodSignature _ -> true | _ -> false); 216 | `Map("()", function `CallSignature _ -> true | _ -> false); 217 | `Map("[a:string]:b", function `IndexSignature _ -> true | _ -> false); 218 | `Map("a", function `PropertySignature _ -> true | _ -> false); 219 | ]; 220 | parse_tests "exportAssignment" exportAssignment [ 221 | `Ok("export = hello;"); 222 | ]; 223 | parse_tests "interfaceExtendsClause" interfaceExtendsClause [ 224 | `Ok "extends a, c"; 225 | `Fail "extends a[]"; 226 | `Fail "extends"; 227 | ]; 228 | parse_tests "interfaceDeclaration" interfaceDeclaration [ 229 | `Ok "interface a { }"; 230 | `Ok "interface a extends c,d { }"; 231 | `Ok "interface a { b;c:d}"; 232 | `Ok "interface a { b:Array; }"; 233 | `Ok "interface a { b:any[]; }"; 234 | ]; 235 | parse_tests "importDeclaration" importDeclaration [ 236 | `Ok "import a = b"; 237 | `Ok "import a = b.c"; 238 | `Fail "import a.c = c"; 239 | ]; 240 | parse_tests "externalImportDeclaration" externalImportDeclaration [ 241 | `Ok "import a = require ( \"b\" );"; 242 | `Ok "export import a = require ( \"b\" );"; 243 | ]; 244 | parse_tests "ambientVariableDeclaration" ambientVariableDeclaration [ 245 | `Ok "var a;"; 246 | `Ok "var a:b;"; 247 | `Ok "var a:b[];"; 248 | `Ok "var a:b>[];"; 249 | ]; 250 | parse_tests "ambientEnumDeclaration" ambientEnumDeclaration [ 251 | `Ok "enum a { b, c }"; 252 | `Ok "enum a { b=0, c=10 }"; 253 | ]; 254 | parse_tests "ambientFunctionDeclaration" ambientFunctionDeclaration [ 255 | `Ok "function a ()"; 256 | `Ok "function a (a,b,c:d)"; 257 | ]; 258 | parse_tests "ambientClassDeclaration" ambientClassDeclaration [ 259 | `Ok "class a {}"; 260 | `Ok "class a {}"; 261 | `Ok "class a extends c implements d, e {}"; 262 | `Ok "class a { constructor (a:b,c); }"; 263 | `Ok "class a { b:c; }"; 264 | `Ok "class a { b(); }"; 265 | `Ok "class a { b() }"; 266 | `Ok "class a { b(c,d:e); }"; 267 | `Ok "class a { b }"; 268 | `Ok "class a { b; }"; 269 | `Ok "class a { a b }"; 270 | `Ok "class a { a b; }"; 271 | ]; 272 | parse_tests "ambientModuleElement" ambientModuleElement [ 273 | `Map("var a:b;", function `AmbientVariableDeclaration _ -> true | _ -> false); 274 | `Map("interface a {}", function `InterfaceDeclaration _ -> true | _ -> false); 275 | `Map("module a {}", function `AmbientModuleDeclaration _ -> true | _ -> false); 276 | `Map("import a = b.c", function `ImportDeclaration _ -> true | _ -> false); 277 | `Map("export function a()", function `AmbientFunctionDeclaration _ -> true | _ -> false); 278 | `Map("enum a { b, c }", function `AmbientEnumDeclaration _ -> true | _ -> false); 279 | (* XXX class *) 280 | ]; 281 | parse_tests "ambientModuleDeclaration" ambientModuleDeclaration [ 282 | `Ok "module a { var a; var b; }"; 283 | `Ok "module a { var a; var b }"; (* now passes *) 284 | ]; 285 | parse_tests "ambientExternalModuleElement" ambientExternalModuleElement [ 286 | `Map("module a {}", function `AmbientModuleElement _ -> true | _ -> false); 287 | `Map("export = hello;", function `ExportAssignment _ -> true | _ -> false); 288 | `Map("import a = require( \"b\" );", function `ExternalImportDeclaration _ -> true | _ -> false); 289 | `Map("export import a = require ( \"b\" );", 290 | function `ExternalImportDeclaration _ -> true | _ -> false); 291 | ]; 292 | parse_tests "ambientExternalModuleDeclaration" ambientExternalModuleDeclaration [ 293 | `Ok "module \"x\" {}"; 294 | `Ok "module \"x\" { var a; }"; 295 | ]; 296 | parse_tests "ambientDeclaration" ambientDeclaration [ 297 | `Map("var a;", function `AmbientVariableDeclaration _ -> true | _ -> false); 298 | `Map("module a {}", function `AmbientModuleDeclaration _ -> true | _ -> false); 299 | `Map("module \"b\" {}", function `AmbientExternalModuleDeclaration _ -> true | _ -> false); 300 | `Map("enum a { b, c }", function `AmbientEnumDeclaration _ -> true | _ -> false); 301 | `Map("function a()", function `AmbientFunctionDeclaration _ -> true | _ -> false); 302 | (* XXX class *) 303 | ]; 304 | parse_tests "declarationElement" declarationElement [ 305 | `Map("declare var a;", function `AmbientDeclaration _ -> true | _ -> false); 306 | `Map("export declare module a {}", function `AmbientDeclaration _ -> true | _ -> false); 307 | `Map("declare module \"a\" {}", function `AmbientDeclaration _ -> true | _ -> false); 308 | `Map("export = a;", function `ExportAssignment _ -> true | _ -> false); 309 | `Map("interface a {}", function `InterfaceDeclaration _ -> true | _ -> false); 310 | `Map("interface a extends c,d { f; g:h }", 311 | function `InterfaceDeclaration _ -> true | _ -> false); 312 | `Map("import a = b.c", function `ImportDeclaration _ -> true | _ -> false); 313 | `Map("import a = require ( \"b\" );", function `ExternalImportDeclaration _ -> true | _ -> false); 314 | `Ok "declare module \"a\" { 315 | export interface a { 316 | } 317 | }"; 318 | ]; 319 | (* a bunch of example code from the TypeScript documentation *) 320 | parse_tests "examples" declarationSourceFile [ 321 | `Ok "declare function vote(candidate: string, callback: (result: string) => any)"; 322 | `Ok " 323 | interface Friend { 324 | name: string; 325 | favoriteColor?: string; 326 | }"; 327 | `Ok " 328 | interface JQuery { 329 | text(content: string); 330 | } 331 | interface JQueryStatic { 332 | get(url: string, callback: (data: string) => any); 333 | (query: string): JQuery; 334 | } 335 | declare var $: JQueryStatic;"; (* XXX $ is valid identifier *) 336 | `Ok " 337 | interface Point { 338 | x: number; 339 | y: number; 340 | }"; 341 | `Ok " 342 | declare class CPoint { 343 | x: number; 344 | y: number; 345 | constructor(x: number, y: number); 346 | }"; 347 | `Ok " 348 | interface BankAccount { 349 | balance: number; 350 | deposit(credit: number): number; 351 | } 352 | declare var BankAccount: new() => BankAccount;"; 353 | `Ok " 354 | declare enum Operator { 355 | ADD, 356 | DIV, 357 | MUL, 358 | SUB 359 | } "; 360 | `Ok " 361 | interface Array { 362 | reverse(): T[]; 363 | sort(compareFn?: (a: T, b: T) => number): T[]; 364 | map(func: (value: T, index: number, array: T[]) => U, thisArg?: any): U[]; 365 | }"; 366 | `Ok " 367 | interface M { 368 | f(): string; 369 | } 370 | declare var M: M; "; 371 | `Ok " 372 | declare module X { 373 | export module Y { 374 | export interface Z { } 375 | } 376 | export interface Y { } 377 | } 378 | declare module A { 379 | export module B { 380 | export class C { } 381 | } 382 | } "; 383 | `Ok " 384 | interface G { 385 | f(x: V): V; 386 | } "; 387 | `Ok " 388 | interface Pair { first: T1; second: T2; } 389 | declare var a : Pair; 390 | declare var b : { first: string; second: Entity; }; 391 | "; 392 | `Ok " 393 | interface A { a: string; } 394 | interface B extends A { b: string; } 395 | interface C extends B { c: string; } 396 | interface G { 397 | x: T; 398 | y: U; 399 | } 400 | "; 401 | `Ok " 402 | declare var v1: { 403 | x: { a: string; }; 404 | y: { a: string; b: string; c: string }; 405 | }; "; 406 | `Ok " 407 | interface Document { 408 | createElement(tagName: \"div\"): HTMLDivElement; 409 | createElement(tagName: \"span\"): HTMLSpanElement; 410 | createElement(tagName: \"canvas\"): HTMLCanvasElement; 411 | createElement(tagName: string): HTMLElement; 412 | } "; 413 | `Ok " 414 | declare var x: 415 | { 416 | func1(x: number): number; 417 | func2: (x: number) => number; 418 | func3: { (x: number): number }; 419 | }; 420 | declare var y: 421 | { 422 | func4(x: number): number; 423 | func4(s: string): string; 424 | func5: { 425 | (x: number): number; 426 | (s: string): string; 427 | }; 428 | }; "; 429 | `Ok " 430 | declare class C { private x: T; } 431 | interface X { f(): string; } 432 | interface Y { f(): string; } 433 | declare var a: C; 434 | declare var b: C; "; 435 | `Ok " 436 | interface List { 437 | data: T; 438 | next: List; 439 | owner: List>; 440 | } "; 441 | `Ok " 442 | interface EventObject { 443 | x: number; 444 | y: number; 445 | } 446 | interface EventHandlers { 447 | mousedown?: (event: EventObject) => void; 448 | mouseup?: (event: EventObject) => void; 449 | mousemove?: (event: EventObject) => void; 450 | } 451 | declare function setEventHandlers(handlers: EventHandlers) "; 452 | `Ok " 453 | declare var attr: { 454 | (name: string): string; 455 | (name: string, value: string): Accessor; 456 | (map: any): Accessor; 457 | }; "; 458 | `Ok " 459 | interface Mover { 460 | move(): void; 461 | getStatus(): { speed: number; }; 462 | } 463 | interface Shaker { 464 | shake(): void; 465 | getStatus(): { frequency: number; }; 466 | } 467 | interface MoverShaker extends Mover, Shaker { 468 | getStatus(): { speed: number; frequency: number; }; 469 | } "; 470 | `Ok " interface StringComparer { (a: string, b: string): number; } "; 471 | `Ok " 472 | interface Document { 473 | createElement(tagName: any): Element; 474 | } 475 | interface Document { 476 | createElement(tagName: string): HTMLElement; 477 | } 478 | interface Document { 479 | createElement(tagName: \"div\"): HTMLDivElement; 480 | createElement(tagName: \"span\"): HTMLSpanElement; 481 | createElement(tagName: \"canvas\"): HTMLCanvasElement; 482 | } "; 483 | `Ok " 484 | declare class A { a: number; } 485 | declare module Foo { 486 | var A; 487 | class B extends A { b: string; } 488 | } "; 489 | `Ok " 490 | interface A { 491 | x: number; 492 | f: () => void; 493 | g: (a: any) => any; 494 | } 495 | interface B { 496 | x: number; 497 | y: number; 498 | f: () => void; 499 | g: (b: boolean) => boolean; 500 | } "; 501 | `Ok " 502 | declare class Pair { 503 | constructor(public item1: T1, public item2: T2); 504 | } 505 | declare class TwoArrays extends Pair {} 506 | interface Pair { 507 | item1: T1; 508 | item2: T2; 509 | } 510 | interface TwoArrays { 511 | item1: T[]; 512 | item2: T[]; 513 | } 514 | declare var Pair: { 515 | new (item1: T1, item2: T2): Pair; 516 | }; 517 | declare var TwoArrays: { 518 | new (item1: T[], item2: T[]): TwoArrays; 519 | }; 520 | "; 521 | `Ok " 522 | interface Point { 523 | x: number; 524 | y: number; 525 | distance(p: Point); 526 | } 527 | declare var Point: { 528 | new(x: number, y: number): Point; 529 | origin: Point; 530 | distance(p1: Point, p2: Point): number; 531 | }; "; 532 | `Ok " 533 | declare enum Color { Red, Green, Blue } 534 | declare var Color: { 535 | [x: number]: string; 536 | Red: Color; 537 | Green: Color; 538 | Blue: Color; 539 | }; "; 540 | `Ok " 541 | declare module A { 542 | export interface X { s: string } 543 | export var X: X; 544 | } "; 545 | `Ok " 546 | interface A { x: string; } 547 | declare module M { 548 | export interface B { x: A; } 549 | export interface C { x: B; } 550 | function foo(c: C) 551 | } "; 552 | ]; 553 | ]; 554 | ] 555 | 556 | let run () = 557 | run_test_tt_main test_typescript |> ignore 558 | 559 | 560 | -------------------------------------------------------------------------------- /src/parser.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Parse typescript definition files. 3 | *) 4 | 5 | open MParser 6 | open MParser_PCRE 7 | 8 | (* utils *) 9 | 10 | type ('a,'b) pp = ('a, 'b) MParser.t 11 | type 'a p = ('a, unit) pp 12 | 13 | let explode str = 14 | let len = String.length str in 15 | let rec f i = 16 | if i < len then str.[i] :: f (i+1) 17 | else [] 18 | in 19 | f 0 20 | 21 | let implode list = 22 | let len = List.length list in 23 | let str = String.create len in 24 | let rec f i = function 25 | | [] -> () 26 | | h::t -> str.[i] <- h; f (i+1) t 27 | in 28 | f 0 list; 29 | str 30 | (* 31 | let implode list = 32 | let s = Array.of_list list in 33 | String.init (Array.length s) (fun i -> s.(i)) 34 | *) 35 | (* comments and whitespace *) 36 | 37 | module Comment = struct 38 | 39 | let start = "/*" 40 | let docstart = "/**" 41 | let end_ = "*/" 42 | let line = "//" 43 | 44 | 45 | (* documentation comment extractor. 46 | * we parse them when consuming white space for the 47 | * token to which they are associated. We dump them into 48 | * a reference and clear them at all other white spcae. 49 | * The plus side of this uberbodge is we don't need to alter 50 | * the parser except to store the documentation *) 51 | let doc : string list ref = ref [] 52 | let doc_push s = doc := implode s :: !doc 53 | let doc_clear () = doc := [] 54 | let docs () = 55 | let s = String.concat "" (List.rev !doc) in 56 | doc_clear (); 57 | s 58 | 59 | (* skip white space *) 60 | let ignore_space s = (space >> return ()) s 61 | 62 | (* XXX: references '///' *) 63 | 64 | (* single line comment *) 65 | let oneline s = 66 | (attempt (string line) 67 | >> skip_many (satisfy ((!=) '\n')) 68 | >> return ()) s 69 | 70 | (* multiline comment *) 71 | let rec multiline st = 72 | (attempt (string start) >> multi) st 73 | 74 | and multi s = 75 | ( (attempt (string end_) >> return ()) 76 | <|> (skip_many1 (none_of start) >> multi) 77 | <|> (any_of start >> multi) 78 | "end of comment") s 79 | 80 | (* multiline documentation comment *) 81 | let rec docmultiline st = 82 | (attempt (string docstart) >> docmulti) st 83 | 84 | and docmulti s = 85 | ( (attempt (string end_) >> return ()) 86 | <|> (many1 (none_of start) >>= fun s -> doc_push s; docmulti) 87 | <|> (any_of start >>= fun c -> doc_push [c]; docmulti) 88 | "end of doc comment") s 89 | 90 | end 91 | 92 | module Token = struct 93 | 94 | let bom = char '\xef' >> char '\xbb' >> char '\xbf' 95 | 96 | let whitespace s = 97 | let open Comment in 98 | (skip_many (ignore_space <|> (*docmultiline <|>*) multiline <|> oneline "")) s 99 | 100 | let lexeme p = (p >>= fun x -> (whitespace >> return x)) 101 | 102 | let escaped_char s = 103 | (any_of "nrtb\\\"\'" |>> 104 | (function 105 | | 'n' -> '\n' 106 | | 'r' -> '\r' 107 | | 't' -> '\t' 108 | | 'b' -> '\b' 109 | | c -> c)) s 110 | 111 | let escape_sequence_dec = 112 | let int_of_dec c = 113 | (Char.code c) - (Char.code '0') in 114 | let char_of_digits d2 d1 d0 = 115 | char_of_int (100 * (int_of_dec d2) + 10 * (int_of_dec d1) 116 | + (int_of_dec d0)) 117 | in 118 | fun s -> 119 | (digit >>= fun d2 -> 120 | digit >>= fun d1 -> 121 | digit >>= fun d0 -> 122 | try_return3 char_of_digits d2 d1 d0 123 | "Escape sequence is no valid character code" s) s 124 | 125 | let escape_sequence_hex = 126 | let int_of_hex c = 127 | if '0' <= c && c <= '9' then (Char.code c) - (Char.code '0') 128 | else if 'a' <= c && c <= 'f' then (Char.code c) - (Char.code 'a') + 10 129 | else if 'A' <= c && c <= 'F' then (Char.code c) - (Char.code 'A') + 10 130 | else failwith "MParser.int_of_hex: no hex digit" in 131 | let char_of_digits h1 h0 = 132 | char_of_int (16 * (int_of_hex h1) + (int_of_hex h0)) 133 | in 134 | fun s -> 135 | (char 'x' >> 136 | hex_digit >>= fun h1 -> 137 | hex_digit >>= fun h0 -> 138 | try_return2 char_of_digits h1 h0 139 | "Escape sequence is no valid character code" s) s 140 | 141 | let escape_sequence s = 142 | (escape_sequence_dec 143 | <|> escape_sequence_hex) s 144 | 145 | let char_token s = 146 | ((char '\\' >> (escaped_char <|> escape_sequence)) 147 | <|> any_char) s 148 | 149 | let string_literal c s = 150 | (char c >> (many_chars_until char_token (char c)) 151 | "string literal") s 152 | 153 | 154 | let ident = lexeme (many1 (letter <|> digit <|> char '_' <|> char '$') |>> implode) 155 | let string name = lexeme (string name) 156 | let char name = lexeme (char name) 157 | let integer = (lexeme (many1 digit)) >>= fun x -> return (int_of_string (implode x)) 158 | 159 | let stringLiteral = 160 | lexeme 161 | (attempt (string_literal '"') 162 | <|> (string_literal '\'')) 163 | "stringLiteral" 164 | 165 | 166 | end 167 | 168 | module TypeScript = struct 169 | 170 | open Ast 171 | 172 | (* utils *) 173 | 174 | let bool_of_option = function None -> return false | Some(_) -> return true 175 | 176 | (* names *) 177 | 178 | let identifier = Token.ident 179 | let stringLiteral = Token.lexeme Token.stringLiteral 180 | let path = sep_by1 identifier (char '.') (* XXX not allowing spaces between '.'s for now, 181 | use Token.char otherwise *) 182 | 183 | 184 | (* types *) 185 | 186 | let rec typeParameter st = 187 | (perform 188 | tpp_identifier <-- identifier; 189 | tpp_constraint <-- 190 | option 191 | (perform 192 | tmp <-- Token.string "extends"; 193 | (*ident <-- (attempt path) <|> (Token.string "{}" >>= fun s -> return [s]); (* XXX *)*) 194 | ident <-- type_; (* XXX *) 195 | return ident); 196 | return {tpp_identifier; tpp_constraint}) st 197 | 198 | and typeParameters st = 199 | (perform 200 | tmp <-- Token.char '<'; 201 | params <-- sep_by1 typeParameter (Token.char ','); 202 | tmp <-- Token.char '>'; 203 | return params) st 204 | 205 | and predefinedType st = 206 | ( attempt (Token.string "any" >> return `Any) 207 | <|> attempt (Token.string "number" >> return `Number) 208 | <|> attempt (Token.string "boolean" >> return `Boolean) 209 | <|> attempt (Token.string "string" >> return `String) 210 | <|> attempt (Token.string "void" >> return `Void) 211 | <|> fail "predefinedType") st 212 | 213 | and typeReference st = 214 | (perform 215 | (*trf_typeName <-- (attempt path) <|> (stringLiteral >>= fun s -> return [s]); (* XXX *) *) 216 | trf_typeName <-- path; 217 | trf_typeArguments <-- option typeArguments; 218 | return { trf_typeName; trf_typeArguments }) st 219 | 220 | and typeArguments st = 221 | (perform 222 | tmp <-- Token.char '<'; 223 | args <-- sep_by1 type_ (Token.char ','); 224 | tmp <-- Token.char '>'; 225 | return args) st 226 | 227 | and typeQuery st = 228 | (perform 229 | tmp <-- Token.string "typeof"; 230 | name <-- path; 231 | return name) st 232 | 233 | (* this is not how the spec defines arrays (which doesn't work 234 | * and seems ambiguous). This is more logical but may be wrong. *) 235 | and elementType st = (* array element type *) 236 | ( attempt (predefinedType |>> fun x -> `PredefinedType x) 237 | <|> attempt (typeQuery |>> fun x -> `TypeQuery x) 238 | <|> attempt (typeReference |>> fun x -> `TypeReference x) 239 | <|> attempt (objectType |>> fun x -> `ObjectType x) 240 | (*<|> attempt (arrayType |>> fun x -> `ArrayType x)*) 241 | <|> fail "elementType") st 242 | 243 | and arrayType st = 244 | (perform 245 | arr_elementType <-- elementType; (* recurses indefinitely ... *) 246 | arr_dimensions <-- 247 | many1 (perform 248 | tmp <-- Token.char '['; 249 | tmp <-- Token.char ']'; 250 | return ()) |>> List.length; 251 | return { arr_elementType; arr_dimensions }) st 252 | 253 | and functionType st = 254 | (perform 255 | fnt_typeParameters <-- option typeParameters; 256 | tmp <-- Token.char '('; 257 | fnt_parameterList <-- parameterList; 258 | tmp <-- Token.char ')'; 259 | tmp <-- Token.string "=>"; 260 | fnt_type <-- type_; 261 | return { fnt_typeParameters; fnt_parameterList; fnt_type }) st 262 | 263 | and constructorType st = 264 | (perform 265 | tmp <-- Token.string "new"; 266 | cnt_typeParameters <-- option typeParameters; 267 | tmp <-- Token.char '('; 268 | cnt_parameterList <-- parameterList; 269 | tmp <-- Token.char ')'; 270 | tmp <-- Token.string "=>"; 271 | cnt_type <-- type_; 272 | return { cnt_typeParameters; cnt_parameterList; cnt_type }) st 273 | 274 | and typeLiteral st = 275 | ( zero 276 | <|> attempt (arrayType |>> fun x -> `ArrayType x) 277 | <|> attempt (objectType |>> fun x -> `ObjectType x) 278 | <|> attempt (functionType |>> fun x -> `FunctionType x) 279 | <|> attempt (constructorType |>> fun x -> `ConstructorType x) 280 | <|> fail "typeLiteral") st 281 | 282 | and type_ st = 283 | ( zero 284 | <|> attempt (typeQuery |>> fun x -> `TypeQuery x) 285 | <|> attempt (typeLiteral |>> fun x -> `TypeLiteral x) 286 | <|> attempt (predefinedType |>> fun t -> `PredefinedType t) 287 | <|> attempt (typeReference |>> fun t -> `TypeReference t) 288 | <|> fail "type") st 289 | 290 | and typeAnnotation st = 291 | (perform 292 | tmp <-- Token.char ':'; 293 | type_ <-- type_; 294 | return type_) st 295 | 296 | and propertyName = 297 | attempt stringLiteral <|> identifier 298 | (* XXX: identifierName | stringLiteral | numericLiteral *) 299 | 300 | and propertySignature st = 301 | (perform 302 | psg_propertyName <-- propertyName; 303 | psg_optional <-- option (Token.char '?') >>= bool_of_option; 304 | psg_typeAnnotation <-- option typeAnnotation; 305 | return { psg_propertyName; psg_optional; psg_typeAnnotation }) st 306 | 307 | and publicOrPrivate st = 308 | ( attempt (Token.string "public" >> return `Public) 309 | <|> (Token.string "private" >> return `Private)) st 310 | 311 | and requiredParameter st = 312 | (perform 313 | rpr_publicOrPrivate <-- option publicOrPrivate; 314 | rpr_identifier <-- identifier; 315 | rpr_typeAnnotation <-- option typeAnnotation; 316 | return { rpr_publicOrPrivate; rpr_identifier; rpr_typeAnnotation }) st 317 | 318 | and requiredParameterSpecialized st = 319 | (perform 320 | rps_identifier <-- identifier; 321 | tmp <-- Token.char ':'; 322 | rps_specializedSignature <-- stringLiteral; 323 | return { rps_identifier; rps_specializedSignature }) st 324 | 325 | and optionalParameter st = 326 | (perform 327 | opr_publicOrPrivate <-- option publicOrPrivate; 328 | opr_identifier <-- identifier; 329 | tmp <-- Token.char '?'; 330 | opr_typeAnnotation <-- option typeAnnotation; 331 | return { opr_publicOrPrivate; opr_identifier; opr_typeAnnotation }) st 332 | 333 | (* XXX NOT SURE WHAT IS ACTUALLY INTENDED HERE, 334 | * see select2.d.ts *) 335 | and optionalParameterSpecialized st = 336 | (perform 337 | ops_identifier <-- identifier; 338 | tmp <-- Token.char '?'; 339 | tmp <-- Token.char ':'; 340 | ops_specializedSignature <-- stringLiteral; 341 | return { ops_identifier; ops_specializedSignature }) st 342 | 343 | and initialiser = fail "initialiser" 344 | 345 | and optionalParameterInit st = 346 | (perform 347 | opi_publicOrPrivate <-- option publicOrPrivate; 348 | opi_identifier <-- identifier; 349 | opi_typeAnnotation <-- option typeAnnotation; 350 | opi_initialiser <-- initialiser; (* XXX *) 351 | return { opi_publicOrPrivate; opi_identifier; opi_typeAnnotation; opi_initialiser }) st 352 | 353 | and restParameter st = 354 | (perform 355 | tmp <-- Token.string "..."; 356 | rsp_identifier <-- identifier; 357 | rsp_typeAnnotation <-- option typeAnnotation; 358 | return { rsp_identifier; rsp_typeAnnotation }) st 359 | 360 | and parameter st = 361 | ( zero 362 | <|> attempt (optionalParameterSpecialized |>> fun t -> `OptionalParameterSpecialized t) 363 | <|> attempt (requiredParameterSpecialized |>> fun t -> `RequiredParameterSpecialized t) 364 | <|> attempt (optionalParameter |>> fun t -> `OptionalParameter t) 365 | <|> attempt (optionalParameterInit |>> fun t -> `OptionalParameterInit t) 366 | <|> attempt (restParameter |>> fun t -> `RestParameter t) 367 | <|> attempt (requiredParameter |>> fun t -> `RequiredParameter t) 368 | <|> fail "parameter") st 369 | 370 | and parameterList st = (sep_by (attempt parameter) (Token.char ',')) st 371 | 372 | and callSignature st = 373 | (perform 374 | csg_typeParameters <-- option typeParameters; 375 | tmp <-- Token.char '('; 376 | csg_parameterList <-- parameterList; 377 | tmp <-- Token.char ')'; 378 | csg_typeAnnotation <-- option typeAnnotation; 379 | return { csg_typeParameters; csg_parameterList; csg_typeAnnotation }) st 380 | 381 | and constructSignature st = 382 | (perform 383 | tmp <-- Token.string "new"; 384 | cns_typeParameters <-- option typeParameters; 385 | tmp <-- Token.char '('; 386 | cns_parameterList <-- parameterList; 387 | tmp <-- Token.char ')'; 388 | cns_typeAnnotation <-- option typeAnnotation; 389 | return { cns_typeParameters; cns_parameterList; cns_typeAnnotation }) st 390 | 391 | and stringOrNumber st = 392 | ( attempt (Token.string "string" >> return `String) 393 | <|> (Token.string "number" >> return `Number)) st 394 | 395 | and indexSignature st = 396 | (perform 397 | tmp <-- Token.char '['; 398 | ids_identifier <-- identifier; 399 | tmp <-- Token.char ':'; 400 | ids_stringOrNumber <-- stringOrNumber; 401 | tmp <-- Token.char ']'; 402 | ids_typeAnnotation <-- typeAnnotation; 403 | return { ids_identifier; ids_stringOrNumber; ids_typeAnnotation }) st 404 | 405 | and methodSignature st = 406 | (perform 407 | mts_propertyName <-- propertyName; 408 | mts_optional <-- (option (Token.char '?')) >>= bool_of_option; 409 | mts_callSignature <-- callSignature; 410 | return { mts_propertyName; mts_optional; mts_callSignature }) st 411 | 412 | and typeMember st = 413 | ( zero 414 | <|> attempt (constructSignature |>> fun s -> `ConstructSignature s) 415 | <|> attempt (methodSignature |>> fun s -> `MethodSignature s) 416 | <|> attempt (callSignature |>> fun s -> `CallSignature s) 417 | <|> attempt (indexSignature |>> fun s -> `IndexSignature s) 418 | <|> attempt (propertySignature |>> fun s -> `PropertySignature s) 419 | <|> fail "typeMember") st 420 | 421 | (* typeMember; typeMember; ....; typeMember[;] *) 422 | (*and typeMemberList st = 423 | let t = 424 | attempt (perform 425 | t <-- typeMember; 426 | tmp <-- Token.char ';'; 427 | return t) 428 | in 429 | (many t >>= (fun t -> 430 | ( attempt (typeMember >>= fun t' -> return (t@[t']))) 431 | <|> (return t))) st 432 | *) 433 | 434 | and typeMemberList st = 435 | many (attempt (perform 436 | t <-- typeMember; 437 | tmp <-- option (Token.char ';'); 438 | return t)) st 439 | 440 | and objectType st = 441 | (perform 442 | tmp <-- Token.char '{'; 443 | objectType <-- typeMemberList; 444 | (*tmp <-- option (Token.char ';');*) 445 | tmp <-- Token.char '}'; 446 | return objectType) st 447 | 448 | (* top level elements *) 449 | 450 | and classOrInterfaceTypeList st = (sep_by1 typeReference (Token.char ',')) st 451 | 452 | and interfaceExtendsClause st = 453 | (perform 454 | tmp <-- Token.string "extends"; 455 | classOrInterfaceTypeList <-- classOrInterfaceTypeList; 456 | return classOrInterfaceTypeList) st 457 | 458 | let exportAssignment = 459 | perform 460 | tmp <-- Token.string "export"; 461 | tmp <-- Token.char '='; 462 | identifier <-- identifier; 463 | tmp <-- option (Token.char ';'); 464 | return identifier 465 | 466 | let interfaceDeclaration st = 467 | (perform 468 | tmp <-- option (Token.string "export"); (* XXX LeapMotion.d.ts; this shouldn't be needed *) 469 | tmp <-- Token.string "interface"; 470 | idf_identifier <-- identifier; 471 | idf_typeParameters <-- option typeParameters; 472 | idf_interfaceExtendsClause <-- option interfaceExtendsClause; 473 | idf_objectType <-- objectType; 474 | return 475 | { idf_identifier; idf_typeParameters; idf_interfaceExtendsClause; 476 | idf_objectType }) st 477 | 478 | let importDeclaration st = 479 | (perform 480 | tmp <-- option (Token.string "export"); (* XXX ??? *) 481 | tmp <-- Token.string "import"; 482 | idl_identifier <-- identifier; 483 | tmp <-- Token.char '='; 484 | idl_entityName <-- path; 485 | tmp <-- option (Token.char ';'); 486 | return { idl_identifier; idl_entityName }) st 487 | 488 | let externalImportDeclaration = 489 | perform 490 | eid_export <-- option (Token.string "export") >>= bool_of_option; 491 | tmp <-- Token.string "import"; 492 | eid_identifier <-- identifier; 493 | tmp <-- Token.char '='; 494 | tmp <-- Token.string "require"; 495 | tmp <-- Token.char '('; 496 | eid_stringLiteral <-- stringLiteral; 497 | tmp <-- Token.char ')'; 498 | tmp <-- Token.char ';'; 499 | return { eid_export; eid_identifier; eid_stringLiteral } 500 | 501 | let ambientVariableDeclaration = 502 | perform 503 | tmp <-- Token.string "var"; 504 | avd_identifier <-- identifier; 505 | avd_typeAnnotation <-- option typeAnnotation; 506 | tmp <-- option (Token.char ';'); 507 | return { avd_identifier; avd_typeAnnotation } 508 | 509 | let ambientFunctionDeclaration = 510 | perform 511 | tmp <-- Token.string "function"; 512 | afn_identifier <-- identifier; 513 | afn_callSignature <-- callSignature; 514 | tmp <-- option (Token.char ';'); 515 | return { afn_identifier; afn_callSignature } 516 | 517 | let ambientConstructorDeclaration = 518 | perform 519 | tmp <-- Token.string "constructor"; 520 | tmp <-- Token.char '('; 521 | params <-- parameterList; 522 | tmp <-- Token.char ')'; 523 | tmp <-- Token.char ';'; 524 | return params 525 | 526 | let ambientPropertyMemberData data = 527 | perform 528 | apm_publicOrPrivate <-- option publicOrPrivate; 529 | apm_static <-- option (Token.string "static") >>= bool_of_option; 530 | apm_propertyName <-- propertyName; 531 | apm_data <-- data; 532 | tmp <-- option (Token.char ';'); 533 | return { apm_publicOrPrivate; apm_static; apm_propertyName; apm_data } 534 | 535 | let ambientPropertyMemberDeclaration = 536 | ( zero 537 | <|> attempt (ambientPropertyMemberData callSignature |>> 538 | fun d -> `AmbientPropertyMemberDeclarationCallSignature d) 539 | <|> attempt (ambientPropertyMemberData (option typeAnnotation) |>> 540 | fun d -> `AmbientPropertyMemberDeclarationTypeAnnotation d) 541 | <|> fail "ambientPropertyMemberDeclaration") 542 | 543 | let ambientClassBodyElement = 544 | ( zero 545 | <|> attempt (ambientConstructorDeclaration |>> fun d -> `AmbientConstructorDeclaration d) 546 | <|> attempt (ambientPropertyMemberDeclaration |>> fun d -> `AmbientPropertyMemberDeclaration d) 547 | <|> attempt (indexSignature |>> fun d -> `IndexSignature d) 548 | <|> fail "ambientClassBodyElement") 549 | 550 | let ambientClassDeclaration = 551 | perform 552 | tmp <-- Token.string "class"; 553 | acd_identifier <-- identifier; 554 | acd_typeParameters <-- option typeParameters; 555 | acd_extends <-- option 556 | (perform 557 | tmp <-- Token.string "extends"; 558 | ct <-- typeReference; 559 | return ct); 560 | acd_implements <-- option 561 | (perform 562 | tmp <-- Token.string "implements"; 563 | ci <-- classOrInterfaceTypeList; 564 | return ci); 565 | tmp <-- Token.char '{'; 566 | acd_classBody <-- many (attempt ambientClassBodyElement); 567 | tmp <-- Token.char '}'; 568 | return { acd_identifier; acd_typeParameters; acd_extends; 569 | acd_implements; acd_classBody } 570 | 571 | let ambientEnumMember = 572 | perform 573 | aem_propertyName <-- propertyName; 574 | aem_integerLiteral <-- option 575 | (perform 576 | tmp <-- Token.char '='; 577 | int <-- Token.integer; 578 | return int); 579 | return { aem_propertyName; aem_integerLiteral } 580 | 581 | let ambientEnumDeclaration = 582 | perform 583 | tmp <-- Token.string "enum"; 584 | aed_identifier <-- identifier; 585 | tmp <-- Token.char '{'; 586 | aed_enumBody <-- many (attempt ((<<) ambientEnumMember (option (Token.char ',')))); 587 | tmp <-- Token.char '}'; 588 | return { aed_identifier; aed_enumBody } 589 | 590 | let rec ambientModuleElements st = (many (attempt ambientModuleElement)) st 591 | 592 | and ambientModuleElement st = 593 | (perform 594 | export <-- option (Token.string "export") >>= bool_of_option; 595 | res <-- 596 | ( zero 597 | <|> attempt (ambientVariableDeclaration |>> fun a -> `AmbientVariableDeclaration (export,a)) 598 | <|> attempt (ambientFunctionDeclaration |>> fun a -> `AmbientFunctionDeclaration (export,a)) 599 | <|> attempt (ambientClassDeclaration |>> fun a -> `AmbientClassDeclaration (export,a)) 600 | <|> attempt (interfaceDeclaration |>> fun a -> `InterfaceDeclaration (export,a)) 601 | <|> attempt (ambientEnumDeclaration |>> fun a -> `AmbientEnumDeclaration (export,a)) 602 | <|> attempt (ambientModuleDeclaration |>> fun a -> `AmbientModuleDeclaration (export,a)) 603 | <|> attempt (importDeclaration |>> fun a -> `ImportDeclaration (export,a)) 604 | <|> fail "ambientModuleElement"); 605 | return res) st 606 | 607 | and ambientModuleDeclaration st = 608 | (perform 609 | tmp <-- Token.string "module"; 610 | amd_identifierPath <-- path; 611 | tmp <-- Token.char '{'; 612 | amd_ambientModuleBody <-- ambientModuleElements; 613 | tmp <-- Token.char '}'; 614 | return { amd_identifierPath; amd_ambientModuleBody }) st 615 | 616 | let ambientExternalModuleElement = 617 | ( zero 618 | <|> attempt (externalImportDeclaration |>> fun a -> `ExternalImportDeclaration a) 619 | <|> attempt (ambientModuleElement |>> fun a -> `AmbientModuleElement a) 620 | <|> attempt (exportAssignment |>> fun a -> `ExportAssignment a) 621 | <|> fail "ambientExternalModuleElement") 622 | 623 | let ambientExternalModuleElements = many (attempt ambientExternalModuleElement) 624 | 625 | let ambientExternalModuleDeclaration st = 626 | (perform 627 | tmp <-- Token.string "module"; 628 | eamd_name <-- stringLiteral; 629 | tmp <-- Token.char '{'; 630 | eamd_ambientExternalModuleElements <-- ambientExternalModuleElements; 631 | tmp <-- Token.char '}'; 632 | return { eamd_name; eamd_ambientExternalModuleElements }) st 633 | 634 | let ambientDeclaration export = 635 | zero 636 | <|> attempt (ambientVariableDeclaration |>> fun a -> `AmbientVariableDeclaration (export,a)) 637 | <|> attempt (ambientModuleDeclaration |>> fun a -> `AmbientModuleDeclaration (export,a)) 638 | <|> attempt (ambientFunctionDeclaration |>> fun a -> `AmbientFunctionDeclaration (export,a)) 639 | <|> attempt (ambientClassDeclaration |>> fun a -> `AmbientClassDeclaration (export,a)) 640 | <|> attempt (ambientEnumDeclaration |>> fun a -> `AmbientEnumDeclaration (export,a)) 641 | <|> attempt (ambientExternalModuleDeclaration |>> fun a -> 642 | `AmbientExternalModuleDeclaration (export,a)) 643 | <|> fail "ambientDeclaration" 644 | 645 | let ambientDeclaration = 646 | perform 647 | export <-- option (Token.string "export") >>= bool_of_option; 648 | tmp <-- Token.string "declare"; 649 | amb <-- 650 | zero 651 | <|> attempt (ambientVariableDeclaration |>> fun a -> `AmbientVariableDeclaration (export,a)) 652 | <|> attempt (ambientModuleDeclaration |>> fun a -> `AmbientModuleDeclaration (export,a)) 653 | <|> attempt (ambientFunctionDeclaration |>> fun a -> `AmbientFunctionDeclaration (export,a)) 654 | <|> attempt (ambientClassDeclaration |>> fun a -> `AmbientClassDeclaration (export,a)) 655 | <|> attempt (ambientEnumDeclaration |>> fun a -> `AmbientEnumDeclaration (export,a)) 656 | <|> attempt (ambientExternalModuleDeclaration |>> fun a -> 657 | `AmbientExternalModuleDeclaration (export,a)) 658 | <|> fail "ambientDeclaration" ; 659 | return amb 660 | 661 | let declarationElement st = 662 | ( zero 663 | <|> attempt (ambientDeclaration |>> fun d -> `AmbientDeclaration d) 664 | <|> attempt (exportAssignment |>> fun d -> `ExportAssignment d) 665 | <|> attempt (interfaceDeclaration |>> fun d -> `InterfaceDeclaration d) 666 | <|> attempt (externalImportDeclaration |>> fun d -> `ExternalImportDeclaration d) 667 | <|> attempt (importDeclaration |>> fun d -> `ImportDeclaration d) 668 | <|> fail "declarationElement") st 669 | 670 | let rec declarationElements st = 671 | ((attempt declarationElement >>= fun d -> 672 | declarationElements >>= fun dt -> 673 | return (d::dt)) 674 | <|> (eof >> return [])) st 675 | 676 | let declarationSourceFile = option Token.bom >> Token.whitespace >> declarationElements 677 | 678 | end 679 | 680 | (*********************************************************************************) 681 | 682 | (*let to_string ast = 683 | Show.show ast*) 684 | 685 | (* parse a string *) 686 | let sparse p s = 687 | let open Printf in 688 | match parse_string p s () with 689 | | Success(x) -> x 690 | | Failed(x,_) -> printf "Error:\n%s\n" x; failwith "parse error" 691 | 692 | (* parse a file *) 693 | let parse ?(verbose=false) filename file = 694 | let open Printf in 695 | match parse_channel TypeScript.declarationSourceFile file () with 696 | | Success(x) -> Some(x) 697 | | Failed(x,_) -> begin 698 | (if verbose then printf "ERROR:\n %s\n" x); 699 | None 700 | end 701 | 702 | --------------------------------------------------------------------------------