├── .gitignore
├── CodeAlchemist.sln
├── LICENSE.md
├── Makefile
├── README.md
├── conf
├── Chakra.conf
├── JSC.conf
├── MOZ.conf
├── README.md
└── V8.conf
├── docs
├── CVE.md
└── CodeAlchemist.png
└── src
├── AST
├── AST.fs
├── AST.fsproj
├── CodeGen.fs
├── Loader.fs
├── Normalize.fs
├── Parser.fs
└── Parser.js
├── Analyzer
├── Analyzer.fsproj
├── CodeBrick.fs
├── Constraint.fs
├── Instrument.fs
├── JSType.fs
└── jsLib
│ ├── Chakra.js
│ ├── JSC.js
│ ├── MOZ.js
│ └── V8.js
├── Common
├── BuiltInGetter.js
├── Common.fsproj
├── Conf.fs
├── Executor.fs
├── Extends.fs
├── Json.fs
├── Logger.fs
├── Utils.fs
└── lib
│ ├── Makefile
│ └── exec.c
├── Fuzzer
├── Context.fs
├── Fuzzer.fs
├── Fuzzer.fsproj
├── Oracle.fs
├── Pool.fs
└── Selector.fs
└── Main
├── Main.fs
├── Main.fsproj
└── Preprocess.fs
/.gitignore:
--------------------------------------------------------------------------------
1 | obj/
2 | bin/
3 | build/
4 | *.swp
5 | *.swo
6 | *.dll
7 | node_modules/
8 |
--------------------------------------------------------------------------------
/CodeAlchemist.sln:
--------------------------------------------------------------------------------
1 |
2 | Microsoft Visual Studio Solution File, Format Version 12.00
3 | # Visual Studio 15
4 | VisualStudioVersion = 15.0.26124.0
5 | MinimumVisualStudioVersion = 15.0.26124.0
6 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "src", "src", "{876C937D-6906-467E-AE7C-DB10BB13A8EA}"
7 | EndProject
8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Analyzer", "src\Analyzer\Analyzer.fsproj", "{E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}"
9 | EndProject
10 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "AST", "src\AST\AST.fsproj", "{07923163-24E0-4FDB-A894-D172196344C5}"
11 | EndProject
12 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Common", "src\Common\Common.fsproj", "{E12BB09B-F4C5-4599-9C04-915C7F6EA813}"
13 | EndProject
14 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fuzzer", "src\Fuzzer\Fuzzer.fsproj", "{1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}"
15 | EndProject
16 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Main", "src\Main\Main.fsproj", "{6EA0AE33-5B5E-4316-8403-6067593C139B}"
17 | EndProject
18 | Global
19 | GlobalSection(SolutionConfigurationPlatforms) = preSolution
20 | Debug|Any CPU = Debug|Any CPU
21 | Debug|x64 = Debug|x64
22 | Debug|x86 = Debug|x86
23 | Release|Any CPU = Release|Any CPU
24 | Release|x64 = Release|x64
25 | Release|x86 = Release|x86
26 | EndGlobalSection
27 | GlobalSection(SolutionProperties) = preSolution
28 | HideSolutionNode = FALSE
29 | EndGlobalSection
30 | GlobalSection(ProjectConfigurationPlatforms) = postSolution
31 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
32 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Debug|Any CPU.Build.0 = Debug|Any CPU
33 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Debug|x64.ActiveCfg = Debug|Any CPU
34 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Debug|x64.Build.0 = Debug|Any CPU
35 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Debug|x86.ActiveCfg = Debug|Any CPU
36 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Debug|x86.Build.0 = Debug|Any CPU
37 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Release|Any CPU.ActiveCfg = Release|Any CPU
38 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Release|Any CPU.Build.0 = Release|Any CPU
39 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Release|x64.ActiveCfg = Release|Any CPU
40 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Release|x64.Build.0 = Release|Any CPU
41 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Release|x86.ActiveCfg = Release|Any CPU
42 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C}.Release|x86.Build.0 = Release|Any CPU
43 | {07923163-24E0-4FDB-A894-D172196344C5}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
44 | {07923163-24E0-4FDB-A894-D172196344C5}.Debug|Any CPU.Build.0 = Debug|Any CPU
45 | {07923163-24E0-4FDB-A894-D172196344C5}.Debug|x64.ActiveCfg = Debug|Any CPU
46 | {07923163-24E0-4FDB-A894-D172196344C5}.Debug|x64.Build.0 = Debug|Any CPU
47 | {07923163-24E0-4FDB-A894-D172196344C5}.Debug|x86.ActiveCfg = Debug|Any CPU
48 | {07923163-24E0-4FDB-A894-D172196344C5}.Debug|x86.Build.0 = Debug|Any CPU
49 | {07923163-24E0-4FDB-A894-D172196344C5}.Release|Any CPU.ActiveCfg = Release|Any CPU
50 | {07923163-24E0-4FDB-A894-D172196344C5}.Release|Any CPU.Build.0 = Release|Any CPU
51 | {07923163-24E0-4FDB-A894-D172196344C5}.Release|x64.ActiveCfg = Release|Any CPU
52 | {07923163-24E0-4FDB-A894-D172196344C5}.Release|x64.Build.0 = Release|Any CPU
53 | {07923163-24E0-4FDB-A894-D172196344C5}.Release|x86.ActiveCfg = Release|Any CPU
54 | {07923163-24E0-4FDB-A894-D172196344C5}.Release|x86.Build.0 = Release|Any CPU
55 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
56 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Debug|Any CPU.Build.0 = Debug|Any CPU
57 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Debug|x64.ActiveCfg = Debug|Any CPU
58 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Debug|x64.Build.0 = Debug|Any CPU
59 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Debug|x86.ActiveCfg = Debug|Any CPU
60 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Debug|x86.Build.0 = Debug|Any CPU
61 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Release|Any CPU.ActiveCfg = Release|Any CPU
62 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Release|Any CPU.Build.0 = Release|Any CPU
63 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Release|x64.ActiveCfg = Release|Any CPU
64 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Release|x64.Build.0 = Release|Any CPU
65 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Release|x86.ActiveCfg = Release|Any CPU
66 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813}.Release|x86.Build.0 = Release|Any CPU
67 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
68 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Debug|Any CPU.Build.0 = Debug|Any CPU
69 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Debug|x64.ActiveCfg = Debug|Any CPU
70 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Debug|x64.Build.0 = Debug|Any CPU
71 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Debug|x86.ActiveCfg = Debug|Any CPU
72 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Debug|x86.Build.0 = Debug|Any CPU
73 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Release|Any CPU.ActiveCfg = Release|Any CPU
74 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Release|Any CPU.Build.0 = Release|Any CPU
75 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Release|x64.ActiveCfg = Release|Any CPU
76 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Release|x64.Build.0 = Release|Any CPU
77 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Release|x86.ActiveCfg = Release|Any CPU
78 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B}.Release|x86.Build.0 = Release|Any CPU
79 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
80 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Debug|Any CPU.Build.0 = Debug|Any CPU
81 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Debug|x64.ActiveCfg = Debug|Any CPU
82 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Debug|x64.Build.0 = Debug|Any CPU
83 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Debug|x86.ActiveCfg = Debug|Any CPU
84 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Debug|x86.Build.0 = Debug|Any CPU
85 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Release|Any CPU.ActiveCfg = Release|Any CPU
86 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Release|Any CPU.Build.0 = Release|Any CPU
87 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Release|x64.ActiveCfg = Release|Any CPU
88 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Release|x64.Build.0 = Release|Any CPU
89 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Release|x86.ActiveCfg = Release|Any CPU
90 | {6EA0AE33-5B5E-4316-8403-6067593C139B}.Release|x86.Build.0 = Release|Any CPU
91 | EndGlobalSection
92 | GlobalSection(NestedProjects) = preSolution
93 | {E5540A82-51CC-4CA8-A9D5-3461C4F1BC3C} = {876C937D-6906-467E-AE7C-DB10BB13A8EA}
94 | {07923163-24E0-4FDB-A894-D172196344C5} = {876C937D-6906-467E-AE7C-DB10BB13A8EA}
95 | {E12BB09B-F4C5-4599-9C04-915C7F6EA813} = {876C937D-6906-467E-AE7C-DB10BB13A8EA}
96 | {1D96DC1B-6302-48B1-B7DB-52A7EFCAF36B} = {876C937D-6906-467E-AE7C-DB10BB13A8EA}
97 | {6EA0AE33-5B5E-4316-8403-6067593C139B} = {876C937D-6906-467E-AE7C-DB10BB13A8EA}
98 | EndGlobalSection
99 | EndGlobal
100 |
--------------------------------------------------------------------------------
/LICENSE.md:
--------------------------------------------------------------------------------
1 | MIT License
2 |
3 | Copyright (c) 2019 HyungSeok Han, DongHyeon Oh, and Sang Kil Cha at SoftSec,
4 | KAIST
5 |
6 | Permission is hereby granted, free of charge, to any person obtaining a copy
7 | of this software and associated documentation files (the "Software"), to deal
8 | in the Software without restriction, including without limitation the rights
9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
10 | copies of the Software, and to permit persons to whom the Software is
11 | furnished to do so, subject to the following conditions:
12 |
13 | The above copyright notice and this permission notice shall be included in all
14 | copies or substantial portions of the Software.
15 |
16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
22 | SOFTWARE.
23 |
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | OUTDIR = $(shell pwd)/bin
2 |
3 | all: CodeAlchemist
4 |
5 | CodeAlchemist:
6 | dotnet build -c Release -o $(OUTDIR)
7 |
8 | clean:
9 | dotnet clean
10 | rm -rf $(OUTDIR)
11 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 |
3 | # CodeAlchemist
4 |
5 | CodeAlchemist is a JavaScript engine fuzzer that improves classic grammar-based
6 | JS engine fuzzers by a novel test case generation algorithm, called
7 | semantics-aware assembly. The details of the algorithm is in our
8 | [paper](https://daramg.gift/paper/han-ndss2019.pdf), "CodeAlchemist:
9 | Semantics-Aware Code Generation to Find Vulnerabilities in JavaScript Engines",
10 | which appeared in NDSS 2019. This is a stable version of CodeAlchemist and it
11 | currently supports ChakraCore, V8, SpiderMonkey, and JavaScriptCore.
12 |
13 | # Installation
14 |
15 | CodeAlchemist currently works on only Linux and we tested on Ubuntu 18.04.
16 |
17 | 1. Install dependencies (`build-essential`, `nodejs`, `npm`, `esprima`, `dotnet`)
18 | ```
19 | $ sudo apt update
20 | $ sudo apt install build-essential
21 | $ sudo apt install nodejs npm
22 | $ npm i esprima@4.0.1
23 | ```
24 | Installation for `dotnet` depends on OS version, so please refer this [link](https://dotnet.microsoft.com/download/linux-package-manager/ubuntu18-04/sdk-current).
25 |
26 | 2. Clone and build `CodeAlchemist`
27 | ```
28 | $ git clone https://github.com/SoftSec-KAIST/CodeAlchemist
29 | $ cd CodeAlchemist
30 | $ make
31 | ```
32 |
33 | # Usage
34 |
35 | 1. Prepare to start
36 |
37 | Prepare JS seed files, a configuration file, and the requirements in the
38 | configuration. Please refer [conf/README.md](conf/README.md) for writing the
39 | configuration file.
40 |
41 | 2. Preprocess JS seed files
42 | ```
43 | $ dotnet bin/Main.dll rewrite
44 | $ dotnet bin/Main.dll instrument
45 | ```
46 |
47 | 3. Run fuzzing process
48 | ```
49 | $ dotnet bin/Main.dll fuzz
50 | ```
51 | There are four optional parameters for our JS code generation algorithm.
52 | - `iMax` (default: 8): The maximum number of iterations of the generation
53 | algorithm.
54 | - `pBlk` (default: 16): The probability of reinventing block statements.
55 | - `iBlk` (default: 3): The maximum number of iteration for generating a block
56 | statement.
57 | - `dMax` (default: 3): The maximum nesting level for a reassembling block
58 | statement.
59 |
60 | You can specify parameters with following commands.
61 | ```
62 | $ dotnet bin/Main.dll fuzz --iMax 8 --pBlk 16 --iBlk 3 --dMax 3
63 | ```
64 |
65 | # CVEs ([Credits](./docs/CVE.md))
66 | If you find bugs and get CVEs by running CodeAlchemist, please let us know
67 | by sending a PR for [./docs/CVE.md](./docs/CVE.md).
68 |
69 | - JavaScriptCore: CVE-2018-4464, CVE-2018-4437, CVE-2018-4378, CVE-2018-4372
70 |
71 | # Authors
72 | This research project has been conducted by [SoftSec Lab](https://softsec.kaist.ac.kr) at KAIST.
73 | * [HyungSeok Han](http://daramg.gift/)
74 | * [DongHyeon Oh](https://zanywhale.com/)
75 | * [Sang Kil Cha](https://softsec.kaist.ac.kr/~sangkilc/)
76 |
77 |
78 | # Citation
79 | If you plan to use CodeAlchemist in your own research. Please consider citing
80 | our [paper](https://daramg.gift/paper/han-ndss2019.pdf):
81 | ```
82 | @INPROCEEDINGS{han:ndss:2019,
83 | author = {HyungSeok Han and DongHyeon Oh and Sang Kil Cha},
84 | title = {{CodeAlchemist}: Semantics-Aware Code Generation to Find Vulnerabilities in JavaScript Engines},
85 | booktitle = ndss,
86 | year = 2019
87 | }
88 | ```
89 |
--------------------------------------------------------------------------------
/conf/Chakra.conf:
--------------------------------------------------------------------------------
1 | {
2 | "engine": "Chakra",
3 | "timeout": 30,
4 | "engine_path": "/path/to/ch",
5 | "argv": [],
6 | "env": { },
7 | "seed_path": "/path/to/seed",
8 | "preproc_dir": "/path/to/pre",
9 | "tmp_dir": "/path/to/tmp",
10 | "bug_dir": "/path/to/bug",
11 | "filters": [
12 | "load", "assert", "eval", "shouldBeFalse", "shouldNotThrow", "shouldBe",
13 | "shouldBeNull", "shouldBeUndefined", "shouldThrow", "shouldBeTrue",
14 | "shouldBeEqualToString", "crash" , "$ERROR", "Test", "tryItOut", "Function",
15 | "read", "readbuffer", "readline", "console"
16 | ],
17 | "jobs": 56
18 | }
19 |
--------------------------------------------------------------------------------
/conf/JSC.conf:
--------------------------------------------------------------------------------
1 | {
2 | "engine": "JSC",
3 | "timeout": 30,
4 | "engine_path": "/path/to/jsc",
5 | "argv": [],
6 | "env": { },
7 | "seed_path": "/path/to/seed",
8 | "preproc_dir": "/path/to/pre",
9 | "tmp_dir": "/path/to/tmp",
10 | "bug_dir": "/path/to/bug",
11 | "filters": [
12 | "load", "assert", "eval", "shouldBeFalse", "shouldNotThrow", "shouldBe",
13 | "shouldBeNull", "shouldBeUndefined", "shouldThrow", "shouldBeTrue",
14 | "shouldBeEqualToString", "crash" , "$ERROR", "Test", "tryItOut", "WScript",
15 | "Function", "checkSyntax", "run", "read", "readFile", "readline", "console"
16 | ],
17 | "jobs": 56
18 | }
19 |
--------------------------------------------------------------------------------
/conf/MOZ.conf:
--------------------------------------------------------------------------------
1 | {
2 | "engine": "MOZ",
3 | "timeout": 30,
4 | "engine_path": "/path/to/moz",
5 | "argv": [],
6 | "env": { },
7 | "seed_path": "/path/to/seed",
8 | "preproc_dir": "/path/to/pre",
9 | "tmp_dir": "/path/to/tmp",
10 | "bug_dir": "/path/to/bug",
11 | "filters": [
12 | "load", "assert", "eval", "shouldBeFalse", "shouldNotThrow", "shouldBe",
13 | "shouldBeNull", "shouldBeUndefined", "shouldThrow", "shouldBeTrue",
14 | "shouldBeEqualToString", "crash" , "$ERROR", "Test", "tryItOut", "WScript",
15 | "Function", "run", "readline", "readlineBuf", "read", "console"
16 | ],
17 | "jobs": 56
18 | }
19 |
--------------------------------------------------------------------------------
/conf/README.md:
--------------------------------------------------------------------------------
1 | A configuration file is json file with following fields. And you can find
2 | example configuration files for 4 JS engines.
3 | - `engine`: Type of JS engine ("Charka", "JSC", "MOZ", "V8").
4 | - `engine_path`: ABSPATH to engine
5 | - `timeout`: Timeout for executing a JS code.
6 | - `argv`: Additional arguments for executing a JS engine.
7 | - `env`: Additional environment variables for executing a JS engine.
8 | - `seed_path`: ABSPATH to seed.
9 | - `preproc_dir`: ABSPATH for saving preprocessing results.
10 | - `tmp_dir`: ABSPATH for temporarily saving generated JS code.
11 | - `bug_dir`: ABSPATH for saving JS code which triggered some crash.
12 | - `filters`: List of symbols to exclude from the code brick pool.
13 | - `jobs`: The number of jobs (cores) to use for fuzzing.
14 |
--------------------------------------------------------------------------------
/conf/V8.conf:
--------------------------------------------------------------------------------
1 | {
2 | "engine": "V8",
3 | "timeout": 30,
4 | "engine_path": "/path/to/v8",
5 | "argv": ["--expose-gc", "--allow-natives-syntax"],
6 | "env": { },
7 | "seed_path": "/path/to/seed",
8 | "preproc_dir": "/path/to/pre",
9 | "tmp_dir": "/path/to/tmp",
10 | "bug_dir": "/path/to/bug",
11 | "filters": [
12 | "load", "assert", "eval", "shouldBeFalse", "shouldNotThrow", "shouldBe",
13 | "shouldBeNull", "shouldBeUndefined", "shouldThrow", "shouldBeTrue",
14 | "shouldBeEqualToString", "crash" , "$ERROR", "Test", "tryItOut", "WScript",
15 | "Function", "read", "readbuffer", "readline", "console", "%AbortJS"
16 | ],
17 | "jobs": 56
18 | }
19 |
--------------------------------------------------------------------------------
/docs/CVE.md:
--------------------------------------------------------------------------------
1 | # JavaScriptCore
2 |
3 | CVE Number | Credit
4 | -----------| ------
5 | CVE-2018-4464 | HyungSeok Han, DongHyeon Oh, and Sang Kil Cha of KAIST SoftSec Lab.
6 | CVE-2018-4437 | HyungSeok Han, DongHyeon Oh, and Sang Kil Cha of KAIST SoftSec Lab.
7 | CVE-2018-4378 | HyungSeok Han, DongHyeon Oh, and Sang Kil Cha of KAIST SoftSec Lab.
8 | CVE-2018-4372 | HyungSeok Han, DongHyeon Oh, and Sang Kil Cha of KAIST SoftSec Lab.
9 |
--------------------------------------------------------------------------------
/docs/CodeAlchemist.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/SoftSec-KAIST/CodeAlchemist/c7725d8cbda75dd2c6f6d27db9843764d9ffa987/docs/CodeAlchemist.png
--------------------------------------------------------------------------------
/src/AST/AST.fs:
--------------------------------------------------------------------------------
1 | namespace AST
2 |
3 | type VarDeclKind =
4 | | Var
5 | | Const
6 | | Let
7 |
8 | type PropKind =
9 | | Get
10 | | Set
11 | | Init
12 |
13 | type MethodDefKind =
14 | | Method
15 | | Constructor
16 | | Set
17 | | Get
18 |
19 | type UpOp =
20 | | Inc
21 | | Dec
22 |
23 | type UnOp =
24 | | Pos | Neg
25 | | Not | BitNot
26 | | Delete | Void | TypeOf
27 |
28 | type BinOp =
29 | | Add | Sub | Mul | Div | Mod | Power
30 | | Or | Xor | And
31 | | LShift | RShift | RShiftZ
32 | | InstanceOf | In
33 | | Eq | Neq | AbsEq | AbsNeq | Gt | Ge | Lt | Le
34 |
35 | type LogicOp =
36 | | Or
37 | | And
38 |
39 | type AssignOp =
40 | | Assign
41 | | Mul | Div | Mod | Add | Sub | Power
42 | | LShift | RShift | RShiftZ
43 | | And | Xor | Or
44 |
45 | type Id = string
46 |
47 | type Literal =
48 | | Null
49 | | Bool of bool
50 | | Number of string
51 | | String of string
52 | | Regex of string
53 |
54 | type Stmt =
55 | | Block of StmtList
56 | | Break of Id option
57 | | Continue of Id option
58 | | Debugger
59 | | DoWhile of Stmt * Expr
60 | | Empty
61 | | Expr of Expr * string option
62 | | For of ForInit option * Expr option * Expr option * Stmt
63 | | ForIn of ForBind * Expr * Stmt
64 | | ForOf of ForBind * Expr * Stmt
65 | | FuncDecl of FuncDecl
66 | | If of Expr * Stmt * Stmt option
67 | | Labeled of Id * Stmt
68 | | Return of Expr option
69 | | Switch of Expr * Case array
70 | | Throw of Expr
71 | | Try of StmtList * Catch option * StmtList option
72 | | VarDecl of VarDecl
73 | | While of Expr * Stmt
74 | | With of Expr * Stmt
75 |
76 | and Decl =
77 | | ClassDecl of ClassDecl
78 | | VarDecl of VarDecl
79 | | FuncDecl of FuncDecl
80 |
81 | and StmtList = StmtListItem array
82 |
83 | and StmtListItem =
84 | | Stmt of Stmt
85 | | Decl of Decl
86 |
87 | and Expr =
88 | | This
89 | | Id of Id
90 | | Literal of Literal
91 | | TempLiteral of TempLiteral
92 | | Array of ArrayElem array
93 | | Object of Property array
94 | | Function of FuncExpr
95 | | ArrowFunction of Id option * Params * ArrowFuncBody * bool * bool
96 | | Class of Id option * Expr option * MethodDef array
97 | | TaggedTemp of Expr * TempLiteral
98 | | Member of MemberExpr
99 | | Super
100 | | MetaProp of Id * Id
101 | | New of Expr * Arg array
102 | | Call of Callee * Arg array
103 | | Update of UpOp * Expr * bool
104 | | Await of Expr
105 | | Unary of UnOp * Expr
106 | | Binary of BinOp * Expr * Expr
107 | | Logic of LogicOp * Expr * Expr
108 | | Cond of Expr * Expr * Expr
109 | | Yield of Expr option * bool
110 | | Assign of AssignOp * AssignLeft * Expr
111 | | Seq of Expr array
112 |
113 | and FuncExpr = Id option * Params * StmtList * bool * bool (* gen, async *)
114 |
115 | and MemberExpr = Expr * Expr * bool
116 |
117 | and ForInit =
118 | | Expr of Expr
119 | | VarDecl of VarDecl
120 |
121 | and ForBind =
122 | | VarDecl of VarDecl
123 | | Binding of Binding
124 |
125 | and FuncDecl = Id * Params * StmtList * bool * bool (* gen, async *)
126 |
127 | and Params = Param array
128 |
129 | and Case = Expr option * Stmt array
130 |
131 | and Catch = Binding option * StmtList
132 |
133 | and VarDecl = VarDeclKind * VarDeclr array
134 |
135 | and VarDeclr = Binding * Expr option
136 |
137 | and ClassDecl = Id * Expr option * MethodDef array
138 |
139 | and MethodDef = Expr * FuncExpr * MethodDefKind * bool * bool
140 | (* computed, static*)
141 |
142 | and ArrayElem =
143 | | Expr of Expr
144 | | Spread of Expr
145 | | Empty
146 |
147 | and Property = Expr * PropVal * PropKind * bool * bool (* computed, shorthand *)
148 |
149 | and PropVal =
150 | | Expr of Expr
151 | | BindingPt of BindingPt
152 | | AssignPt of AssignPt
153 | | Empty
154 |
155 | and Callee =
156 | | Expr of Expr
157 | | Import
158 |
159 | and Arg =
160 | | Expr of Expr
161 | | Spread of Expr
162 |
163 | and TempLiteral = string array * Expr array
164 |
165 | and ArrowFuncBody =
166 | | Block of StmtList
167 | | Expr of Expr
168 |
169 | and Param =
170 | | Id of Id
171 | | BindingPt of BindingPt
172 | | AssignPt of AssignPt
173 | | RestElem of Binding
174 |
175 | and BindingPt =
176 | | ArrayPt of ArrayPtElem array
177 | | ObjectPt of Property array
178 |
179 | and AssignPt = Binding * Expr
180 |
181 | and ArrayPtElem =
182 | | Id of Id
183 | | BindingPt of BindingPt
184 | | AssignPt of AssignPt
185 | | RestElem of Binding
186 | | MemberExpr of MemberExpr
187 | | Empty
188 |
189 | and Binding =
190 | | Id of Id
191 | | BindingPt of BindingPt
192 | | AssignPt of AssignPt
193 | | MemberExpr of MemberExpr
194 |
195 | and AssignLeft =
196 | | Expr of Expr
197 | | Binding of Binding
198 |
199 | type Program =
200 | | Script of StmtList
201 | | Module of string
202 | // TODO
203 |
--------------------------------------------------------------------------------
/src/AST/AST.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | netstandard2.0
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
--------------------------------------------------------------------------------
/src/AST/CodeGen.fs:
--------------------------------------------------------------------------------
1 | module AST.CodeGen
2 |
3 | open System
4 | open Common
5 |
6 | exception ToCodeException of string
7 |
8 | type SB = System.Text.StringBuilder
9 |
10 | let addStr (sb: SB) (str: string) = sb.Append (str) |> ignore
11 | let addSpc (sb: SB) = sb.Append (" ") |> ignore
12 | let addSemiCol (sb: SB) = sb.Append (";") |> ignore
13 | let addComma (sb: SB) = sb.Append (", ") |> ignore
14 | let trimComma (sb: SB) = function
15 | | 0 -> ()
16 | | _ -> sb.Remove (sb.Length - 2, 2) |> ignore
17 |
18 | let varKindToStr = function
19 | | Var -> "var "
20 | | Const -> "const "
21 | | Let -> "let "
22 |
23 | let assignOpToStr = function
24 | | AssignOp.Assign -> " = "
25 | | AssignOp.Mul -> " *= "
26 | | AssignOp.Div -> " /= "
27 | | AssignOp.Mod -> " %= "
28 | | AssignOp.Add -> " += "
29 | | AssignOp.Sub -> " -= "
30 | | AssignOp.Power -> " **= "
31 | | AssignOp.LShift -> " <<= "
32 | | AssignOp.RShift -> " >>= "
33 | | AssignOp.RShiftZ -> " >>>= "
34 | | AssignOp.And -> " &= "
35 | | AssignOp.Xor -> " ^= "
36 | | AssignOp.Or -> " |= "
37 |
38 | let binOpToStr = function
39 | | BinOp.Add -> " + "
40 | | BinOp.Sub -> " - "
41 | | BinOp.Mul -> " * "
42 | | BinOp.Div -> " / "
43 | | BinOp.Mod -> " % "
44 | | BinOp.Power -> " ** "
45 | | BinOp.Or -> " | "
46 | | BinOp.Xor -> " ^ "
47 | | BinOp.And -> " & "
48 | | BinOp.LShift -> " << "
49 | | BinOp.RShift -> " >> "
50 | | BinOp.RShiftZ -> " >>> "
51 | | BinOp.InstanceOf -> " instanceof "
52 | | BinOp.In -> " in "
53 | | BinOp.Eq -> " == "
54 | | BinOp.Neq -> " != "
55 | | BinOp.AbsEq -> " === "
56 | | BinOp.AbsNeq -> " !== "
57 | | BinOp.Gt -> " > "
58 | | BinOp.Ge -> " >= "
59 | | BinOp.Lt -> " < "
60 | | BinOp.Le -> " <= "
61 |
62 | let logicOpToStr = function
63 | | LogicOp.Or -> " || "
64 | | LogicOp.And -> " && "
65 |
66 | let unOpToStr = function
67 | | Pos -> "+ "
68 | | Neg -> "- "
69 | | Not -> "! "
70 | | BitNot -> "~ "
71 | | Delete -> "delete "
72 | | Void -> "void "
73 | | TypeOf -> "typeof "
74 |
75 | let upOpToStr = function
76 | | Inc -> "++"
77 | | Dec -> "--"
78 |
79 | let literalToStr = function
80 | | Null -> "null"
81 | | Bool true -> "true"
82 | | Bool false -> "false"
83 | | Number str -> str
84 | | String str -> str
85 | | Regex str -> str
86 |
87 | let funcHeadToCode sb isGen isAsync =
88 | if isAsync then addStr sb "async "
89 | else ()
90 | if isGen then addStr sb "function* "
91 | else addStr sb "function "
92 |
93 | let methodHeadToCode sb isGen isAsync =
94 | if isAsync then addStr sb "async "
95 | else ()
96 | if isGen then addStr sb " * "
97 | else ()
98 |
99 | let methodKindToCode sb = function
100 | | Method
101 | | Constructor -> ()
102 | | Set -> addStr sb "set "
103 | | Get -> addStr sb "get "
104 |
105 | let propKindToCode sb = function
106 | | PropKind.Get -> addStr sb "get "
107 | | PropKind.Set -> addStr sb "set "
108 | | PropKind.Init -> ()
109 |
110 | let nameToCode sb = function
111 | | Expr.Id id -> addStr sb id
112 | | Expr.Literal literal -> literalToStr literal |> addStr sb
113 | | e -> Logger.error "nameToCode fail: %A" e
114 |
115 | let idToCode map sb id =
116 | match Map.tryFind id map with
117 | | Some iter -> addStr sb iter
118 | | None -> addStr sb id
119 |
120 | let idOptToCode map sb = function
121 | | Some id -> idToCode map sb id
122 | | None -> ()
123 |
124 | let labelToCode map sb key label =
125 | addStr sb key
126 | idOptToCode map sb label
127 | addSemiCol sb
128 |
129 | let rec stmtListToCode map sb stmts = Array.iter (stmtItemToCode map sb) stmts
130 |
131 | and stmtItemToCode map sb = function
132 | | Stmt stmt -> stmtToCode map sb stmt
133 | | Decl decl -> declToCode map sb decl
134 |
135 | and stmtToCode map sb stmt =
136 | match stmt with
137 | | Stmt.Block body -> blockToCode map sb body
138 | | Stmt.Break label -> labelToCode map sb "break " label
139 | | Stmt.Continue label -> labelToCode map sb "continue " label
140 | | Stmt.Debugger -> addStr sb "debugger;"
141 | | Stmt.DoWhile (body, test) -> doWhileToCode map sb body test
142 | | Stmt.Empty -> addSemiCol sb
143 | | Stmt.Expr (expr, _) -> exprToCode map sb expr; addSemiCol sb
144 | | Stmt.For (init, cond, up, body) -> forToCode map sb init cond up body
145 | | Stmt.ForIn (bind, expr, body) -> forInOfToCode map sb " in " bind expr body
146 | | Stmt.ForOf (bind, expr, body) -> forInOfToCode map sb " of " bind expr body
147 | | Stmt.FuncDecl decl -> funcDeclToCode map sb decl
148 | | Stmt.If (test, tStmt, fStmt) -> ifToCode map sb test tStmt fStmt
149 | | Stmt.Labeled (id, body) -> labeledToCode map sb id body
150 | | Stmt.Return None -> addStr sb "return;"
151 | | Stmt.Return (Some arg) -> argStmtToCode map sb "return " arg
152 | | Stmt.Switch (test, cases) -> switchToCode map sb test cases
153 | | Stmt.Throw arg -> argStmtToCode map sb "throw " arg
154 | | Stmt.Try (body, catch, final) -> tryToCode map sb body catch final
155 | | Stmt.VarDecl decl -> varDeclToCode map sb true decl
156 | | Stmt.While (test, body) -> whileToCode map sb test body
157 | | Stmt.With (expr, body) -> withToCode map sb expr body
158 | addStr sb "\n"
159 |
160 | and declToCode map sb decl =
161 | match decl with
162 | | Decl.ClassDecl decl -> classDeclToCode map sb decl
163 | | Decl.VarDecl decl -> varDeclToCode map sb true decl
164 | | Decl.FuncDecl decl -> funcDeclToCode map sb decl
165 | addStr sb "\n"
166 |
167 | and exprToCode map sb = function
168 | | Expr.This -> addStr sb "this"
169 | | Expr.Id id -> idToCode map sb id
170 | | Expr.Literal literal -> literalToStr literal |> addStr sb
171 | | Expr.TempLiteral temp -> tempLiteralToCode map sb temp
172 | | Expr.Array elems -> arrayToCode map sb elems
173 | | Expr.Object props -> objToCode map sb props
174 | | Expr.Function expr -> funcExprToCode map sb expr
175 | | Expr.ArrowFunction (id, params_, body, isGen, isAsync) ->
176 | arrowFuncExprToCode map sb id params_ body isGen isAsync
177 | | Class (id, extends, body) -> classExprToCode map sb id extends body
178 | | TaggedTemp (expr, temp) -> taggedTempToCode map sb expr temp
179 | | Expr.Member expr -> memberExprToCode map sb expr
180 | | Expr.Super -> addStr sb "super"
181 | | Expr.MetaProp (id, key) -> metaPropToCode map sb id key
182 | | Expr.New (expr, args) -> newToCode map sb expr args
183 | | Expr.Call (callee, args) -> callToCode map sb callee args
184 | | Expr.Update (op, expr, prefix) -> updateToCode map sb op expr prefix
185 | | Expr.Await expr -> unExprToCode map sb expr "await "
186 | | Expr.Unary (op, expr) -> unOpToStr op |> unExprToCode map sb expr
187 | | Expr.Binary (op, l, r) -> binOpToStr op |> binExprToCode map sb l r
188 | | Expr.Logic (op, l, r) -> logicOpToStr op |> binExprToCode map sb l r
189 | | Expr.Cond (cond, tExpr, fExpr) -> condToCode map sb cond tExpr fExpr
190 | | Expr.Yield (arg, isGen) -> yieldToCode map sb arg isGen
191 | | Expr.Assign (op, left, init) -> assignExprToCode map sb op left init
192 | | Expr.Seq exprs -> seqExprToCode map sb exprs
193 |
194 | and exprParenToCode map sb expr =
195 | addStr sb "("
196 | exprToCode map sb expr
197 | addStr sb ")"
198 |
199 | and exprOptToCode map sb = function
200 | | Some expr -> exprToCode map sb expr
201 | | None -> ()
202 |
203 | and exprOptKeyToCode map sb key = function
204 | | Some expr ->
205 | addStr sb key
206 | exprToCode map sb expr
207 | | None -> ()
208 |
209 | and blockToCode map sb body =
210 | addStr sb "{\n"
211 | stmtListToCode map sb body
212 | addStr sb "}"
213 |
214 | and bodyToCode map sb = function
215 | | Stmt.Block block -> blockToCode map sb block
216 | | stmt ->
217 | addStr sb "{\n"
218 | stmtToCode map sb stmt
219 | addStr sb "}"
220 |
221 | and doWhileToCode map sb body test =
222 | addStr sb "do "
223 | bodyToCode map sb body
224 | addStr sb "while("
225 | exprToCode map sb test
226 | addStr sb ")"
227 |
228 | and forToCode map sb init cond update body =
229 | addStr sb "for("
230 | forInitToCode map sb init
231 | addStr sb ";"
232 | exprOptToCode map sb cond
233 | addStr sb ";"
234 | exprOptToCode map sb update
235 | addStr sb ")"
236 | bodyToCode map sb body
237 |
238 | and forInitToCode map sb = function
239 | | Some (ForInit.Expr expr) -> exprToCode map sb expr
240 | | Some (ForInit.VarDecl decl) -> varDeclToCode map sb false decl
241 | | None -> ()
242 |
243 | and forInOfToCode map sb key bind expr body =
244 | addStr sb "for("
245 | forBindToCode map sb bind
246 | addStr sb key
247 | exprToCode map sb expr
248 | addStr sb ")"
249 | bodyToCode map sb body
250 |
251 | and forBindToCode map sb = function
252 | | ForBind.VarDecl decl -> varDeclToCode map sb false decl
253 | | ForBind.Binding bind -> bindingToCode map sb bind
254 |
255 | and ifToCode map sb test tStmt fStmt =
256 | addStr sb "if("
257 | exprToCode map sb test
258 | addStr sb ")"
259 | bodyToCode map sb tStmt
260 | match fStmt with
261 | | Some fStmt ->
262 | addStr sb "else "
263 | bodyToCode map sb fStmt
264 | | _ -> ()
265 |
266 | and labeledToCode map sb id body =
267 | idToCode map sb id
268 | addStr sb ":\n"
269 | stmtToCode map sb body
270 |
271 | and argStmtToCode map sb key arg =
272 | addStr sb key
273 | exprToCode map sb arg
274 | addSemiCol sb
275 |
276 | and switchToCode map sb test cases =
277 | addStr sb "switch("
278 | exprToCode map sb test
279 | addStr sb "){\n"
280 | Array.iter (caseToCode map sb) cases
281 | addStr sb "}"
282 |
283 | and caseToCode map sb (test, body) =
284 | match test with
285 | | Some test ->
286 | addStr sb "case "
287 | exprToCode map sb test
288 | | None -> addStr sb "default"
289 | addStr sb ":\n"
290 | Array.iter (stmtToCode map sb) body
291 |
292 | and tryToCode map sb body catch final =
293 | addStr sb "try"
294 | blockToCode map sb body
295 | catchToCode map sb catch
296 | match final with
297 | | Some final ->
298 | addStr sb "finally"
299 | blockToCode map sb final
300 | | None -> ()
301 |
302 | and catchToCode map sb = function
303 | | Some (bindOpt, body) ->
304 | addStr sb "catch("
305 | bindingOptToCode map sb bindOpt
306 | addStr sb ")"
307 | blockToCode map sb body
308 | | None -> ()
309 |
310 | and whileToCode map sb test body =
311 | addStr sb "while("
312 | exprToCode map sb test
313 | addStr sb ")"
314 | bodyToCode map sb body
315 |
316 | and withToCode map sb expr body =
317 | addStr sb "with("
318 | exprToCode map sb expr
319 | addStr sb ")"
320 | bodyToCode map sb body
321 |
322 | and classDeclToCode map sb (id, extends, body) =
323 | addStr sb "class "
324 | idToCode map sb id
325 | exprOptKeyToCode map sb " extends " extends
326 | addStr sb "{\n"
327 | Array.iter (methodToCode map sb) body
328 | addStr sb "}"
329 |
330 | and methodToCode map sb (key, body, kind, isComputed, isStatic) =
331 | let _, params_, body, isGen, isAsync = body
332 | if isStatic then addStr sb "static "
333 | else ()
334 | methodHeadToCode sb isGen isAsync
335 | methodKindToCode sb kind
336 | keyNameToCode map sb key isComputed
337 | paramsToCode map sb params_
338 | blockToCode map sb body
339 |
340 | and varDeclToCode map sb needSemi (kind, declrs) =
341 | varKindToStr kind |> addStr sb
342 | Array.iter (varDeclrToCode map sb) declrs
343 | trimComma sb (Array.length declrs)
344 | if needSemi then addSemiCol sb
345 |
346 | and varDeclrToCode map sb (bind, init) =
347 | bindingToCode map sb bind
348 | exprOptKeyToCode map sb " = " init
349 | addComma sb
350 |
351 | and funcDeclToCode map sb (id, params_, body, isGen, isAsync) =
352 | funcHeadToCode sb isGen isAsync
353 | idToCode map sb id
354 | paramsToCode map sb params_
355 | blockToCode map sb body
356 |
357 | and paramsToCode map sb params_ =
358 | addStr sb "("
359 | Array.iter (paramToCode map sb) params_
360 | trimComma sb (Array.length params_)
361 | addStr sb ")"
362 |
363 | and paramToCode map sb param =
364 | match param with
365 | | Param.Id id -> idToCode map sb id
366 | | Param.BindingPt pt -> bindingPtToCode map sb pt
367 | | Param.AssignPt pt -> assignPtToCode map sb pt
368 | | Param.RestElem bind -> addStr sb "..."; bindingToCode map sb bind
369 | addComma sb
370 |
371 | and bindingPtToCode map sb = function
372 | | ArrayPt elems -> arrayPtToCode map sb elems
373 | | ObjectPt props -> propsToCode map sb props
374 |
375 | and arrayPtToCode map sb elems =
376 | addStr sb "["
377 | Array.iter (arrayPtElemToCode map sb) elems
378 | trimComma sb (Array.length elems)
379 | addStr sb "]"
380 |
381 | and arrayPtElemToCode map sb elem =
382 | match elem with
383 | | ArrayPtElem.Id id -> idToCode map sb id
384 | | ArrayPtElem.BindingPt pt -> bindingPtToCode map sb pt
385 | | ArrayPtElem.AssignPt pt -> assignPtToCode map sb pt
386 | | ArrayPtElem.RestElem bind -> addStr sb "..."; bindingToCode map sb bind
387 | | ArrayPtElem.MemberExpr expr -> memberExprToCode map sb expr
388 | | ArrayPtElem.Empty -> ()
389 | addComma sb
390 |
391 | and assignPtToCode map sb (bind, expr) =
392 | bindingToCode map sb bind
393 | addStr sb " = "
394 | exprToCode map sb expr
395 |
396 | and bindingToCode map sb = function
397 | | Binding.Id id -> idToCode map sb id
398 | | Binding.BindingPt pt -> bindingPtToCode map sb pt
399 | | Binding.AssignPt pt -> assignPtToCode map sb pt
400 | | Binding.MemberExpr expr -> memberExprToCode map sb expr
401 |
402 | and bindingOptToCode map sb = function
403 | | Some bind -> bindingToCode map sb bind
404 | | None -> ()
405 |
406 | and tempLiteralToCode map sb (elems, exprs) =
407 | addStr sb "`"
408 | Array.iteri (Array.length exprs|> tempLiteralIter map sb exprs) elems
409 | addStr sb "`"
410 |
411 | and tempLiteralIter map sb exprs last idx elem =
412 | addStr sb elem
413 | if idx < last then
414 | addStr sb "${"
415 | Array.get exprs idx |> exprToCode map sb
416 | addStr sb "}"
417 | else ()
418 |
419 | and arrayToCode map sb elems =
420 | addStr sb "["
421 | Array.iter (arrayElemToCode map sb) elems
422 | trimComma sb (Array.length elems)
423 | addStr sb "]"
424 |
425 | and arrayElemToCode map sb elem =
426 | match elem with
427 | | ArrayElem.Expr expr -> exprToCode map sb expr
428 | | ArrayElem.Spread expr -> addStr sb "..."; exprToCode map sb expr
429 | | ArrayElem.Empty -> ()
430 | addComma sb
431 |
432 | and objToCode map sb props =
433 | addStr sb "("
434 | propsToCode map sb props
435 | addStr sb ")"
436 |
437 | and propsToCode map sb props =
438 | addStr sb "{"
439 | Array.iter (propToCode map sb) props
440 | trimComma sb (Array.length props)
441 | addStr sb "}"
442 |
443 | and propToCode map sb (key, value, kind, isComputed, isShort) =
444 | match kind with
445 | | PropKind.Init -> propInitToCode map sb key value isComputed isShort
446 | | kind ->
447 | propKindToCode sb kind
448 | keyNameToCode map sb key isComputed
449 | accToCode map sb value
450 | addComma sb
451 |
452 | and propInitToCode map sb key value isComputed isShort =
453 | if isShort then propValToCode map sb value
454 | else
455 | keyNameToCode map sb key isComputed
456 | addStr sb " : "
457 | propValToCode map sb value
458 |
459 | and propValToCode map sb = function
460 | | PropVal.Expr expr -> exprToCode map sb expr
461 | | PropVal.BindingPt pt -> bindingPtToCode map sb pt
462 | | PropVal.AssignPt pt -> assignPtToCode map sb pt
463 | | PropVal.Empty -> ()
464 |
465 | and accToCode map sb = function
466 | | PropVal.Expr (Expr.Function (_, params_, body, false, false)) ->
467 | paramsToCode map sb params_
468 | blockToCode map sb body
469 | | _ -> raise (ToCodeException "accToCode")
470 |
471 | and funcExprToCode map sb (id, params_, body, isGen, isAsync) =
472 | addStr sb "("
473 | funcHeadToCode sb isGen isAsync
474 | idOptToCode map sb id
475 | paramsToCode map sb params_
476 | blockToCode map sb body
477 | addStr sb ")"
478 |
479 | and arrowFuncExprToCode map sb id params_ body isGen isAsync =
480 | addStr sb "("
481 | if isAsync then addStr sb "async "
482 | else ()
483 | if isGen then addStr sb "*"
484 | else ()
485 | idOptToCode map sb id
486 | paramsToCode map sb params_
487 | addStr sb "=>"
488 | arrowFuncBodyToCode map sb body
489 | addStr sb ")"
490 |
491 | and arrowFuncBodyToCode map sb = function
492 | | ArrowFuncBody.Block body -> blockToCode map sb body
493 | | ArrowFuncBody.Expr expr -> exprToCode map sb expr
494 |
495 | and classExprToCode map sb id extends body =
496 | addStr sb "(class "
497 | idOptToCode map sb id
498 | exprOptKeyToCode map sb " extends " extends
499 | addStr sb "{\n"
500 | Array.iter (methodToCode map sb) body
501 | addStr sb "})"
502 |
503 | and taggedTempToCode map sb expr temp =
504 | exprToCode map sb expr
505 | addStr sb " "
506 | tempLiteralToCode map sb temp
507 |
508 | and memberExprToCode map sb (expr, key, isComputed) =
509 | exprToCode map sb expr
510 | memNameToCode map sb key isComputed
511 |
512 | and memNameToCode map sb key isComputed =
513 | if isComputed then
514 | addStr sb "["
515 | exprToCode map sb key
516 | addStr sb "]"
517 | else
518 | addStr sb "."
519 | nameToCode sb key
520 |
521 | and keyNameToCode map sb key isComputed =
522 | if isComputed then
523 | addStr sb "["
524 | exprToCode map sb key
525 | addStr sb "]"
526 | else nameToCode sb key
527 |
528 | and metaPropToCode map sb id key =
529 | idToCode map sb id
530 | addStr sb "."
531 | idToCode map sb key
532 |
533 | and newToCode map sb expr args =
534 | addStr sb "new "
535 | exprToCode map sb expr
536 | argsToCode map sb args
537 |
538 | and callToCode map sb callee args =
539 | calleeToCode map sb callee
540 | argsToCode map sb args
541 |
542 | and calleeToCode map sb = function
543 | | Callee.Expr expr -> exprToCode map sb expr
544 | | Callee.Import -> addStr sb "import"
545 |
546 | and argsToCode map sb args =
547 | addStr sb "("
548 | Array.iter (argToCode map sb) args
549 | trimComma sb (Array.length args)
550 | addStr sb ")"
551 |
552 | and argToCode map sb arg =
553 | match arg with
554 | | Arg.Expr expr -> exprToCode map sb expr
555 | | Arg.Spread expr ->
556 | addStr sb "..."
557 | exprToCode map sb expr
558 | addComma sb
559 |
560 | and updateToCode map sb op expr prefix =
561 | if prefix then
562 | upOpToStr op |> addStr sb
563 | exprToCode map sb expr
564 | else
565 | exprToCode map sb expr
566 | upOpToStr op |> addStr sb
567 |
568 | and unExprToCode map sb expr key =
569 | addStr sb key
570 | exprToCode map sb expr
571 |
572 | and binExprToCode map sb left right op =
573 | exprParenToCode map sb left
574 | addStr sb op
575 | exprParenToCode map sb right
576 |
577 | and condToCode map sb cond tExpr fExpr =
578 | exprParenToCode map sb cond
579 | addStr sb " ? "
580 | exprParenToCode map sb tExpr
581 | addStr sb " : "
582 | exprParenToCode map sb fExpr
583 |
584 | and yieldToCode map sb arg isGen =
585 | if isGen then addStr sb "yield* "
586 | else addStr sb "yield "
587 | exprOptToCode map sb arg
588 |
589 | and assignExprToCode map sb op left expr =
590 | assignLeftToCode map sb left
591 | assignOpToStr op |> addStr sb
592 | exprToCode map sb expr
593 |
594 | and assignLeftToCode map sb = function
595 | | AssignLeft.Expr expr -> exprToCode map sb expr
596 | | AssignLeft.Binding bind ->
597 | addStr sb "("
598 | bindingToCode map sb bind
599 | addStr sb ")"
600 |
601 | and seqExprToCode map sb exprs =
602 | addStr sb "("
603 | Array.iter (seqElemToCode map sb) exprs
604 | trimComma sb (Array.length exprs)
605 | addStr sb ")"
606 |
607 | and seqElemToCode map sb expr =
608 | exprToCode map sb expr
609 | addComma sb
610 |
611 | let progToCode map prog =
612 | let sb = new SB ()
613 | match prog with
614 | | Script stmts -> stmtListToCode map sb stmts
615 | | _ -> Logger.error "Module is not supported"
616 | sb.ToString ()
617 |
--------------------------------------------------------------------------------
/src/AST/Loader.fs:
--------------------------------------------------------------------------------
1 | module AST.Loader
2 |
3 | open Common
4 | open Common.Json
5 | open Common.Utils
6 |
7 | exception LoadASTException of string
8 |
9 | let getType json = getPropStr json "type"
10 |
11 | let toArrayProp json key = getProp json key |> toArray
12 |
13 | let getStrOpt json key =
14 | match tryGetProp json key with
15 | | Some json -> toStr json |> Some
16 | | None -> None
17 |
18 | let isDecl = function
19 | | "ClassDeclaration"
20 | | "FunctionDeclaration"
21 | | "VariableDeclaration" -> true
22 | | _ -> false
23 |
24 | let isStmt = function
25 | | "BlockStatement"
26 | | "BreakStatement"
27 | | "ContinueStatement"
28 | | "DebuggerStatement"
29 | | "DoWhileStatement"
30 | | "EmptyStatement"
31 | | "ExpressionStatement"
32 | | "ForStatement"
33 | | "ForInStatement"
34 | | "ForOfStatement"
35 | | "FunctionDeclaration"
36 | | "IfStatement"
37 | | "LabeledStatement"
38 | | "ReturnStatement"
39 | | "SwitchStatement"
40 | | "ThrowStatement"
41 | | "TryStatement"
42 | | "VariableDeclaration"
43 | | "WhileStatement"
44 | | "WithStatement" -> true
45 | | _ -> false
46 |
47 | let isExpr = function
48 | | "ThisExpression"
49 | | "Identifier"
50 | | "TemplateLiteral"
51 | | "Literal"
52 | | "ArrayExpression"
53 | | "ObjectExpression"
54 | | "FunctionExpression"
55 | | "ArrowFunctionExpression"
56 | | "ClassExpression"
57 | | "TaggedTemplateExpression"
58 | | "MemberExpression"
59 | | "Super"
60 | | "MetaProperty"
61 | | "NewExpression"
62 | | "CallExpression"
63 | | "UpdateExpression"
64 | | "AwaitExpression"
65 | | "UnaryExpression"
66 | | "BinaryExpression"
67 | | "LogicalExpression"
68 | | "ConditionalExpression"
69 | | "YieldExpression"
70 | | "AssignmentExpression"
71 | | "SequenceExpression" -> true
72 | | _ -> false
73 |
74 | let isMemberExpr = function
75 | | "MemberExpression" -> true
76 | | _ -> false
77 |
78 | let isId = function
79 | | "Identifier" -> true
80 | | _ -> false
81 |
82 | let isBindingPt = function
83 | | "ArrayPattern"
84 | | "ObjectPattern" -> true
85 | | _ -> false
86 |
87 | let isArrayPt = function
88 | | "ArrayPattern" -> true
89 | | _ -> false
90 |
91 | let isObjectPt = function
92 | | "ObjectPattern" -> true
93 | | _ -> false
94 |
95 | let isBinding = function
96 | | "Identifier"
97 | | "ArrayPattern"
98 | | "ObjectPattern"
99 | | "AssignmentPattern"
100 | | "MemberExpression" -> true
101 | | _ -> false
102 |
103 | let isAssignPt = function
104 | | "AssignmentPattern" -> true
105 | | _ -> false
106 |
107 | let isRestElem = function
108 | | "RestElement" -> true
109 | | _ -> false
110 |
111 | let isVarDecl = function
112 | | "VariableDeclaration" -> true
113 | | _ -> false
114 |
115 | let isSpreadElem = function
116 | | "SpreadElement" -> true
117 | | _ -> false
118 |
119 | let isImport = function
120 | | "Import" -> true
121 | | _ -> false
122 |
123 | let isBlock = function
124 | | "BlockStatement" -> true
125 | | _ -> false
126 |
127 | let loadId json = getPropStr json "name"
128 |
129 | let loadIdProp json key = getProp json key |> loadId
130 |
131 | let loadIdOpt json key =
132 | match getProp json key with
133 | | Json.Null -> None
134 | | json -> loadId json |> Some
135 |
136 | let getOp json = getPropStr json "operator"
137 |
138 | let getKind json = getPropStr json "kind"
139 |
140 | let loadUpOp json =
141 | match getOp json with
142 | | "++" -> Inc
143 | | "--" -> Dec
144 | | _ -> raise (LoadASTException "UpOp")
145 |
146 | let loadUnOp json =
147 | match getOp json with
148 | | "+" -> Pos
149 | | "-" -> Neg
150 | | "~" -> BitNot
151 | | "!" -> Not
152 | | "delete" -> Delete
153 | | "void" -> Void
154 | | "typeof" -> TypeOf
155 | | _ -> raise (LoadASTException "UnOp")
156 |
157 | let loadBinOp json =
158 | match getOp json with
159 | | "+" -> BinOp.Add
160 | | "-" -> BinOp.Sub
161 | | "*" -> BinOp.Mul
162 | | "/" -> BinOp.Div
163 | | "%" -> BinOp.Mod
164 | | "**" -> BinOp.Power
165 | | "|" -> BinOp.Or
166 | | "^" -> BinOp.Xor
167 | | "&" -> BinOp.And
168 | | "<<" -> BinOp.LShift
169 | | ">>" -> BinOp.RShift
170 | | ">>>" -> BinOp.RShiftZ
171 | | "instanceof" -> InstanceOf
172 | | "in" -> In
173 | | "==" -> Eq
174 | | "!=" -> Neq
175 | | "===" -> AbsEq
176 | | "!==" -> AbsNeq
177 | | "<" -> Lt
178 | | ">" -> Gt
179 | | "<=" -> Le
180 | | ">=" -> Ge
181 | | _ -> raise (LoadASTException "BinOp")
182 |
183 | let loadLogicOp json =
184 | match getOp json with
185 | | "||" -> LogicOp.Or
186 | | "&&" -> LogicOp.And
187 | | _ -> raise (LoadASTException "LogicOp")
188 |
189 | let loadAssignOp json =
190 | match getOp json with
191 | | "=" -> AssignOp.Assign
192 | | "*=" -> Mul
193 | | "**=" -> Power
194 | | "/=" -> Div
195 | | "%=" -> Mod
196 | | "+=" -> Add
197 | | "-=" -> Sub
198 | | "<<=" -> LShift
199 | | ">>=" -> RShift
200 | | ">>>=" -> RShiftZ
201 | | "&=" -> And
202 | | "^=" -> Xor
203 | | "|=" -> Or
204 | | _ -> raise (LoadASTException "AssignOp")
205 |
206 | let loadVarKind json =
207 | match getKind json with
208 | | "var" -> Var
209 | | "const" -> Const
210 | | "let" -> Let
211 | | _ -> raise (LoadASTException "VarKind")
212 |
213 | let loadPropKind json =
214 | match getKind json with
215 | | "get" -> PropKind.Get
216 | | "set" -> PropKind.Set
217 | | "init" -> PropKind.Init
218 | | _ -> raise (LoadASTException "PropKind")
219 |
220 | let loadMethodKind json =
221 | match getKind json with
222 | | "method" -> Method
223 | | "constructor" -> Constructor
224 | | "set" -> Set
225 | | "get" -> Get
226 | | _ -> raise (LoadASTException "MethodKind")
227 |
228 | let loadLiteral json =
229 | let raw = getPropStr json "raw"
230 | match getProp json "value" with
231 | | Json.Null -> Literal.Null
232 | | Json.Boolean v -> Literal.Bool v
233 | | Json.Number _ -> Literal.Number raw
234 | | Json.Float _ -> Literal.Number raw
235 | | Json.String _ -> Literal.String raw
236 | | Json.Record _ -> Literal.Regex raw
237 | | _ -> raise (LoadASTException "Literal")
238 |
239 | let rec loadStmtList json = toArray json |> Array.map loadStmtListItem
240 |
241 | and loadStmtListProp json key = getProp json key |> loadStmtList
242 |
243 | and loadStmtListOpt json key =
244 | match getProp json key with
245 | | Json.Null -> None
246 | | json -> loadStmtList json |> Some
247 |
248 | and loadStmtListItem json =
249 | let ty = getType json
250 | if isDecl ty then loadDecl json |> StmtListItem.Decl
251 | elif isStmt ty then loadStmt json |> StmtListItem.Stmt
252 | else raise (LoadASTException "StmtListItem")
253 |
254 | and loadDecl json =
255 | match getType json with
256 | | "ClassDeclaration" -> loadClassDecl json |> Decl.ClassDecl
257 | | "FunctionDeclaration" -> loadFuncDecl json |> Decl.FuncDecl
258 | | "VariableDeclaration" -> loadVarDecl json |> Decl.VarDecl
259 | | _ -> raise (LoadASTException "Decl")
260 |
261 | and loadStmt json =
262 | match getType json with
263 | | "BlockStatement" -> loadStmtListProp json "body" |> Stmt.Block
264 | | "BreakStatement" -> loadIdOpt json "label" |> Stmt.Break
265 | | "ContinueStatement" -> loadIdOpt json "label"|> Stmt.Continue
266 | | "DebuggerStatement" -> Stmt.Debugger
267 | | "DoWhileStatement" ->
268 | (loadStmtProp json "body", loadExprProp json "test") |> Stmt.DoWhile
269 | | "EmptyStatement" -> Stmt.Empty
270 | | "ExpressionStatement" ->
271 | (loadExprProp json "expression", getStrOpt json "directive") |> Stmt.Expr
272 | | "ForStatement" ->
273 | (loadForInitOpt json, loadExprOpt json "test", loadExprOpt json "update",
274 | loadStmtProp json "body") |> For
275 | | "ForInStatement" -> loadForInOf json |> ForIn
276 | | "ForOfStatement" -> loadForInOf json |> ForOf
277 | | "FunctionDeclaration" -> loadFuncDecl json |> Stmt.FuncDecl
278 | | "IfStatement" ->
279 | (loadExprProp json "test", loadStmtProp json "consequent",
280 | loadStmtOpt json "alternate") |> Stmt.If
281 | | "LabeledStatement" ->
282 | (loadIdProp json "label", loadStmtProp json "body") |> Stmt.Labeled
283 | | "ReturnStatement" -> loadExprOpt json "argument" |> Stmt.Return
284 | | "SwitchStatement" ->
285 | (loadExprProp json "discriminant", loadCases json) |> Stmt.Switch
286 | | "ThrowStatement" -> loadExprProp json "argument" |> Stmt.Throw
287 | | "TryStatement" ->
288 | (loadBlock json "block", loadCatchOpt json,
289 | loadBlockOpt json "finalizer") |> Stmt.Try
290 | | "VariableDeclaration" -> loadVarDecl json |> Stmt.VarDecl
291 | | "WhileStatement" ->
292 | (loadExprProp json "test", loadStmtProp json "body") |> Stmt.While
293 | | "WithStatement" ->
294 | (loadExprProp json "object", loadStmtProp json "body") |> Stmt.With
295 | | _ -> raise (LoadASTException "Stmt")
296 |
297 | and loadStmtProp json key = getProp json key |> loadStmt
298 |
299 | and loadStmtOpt json key =
300 | match getProp json key with
301 | | Json.Null -> None
302 | | json -> loadStmt json |> Some
303 |
304 | and loadStmts json key = toArrayProp json key |> Array.map loadStmt
305 |
306 | and loadExpr json =
307 | match getType json with
308 | | "ThisExpression" -> Expr.This
309 | | "Identifier" -> loadId json |> Expr.Id
310 | | "Literal" -> loadLiteral json |> Expr.Literal
311 | | "TemplateLiteral" -> loadTempLiteral json |> Expr.TempLiteral
312 | | "ArrayExpression" -> toArray json |> Array.map loadArrayElem |> Expr.Array
313 | | "ObjectExpression" -> loadProps json |> Expr.Object
314 | | "FunctionExpression" -> loadFuncExpr json |> Expr.Function
315 | | "ArrowFunctionExpression" -> loadArrowFuncExpr json |> Expr.ArrowFunction
316 | | "ClassExpression" ->
317 | (loadIdOpt json "id", loadExprOpt json "superClass", loadClassBody json)
318 | |> Expr.Class
319 | | "TaggedTemplateExpression" ->
320 | (loadExprProp json "tag", loadTempLiteralProp json "quasi") |> TaggedTemp
321 | | "MemberExpression" -> loadMemberExpr json |> Expr.Member
322 | | "Super" -> Expr.Super
323 | | "MetaProperty" ->
324 | (loadIdProp json "meta", loadIdProp json "property") |> Expr.MetaProp
325 | | "NewExpression" -> (loadExprProp json "callee", loadArgs json) |> Expr.New
326 | | "CallExpression" -> (loadCallee json, loadArgs json) |> Expr.Call
327 | | "UpdateExpression" ->
328 | (loadUpOp json, loadExprProp json "argument", getBool json "prefix")
329 | |> Expr.Update
330 | | "AwaitExpression" -> loadExprProp json "argument" |> Expr.Await
331 | | "UnaryExpression" ->
332 | (loadUnOp json, loadExprProp json "argument") |> Expr.Unary
333 | | "BinaryExpression" ->
334 | (loadBinOp json, loadExprProp json "left", loadExprProp json "right")
335 | |> Expr.Binary
336 | | "LogicalExpression" ->
337 | (loadLogicOp json, loadExprProp json "left", loadExprProp json "right")
338 | |> Expr.Logic
339 | | "ConditionalExpression" ->
340 | (loadExprProp json "test", loadExprProp json "consequent",
341 | loadExprProp json "alternate") |> Expr.Cond
342 | | "YieldExpression" ->
343 | (loadExprOpt json "argument", getBool json "delegate") |> Expr.Yield
344 | | "AssignmentExpression" ->
345 | (loadAssignOp json, loadAssignLeft json, loadExprProp json "right")
346 | |> Expr.Assign
347 | | "SequenceExpression" ->
348 | toArrayProp json "expressions" |> Array.map loadExpr |> Expr.Seq
349 | | _ -> raise (LoadASTException "Expr")
350 |
351 | and loadExprProp json key = getProp json key |> loadExpr
352 |
353 | and loadExprOpt json key =
354 | match getProp json key with
355 | | Json.Null -> None
356 | | json -> loadExpr json |> Some
357 |
358 | and loadClassDecl json =
359 | loadIdProp json "id", loadExprOpt json "superClass", loadClassBody json
360 |
361 | and loadFuncDecl json =
362 | loadIdProp json "id", loadParams json, loadBlock json "body",
363 | getBool json "generator", getBool json "async"
364 |
365 | and loadBlock json key = loadStmtListProp (getProp json key) "body"
366 |
367 | and loadBlockOpt json key =
368 | match getProp json key with
369 | | Json.Null -> None
370 | | json -> loadStmtListProp json "body" |> Some
371 |
372 | and loadVarDecl json =
373 | loadVarKind json, toArrayProp json "declarations" |> Array.map loadVarDeclr
374 |
375 | and loadVarDeclr json = loadBindingProp json "id", loadExprOpt json "init"
376 |
377 | and loadForInitOpt json =
378 | match getProp json "init" with
379 | | Json.Null -> None
380 | | json ->
381 | let ty = getType json
382 | if isExpr ty then loadExpr json |> ForInit.Expr |> Some
383 | elif isVarDecl ty then loadVarDecl json |> ForInit.VarDecl |> Some
384 | else raise (LoadASTException "ForInit")
385 |
386 | and loadForInOf json =
387 | (loadForBind json, loadExprProp json "right", loadStmtProp json "body")
388 |
389 | and loadForBind json =
390 | let json = getProp json "left"
391 | let ty = getType json
392 | if isVarDecl ty then loadVarDecl json |> ForBind.VarDecl
393 | elif isBinding ty then loadBinding json |> ForBind.Binding
394 | else raise (LoadASTException ("ForBind: "+ ty))
395 |
396 | and loadCases json = toArray json |> Array.map loadCase
397 |
398 | and loadCase json = loadExprOpt json "test", loadStmts json "consequent"
399 |
400 | and loadCatchOpt json =
401 | match getProp json "handler" with
402 | | Json.Null -> None
403 | | json -> (loadBindingOpt json "param", loadBlock json "body") |> Some
404 |
405 | and loadTempLiteral json =
406 | toArrayProp json "quasis" |> Array.map loadTempElem,
407 | toArrayProp json "expressions" |> Array.map loadExpr
408 |
409 | and loadTempElem json =
410 | let value = getProp json "value"
411 | getPropStr value "raw"
412 |
413 | and loadTempLiteralProp json key = getProp json key |> loadTempLiteral
414 |
415 | and loadBinding json =
416 | let ty = getType json
417 | if isId ty then loadId json |> Binding.Id
418 | elif isBindingPt ty then loadBindingPt json |> Binding.BindingPt
419 | elif isAssignPt ty then loadAssignPt json |> Binding.AssignPt
420 | elif isMemberExpr ty then loadMemberExpr json |> Binding.MemberExpr
421 | else raise (LoadASTException "Binding")
422 |
423 | and loadBindingProp json key = getProp json key |> loadBinding
424 |
425 | and loadBindingOpt json key =
426 | match getProp json key with
427 | | Json.Null -> None
428 | | json -> loadBinding json |> Some
429 |
430 | and loadBindingPt json =
431 | let ty = getType json
432 | if isArrayPt ty then
433 | toArrayProp json "elements" |> Array.map loadArrayPtElem
434 | |> BindingPt.ArrayPt
435 | elif isObjectPt ty then loadProps json |> BindingPt.ObjectPt
436 | else raise (LoadASTException "BindingPt")
437 |
438 | and loadArrayPtElem json =
439 | match json with
440 | | Json.Null -> ArrayPtElem.Empty
441 | | json ->
442 | let ty = getType json
443 | if isId ty then loadId json |> ArrayPtElem.Id
444 | elif isBindingPt ty then loadBindingPt json |> ArrayPtElem.BindingPt
445 | elif isAssignPt ty then loadAssignPt json |> ArrayPtElem.AssignPt
446 | elif isRestElem ty then loadBindingProp json "argument" |> RestElem
447 | elif isMemberExpr ty then loadMemberExpr json |> ArrayPtElem.MemberExpr
448 | else raise (LoadASTException "ArrayPtElem")
449 |
450 | and loadParams json = toArrayProp json "params" |> Array.map loadParam
451 |
452 | and loadParam json =
453 | let ty = getType json
454 | if isId ty then loadId json |> Param.Id
455 | elif isBindingPt ty then loadBindingPt json |> Param.BindingPt
456 | elif isAssignPt ty then loadAssignPt json |> Param.AssignPt
457 | elif isRestElem ty then loadBindingProp json "argument" |> Param.RestElem
458 | else raise (LoadASTException "Param")
459 |
460 | and loadAssignPt json = loadBindingProp json "left", loadExprProp json "right"
461 |
462 | and loadArgs json = toArrayProp json "arguments" |> Array.map loadArg
463 |
464 | and loadArg json =
465 | let ty = getType json
466 | if isExpr ty then loadExpr json |> Arg.Expr
467 | elif isSpreadElem ty then getProp json "argument" |> loadExpr |> Arg.Spread
468 | else raise (LoadASTException "Arg")
469 |
470 | and loadCallee json =
471 | let json = getProp json "callee"
472 | let ty = getType json
473 | if isExpr ty then loadExpr json |> Callee.Expr
474 | elif isImport ty then Callee.Import
475 | else raise (LoadASTException "Callee")
476 |
477 | and loadArrayElem = function
478 | | Json.Null -> ArrayElem.Empty
479 | | json ->
480 | let ty = getType json
481 | if isExpr ty then loadExpr json |> ArrayElem.Expr
482 | elif isSpreadElem ty then loadExprProp json "argument" |> ArrayElem.Spread
483 | else raise (LoadASTException "ArrayElem")
484 |
485 | and loadProp json =
486 | loadExprProp json "key", loadPropVal json, loadPropKind json,
487 | getBool json "computed", getBool json "shorthand"
488 |
489 | and loadPropVal json =
490 | match getProp json "value" with
491 | | Json.Null -> PropVal.Empty
492 | | json ->
493 | let ty = getType json
494 | if isExpr ty then loadExpr json |> PropVal.Expr
495 | elif isBindingPt ty then loadBindingPt json |> PropVal.BindingPt
496 | elif isAssignPt ty then loadAssignPt json |> PropVal.AssignPt
497 | else raise (LoadASTException "PropVal")
498 |
499 | and loadProps json = toArrayProp json "properties" |> Array.map loadProp
500 |
501 | and loadClassBody json = toArrayProp json "body" |> Array.map loadMethodDef
502 |
503 | and loadMethodDef json =
504 | loadExprProp json "key", getProp json "value" |> loadFuncExpr,
505 | loadMethodKind json, getBool json "computed", getBool json "static"
506 |
507 | and loadFuncExpr json =
508 | loadIdOpt json "id", loadParams json, loadBlock json "body",
509 | getBool json "generator", getBool json "async"
510 |
511 | and loadArrowFuncExpr json =
512 | loadIdOpt json "id", loadParams json, loadArrowFuncBody json,
513 | getBool json "generator", getBool json "async"
514 |
515 | and loadArrowFuncBody json =
516 | let json = getProp json "body"
517 | let ty = getType json
518 | if isExpr ty then loadExpr json |> ArrowFuncBody.Expr
519 | elif isBlock ty then loadStmtListProp json "body" |> ArrowFuncBody.Block
520 | else raise (LoadASTException "ArrowFuncBody")
521 |
522 | and loadAssignLeft json =
523 | let json = getProp json "left"
524 | let ty = getType json
525 | if isBinding ty then loadBinding json |> AssignLeft.Binding
526 | elif isExpr ty then loadExpr json |> AssignLeft.Expr
527 | else raise (LoadASTException "AssignLeft")
528 |
529 | and loadMemberExpr json =
530 | (loadExprProp json "object", loadExprProp json "property",
531 | getBool json "computed")
532 |
533 | let loadProg json =
534 | match getPropStr json "sourceType" with
535 | | "script" -> loadStmtListProp json "body" |> Script
536 | | "module" -> Logger.error "Module is not supported"
537 | | _ -> raise (LoadASTException "Prog")
538 |
539 | let failToLoad fname =
540 | Logger.warn "fail to load seed: %s" fname
541 | fname, Script [||]
542 |
543 | let load fname =
544 | try fname, loadJson fname |> loadProg
545 | with | _ -> failToLoad fname
546 |
547 | let asyncLoad fname = async {
548 | try
549 | let! json = asyncLoadJson fname
550 | return fname, loadProg json
551 | with | _ -> return failToLoad fname
552 | }
553 |
554 | let loads dir =
555 | getFiles [||] dir |> Array.map asyncLoad
556 | |> Async.Parallel
557 | |> Async.RunSynchronously
558 |
--------------------------------------------------------------------------------
/src/AST/Normalize.fs:
--------------------------------------------------------------------------------
1 | module AST.Normalize
2 |
3 | open Common
4 |
5 | let private (=>) (map, ret) f = (map, f ret)
6 |
7 | let private folder f (map, ret) arg =
8 | let map, arg = f map arg
9 | map, arg :: ret
10 |
11 | let private fold filter map f args =
12 | Array.fold (folder (f filter)) (map, []) args => Array.revList
13 |
14 | let getFuncFilter filter id =
15 | if filter id then true
16 | else id = "arguments"
17 |
18 | let getNewId map id =
19 | let nid = Map.count map |> sprintf "v%d"
20 | Map.add id nid map, nid
21 |
22 | let normalizeId filter map id =
23 | match Map.tryFind id map with
24 | | Some id -> map, id
25 | | None -> if filter id then Map.add id id map, id else getNewId map id
26 |
27 | let normalizeIdOpt filter map = function
28 | | Some id -> normalizeId filter map id => Some
29 | | None -> map, None
30 |
31 | let rec normalizeStmtList filter map items =
32 | fold filter map normalizeStmtItem items
33 |
34 | and normalizeStmtListOpt filter map = function
35 | | Some stmts -> normalizeStmtList filter map stmts => Some
36 | | None -> map, None
37 |
38 | and normalizeStmtItem filter map = function
39 | | StmtListItem.Stmt stmt -> normalizeStmt filter map stmt => StmtListItem.Stmt
40 | | StmtListItem.Decl decl -> normalizeDecl filter map decl => StmtListItem.Decl
41 |
42 | and normalizeStmt filter map = function
43 | | Stmt.Block stmts -> normalizeStmtList filter map stmts => Stmt.Block
44 | | Break label -> normalizeIdOpt filter map label => Break
45 | | Continue label -> normalizeIdOpt filter map label => Continue
46 | | Debugger -> map, Debugger
47 | | DoWhile (stmt, expr) -> normalizeDoWhile filter map stmt expr
48 | | Stmt.Empty -> map, Stmt.Empty
49 | | Stmt.Expr (expr, dir) -> normalizeStmtExpr filter map expr dir
50 | | For (init, test, up, body) -> normalizeFor filter map init test up body
51 | | ForIn (bind, expr, body) ->
52 | normalizeForInOf filter map bind expr body => ForIn
53 | | ForOf (bind, expr, body) ->
54 | normalizeForInOf filter map bind expr body => ForOf
55 | | Stmt.FuncDecl decl -> normalizeFuncDecl filter map decl => Stmt.FuncDecl
56 | | If (test, tStmt, fStmt) -> normalizeIf filter map test tStmt fStmt
57 | | Labeled (id, body) -> normalizeLabeled filter map id body
58 | | Return arg -> normalizeExprOpt filter map arg => Return
59 | | Switch (test, cases) -> normalizeSwitch filter map test cases
60 | | Throw arg -> normalizeExpr filter map arg => Throw
61 | | Try (body, catch, final) -> normalizeTry filter map body catch final
62 | | Stmt.VarDecl decl -> normalizeVarDecl filter map decl => Stmt.VarDecl
63 | | While (test, body) -> normalizeExprBody filter map test body => While
64 | | With (expr, body) -> normalizeExprBody filter map expr body => With
65 |
66 | and normalizeStmtOpt filter map = function
67 | | Some stmt -> normalizeStmt filter map stmt => Some
68 | | None -> map, None
69 |
70 | and normalizeDecl filter map = function
71 | | Decl.ClassDecl decl -> normalizeClassDecl filter map decl => Decl.ClassDecl
72 | | Decl.VarDecl decl -> normalizeVarDecl filter map decl => Decl.VarDecl
73 | | Decl.FuncDecl decl -> normalizeFuncDecl filter map decl => Decl.FuncDecl
74 |
75 | and normalizeExpr filter map = function
76 | | Expr.Id id -> normalizeId filter map id => Expr.Id
77 | | TempLiteral temp -> normalizeTempLiteral filter map temp => TempLiteral
78 | | Array elems -> fold filter map normalizeArrayElem elems => Array
79 | | Object props -> fold filter map normalizeProp props => Object
80 | | Function expr -> normalizeFuncExpr filter map expr => Function
81 | | ArrowFunction (id, params_, body, isGen, isAsync) ->
82 | normalizeArrowFunc filter map id params_ body isGen isAsync
83 | | Expr.Class (id, extends, defs) ->
84 | normalizeClassExpr filter map id extends defs
85 | | TaggedTemp (expr, temp) -> normalizeTaggedTemp filter map expr temp
86 | | Member expr -> normalizeMemberExpr filter map expr => Member
87 | | New (expr, args) -> normalizeNew filter map expr args
88 | | Call (callee, args) -> normalizeCall filter map callee args
89 | | Update (op, expr, isPre) -> normalizeUpExpr filter map op expr isPre
90 | | Await expr -> normalizeExpr filter map expr => Await
91 | | Unary (op, expr) -> normalizeUnExpr filter map op expr
92 | | Binary (op, e1, e2) -> normalizeBinExpr filter map op e1 e2
93 | | Logic (op, e1, e2) -> normalizeLogicExpr filter map op e1 e2
94 | | Cond (cond, e1, e2) -> normalizeCondExpr filter map cond e1 e2
95 | | Yield (expr, isGen) -> normalizeYieldExpr filter map expr isGen
96 | | Expr.Assign (op, left, expr) -> normalizeAssign filter map op left expr
97 | | Seq exprs -> fold filter map normalizeExpr exprs => Seq
98 | // This, Literal, Super, MetaProp
99 | | expr -> map, expr
100 |
101 | and normalizeExprOpt filter map = function
102 | | Some expr -> normalizeExpr filter map expr => Some
103 | | None -> map, None
104 |
105 | and normalizeDoWhile filter map body test =
106 | let map, body = normalizeStmt filter map body
107 | let map, test = normalizeExpr filter map test
108 | map, DoWhile (body, test)
109 |
110 | and normalizeStmtExpr filter map expr dir =
111 | let map, expr = normalizeExpr filter map expr
112 | map, Stmt.Expr (expr, dir)
113 |
114 | and normalizeFor filter map init test up body =
115 | let map, init = normalizeForInit filter map init
116 | let map, test = normalizeExprOpt filter map test
117 | let map, up = normalizeExprOpt filter map up
118 | let map, body = normalizeStmt filter map body
119 | map, For (init, test, up, body)
120 |
121 | and normalizeForInit filter map = function
122 | | Some (ForInit.Expr expr) ->
123 | normalizeExpr filter map expr => (ForInit.Expr >> Some)
124 | | Some (ForInit.VarDecl decl) ->
125 | normalizeVarDecl filter map decl => (ForInit.VarDecl >> Some)
126 | | None -> map, None
127 |
128 | and normalizeForInOf filter map bind expr body =
129 | let map, bind = normalizeForBind filter map bind
130 | let map, expr = normalizeExpr filter map expr
131 | let map, body = normalizeStmt filter map body
132 | map, (bind, expr, body)
133 |
134 | and normalizeForBind filter map = function
135 | | ForBind.VarDecl decl -> normalizeVarDecl filter map decl => ForBind.VarDecl
136 | | ForBind.Binding bind -> normalizeBinding filter map bind => ForBind.Binding
137 |
138 | and normalizeIf filter map test tStmt fStmt =
139 | let map, test = normalizeExpr filter map test
140 | let map, tStmt = normalizeStmt filter map tStmt
141 | let map, fStmt = normalizeStmtOpt filter map fStmt
142 | map, If (test, tStmt, fStmt)
143 |
144 | and normalizeLabeled filter map id body =
145 | let map, id = normalizeId filter map id
146 | let map, body = normalizeStmt filter map body
147 | map, Labeled (id, body)
148 |
149 | and normalizeSwitch filter map test cases =
150 | let map, test = normalizeExpr filter map test
151 | let map, cases = fold filter map normalizeCase cases
152 | map, Switch (test, cases)
153 |
154 | and normalizeCase filter map (test, body) =
155 | let map, test = normalizeExprOpt filter map test
156 | let map, body = fold filter map normalizeStmt body
157 | map, (test, body)
158 |
159 | and normalizeTry filter map body catch final =
160 | let map, body = normalizeStmtList filter map body
161 | let map, catch = normalizeCatch filter map catch
162 | let map, final = normalizeStmtListOpt filter map final
163 | map, Try (body, catch, final)
164 |
165 | and normalizeCatch filter map = function
166 | | Some (bind, body) ->
167 | let map, bind = normalizeBindingOpt filter map bind
168 | let map, body = normalizeStmtList filter map body
169 | map, Some (bind, body)
170 | | None -> map, None
171 |
172 | and normalizeExprBody filter map expr body =
173 | let map, expr = normalizeExpr filter map expr
174 | let map, body = normalizeStmt filter map body
175 | map, (expr, body)
176 |
177 | and normalizeClassDecl filter map (id, extends, defs) =
178 | let map, id = normalizeId filter map id
179 | let map, extends = normalizeExprOpt filter map extends
180 | let map, defs = fold filter map normalizeMethodDef defs
181 | map, (id, extends, defs)
182 |
183 | and normalizeMethodDef filter map (key, body, kind, isComputed, isStatic) =
184 | let map, key = normalizeKey filter map key isComputed
185 | let map, body = normalizeFuncExpr filter map body
186 | map, (key, body, kind, isComputed, isStatic)
187 |
188 | and normalizeKey filter map key = function
189 | | true -> normalizeExpr filter map key
190 | | false -> map, key
191 |
192 | and normalizeVarDecl filter map (kind, declrs) =
193 | let map, declrs = fold filter map normalizeVarDeclr declrs
194 | map, (kind, declrs)
195 |
196 | and normalizeVarDeclr filter map (bind, init) =
197 | let map, bind = normalizeBinding filter map bind
198 | let map, init = normalizeExprOpt filter map init
199 | map, (bind, init)
200 |
201 | and normalizeFuncDecl filter map (id, params_, body, isGen, isAsync) =
202 | let filter = getFuncFilter filter
203 | let map, id = normalizeId filter map id
204 | let map, params_ = fold filter map normalizeParam params_
205 | let map, body = normalizeStmtList filter map body
206 | map, (id, params_, body, isGen, isAsync)
207 |
208 | and normalizeParam filter map = function
209 | | Param.Id id -> normalizeId filter map id => Param.Id
210 | | Param.BindingPt pt -> normalizeBindingPt filter map pt => Param.BindingPt
211 | | Param.AssignPt pt -> normalizeAssignPt filter map pt => Param.AssignPt
212 | | Param.RestElem bind -> normalizeBinding filter map bind => Param.RestElem
213 |
214 | and normalizeTempLiteral filter map (strs, exprs) =
215 | let map, exprs = fold filter map normalizeExpr exprs
216 | map, (strs, exprs)
217 |
218 | and normalizeArrayElem filter map = function
219 | | ArrayElem.Expr expr -> normalizeExpr filter map expr => ArrayElem.Expr
220 | | ArrayElem.Spread expr -> normalizeExpr filter map expr => ArrayElem.Spread
221 | | ArrayElem.Empty -> map, ArrayElem.Empty
222 |
223 | and normalizeProp filter map (key, value, kind, isComputed, isShort) =
224 | let map, key = normalizeKey filter map key isComputed
225 | let map, value = normalizePropVal filter map value
226 | map, (key, value, kind, isComputed, isShort)
227 |
228 | and normalizePropVal filter map = function
229 | | PropVal.Expr expr -> normalizeExpr filter map expr => PropVal.Expr
230 | | PropVal.BindingPt pt ->
231 | normalizeBindingPt filter map pt => PropVal.BindingPt
232 | | PropVal.AssignPt pt -> normalizeAssignPt filter map pt => PropVal.AssignPt
233 | | PropVal.Empty -> map, PropVal.Empty
234 |
235 | and normalizeFuncExpr filter map (id, params_, body, isGen, isAsync) =
236 | let filter = getFuncFilter filter
237 | let map, id = normalizeIdOpt filter map id
238 | let map, params_ = fold filter map normalizeParam params_
239 | let map, body = normalizeStmtList filter map body
240 | map, (id, params_, body, isGen, isAsync)
241 |
242 | and normalizeArrowFunc filter map id params_ body isGen isAsync =
243 | let filter = getFuncFilter filter
244 | let map, id = normalizeIdOpt filter map id
245 | let map, params_ = fold filter map normalizeParam params_
246 | let map, body =
247 | match body with
248 | | ArrowFuncBody.Block body ->
249 | normalizeStmtList filter map body => ArrowFuncBody.Block
250 | | ArrowFuncBody.Expr expr ->
251 | normalizeExpr filter map expr => ArrowFuncBody.Expr
252 | map, ArrowFunction (id, params_, body, isGen, isAsync)
253 |
254 | and normalizeClassExpr filter map id extends defs =
255 | let map, id = normalizeIdOpt filter map id
256 | let map, extends = normalizeExprOpt filter map extends
257 | let map, defs = fold filter map normalizeMethodDef defs
258 | map, Class (id, extends, defs)
259 |
260 | and normalizeTaggedTemp filter map expr temp =
261 | let map, expr = normalizeExpr filter map expr
262 | let map, temp = normalizeTempLiteral filter map temp
263 | map, TaggedTemp (expr, temp)
264 |
265 | and normalizeMemberExpr filter map (expr, key, isComputed) =
266 | let map, expr = normalizeExpr filter map expr
267 | let map, key = normalizeKey filter map key isComputed
268 | map, (expr, key, isComputed)
269 |
270 | and normalizeNew filter map expr args =
271 | let map, expr = normalizeExpr filter map expr
272 | let map, args = fold filter map normalizeArg args
273 | map, New (expr, args)
274 |
275 | and normalizeArg filter map = function
276 | | Arg.Expr expr -> normalizeExpr filter map expr => Arg.Expr
277 | | Arg.Spread expr -> normalizeExpr filter map expr => Arg.Spread
278 |
279 | and normalizeCall filter map callee args =
280 | let map, callee =
281 | match callee with
282 | | Callee.Expr expr -> normalizeExpr filter map expr => Callee.Expr
283 | | Callee.Import -> map, callee
284 | let map, args = fold filter map normalizeArg args
285 | map, Call (callee, args)
286 |
287 | and normalizeUpExpr filter map op expr isPre =
288 | let map, expr = normalizeExpr filter map expr
289 | map, Update (op, expr, isPre)
290 |
291 | and normalizeUnExpr filter map op expr =
292 | let map, expr = normalizeExpr filter map expr
293 | map, Unary (op, expr)
294 |
295 | and normalizeBinExpr filter map op e1 e2 =
296 | let map, e1 = normalizeExpr filter map e1
297 | let map, e2 = normalizeExpr filter map e2
298 | map, Binary (op, e1, e2)
299 |
300 | and normalizeLogicExpr filter map op e1 e2 =
301 | let map, e1 = normalizeExpr filter map e1
302 | let map, e2 = normalizeExpr filter map e2
303 | map, Logic (op, e1, e2)
304 |
305 | and normalizeCondExpr filter map cond e1 e2 =
306 | let map, cond = normalizeExpr filter map cond
307 | let map, e1 = normalizeExpr filter map e1
308 | let map, e2 = normalizeExpr filter map e2
309 | map, Cond (cond, e1, e2)
310 |
311 | and normalizeYieldExpr filter map expr isGen =
312 | let map, expr = normalizeExprOpt filter map expr
313 | map, Yield (expr, isGen)
314 |
315 | and normalizeAssign filter map op left expr =
316 | let map, left =
317 | match left with
318 | | AssignLeft.Expr expr -> normalizeExpr filter map expr => AssignLeft.Expr
319 | | AssignLeft.Binding bind ->
320 | normalizeBinding filter map bind => AssignLeft.Binding
321 | let map, expr = normalizeExpr filter map expr
322 | map, Assign (op, left, expr)
323 |
324 | and normalizeBinding filter map = function
325 | | Binding.Id id -> normalizeId filter map id => Binding.Id
326 | | Binding.BindingPt pt ->
327 | normalizeBindingPt filter map pt => Binding.BindingPt
328 | | Binding.AssignPt pt -> normalizeAssignPt filter map pt => Binding.AssignPt
329 | | Binding.MemberExpr expr ->
330 | normalizeMemberExpr filter map expr => Binding.MemberExpr
331 |
332 | and normalizeBindingOpt filter map = function
333 | | Some bind -> normalizeBinding filter map bind => Some
334 | | None -> map, None
335 |
336 | and normalizeBindingPt filter map = function
337 | | ArrayPt pts -> fold filter map normalizeArrayPtElem pts => ArrayPt
338 | | ObjectPt props -> fold filter map normalizeProp props => ObjectPt
339 |
340 | and normalizeArrayPtElem filter map = function
341 | | ArrayPtElem.Id id -> normalizeId filter map id => ArrayPtElem.Id
342 | | ArrayPtElem.BindingPt pt ->
343 | normalizeBindingPt filter map pt => ArrayPtElem.BindingPt
344 | | ArrayPtElem.AssignPt pt ->
345 | normalizeAssignPt filter map pt => ArrayPtElem.AssignPt
346 | | ArrayPtElem.RestElem bind ->
347 | normalizeBinding filter map bind => ArrayPtElem.RestElem
348 | | ArrayPtElem.MemberExpr expr ->
349 | normalizeMemberExpr filter map expr => ArrayPtElem.MemberExpr
350 | | ArrayPtElem.Empty -> map, ArrayPtElem.Empty
351 |
352 | and normalizeAssignPt filter map (bind, expr) =
353 | let map, bind = normalizeBinding filter map bind
354 | let map, expr = normalizeExpr filter map expr
355 | map, (bind, expr)
356 |
--------------------------------------------------------------------------------
/src/AST/Parser.fs:
--------------------------------------------------------------------------------
1 | module AST.Parser
2 |
3 | open System
4 | open Common.Utils
5 | open Common.Executor
6 |
7 | let parseAll engine jsonDir saveDir =
8 | let path = Reflection.Assembly.GetAssembly(typeof).Location
9 | let js = (getDirName path) +/ "Parser.js"
10 | execNodeJs js (engine + " " + jsonDir + " " + saveDir)
11 |
--------------------------------------------------------------------------------
/src/AST/Parser.js:
--------------------------------------------------------------------------------
1 | const esprima = require('esprima');
2 | const fs = require('fs');
3 | const path = require('path');
4 | const print = console.log;
5 | const exit = process.exit;
6 | const PRE = "CodeAlchemist_V8Native"
7 | const RE = new RegExp (PRE, "g");
8 |
9 | function resolveV8Native (src) {
10 | src = src.replace(/%[a-zA-Z]+/g, function(src){ return PRE + src.slice(1)});
11 | return esprima.parse(src);
12 | }
13 |
14 | function parse(fname, isV8){
15 | try{
16 | var src = fs.readFileSync(fname, 'utf8');
17 | return esprima.parse(src);
18 | }catch(e){
19 | if (isV8) {
20 | try { return resolveV8Native (src) }
21 | catch (e) { print (fname + ' : parse error! ' + e); }
22 | } else print(fname + ' : parse error! ' + e);
23 | }
24 | }
25 |
26 | function astToJson(ast, isV8){
27 | try{
28 | var ret = JSON.stringify(ast, null, 2);
29 | }catch(e){
30 | print('astsToJson error!');
31 | }
32 | if (isV8 && ret) ret = ret.replace(RE, "%")
33 | return ret
34 | }
35 |
36 | function listDir(dir){
37 | return fs.readdirSync(dir)
38 | }
39 |
40 | function main(){
41 | var engine = process.argv[2];
42 | var isV8 = (engine === "V8");
43 | var js_dir = process.argv[3];
44 | var json_dir = process.argv[4];
45 | var js_files = listDir(js_dir);
46 | for (let name of js_files){
47 | if(name.endsWith('.js')){
48 | let json = astToJson(parse(path.join(js_dir, name), isV8), isV8);
49 | if(json !== undefined){
50 | fs.writeFileSync(path.join(json_dir, name), json);
51 | }
52 | }
53 |
54 | }
55 | }
56 | main()
57 |
--------------------------------------------------------------------------------
/src/Analyzer/Analyzer.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | netstandard2.0
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
--------------------------------------------------------------------------------
/src/Analyzer/CodeBrick.fs:
--------------------------------------------------------------------------------
1 | namespace Analyzer
2 |
3 | open System
4 | open System.Text
5 | open AST
6 | open AST.Normalize
7 | open AST.CodeGen
8 | open Common
9 |
10 | type Guard =
11 | | For of ForInit option * Expr option * Expr option
12 | | ForIn of ForBind * Expr
13 | | ForOf of ForBind * Expr
14 | | While of Expr
15 | | DoWhile of Expr
16 |
17 | type BrickBody =
18 | | StmtListItem of StmtListItem
19 | | Guard of Guard
20 |
21 | type CodeBrick = {
22 | Hash: int64
23 | Body: BrickBody
24 | Constraint: Constraint
25 | NSymMap: Map
26 | }
27 |
28 | type CodeBricks = Map
29 |
30 | type Context = {
31 | Pool: CodeBricks
32 | GuardMap: Map // StmtListItem -> Guard
33 | IsBuiltIn: string -> bool
34 | IsFilters: CodeBrick -> bool
35 | }
36 |
37 | module Context =
38 | let mkIsBuiltIn conf =
39 | let lists = conf.BuiltIns
40 | match conf.Engine with
41 | | V8 -> (fun x -> (Array.includes lists x) || (x.StartsWith ("%")))
42 | | _ -> Array.includes lists
43 |
44 | let init conf = {
45 | Pool = Map.empty
46 | GuardMap = Map.empty
47 | IsBuiltIn = mkIsBuiltIn conf
48 | IsFilters =
49 | (fun x -> Map.foranyKeys (Array.includes conf.Filters) x.NSymMap)
50 | }
51 |
52 | let prepareBrick brick cons = {
53 | brick with Constraint = Constraint.normalize cons brick.NSymMap
54 | NSymMap = Map.filter String.neq brick.NSymMap
55 | }
56 |
57 | let addBrick ctx cons brick =
58 | if ctx.IsFilters brick then ctx, false
59 | else
60 | let hval = brick.Hash
61 | let pool = ctx.Pool
62 | match Map.tryFind hval pool with
63 | | Some _ -> ctx, true
64 | | None ->
65 | let brick = prepareBrick brick cons
66 | { ctx with Pool = Map.add hval brick pool }, true
67 |
68 | let addGBrick ctx cons sHash brick =
69 | match addBrick ctx cons brick with
70 | | ctx, true -> { ctx with GuardMap = Map.add sHash brick.Hash ctx.GuardMap }
71 | | ctx, false -> ctx
72 |
73 | module CodeBrick =
74 | let calcHash sb =
75 | use md5 = System.Security.Cryptography.MD5.Create()
76 | (sb.ToString () |> Encoding.UTF8.GetBytes |> md5.ComputeHash, 0)
77 | |> BitConverter.ToInt64
78 |
79 | let ofStmt stmt ctx =
80 | let nMap, nStmt = normalizeStmt ctx.IsBuiltIn Map.empty stmt
81 | let sb = new SB ()
82 | stmtToCode Map.empty sb nStmt
83 | { Hash = calcHash sb
84 | Body = StmtListItem.Stmt nStmt |> BrickBody.StmtListItem
85 | Constraint = Constraint.empty
86 | NSymMap = nMap }
87 |
88 | let ofDecl decl ctx =
89 | let nMap, nDecl = normalizeDecl ctx.IsBuiltIn Map.empty decl
90 | let sb = new SB ()
91 | declToCode Map.empty sb nDecl
92 | { Hash = calcHash sb
93 | Body = StmtListItem.Decl nDecl |> BrickBody.StmtListItem
94 | Constraint = Constraint.empty
95 | NSymMap = nMap }
96 |
97 | let guardToStmt = function
98 | | For (init, cond, up) -> Stmt.For (init, cond, up, Stmt.Empty)
99 | | ForIn (bind, expr) -> Stmt.ForIn (bind, expr, Stmt.Empty)
100 | | ForOf (bind, expr) -> Stmt.ForOf (bind, expr, Stmt.Empty)
101 | | While cond -> Stmt.While (cond, Stmt.Empty)
102 | | DoWhile cond -> Stmt.DoWhile (Stmt.Empty, cond)
103 |
104 | let stmtToGuard = function
105 | | Stmt.For (init, cond, up, Stmt.Empty) -> For (init, cond, up)
106 | | Stmt.ForIn (bind, expr, Stmt.Empty) -> ForIn (bind, expr)
107 | | Stmt.ForOf (bind, expr, Stmt.Empty) -> ForOf (bind, expr)
108 | | Stmt.While (cond, Stmt.Empty) -> While cond
109 | | Stmt.DoWhile (Stmt.Empty, cond) -> DoWhile cond
110 | | stmt -> Logger.error "stmtToGuard fail: %A" stmt
111 |
112 | let normalizeGuard filter guard sb =
113 | addStr sb "// Guard\n"
114 | let nMap, nStmt = guardToStmt guard |> normalizeStmt filter Map.empty
115 | stmtToCode Map.empty sb nStmt
116 | nMap, stmtToGuard nStmt, sb
117 |
118 | let ofGuard guard ctx =
119 | let nMap, nGuard, sb = new SB () |> normalizeGuard ctx.IsBuiltIn guard
120 | { Hash = calcHash sb
121 | Body = BrickBody.Guard nGuard
122 | Constraint = Constraint.empty
123 | NSymMap = nMap }
124 |
125 | let getLoggers brick cons = Constraint.getLogger brick.Hash brick.NSymMap cons
126 |
127 | let getTempVar brick =
128 | let hval = brick.Hash
129 | if hval < 0L then sprintf "temp_%d" (-hval)
130 | else sprintf "temp_%d" hval
131 |
132 | let loadTypes pre post brick =
133 | { brick with Constraint = Constraint.loadTypes brick.Constraint pre post }
134 |
135 | let inline private whileToCodeInit map sb cond =
136 | addStr sb "while("
137 | exprToCode map sb cond
138 | addStr sb "){\n"
139 |
140 | let inline private forToCodeInit map sb init cond update =
141 | addStr sb "for("
142 | forInitToCode map sb init
143 | addStr sb ";"
144 | exprOptToCode map sb cond
145 | addStr sb ";"
146 | exprOptToCode map sb update
147 | addStr sb "){\n"
148 |
149 | let inline private forInOfToCode map sb key bind expr =
150 | addStr sb "for("
151 | forBindToCode map sb bind
152 | addStr sb key
153 | exprToCode map sb expr
154 | addStr sb "){\n"
155 |
156 | let guardToCodeInit map sb guard =
157 | addStr sb "// GenBlkBrick\n"
158 | match guard with
159 | | DoWhile _ -> addStr sb "do {\n"
160 | | For (init, cond, update) -> forToCodeInit map sb init cond update
161 | | ForIn (bind, expr) -> forInOfToCode map sb " in " bind expr
162 | | ForOf (bind, expr) -> forInOfToCode map sb " of " bind expr
163 | | While cond -> whileToCodeInit map sb cond
164 |
165 | let guardToCodeFini map sb = function
166 | | DoWhile cond ->
167 | addStr sb "} while("
168 | exprToCode map sb cond
169 | addStr sb ");\n"
170 | | _ -> addStr sb "}\n"
171 |
172 | let setGuardSyntax syntax = function
173 | | _ -> { syntax with Loop = true }
174 |
175 | let getGuardLv = function
176 | | _ -> ScopeLv.Block
177 |
--------------------------------------------------------------------------------
/src/Analyzer/Constraint.fs:
--------------------------------------------------------------------------------
1 | namespace Analyzer
2 |
3 | open AST
4 | open Common
5 |
6 | type ScopeLv =
7 | | Block
8 | | Func
9 | | Glob
10 | | Pre
11 |
12 | type PreCond = Map
13 |
14 | type PostCond = Map
15 |
16 | type SyntaxCond = {
17 | Func: bool
18 | Try: bool
19 | Loop: bool
20 | Class: bool
21 | Gen: bool
22 | Async: bool
23 | }
24 |
25 | type Constraint = {
26 | Pre: PreCond
27 | Post: PostCond
28 | Syntax: SyntaxCond
29 | }
30 |
31 | module Constraint =
32 | let emptySyntax = {
33 | Func = false
34 | Try = false
35 | Loop = false
36 | Class = false
37 | Gen = false
38 | Async = false
39 | }
40 |
41 | let empty = {
42 | Pre = Map.empty
43 | Post = Map.empty
44 | Syntax = emptySyntax
45 | }
46 |
47 | let isEmptyVars cons = cons.Pre = Map.empty && cons.Post = Map.empty
48 |
49 | let isSubSyntax big small =
50 | (big.Func || not small.Func) &&
51 | (big.Try || not small.Try) &&
52 | (big.Loop || not small.Loop) &&
53 | (big.Class || not small.Class) &&
54 | (big.Gen || not small.Gen) &&
55 | (big.Async || not small.Async)
56 |
57 | let initPre id ty = { empty with Pre = Map.add id ty Map.empty}
58 |
59 | let addPost id ty lv cons = { cons with Post = Map.add id (ty, lv) cons.Post }
60 |
61 | let addUndefPost lv post id = Map.add id (Undef, lv) post
62 |
63 | let addUndefPre pre id = Map.add id Undef pre
64 |
65 | let addOut cons lv out =
66 | { cons with Post = Set.fold (addUndefPost lv) cons.Post out }
67 |
68 | let addInOut out lv cons =
69 | { cons with Post = Set.fold (addUndefPost lv) cons.Post out
70 | Pre = Set.fold addUndefPre cons.Pre out }
71 |
72 | let initLabel = function
73 | | Some label -> { empty with Pre = Map.add label Label Map.empty
74 | Syntax = { emptySyntax with Loop = true } }
75 | | None -> { empty with Syntax = {emptySyntax with Loop = true } }
76 |
77 | let addLabel cons label = addPost label JSType.Label Glob cons
78 |
79 | let initId isBuiltIn id =
80 | if isBuiltIn id then empty
81 | else { empty with Pre = Map.add id Undef Map.empty
82 | Post = Map.add id (Undef, Pre) Map.empty }
83 |
84 | let setFunc cons = { cons with Syntax = { cons.Syntax with Func = true } }
85 |
86 | let unsetFunc isGen isAsync cons =
87 | let syntax = cons.Syntax
88 | let syntax = { syntax with Func = false
89 | Gen = syntax.Gen && (not isGen)
90 | Async = syntax.Async && (not isAsync) }
91 | { cons with Syntax = syntax }
92 |
93 | let setTry cons = { cons with Syntax = { cons.Syntax with Try = true } }
94 | let unsetTry cons = { cons with Syntax = { cons.Syntax with Try = false } }
95 |
96 | let setLoop cons = { cons with Syntax = { cons.Syntax with Loop = true } }
97 | let unsetLoop cons = { cons with Syntax = { cons.Syntax with Loop = false } }
98 |
99 | let setClass cons = { cons with Syntax = { cons.Syntax with Class = true } }
100 | let unsetClass cons = { cons with Syntax = { cons.Syntax with Class = false } }
101 |
102 | let setGen cons = { cons with Syntax = { cons.Syntax with Gen = true } }
103 |
104 | let setAsync cons = { cons with Syntax = { cons.Syntax with Async = true } }
105 |
106 | let super = { empty with Syntax = { emptySyntax with Class = true } }
107 | let metaProp = { empty with Syntax = { emptySyntax with Func = true } }
108 | let this = metaProp
109 |
110 | let mergeSyntax s1 s2 = {
111 | Func = s1.Func || s2.Func
112 | Try = s1.Try || s2.Try
113 | Loop = s1.Loop || s2.Loop
114 | Class = s1.Class || s2.Class
115 | Gen = s1.Gen || s2.Gen
116 | Async = s1.Async || s2.Async
117 | }
118 |
119 | let glue cons1 cons2 = {
120 | Pre = Map.getKeys cons1.Post |> Map.delKeys cons2.Pre |> Map.merge cons1.Pre
121 | Post = Map.merge cons1.Post cons2.Post
122 | Syntax = mergeSyntax cons1.Syntax cons2.Syntax
123 | }
124 |
125 | let union cons1 cons2 = {
126 | Pre = Map.merge cons1.Pre cons2.Pre
127 | Post = Map.merge cons1.Post cons2.Post
128 | Syntax = mergeSyntax cons1.Syntax cons2.Syntax
129 | }
130 |
131 | let normalize cons map =
132 | { cons with Pre = Map.mapKey (Map.get map) cons.Pre
133 | Post = Map.mapKey (Map.get map) cons.Post }
134 |
135 | let rmPost id cons = { cons with Post = Map.remove id cons.Post }
136 |
137 | let logPre = Expr.Id "codealchemist_log_type_pre" |> Callee.Expr
138 |
139 | let logPost = Expr.Id "codealchemist_log_type_post" |> Callee.Expr
140 |
141 | let undef = Expr.Id "undefined"
142 | let undefStr = Literal.String "'undefined'" |> Expr.Literal
143 |
144 | let mkLoggerVal id =
145 | let test = Binary (BinOp.Neq, Unary (UnOp.TypeOf, id), undefStr)
146 | Cond (test, id, undef) |> PropVal.Expr
147 |
148 | let mkLoggerVar map id =
149 | let nId = Map.find id map |> Expr.Id
150 | nId, Expr.Id id |> mkLoggerVal, PropKind.Init, false, false
151 |
152 | let mkLogger func hval map cond =
153 | let vars = Map.filterVal JSType.isUndef cond |> Map.getKeys
154 | |> Array.map (mkLoggerVar map)
155 | |> Expr.Object |> Arg.Expr
156 | Stmt.Expr (Expr.Call (func, [|hval; vars|]), None)
157 |
158 | let getLogger (hval: int64) map cons =
159 | let hval = sprintf "'%d'" hval |> Literal.String |> Expr.Literal |> Arg.Expr
160 | mkLogger logPre hval map cons.Pre,
161 | Map.mapVal fst cons.Post |> mkLogger logPost hval map
162 |
163 | let assign op out cons =
164 | match op with
165 | | AssignOp.Assign -> addOut cons Pre out
166 | | _ -> addInOut out Pre cons
167 |
168 | let filterPost tlv _ (_, lv) = tlv <> lv
169 |
170 | let filtPost lv cons =
171 | { cons with Post = Map.filter (filterPost lv) cons.Post }
172 |
173 | let finiBlock cons = filtPost Block cons
174 |
175 | let finiFuncExpr id isGen isAsync params_ cons1 cons2 =
176 | let cons1 =
177 | match id with
178 | | Some id -> Set.add id params_
179 | | None -> params_
180 | |> Set.add "arguments" |> addOut cons1 Func
181 | glue cons1 { cons2 with Post = Map.empty }
182 | |> filtPost Func |> unsetFunc isGen isAsync
183 |
184 | let finiFuncDecl id isGen isAsync params_ cons1 cons2 =
185 | finiFuncExpr (Some id) isGen isAsync params_ cons1 cons2
186 | |> addPost id JSType.Function Func
187 |
188 | let finiFor cons = finiBlock cons |> unsetLoop
189 |
190 | let finiSwitch = finiFor
191 |
192 | let finiTry cons = finiBlock cons |> unsetTry
193 |
194 | let finiVarDeclr kind out cons =
195 | let lv = match kind with
196 | | Let -> Block
197 | | _ -> Func
198 | addOut cons lv out
199 |
200 | let finiClass id cons = addPost id JSType.Object Func cons |> unsetClass
201 |
202 | let finiClassExpr id cons1 cons2 =
203 | match id with
204 | | Some id -> glue (addPost id JSType.Object Func cons1) cons2 |> rmPost id
205 | | None -> glue cons1 cons2
206 | |> unsetClass
207 |
208 | let finiCatch out cons1 cons2 =
209 | glue (addOut cons1 Block out) cons2 |> finiBlock
210 |
211 | let loadTypePost post id ty =
212 | match Map.tryFind id post with
213 | | Some (_, scope) ->
214 | if JSType.isUndef ty then Map.remove id post
215 | else Map.add id (ty, scope) post
216 | | None -> post
217 |
218 | let loadTypePre pre id ty =
219 | match Map.tryFind id pre with
220 | | Some _ ->
221 | if JSType.isUndef ty then Map.remove id pre
222 | else Map.add id ty pre
223 | | _ -> pre
224 |
225 | let loadTypes cons pre post =
226 | { cons with Pre = Map.fold loadTypePre cons.Pre pre
227 | Post = Map.fold loadTypePost cons.Post post }
228 |
--------------------------------------------------------------------------------
/src/Analyzer/Instrument.fs:
--------------------------------------------------------------------------------
1 | module Analyzer.Instrument
2 |
3 | open System
4 | open AST
5 | open Common
6 | open Common.Utils
7 |
8 | let private (=>) (ast, ctx, cons) f = (f ast, ctx, cons)
9 | let private (==>) (ast, ctx, cons, out) f = (f ast, ctx, cons, out)
10 | let private (+>) cons1 cons2 = Constraint.glue cons1 cons2
11 | let private (+=) cons1 cons2 = Constraint.union cons1 cons2
12 | let private packOut f (ast, ctx, cons) = (f ast, ctx, cons, Set.empty)
13 |
14 | let private folder f g (args, ctx, cons) arg =
15 | let arg, ctx, cons1 = f arg ctx
16 | arg :: args, ctx, g cons cons1
17 |
18 | let private fold ctx f g args =
19 | Array.fold (folder f g) ([], ctx, Constraint.empty) args => Array.revList
20 |
21 | let private foldG ctx f args = fold ctx f (+>) args
22 | let private foldU ctx f args = fold ctx f (+=) args
23 |
24 | let private folder2 f (args, ctx, cons, out) arg =
25 | let arg, ctx, cons1, out1 = f arg ctx
26 | arg :: args, ctx, cons +> cons1, out + out1
27 |
28 | let private fold2 ctx f args =
29 | Array.fold (folder2 f) ([], ctx, Constraint.empty, Set.empty) args
30 | ==> Array.revList
31 |
32 | let private folder3 f g (args, ctx, cons) arg =
33 | let args1, ctx, cons1 = f arg ctx
34 | args1 :: args, ctx, g cons cons1
35 |
36 | let private fold3 ctx f g args =
37 | Array.fold (folder3 f g) ([], ctx, Constraint.empty) args
38 | => (Array.revList >> Array.concat)
39 |
40 | let private fold3G ctx f args = fold3 ctx f (+>) args
41 | let private fold3U ctx f args = fold3 ctx f (+=) args
42 |
43 | let toStmtList stmts = Array.map StmtListItem.Stmt stmts
44 |
45 | let toBlock stmts =
46 | match stmts with
47 | | [| Stmt.Block stmts |] -> Stmt.Block stmts
48 | | stmts -> toStmtList stmts |> Stmt.Block
49 |
50 | let mkVarStmt id expr =
51 | (Var, [| Binding.Id id, Some expr |]) |> Stmt.VarDecl
52 |
53 | let addRetThrowLogger conv brick ctx cons arg =
54 | let pre, post = CodeBrick.getLoggers brick cons
55 | let id = CodeBrick.getTempVar brick
56 | let assign = mkVarStmt id arg
57 | [|pre; assign; post; Expr.Id id |> conv|], ctx, cons
58 |
59 | let addRetLogger brick ctx cons = function
60 | | Some expr -> addRetThrowLogger (Some >> Return) brick ctx cons expr
61 | | None -> [|Return None|], ctx, cons
62 |
63 | let addStmtLogger brick (stmt, ctx, cons) =
64 | match stmt with
65 | | Stmt.Block _ | Break _ | Continue _ | Debugger | Stmt.Empty ->
66 | [|stmt|], ctx, cons
67 | | Stmt.Return arg -> addRetLogger brick ctx cons arg
68 | | Stmt.Throw arg -> addRetThrowLogger Throw brick ctx cons arg
69 | | stmt -> let pre, post = CodeBrick.getLoggers brick cons
70 | [|pre; stmt; post|], ctx, cons
71 |
72 | let addDeclLogger brick (decl, ctx, cons) =
73 | let pre, post = CodeBrick.getLoggers brick cons
74 | [|StmtListItem.Stmt pre; decl; StmtListItem.Stmt post|], ctx, cons
75 |
76 | let addBlockLogger brick (stmts, ctx, cons) =
77 | let pre, post = CodeBrick.getLoggers brick cons
78 | Array.concat [|[|StmtListItem.Stmt pre|]; stmts; [|StmtListItem.Stmt post|]|],
79 | ctx, cons
80 |
81 | let updateStmt brick (stmt, ctx, cons) =
82 | match Context.addBrick ctx cons brick with
83 | | ctx, true -> addStmtLogger brick (stmt, ctx, cons)
84 | | ctx, false -> [|stmt|], ctx, cons
85 |
86 | let updateDecl brick (decl, ctx, cons) =
87 | match Context.addBrick ctx cons brick with
88 | | ctx, true -> addDeclLogger brick (decl, ctx, cons)
89 | | ctx, false -> [|decl|], ctx, cons
90 |
91 | let updateGuard ctx cons sHash guard =
92 | CodeBrick.ofGuard guard ctx |> Context.addGBrick ctx cons sHash
93 |
94 | let updateBlock brick (block, ctx, cons) =
95 | match Context.addBrick ctx cons brick with
96 | | ctx, true -> addBlockLogger brick (block, ctx, cons) => Stmt.Block
97 | | ctx, false -> Stmt.Block block, ctx, cons
98 |
99 | let inline toUnary op (expr, ctx, cons) = Unary (op, expr), ctx, cons
100 |
101 | let rec rewriteStmtList stmts ctx = fold3G ctx rewriteStmtItem stmts
102 |
103 | and rewriteStmtItem item ctx =
104 | match item with
105 | | StmtListItem.Stmt stmt -> rewriteStmt stmt ctx => toStmtList
106 | | StmtListItem.Decl decl -> rewriteDecl decl ctx
107 |
108 | and rewriteStmt stmt ctx =
109 | let brick = CodeBrick.ofStmt stmt ctx
110 | match stmt with
111 | | Stmt.Block stmts -> rewriteBlock stmts ctx |> updateBlock brick
112 | | Break label -> rewriteLabel Break label ctx
113 | | Continue label -> rewriteLabel Continue label ctx
114 | | DoWhile (body, test) -> rewriteDoWhile body test ctx brick.Hash
115 | | Stmt.Expr (expr, dir) -> rewriteExprStmt expr dir ctx
116 | | For (init, test, update, body) ->
117 | rewriteFor init test update body ctx brick.Hash
118 | | ForIn (bind, expr, body) -> rewriteForIn bind expr body ctx brick.Hash
119 | | ForOf (bind, expr, body) -> rewriteForOf bind expr body ctx brick.Hash
120 | | Stmt.FuncDecl decl -> rewriteFuncDecl decl ctx
121 | | If (test, tStmt, fStmt) -> rewriteIf test tStmt fStmt ctx
122 | | Labeled (label, body) -> rewriteLabeled label body ctx
123 | | Return arg -> rewriteReturn arg ctx
124 | | Switch (test, cases) -> rewriteSwitch test cases ctx
125 | | Throw arg -> rewriteThrow arg ctx
126 | | Try (body, catch, final) -> rewriteTry body catch final ctx
127 | | Stmt.VarDecl decl -> rewriteVarDeclStmt decl ctx
128 | | While (test, body) -> rewriteWhile test body ctx brick.Hash
129 | | With (expr, body) -> rewriteWith expr body ctx
130 | // Debugger, Empty
131 | | stmt -> rewriteEmpty stmt ctx
132 | |> updateStmt brick
133 |
134 | and rewriteStmtOpt stmt ctx =
135 | match stmt with
136 | | Some stmt -> rewriteStmt stmt ctx => (toBlock >> Some)
137 | | None -> None, ctx, Constraint.empty
138 |
139 | and rewriteDecl decl ctx =
140 | match decl with
141 | | Decl.ClassDecl decl -> rewriteClassDecl decl ctx => StmtListItem.Decl
142 | | Decl.VarDecl decl -> rewriteVarDeclStmt decl ctx => StmtListItem.Stmt
143 | | Decl.FuncDecl decl -> rewriteFuncDecl decl ctx => StmtListItem.Stmt
144 | |> updateDecl (CodeBrick.ofDecl decl ctx)
145 |
146 | and rewriteExpr expr ctx =
147 | match expr with
148 | | Expr.Id id -> expr, ctx, Constraint.initId ctx.IsBuiltIn id
149 | | TempLiteral temp -> rewriteTempLiteral temp ctx => TempLiteral
150 | | Array elems -> foldG ctx rewriteArrayElem elems => Array
151 | | Object props -> rewriteObject props ctx
152 | | Function expr -> rewriteFuncExpr expr ctx => Function
153 | | ArrowFunction (id, params_, body, isGen, isAsync) ->
154 | rewriteArrowFunc id params_ body isGen isAsync ctx
155 | | Class (id, extends, defs) -> rewriteClassExpr id extends defs ctx
156 | | TaggedTemp (expr, temp) -> rewriteTaggedTemp expr temp ctx
157 | | Member expr -> rewriteMemberExpr expr ctx => Member
158 | | Super -> expr, ctx, Constraint.super
159 | | New (expr, args) -> rewriteNew expr args ctx
160 | | Call (callee, args) -> rewriteCall callee args ctx
161 | | Update (op, expr, isPre) -> rewriteUpdate op expr isPre ctx
162 | | Await expr -> rewriteAwait expr ctx
163 | | Unary (op, expr) -> rewriteExpr expr ctx |> toUnary op
164 | | Binary (op, e1, e2) -> rewriteBinary op e1 e2 ctx
165 | | Logic (op, e1, e2) -> rewriteLogic op e1 e2 ctx
166 | | Cond (cond, tExpr, fExpr) -> rewriteCond cond tExpr fExpr ctx
167 | | Yield (arg, isGen) -> rewriteYield arg isGen ctx
168 | | Assign (op, left, expr) -> rewriteAssign op left expr ctx
169 | | Seq exprs -> foldG ctx rewriteExpr exprs => Seq
170 | | MetaProp _ -> expr, ctx, Constraint.metaProp
171 | | This -> This, ctx, Constraint.this
172 | // Literal
173 | | _ -> expr, ctx, Constraint.empty
174 |
175 | and rewriteExprOpt expr ctx =
176 | match expr with
177 | | Some expr -> rewriteExpr expr ctx => Some
178 | | None -> None, ctx, Constraint.empty
179 |
180 | and rewriteBlock stmts ctx =
181 | let stmts, ctx, cons = rewriteStmtList stmts ctx
182 | stmts, ctx, Constraint.finiBlock cons
183 |
184 | and rewriteBlockOpt stmts ctx =
185 | match stmts with
186 | | Some stmts -> rewriteBlock stmts ctx => Some
187 | | None -> None, ctx, Constraint.empty
188 |
189 | and rewriteLabel conv label ctx = conv label, ctx, Constraint.initLabel label
190 |
191 | and rewriteDoWhile body test ctx sHash =
192 | let guard = Guard.DoWhile test
193 | let body, ctx, cons1 = rewriteStmt body ctx => toBlock
194 | let test, ctx, cons2 = rewriteExpr test ctx
195 | let ctx = updateGuard ctx cons2 sHash guard
196 | (DoWhile (body, test), ctx, cons1 +> cons2 |> Constraint.unsetLoop)
197 |
198 | and rewriteExprStmt expr dir ctx =
199 | let expr, ctx, cons = rewriteExpr expr ctx
200 | Stmt.Expr (expr, dir), ctx, cons
201 |
202 | and rewriteFor init test update body ctx sHash =
203 | let guard = Guard.For (init, test, update)
204 | let init, ctx, cons1 = rewriteForInit init ctx
205 | let test, ctx, cons2 = rewriteExprOpt test ctx
206 | let body, ctx, cons3 = rewriteStmt body ctx => toBlock
207 | let update, ctx, cons4 = rewriteExprOpt update ctx
208 | let ctx = updateGuard ctx (cons1 +> cons2 +> cons4) sHash guard
209 | ( For (init, test, update, body), ctx,
210 | cons1 +> cons2 +> cons3 +> cons4 |> Constraint.finiFor )
211 |
212 | and rewriteForInit init ctx =
213 | match init with
214 | | Some (ForInit.Expr expr) -> rewriteExpr expr ctx => (ForInit.Expr >> Some)
215 | | Some (ForInit.VarDecl decl) ->
216 | rewriteVarDecl decl ctx => (ForInit.VarDecl >> Some)
217 | | None -> None, ctx, Constraint.empty
218 |
219 | and rewriteVarDecl (kind, declr) ctx =
220 | let declr, ctx, cons = foldG ctx (rewriteVarDeclr kind) declr
221 | (kind, declr), ctx, cons
222 |
223 | and rewriteVarDeclr kind (bind, init) ctx =
224 | let bind, ctx, cons1, out = rewriteBinding bind ctx
225 | let init, ctx, cons2 = rewriteExprOpt init ctx
226 | (bind, init), ctx, cons1 +> cons2 |> Constraint.finiVarDeclr kind out
227 |
228 | and rewriteForIn bind expr body ctx sHash =
229 | let guard = Guard.ForIn (bind, expr)
230 | let bind, ctx, cons1 = rewriteForBind bind ctx
231 | let expr, ctx, cons2 = rewriteExpr expr ctx
232 | let body, ctx, cons3 = rewriteStmt body ctx => toBlock
233 | let ctx = updateGuard ctx (cons1 +> cons2) sHash guard
234 | ForIn (bind, expr, body), ctx, cons1 +> cons2 +> cons3 |> Constraint.finiFor
235 |
236 | and rewriteForOf bind expr body ctx sHash =
237 | let guard = Guard.ForOf (bind, expr)
238 | let bind, ctx, cons1 = rewriteForBind bind ctx
239 | let expr, ctx, cons2 = rewriteExpr expr ctx
240 | let body, ctx, cons3 = rewriteStmt body ctx => toBlock
241 | let ctx = updateGuard ctx (cons1 +> cons2) sHash guard
242 | ForOf (bind, expr, body), ctx, cons1 +> cons2 +> cons3 |> Constraint.finiFor
243 |
244 | and rewriteForBind bind ctx =
245 | match bind with
246 | | ForBind.VarDecl decl -> rewriteVarDecl decl ctx => ForBind.VarDecl
247 | | ForBind.Binding bind ->
248 | let bind, ctx, cons, out = rewriteBinding bind ctx
249 | ForBind.Binding bind, ctx, Constraint.addOut cons Glob out
250 |
251 | and rewriteFuncDecl (id, params_, body, isGen, isAsync) ctx =
252 | let params_, ctx, cons1, out = fold2 ctx rewriteParam params_
253 | let body, ctx, cons2 = rewriteBlock body ctx
254 | ( Stmt.FuncDecl (id, params_, body, isGen, isAsync), ctx,
255 | Constraint.finiFuncDecl id isGen isAsync out cons1 cons2 )
256 |
257 | and rewriteParam param ctx =
258 | match param with
259 | | Param.Id id -> param, ctx, Constraint.empty, Set.init id
260 | | Param.BindingPt pt -> rewriteBindingPt pt ctx ==> Param.BindingPt
261 | | Param.AssignPt pt -> rewriteAssignPt pt ctx ==> Param.AssignPt
262 | | Param.RestElem bind -> rewriteBinding bind ctx ==> Param.RestElem
263 |
264 | and rewriteIf test tStmt fStmt ctx =
265 | let test, ctx, cons1 = rewriteExpr test ctx
266 | let tStmt, ctx, cons2 = rewriteStmt tStmt ctx => toBlock
267 | let fStmt, ctx, cons3 = rewriteStmtOpt fStmt ctx
268 | If (test, tStmt, fStmt), ctx, cons1 +> (cons2 += cons3)
269 |
270 | and rewriteLabeled label body ctx =
271 | let body, ctx, cons = rewriteStmt body ctx => toBlock
272 | Labeled (label, body), ctx, Constraint.addLabel cons label
273 |
274 | and rewriteReturn arg ctx =
275 | let arg, ctx, cons = rewriteExprOpt arg ctx
276 | Return arg, ctx, Constraint.setFunc cons
277 |
278 | and rewriteSwitch test cases ctx =
279 | let test, ctx, cons1 = rewriteExpr test ctx
280 | let cases, ctx, cons2 = foldU ctx rewriteCase cases
281 | Switch (test, cases), ctx, cons1 +> cons2 |> Constraint.finiSwitch
282 |
283 | and rewriteCase (expr, body) ctx =
284 | let expr, ctx, cons1 = rewriteExprOpt expr ctx
285 | let body, ctx, cons2 = fold3U ctx rewriteStmt body
286 | Case (expr, body), ctx, cons1 +> cons2
287 |
288 | and rewriteThrow arg ctx =
289 | let arg, ctx, cons = rewriteExpr arg ctx
290 | Throw arg, ctx, Constraint.setTry cons
291 |
292 | and rewriteTry body catch final ctx =
293 | let body, ctx, cons1 = rewriteBlock body ctx
294 | let catch, ctx, cons2 = rewriteCatch catch ctx
295 | let final, ctx, cons3 = rewriteBlockOpt final ctx
296 | Try (body, catch, final), ctx, (Constraint.finiTry cons1) +> cons2 +> cons3
297 |
298 | and rewriteCatch catch ctx =
299 | match catch with
300 | | Some (bind, body) ->
301 | let bind, ctx, cons1, out = rewriteBindingOpt bind ctx
302 | let body, ctx, cons2 = rewriteBlock body ctx
303 | Some (bind, body), ctx, Constraint.finiCatch out cons1 cons2
304 | | None -> None, ctx, Constraint.empty
305 |
306 | and rewriteVarDeclStmt decl ctx = rewriteVarDecl decl ctx => Stmt.VarDecl
307 |
308 | and rewriteWhile test body ctx sHash =
309 | let guard = Guard.While test
310 | let test, ctx, cons1 = rewriteExpr test ctx
311 | let body, ctx, cons2 = rewriteStmt body ctx => toBlock
312 | let ctx = updateGuard ctx cons1 sHash guard
313 | While (test, body), ctx, cons1 +> cons2 |> Constraint.unsetLoop
314 |
315 | and rewriteWith expr body ctx =
316 | let expr, ctx, cons1 = rewriteExpr expr ctx
317 | let body, ctx, cons2 = rewriteStmt body ctx => toBlock
318 | With (expr, body), ctx, cons1 +> cons2
319 |
320 | and rewriteEmpty stmt ctx = stmt, ctx, Constraint.empty
321 |
322 | and rewriteClassDecl (id, extends, defs) ctx =
323 | let extends, ctx, cons1 = rewriteExprOpt extends ctx
324 | let defs, ctx, cons2 = foldU ctx rewriteDef defs
325 | ClassDecl (id, extends, defs), ctx, cons1 +> cons2 |> Constraint.finiClass id
326 |
327 | and rewriteDef (key, body, kind, isComputed, isStatic) ctx =
328 | let key, ctx, cons1 = rewriteMemName key isComputed ctx
329 | let body, ctx, cons2 = rewriteFuncExpr body ctx
330 | (key, body, kind, isComputed, isStatic), ctx, cons1 +> cons2
331 |
332 | and rewriteTempLiteral (strs, exprs) ctx =
333 | let exprs, ctx, cons = foldG ctx rewriteExpr exprs
334 | (strs, exprs), ctx, cons
335 |
336 | and rewriteArrayElem elem ctx =
337 | match elem with
338 | | ArrayElem.Expr expr -> rewriteExpr expr ctx => ArrayElem.Expr
339 | | ArrayElem.Spread expr -> rewriteExpr expr ctx => ArrayElem.Spread
340 | | ArrayElem.Empty -> elem, ctx, Constraint.empty
341 |
342 | and rewriteObject props ctx =
343 | let props, ctx, cons, _ = fold2 ctx (rewriteProp true) props
344 | Object props, ctx, cons
345 |
346 | and rewriteProp isExpr (key, value, kind, isComputed, isShort) ctx =
347 | let key, ctx, cons1 = rewriteMemName key isComputed ctx
348 | let value, ctx, cons2, out = rewritePropVal isExpr value ctx
349 | (key, value, kind, isComputed, isShort), ctx, cons1 +> cons2, out
350 |
351 | and rewritePropVal isExpr value ctx =
352 | match value with
353 | | PropVal.Expr ((Expr.Id id) as expr) ->
354 | if isExpr then rewriteExpr expr ctx |> packOut PropVal.Expr
355 | else value, ctx, Constraint.empty, Set.init id
356 | | PropVal.Expr expr -> rewriteExpr expr ctx |> packOut PropVal.Expr
357 | | PropVal.BindingPt pt -> rewriteBindingPt pt ctx ==> PropVal.BindingPt
358 | | PropVal.AssignPt pt -> rewriteAssignPt pt ctx ==> PropVal.AssignPt
359 | | PropVal.Empty -> value, ctx, Constraint.empty, Set.empty
360 |
361 | and rewriteFuncExpr (id, params_, body, isGen, isAsync) ctx =
362 | let params_, ctx, cons1, out = fold2 ctx rewriteParam params_
363 | let body, ctx, cons2 = rewriteBlock body ctx
364 | ( (id, params_, body, isGen, isAsync), ctx,
365 | Constraint.finiFuncExpr id isGen isAsync out cons1 cons2 )
366 |
367 | and rewriteArrowFunc id params_ body isGen isAsync ctx =
368 | let params_, ctx, cons1, out = fold2 ctx rewriteParam params_
369 | let body, ctx, cons2 = rewriteArrowFuncBody body ctx
370 | ( ArrowFunction (id, params_, body, isGen, isAsync), ctx,
371 | Constraint.finiFuncExpr id isGen isAsync out cons1 cons2 )
372 |
373 | and rewriteArrowFuncBody body ctx =
374 | match body with
375 | | ArrowFuncBody.Block stmts -> rewriteBlock stmts ctx => ArrowFuncBody.Block
376 | | ArrowFuncBody.Expr expr -> rewriteExpr expr ctx => ArrowFuncBody.Expr
377 |
378 | and rewriteClassExpr id extends defs ctx =
379 | let extends, ctx, cons1 = rewriteExprOpt extends ctx
380 | let defs, ctx, cons2 = foldU ctx rewriteDef defs
381 | Expr.Class (id, extends, defs), ctx, Constraint.finiClassExpr id cons1 cons2
382 |
383 | and rewriteTaggedTemp expr temp ctx =
384 | let expr, ctx, cons1 = rewriteExpr expr ctx
385 | let temp, ctx, cons2 = rewriteTempLiteral temp ctx
386 | TaggedTemp (expr, temp), ctx, cons1 +> cons2
387 |
388 | and rewriteMemberExpr (expr, key, isComputed) ctx =
389 | let expr, ctx, cons1 = rewriteExpr expr ctx
390 | let key, ctx, cons2 = rewriteMemName key isComputed ctx
391 | (expr, key, isComputed), ctx, cons1 +> cons2
392 |
393 | and rewriteMemName key isComputed ctx =
394 | if isComputed then rewriteExpr key ctx
395 | else key, ctx, Constraint.empty
396 |
397 | and rewriteNew expr args ctx =
398 | let expr, ctx, cons1 = rewriteExpr expr ctx
399 | let args, ctx, cons2 = foldG ctx rewriteArg args
400 | New (expr, args), ctx, cons1 +> cons2
401 |
402 | and rewriteArg arg ctx =
403 | match arg with
404 | | Arg.Expr expr -> rewriteExpr expr ctx => Arg.Expr
405 | | Arg.Spread expr -> rewriteExpr expr ctx => Arg.Spread
406 |
407 | and rewriteCall callee args ctx =
408 | let callee, ctx, cons1 =
409 | match callee with
410 | | Callee.Expr expr -> rewriteExpr expr ctx => Callee.Expr
411 | | Callee.Import -> callee, ctx, Constraint.empty
412 | let args, ctx, cons2 = foldG ctx rewriteArg args
413 | Call (callee, args), ctx, cons1 +> cons2
414 |
415 | and rewriteUpdate op expr isPre ctx =
416 | let expr, ctx, cons = rewriteExpr expr ctx
417 | Update (op, expr, isPre), ctx, cons
418 |
419 | and rewriteAwait expr ctx =
420 | let expr, ctx, cons = rewriteExpr expr ctx
421 | Await expr, ctx, Constraint.setAsync cons
422 |
423 | and rewriteBinary op e1 e2 ctx =
424 | let e1, ctx, cons1 = rewriteExpr e1 ctx
425 | let e2, ctx, cons2 = rewriteExpr e2 ctx
426 | Binary (op, e1, e2), ctx, cons1 +> cons2
427 |
428 | and rewriteLogic op e1 e2 ctx =
429 | let e1, ctx, cons1 = rewriteExpr e1 ctx
430 | let e2, ctx, cons2 = rewriteExpr e2 ctx
431 | Logic (op, e1, e2), ctx, cons1 +> cons2
432 |
433 | and rewriteCond cond tExpr fExpr ctx =
434 | let cond, ctx, cons1 = rewriteExpr cond ctx
435 | let tExpr, ctx, cons2 = rewriteExpr tExpr ctx
436 | let fExpr, ctx, cons3 = rewriteExpr fExpr ctx
437 | Cond (cond, tExpr, fExpr), ctx, cons1 +> (cons2 += cons3)
438 |
439 | and rewriteYield arg isGen ctx =
440 | let arg, ctx, cons = rewriteExprOpt arg ctx
441 | Yield (arg, isGen), ctx, Constraint.setGen cons
442 |
443 | and rewriteAssign op left expr ctx =
444 | let left, ctx, cons1, out = rewriteAssignLeft left ctx
445 | let expr, ctx, cons2 = rewriteExpr expr ctx
446 | ( Assign (op, left, expr), ctx, cons1 +> cons2 |> Constraint.assign op out )
447 |
448 | and rewriteAssignLeft left ctx =
449 | match left with
450 | | AssignLeft.Binding bind -> rewriteBinding bind ctx ==> AssignLeft.Binding
451 | | AssignLeft.Expr expr -> rewriteExpr expr ctx |> packOut AssignLeft.Expr
452 |
453 | and rewriteBinding bind ctx =
454 | match bind with
455 | | Binding.Id id -> bind, ctx, Constraint.empty, Set.init id
456 | | Binding.BindingPt pt -> rewriteBindingPt pt ctx ==> Binding.BindingPt
457 | | Binding.AssignPt pt -> rewriteAssignPt pt ctx ==> Binding.AssignPt
458 | | Binding.MemberExpr expr -> rewriteMemberPt expr ctx ==> Binding.MemberExpr
459 |
460 | and rewriteBindingOpt bind ctx =
461 | match bind with
462 | | Some bind -> rewriteBinding bind ctx ==> Some
463 | | None -> None, ctx, Constraint.empty, Set.empty
464 |
465 | and rewriteBindingPt pt ctx =
466 | match pt with
467 | | ArrayPt elems -> fold2 ctx rewriteArrayPtElem elems ==> ArrayPt
468 | | ObjectPt props -> fold2 ctx (rewriteProp false) props ==> ObjectPt
469 |
470 | and rewriteArrayPtElem elem ctx =
471 | match elem with
472 | | ArrayPtElem.Id id -> elem, ctx, Constraint.empty, Set.init id
473 | | ArrayPtElem.BindingPt pt ->
474 | rewriteBindingPt pt ctx ==> ArrayPtElem.BindingPt
475 | | ArrayPtElem.AssignPt pt -> rewriteAssignPt pt ctx ==> ArrayPtElem.AssignPt
476 | | ArrayPtElem.RestElem bind ->
477 | rewriteBinding bind ctx ==> ArrayPtElem.RestElem
478 | | ArrayPtElem.MemberExpr expr ->
479 | rewriteMemberPt expr ctx ==> ArrayPtElem.MemberExpr
480 | | ArrayPtElem.Empty -> elem, ctx, Constraint.empty, Set.empty
481 |
482 | and rewriteAssignPt (bind, expr) ctx =
483 | let bind, ctx, cons1, out = rewriteBinding bind ctx
484 | let expr, ctx, cons2 = rewriteExpr expr ctx
485 | (bind, expr), ctx, cons1 +> cons2, out
486 |
487 | and rewriteMemberPt expr ctx =
488 | let expr, ctx, cons = rewriteMemberExpr expr ctx
489 | expr, ctx, cons, Set.empty
490 |
491 | let rewriteProg ctx = function
492 | | Script stmts -> let stmts, ctx, _ = rewriteStmtList stmts ctx
493 | Script stmts, (ctx.Pool, ctx.GuardMap)
494 | | Module _ -> Logger.error "Module is not supported"
495 |
496 | let getJsLibPath engine =
497 | let dir = Reflection.Assembly.GetExecutingAssembly().Location |> getDirName
498 | let js = (Conf.engineToStr engine) + ".js"
499 | dir +/ "jsLib" +/ js
500 |
501 | let getLoader = function
502 | | Chakra -> sprintf "WScript.LoadScriptFile('%s');\n"
503 | | engine -> sprintf "load('%s');\n"
504 |
505 | let mkLoader engine = getJsLibPath engine |> getLoader engine
506 |
--------------------------------------------------------------------------------
/src/Analyzer/JSType.fs:
--------------------------------------------------------------------------------
1 | namespace Analyzer
2 |
3 | exception LoadJSTypeException of string
4 |
5 | type JSType =
6 | | PriBoolean
7 | | Null
8 | | Undef
9 | | PriNumber
10 | | PriString
11 | | PriSymbol
12 | | Object
13 | | Array
14 | | ArrayBuffer
15 | | Boolean
16 | | DataView
17 | | Date
18 | | Error
19 | | EvalError
20 | | Float32Array
21 | | Float64Array
22 | | Function
23 | | Class
24 | | Int16Array
25 | | Int32Array
26 | | Int8Array
27 | | IntlCollator
28 | | IntlDateTimeFormat
29 | | IntlNumberFormat
30 | | IntlPluralRules
31 | | Map
32 | | Number
33 | | Promise
34 | | Proxy
35 | | RangeError
36 | | ReferenceError
37 | | RegExp
38 | | Set
39 | | SharedArrayBuffer
40 | | String
41 | | Symbol
42 | | SyntaxError
43 | | TypeError
44 | | URIError
45 | | Uint16Array
46 | | Uint32Array
47 | | Uint8Array
48 | | Uint8ClampedArray
49 | | WeakMap
50 | | WeakSet
51 | (* Expreimental Types *)
52 | | WebAssemblyModule
53 | | WebAssemblyInstance
54 | | WebAssemblyMemory
55 | | WebAssemblyTable
56 | | WebAssemblyCompileError
57 | | WebAssemblyLinkError
58 | | WebAssemblyRuntimeError
59 | | Worker
60 | | BigUint64Array
61 | | BigInt64Array
62 | | BigInt
63 | | Label
64 |
65 | module JSType =
66 | let ofStr = function
67 | | "boolean" -> PriBoolean
68 | | "null" -> Null
69 | | "undefined" -> Undef
70 | | "number" -> PriNumber
71 | | "string" -> PriString
72 | | "symbol" -> PriSymbol
73 | | "function" -> Function
74 | | "object" -> Object
75 | | "bigint" -> BigInt
76 | | "Array" -> Array
77 | | "ArrayBuffer" -> ArrayBuffer
78 | | "Boolean" -> Boolean
79 | | "BigUint64Array" -> BigUint64Array
80 | | "BigInt64Array" -> BigInt64Array
81 | | "DataView" -> DataView
82 | | "Date" -> Date
83 | | "Error" -> Error
84 | | "EvalError" -> EvalError
85 | | "Float32Array" -> Float32Array
86 | | "Float64Array" -> Float64Array
87 | | "Function" -> Function
88 | | "Int16Array" -> Int16Array
89 | | "Int32Array" -> Int32Array
90 | | "Int8Array" -> Int8Array
91 | | "IntlCollator" -> IntlCollator
92 | | "Intl.Collator" -> IntlCollator
93 | | "Intl.DateTimeFormat" -> IntlDateTimeFormat
94 | | "Intl.NumberFormat" -> IntlNumberFormat
95 | | "Map" -> Map
96 | | "Number" -> Number
97 | | "Promise" -> Promise
98 | | "Proxy" -> Proxy
99 | | "RangeError" -> RangeError
100 | | "ReferenceError" -> ReferenceError
101 | | "RegExp" -> RegExp
102 | | "Set" -> Set
103 | | "SharedArrayBuffer" -> SharedArrayBuffer
104 | | "String" -> String
105 | | "Symbol" -> Symbol
106 | | "SyntaxError" -> SyntaxError
107 | | "TypeError" -> TypeError
108 | | "URIError" -> URIError
109 | | "Uint16Array" -> Uint16Array
110 | | "Uint32Array" -> Uint32Array
111 | | "Uint8Array" -> Uint8Array
112 | | "Uint8ClampedArray" -> Uint8ClampedArray
113 | | "WeakMap" -> WeakMap
114 | | "WeakSet" -> WeakSet
115 | (* Expreimental Types *)
116 | | "WebAssembly.Module" -> WebAssemblyModule
117 | | "WebAssembly.Instance" -> WebAssemblyInstance
118 | | "WebAssembly.Memory" -> WebAssemblyMemory
119 | | "WebAssembly.Table" -> WebAssemblyTable
120 | | "WebAssembly.CompileError" -> WebAssemblyCompileError
121 | | "WebAssembly.LinkError" -> WebAssemblyLinkError
122 | | "WebAssembly.RuntimeError" -> WebAssemblyRuntimeError
123 | | "Class" -> Class
124 | | "Worker" -> Worker
125 | | e -> LoadJSTypeException e |> raise
126 |
127 | let isUndef = function
128 | | Undef -> true
129 | | _ -> false
130 |
--------------------------------------------------------------------------------
/src/Analyzer/jsLib/Chakra.js:
--------------------------------------------------------------------------------
1 | var load = WScript.LoadScriptFile;
2 |
3 | var codealchemist_types = {
4 | "Function" : Function,
5 | "Boolean" : Boolean,
6 | "Symbol" : Symbol,
7 | "Error" : Error,
8 | "EvalError" : EvalError,
9 | "RangeError" : RangeError,
10 | "ReferenceError" : ReferenceError,
11 | "SyntaxError" : SyntaxError,
12 | "TypeError" : TypeError,
13 | "URIError" : URIError,
14 | "Number" : Number,
15 | "Date" : Date,
16 | "String" : String,
17 | "RegExp" : RegExp,
18 | "Array" : Array,
19 | "Int8Array" : Int8Array,
20 | "Uint8Array" : Uint8Array,
21 | "Uint8ClampedArray" : Uint8ClampedArray,
22 | "Int16Array" : Int16Array,
23 | "Uint16Array" : Uint16Array,
24 | "Int32Array" : Int32Array,
25 | "Uint32Array" : Uint32Array,
26 | "Float32Array" : Float32Array,
27 | "Float64Array" : Float64Array,
28 | "Map" : Map,
29 | "Set" : Set,
30 | "WeakMap" : WeakMap,
31 | "WeakSet" : WeakSet,
32 | "ArrayBuffer" : ArrayBuffer,
33 | "DataView" : DataView,
34 | "Promise" : Promise,
35 | "Intl.Collator" : Intl.Collator,
36 | "Intl.DateTimeFormat" : Intl.DateTimeFormat,
37 | "Intl.NumberFormat" : Intl.NumberFormat,
38 | "WebAssembly.Module" : WebAssembly.Module,
39 | "WebAssembly.Instance" : WebAssembly.Instance,
40 | "WebAssembly.Memory" : WebAssembly.Memory,
41 | "WebAssembly.Table" : WebAssembly.Table,
42 | "WebAssembly.CompileError" : WebAssembly.CompileError,
43 | "WebAssembly.LinkError" : WebAssembly.LinkError,
44 | "WebAssembly.RuntimeError" : WebAssembly.RuntimeError,
45 | };
46 |
47 | var codealchemist_logs;
48 | if (typeof codealchemist_logs === "undefined") codealchemist_logs = {};
49 |
50 | var codealchemist_tmps;
51 | if (typeof codealchemist_tmps === "undefined") codealchemist_tmps = {};
52 |
53 | function codealchemist_get_type (target) {
54 | let ty = typeof target;
55 | switch (ty){
56 | case "object":
57 | if (target === null) return "null";
58 | for (let name in codealchemist_types){
59 | try {
60 | if(target instanceof codealchemist_types[name]) return name;
61 | } catch (e) {}
62 | }
63 | return ty;
64 | case "function":
65 | if (target.toString().startsWith("class")) return "Class";
66 | return "function";
67 | default:
68 | return ty;
69 | }
70 | }
71 |
72 | function codealchemist_get_types (vars){
73 | let ret = {};
74 | for (let name in vars){
75 | if (name[0] === 'v') {
76 | let ty = codealchemist_get_type (vars[name]);
77 | ret[name] = ty;
78 | }
79 | }
80 | return JSON.stringify (ret);
81 | }
82 |
83 | function codealchemist_print (hval, pre, post) {
84 | let print = console.log
85 | let s1 = "{ \"hval\": " + hval + ",";
86 | let s2 = " \"pre\": " + pre + ",";
87 | let s3 = " \"post\": " + post + "}";
88 | print ("=== CodeAlchemist Start ===");
89 | print (s1);
90 | print (s2);
91 | print (s3);
92 | print ("=== CodeAlchemist End ===");
93 | }
94 |
95 | function codealchemist_log_type_pre (hval, vars){
96 | let pre = codealchemist_get_types (vars);
97 | if (!(hval in codealchemist_tmps)) codealchemist_tmps[hval] = [];
98 | codealchemist_tmps[hval].push (pre);
99 | }
100 |
101 | function codealchemist_log_type_post (hval, vars){
102 | let post = codealchemist_get_types (vars);
103 | let pre = codealchemist_tmps[hval].pop ();
104 | let key = pre + post;
105 | if (pre === undefined || post === undefined) return;
106 | if (!(hval in codealchemist_logs)) codealchemist_logs[hval] = {};
107 | if (!(key in codealchemist_logs[hval])) {
108 | codealchemist_logs[hval][key] = true;
109 | codealchemist_print (hval, pre, post);
110 | }
111 | }
112 |
--------------------------------------------------------------------------------
/src/Analyzer/jsLib/JSC.js:
--------------------------------------------------------------------------------
1 | var codealchemist_types = {
2 | "Function" : Function,
3 | "Boolean" : Boolean,
4 | "Symbol" : Symbol,
5 | "Error" : Error,
6 | "EvalError" : EvalError,
7 | "RangeError" : RangeError,
8 | "ReferenceError" : ReferenceError,
9 | "SyntaxError" : SyntaxError,
10 | "TypeError" : TypeError,
11 | "URIError" : URIError,
12 | "Number" : Number,
13 | "Date" : Date,
14 | "String" : String,
15 | "RegExp" : RegExp,
16 | "Array" : Array,
17 | "Int8Array" : Int8Array,
18 | "Uint8Array" : Uint8Array,
19 | "Uint8ClampedArray" : Uint8ClampedArray,
20 | "Int16Array" : Int16Array,
21 | "Uint16Array" : Uint16Array,
22 | "Int32Array" : Int32Array,
23 | "Uint32Array" : Uint32Array,
24 | "Float32Array" : Float32Array,
25 | "Float64Array" : Float64Array,
26 | "Map" : Map,
27 | "Set" : Set,
28 | "WeakMap" : WeakMap,
29 | "WeakSet" : WeakSet,
30 | "ArrayBuffer" : ArrayBuffer,
31 | "DataView" : DataView,
32 | "Promise" : Promise,
33 | "Intl.Collator" : Intl.Collator,
34 | "Intl.DateTimeFormat" : Intl.DateTimeFormat,
35 | "Intl.NumberFormat" : Intl.NumberFormat,
36 | "WebAssembly.Module" : WebAssembly.Module,
37 | "WebAssembly.Instance" : WebAssembly.Instance,
38 | "WebAssembly.Memory" : WebAssembly.Memory,
39 | "WebAssembly.Table" : WebAssembly.Table,
40 | "WebAssembly.CompileError" : WebAssembly.CompileError,
41 | "WebAssembly.LinkError" : WebAssembly.LinkError,
42 | "WebAssembly.RuntimeError" : WebAssembly.RuntimeError,
43 | };
44 |
45 | var codealchemist_logs;
46 | if (typeof codealchemist_logs === "undefined") codealchemist_logs = {};
47 |
48 | var codealchemist_tmps;
49 | if (typeof codealchemist_tmps === "undefined") codealchemist_tmps = {};
50 |
51 | function codealchemist_get_type (target) {
52 | let ty = typeof target;
53 | switch (ty){
54 | case "object":
55 | if (target === null) return "null";
56 | for (let name in codealchemist_types){
57 | try {
58 | if(target instanceof codealchemist_types[name]) return name;
59 | } catch (e) {}
60 | }
61 | return ty;
62 | case "function":
63 | if (target.toString().startsWith("class")) return "Class";
64 | return "function";
65 | default:
66 | return ty;
67 | }
68 | }
69 |
70 | function codealchemist_get_types (vars){
71 | let ret = {};
72 | for (let name in vars){
73 | if (name[0] === 'v') {
74 | let ty = codealchemist_get_type (vars[name]);
75 | ret[name] = ty;
76 | }
77 | }
78 | return JSON.stringify (ret);
79 | }
80 |
81 | function codealchemist_print (hval, pre, post) {
82 | let s1 = "{ \"hval\": " + hval + ",";
83 | let s2 = " \"pre\": " + pre + ",";
84 | let s3 = " \"post\": " + post + "}";
85 | print ("=== CodeAlchemist Start ===");
86 | print (s1);
87 | print (s2);
88 | print (s3);
89 | print ("=== CodeAlchemist End ===");
90 | }
91 |
92 | function codealchemist_log_type_pre (hval, vars){
93 | let pre = codealchemist_get_types (vars);
94 | if (!(hval in codealchemist_tmps)) codealchemist_tmps[hval] = [];
95 | codealchemist_tmps[hval].push (pre);
96 | }
97 |
98 | function codealchemist_log_type_post (hval, vars){
99 | let post = codealchemist_get_types (vars);
100 | let pre = codealchemist_tmps[hval].pop ();
101 | let key = pre + post;
102 | if (pre === undefined || post === undefined) return;
103 | if (!(hval in codealchemist_logs)) codealchemist_logs[hval] = {};
104 | if (!(key in codealchemist_logs[hval])) {
105 | codealchemist_logs[hval][key] = true;
106 | codealchemist_print (hval, pre, post);
107 | }
108 | }
109 |
--------------------------------------------------------------------------------
/src/Analyzer/jsLib/MOZ.js:
--------------------------------------------------------------------------------
1 | var codealchemist_types = {
2 | "Function" : Function,
3 | "Boolean" : Boolean,
4 | "Symbol" : Symbol,
5 | "Error" : Error,
6 | "EvalError" : EvalError,
7 | "InternalError" : InternalError,
8 | "RangeError" : RangeError,
9 | "ReferenceError" : ReferenceError,
10 | "SyntaxError" : SyntaxError,
11 | "TypeError" : TypeError,
12 | "URIError" : URIError,
13 | "Number" : Number,
14 | "Date" : Date,
15 | "String" : String,
16 | "RegExp" : RegExp,
17 | "Array" : Array,
18 | "Int8Array" : Int8Array,
19 | "Uint8Array" : Uint8Array,
20 | "Uint8ClampedArray" : Uint8ClampedArray,
21 | "Int16Array" : Int16Array,
22 | "Uint16Array" : Uint16Array,
23 | "Int32Array" : Int32Array,
24 | "Uint32Array" : Uint32Array,
25 | "Float32Array" : Float32Array,
26 | "Float64Array" : Float64Array,
27 | "Map" : Map,
28 | "Set" : Set,
29 | "WeakMap" : WeakMap,
30 | "WeakSet" : WeakSet,
31 | "ArrayBuffer" : ArrayBuffer,
32 | "SharedArrayBuffer" : SharedArrayBuffer,
33 | "DataView" : DataView,
34 | "Promise" : Promise,
35 | "Intl.Collator" : Intl.Collator,
36 | "Intl.DateTimeFormat" : Intl.DateTimeFormat,
37 | "Intl.NumberFormat" : Intl.NumberFormat,
38 | "WebAssembly.Module" : WebAssembly.Module,
39 | "WebAssembly.Instance" : WebAssembly.Instance,
40 | "WebAssembly.Memory" : WebAssembly.Memory,
41 | "WebAssembly.Table" : WebAssembly.Table,
42 | "WebAssembly.CompileError" : WebAssembly.CompileError,
43 | "WebAssembly.LinkError" : WebAssembly.LinkError,
44 | "WebAssembly.RuntimeError" : WebAssembly.RuntimeError,
45 | "Debugger" : Debugger,
46 | "PerfMeasurement" : PerfMeasurement,
47 | "FakeDOMObject" : FakeDOMObject,
48 | };
49 |
50 | var codealchemist_logs;
51 | if (typeof codealchemist_logs === "undefined") codealchemist_logs = {};
52 |
53 | var codealchemist_tmps;
54 | if (typeof codealchemist_tmps === "undefined") codealchemist_tmps = {};
55 |
56 | function codealchemist_get_type (target) {
57 | let ty = typeof target;
58 | switch (ty){
59 | case "object":
60 | if (target === null) return "null";
61 | for (let name in codealchemist_types){
62 | try {
63 | if(target instanceof codealchemist_types[name]) return name;
64 | } catch (e) {}
65 | }
66 | return ty;
67 | case "function":
68 | if (target.toString().startsWith("class")) return "Class";
69 | return "function";
70 | default:
71 | return ty;
72 | }
73 | }
74 |
75 | function codealchemist_get_types (vars){
76 | let ret = {};
77 | for (let name in vars){
78 | if (name[0] === 'v') {
79 | let ty = codealchemist_get_type (vars[name]);
80 | ret[name] = ty;
81 | }
82 | }
83 | return JSON.stringify (ret);
84 | }
85 |
86 | function codealchemist_print (hval, pre, post) {
87 | let s1 = "{ \"hval\": " + hval + ",";
88 | let s2 = " \"pre\": " + pre + ",";
89 | let s3 = " \"post\": " + post + "}";
90 | print ("=== CodeAlchemist Start ===");
91 | print (s1);
92 | print (s2);
93 | print (s3);
94 | print ("=== CodeAlchemist End ===");
95 | }
96 |
97 | function codealchemist_log_type_pre (hval, vars){
98 | let pre = codealchemist_get_types (vars);
99 | if (!(hval in codealchemist_tmps)) codealchemist_tmps[hval] = [];
100 | codealchemist_tmps[hval].push (pre);
101 | }
102 |
103 | function codealchemist_log_type_post (hval, vars){
104 | let post = codealchemist_get_types (vars);
105 | let pre = codealchemist_tmps[hval].pop ();
106 | let key = pre + post;
107 | if (pre === undefined || post === undefined) return;
108 | if (!(hval in codealchemist_logs)) codealchemist_logs[hval] = {};
109 | if (!(key in codealchemist_logs[hval])) {
110 | codealchemist_logs[hval][key] = true;
111 | codealchemist_print (hval, pre, post);
112 | }
113 | }
114 |
--------------------------------------------------------------------------------
/src/Analyzer/jsLib/V8.js:
--------------------------------------------------------------------------------
1 | var codealchemist_types = {
2 | "Function" : Function,
3 | "Boolean" : Boolean,
4 | "Symbol" : Symbol,
5 | "Error" : Error,
6 | "EvalError" : EvalError,
7 | "RangeError" : RangeError,
8 | "ReferenceError" : ReferenceError,
9 | "SyntaxError" : SyntaxError,
10 | "TypeError" : TypeError,
11 | "URIError" : URIError,
12 | "Number" : Number,
13 | "Date" : Date,
14 | "String" : String,
15 | "RegExp" : RegExp,
16 | "Array" : Array,
17 | "Int8Array" : Int8Array,
18 | "Uint8Array" : Uint8Array,
19 | "Uint8ClampedArray" : Uint8ClampedArray,
20 | "Int16Array" : Int16Array,
21 | "Uint16Array" : Uint16Array,
22 | "Int32Array" : Int32Array,
23 | "Uint32Array" : Uint32Array,
24 | "Float32Array" : Float32Array,
25 | "Float64Array" : Float64Array,
26 | "BigUint64Array" : BigUint64Array,
27 | "BigInt64Array" : BigInt64Array,
28 | "Map" : Map,
29 | "Set" : Set,
30 | "WeakMap" : WeakMap,
31 | "WeakSet" : WeakSet,
32 | "ArrayBuffer" : ArrayBuffer,
33 | "SharedArrayBuffer" : SharedArrayBuffer,
34 | "DataView" : DataView,
35 | "Promise" : Promise,
36 | "Intl.Collator" : Intl.Collator,
37 | "Intl.DateTimeFormat" : Intl.DateTimeFormat,
38 | "Intl.NumberFormat" : Intl.NumberFormat,
39 | "WebAssembly.Module" : WebAssembly.Module,
40 | "WebAssembly.Instance" : WebAssembly.Instance,
41 | "WebAssembly.Memory" : WebAssembly.Memory,
42 | "WebAssembly.Table" : WebAssembly.Table,
43 | "WebAssembly.CompileError" : WebAssembly.CompileError,
44 | "WebAssembly.LinkError" : WebAssembly.LinkError,
45 | "WebAssembly.RuntimeError" : WebAssembly.RuntimeError,
46 | "Worker" : Worker
47 | };
48 |
49 | var codealchemist_logs;
50 | if (typeof codealchemist_logs === "undefined") codealchemist_logs = {};
51 |
52 | var codealchemist_tmps;
53 | if (typeof codealchemist_tmps === "undefined") codealchemist_tmps = {};
54 |
55 | function codealchemist_get_type (target) {
56 | let ty = typeof target;
57 | switch (ty){
58 | case "object":
59 | if (target === null) return "null";
60 | for (let name in codealchemist_types){
61 | try {
62 | if(target instanceof codealchemist_types[name]) return name;
63 | } catch (e) {}
64 | }
65 | return ty;
66 | case "function":
67 | if (target.toString().startsWith("class")) return "Class";
68 | return "function";
69 | default:
70 | return ty;
71 | }
72 | }
73 |
74 | function codealchemist_get_types (vars){
75 | let ret = {};
76 | for (let name in vars){
77 | if (name[0] === 'v') {
78 | let ty = codealchemist_get_type (vars[name]);
79 | ret[name] = ty;
80 | }
81 | }
82 | return JSON.stringify (ret);
83 | }
84 |
85 | function codealchemist_print (hval, pre, post) {
86 | let print = console.log
87 | let s1 = "{ \"hval\": " + hval + ",";
88 | let s2 = " \"pre\": " + pre + ",";
89 | let s3 = " \"post\": " + post + "}";
90 | print ("=== CodeAlchemist Start ===");
91 | print (s1);
92 | print (s2);
93 | print (s3);
94 | print ("=== CodeAlchemist End ===");
95 | }
96 |
97 | function codealchemist_log_type_pre (hval, vars){
98 | let pre = codealchemist_get_types (vars);
99 | if (!(hval in codealchemist_tmps)) codealchemist_tmps[hval] = [];
100 | codealchemist_tmps[hval].push (pre);
101 | }
102 |
103 | function codealchemist_log_type_post (hval, vars){
104 | let post = codealchemist_get_types (vars);
105 | let pre = codealchemist_tmps[hval].pop ();
106 | let key = pre + post;
107 | if (pre === undefined || post === undefined) return;
108 | if (!(hval in codealchemist_logs)) codealchemist_logs[hval] = {};
109 | if (!(key in codealchemist_logs[hval])) {
110 | codealchemist_logs[hval][key] = true;
111 | codealchemist_print (hval, pre, post);
112 | }
113 | }
114 |
--------------------------------------------------------------------------------
/src/Common/BuiltInGetter.js:
--------------------------------------------------------------------------------
1 | CodeAlchemist_globals = Object.getOwnPropertyNames (this)
2 | for (name of CodeAlchemist_globals){
3 | print (name)
4 | }
5 |
--------------------------------------------------------------------------------
/src/Common/Common.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
5 |
6 |
7 |
8 |
9 | netstandard2.0
10 | NU1701
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
--------------------------------------------------------------------------------
/src/Common/Conf.fs:
--------------------------------------------------------------------------------
1 | namespace Common
2 |
3 | open System
4 | open System.Diagnostics
5 | open Common.Json
6 | open Common.Utils
7 |
8 | type Engine =
9 | | V8
10 | | Chakra
11 | | JSC
12 | | MOZ
13 |
14 | type Conf = {
15 | Engine: Engine
16 | TimeOut: int
17 | BinPath: string
18 | Argv: string array
19 | Env: Map
20 | SeedDir: string
21 | TmpDir: string
22 | BugDir: string
23 | PreprocDir: string
24 | BuiltIns: string array
25 | Filters: string array
26 | Jobs: int
27 | ProbBlk: int
28 | IterBlk: int
29 | IterMax: int
30 | DepthMax: int
31 | }
32 |
33 | module Conf =
34 | let private builtInGetter =
35 | let path = Reflection.Assembly.GetAssembly(typeof).Location
36 | (getDirName path) +/ "BuiltInGetter.js"
37 |
38 | let private toEngine = function
39 | | "V8" -> V8
40 | | "Chakra" -> Chakra
41 | | "JSC" -> JSC
42 | | "MOZ" -> MOZ
43 | | e -> Logger.error "Not supported engine: %s" e
44 |
45 | let private getProp json key =
46 | match tryGetProp json key with
47 | | Some v -> v
48 | | None -> Logger.error "%s field is required" key
49 |
50 | let private getBuiltIns binPath argv =
51 | let argv = Array.append argv [|builtInGetter|]
52 | let pInfo =
53 | ProcessStartInfo (
54 | FileName = binPath,
55 | Arguments = String.concat " " argv,
56 | RedirectStandardInput = true,
57 | RedirectStandardOutput = true,
58 | RedirectStandardError = true,
59 | UseShellExecute = false)
60 | let proc = new Process (StartInfo = pInfo)
61 | proc.Start () |> ignore
62 | proc.WaitForExit ()
63 | let ret =
64 | proc.StandardOutput.ReadToEnd().Split '\n'
65 | |> Array.filter (String.neq "")
66 | String.concat ", " ret |> Logger.info "BuiltIns:\n[| %s |]"
67 | ret
68 |
69 | let load fname pBlk iBlk iMax dMax =
70 | let json = loadJson fname
71 | let binPath = getPropStr json "engine_path"
72 | let argv = getPropStrs json "argv"
73 | {
74 | Engine = getPropStr json "engine" |> toEngine
75 | TimeOut = getPropInt json "timeout"
76 | BinPath = binPath
77 | Argv = argv
78 | Env = getPropMap json "env"
79 | SeedDir = getPropStr json "seed_path"
80 | TmpDir = getPropStr json "tmp_dir"
81 | BugDir = getPropStr json "bug_dir"
82 | PreprocDir = getPropStr json "preproc_dir"
83 | BuiltIns = getBuiltIns binPath argv
84 | Filters = getPropStrs json "filters"
85 | Jobs = getPropInt json "jobs"
86 | ProbBlk = pBlk
87 | IterBlk = iBlk
88 | IterMax = iMax
89 | DepthMax = dMax
90 | }
91 |
92 | let engineToStr = function
93 | | V8 -> "V8"
94 | | Chakra -> "Chakra"
95 | | JSC -> "JSC"
96 | | MOZ -> "MOZ"
97 |
--------------------------------------------------------------------------------
/src/Common/Executor.fs:
--------------------------------------------------------------------------------
1 | module Common.Executor
2 |
3 | open System
4 | open System.Text
5 | open System.Runtime.InteropServices
6 | open System.Diagnostics
7 |
8 | []
9 | extern int readFd (int fd, byte[] buf, int size);
10 |
11 | []
12 | extern void closeFd (int fd);
13 |
14 | []
15 | extern int waitForExit (int pid);
16 |
17 | []
18 | extern void exec (int argc, string[] argv, string dir, int timeout, int [] ret);
19 |
20 | let [] bufSize = 4096
21 |
22 | let readAll fd =
23 | let mutable buf = [||]
24 | let rec loop () =
25 | let tmp = Array.zeroCreate bufSize
26 | let size = readFd (fd, tmp, bufSize)
27 | if size < bufSize then buf <- Array.sub tmp 0 size |> Array.append buf
28 | else buf <- Array.append buf tmp; loop ()
29 | loop ()
30 | Encoding.UTF8.GetString buf
31 |
32 | let execNodeJs js argv =
33 | let pInfo =
34 | ProcessStartInfo (
35 | FileName = "node",
36 | Arguments = sprintf "%s %s" js argv)
37 | let proc = new Process (StartInfo = pInfo)
38 | proc.Start () |> ignore
39 | proc.WaitForExit ()
40 |
41 | let asyncExec timeout binPath argv dir js = async {
42 | let ret = [|-1; -1; -1|]
43 | let argv = Array.append argv [|js|]
44 | exec (Array.length argv, argv, dir, timeout, ret)
45 | let retCode = waitForExit (ret.[0])
46 | let out = readAll ret.[1]
47 | let err = readAll ret.[2]
48 | closeFd (ret.[1])
49 | closeFd (ret.[2])
50 | return struct (retCode, out, err)
51 | }
52 |
53 | let getAsyncExec conf =
54 | let binPath = conf.BinPath
55 | let argv = Array.filter (String.neq "") conf.Argv |> Array.append [|binPath|]
56 | Map.iter (fun k v -> Environment.SetEnvironmentVariable (k, v)) conf.Env
57 | asyncExec conf.TimeOut binPath argv
58 |
--------------------------------------------------------------------------------
/src/Common/Extends.fs:
--------------------------------------------------------------------------------
1 | namespace Common
2 |
3 | module List =
4 | let partitionFst = function
5 | | first :: remain -> first, remain
6 | | _ -> Logger.error "List.partitionFst fail"
7 |
8 | module Array =
9 | let revList arr = Array.ofList arr |> Array.rev
10 |
11 | let includes arr x = Array.contains x arr
12 |
13 | let remove item arr =
14 | let idx = Array.findIndex (fun x -> x = item) arr
15 | if idx = 0 then arr.[1..]
16 | else Array.append arr.[.. idx - 1] arr.[idx + 1 ..]
17 |
18 | module Map =
19 | let inline count (map: Map<_,_>) = map.Count
20 |
21 | let private mkValFunc f _ v = f v
22 |
23 | let private mkKeyFunc f k _ = f k
24 |
25 | let private mkKeyMap f map k v = Map.add (f k) v map
26 |
27 | let mapVal f map = Map.map (mkValFunc f) map
28 |
29 | let mapKey f map = Map.fold (mkKeyMap f) Map.empty map
30 |
31 | let get map key = Map.find key map
32 |
33 | let filterVal f map = Map.filter (mkValFunc f) map
34 |
35 | let filterKey f map = Map.filter (mkKeyFunc f) map
36 |
37 | let inline containsKey2 map key = Map.containsKey key map
38 |
39 | let getKeys map = Map.toArray map |> Array.map fst
40 |
41 | let private mergeHelper map k v = Map.add k v map
42 |
43 | let merge map1 map2 = Map.fold mergeHelper map1 map2
44 |
45 | let private delKeysHelper keys k v = Array.contains k keys |> not
46 |
47 | let delKeys map keys = Map.filter (delKeysHelper keys) map
48 |
49 | let private foranyKeyHelper f k _ = f k |> not
50 |
51 | let foranyKeys f map = Map.forall (foranyKeyHelper f) map |> not
52 |
53 | let init k v = Map.add k v Map.empty
54 |
55 | module Tuple =
56 | let inline map f (a, b) = (f a, f b)
57 |
58 | module Set =
59 | let init item = Set.add item Set.empty
60 |
61 | module String =
62 | let neq a b = a <> b
63 |
64 | let add (a: string) (b: string) = a + b
65 |
66 | let lastIndexOf (a: string) (b: string) = b.LastIndexOf (a)
67 |
68 | let contains (big: string) (small: string) = big.Contains small
69 |
70 | module Random =
71 | let initSeed n =
72 | let rnd = new System.Random ()
73 | Array.init n (fun _ -> rnd.Next ())
74 |
75 | let inline nxt (rnd: System.Random) max = rnd.Next (max)
76 |
77 | let inline sample rnd arr = Array.length arr |> nxt rnd |> Array.get arr
78 |
79 | let weightedSample rnd f arr =
80 | let map x =
81 | let ret = f x
82 | if ret = 0 then 1 else ret
83 | let length = Array.length arr
84 | if length = 1 then Array.get arr 0
85 | else
86 | let weights = Array.map map arr
87 | let rec getter idx remain =
88 | if idx < length then
89 | let w = Array.get weights idx
90 | if w > remain then idx
91 | else getter (idx + 1) (remain - w)
92 | else length - 1
93 |
94 | Array.sum weights |> nxt rnd |> getter 0 |> Array.get arr
95 |
96 | let private init rnd n _ = nxt rnd n
97 |
98 | let private getCnt arr length item =
99 | let rec loop idx cnt =
100 | if cnt < 2 && idx < length then
101 | if Array.get arr idx = item then loop (idx + 1) (cnt + 1)
102 | else loop (idx + 1) cnt
103 | else cnt
104 | loop 0 0
105 |
106 | let private getUnique init arr length =
107 | let rec loop item =
108 | if getCnt arr length item = 0 then item
109 | else init 0 |> loop
110 | init 0 |> loop
111 |
112 | let rec private deDup init length arr idx =
113 | if idx < length then
114 | if Array.get arr idx |> getCnt arr length = 2 then
115 | arr.[idx] <- getUnique init arr length
116 | deDup init length arr (idx + 1)
117 | else deDup init length arr (idx + 1)
118 | else arr
119 |
120 | let sampleN rnd n arr =
121 | let init = Array.length arr |> init rnd
122 | let first = Array.init n init
123 | deDup init n first 0 |> Array.map (Array.get arr)
124 |
--------------------------------------------------------------------------------
/src/Common/Json.fs:
--------------------------------------------------------------------------------
1 | module Common.Json
2 |
3 | open FSharp.Data
4 |
5 | type Json = JsonValue
6 |
7 | let toStr (json: JsonValue) = json.AsString()
8 |
9 | let getProp (json: JsonValue) key = json.GetProperty(key)
10 |
11 | let tryGetProp (json: JsonValue) key = json.TryGetProperty(key)
12 |
13 | let getPropStr (json: JsonValue) key = json.GetProperty(key).AsString()
14 |
15 | let getPropInt (json: JsonValue) key = json.GetProperty(key).AsInteger()
16 |
17 | let getPropInt64 (json: JsonValue) key = json.GetProperty(key).AsInteger64()
18 |
19 | let getPropStrs (json: JsonValue) key =
20 | json.GetProperty(key).AsArray() |> Array.map toStr
21 |
22 | let getPropMap (json: JsonValue) key =
23 | json.GetProperty(key).Properties() |> Map.ofArray
24 | |> Map.map (fun k v -> toStr v)
25 |
26 | let getBool (json: JsonValue) key = json.GetProperty(key).AsBoolean()
27 |
28 | let toArray (json: JsonValue) = json.AsArray()
29 |
30 | let loadJson (fname: string) = JsonValue.Load fname
31 |
32 | let asyncLoadJson (fname: string) = JsonValue.AsyncLoad fname
33 |
--------------------------------------------------------------------------------
/src/Common/Logger.fs:
--------------------------------------------------------------------------------
1 | namespace Common
2 |
3 | module Logger =
4 | let mkFmt color txt = sprintf "\x1b[0;%dm%s\x1b[0m" color txt
5 | let infoFmt = mkFmt 32 "[INFO]"
6 | let warnFmt = mkFmt 33 "[WARN]"
7 | let errorFmt = mkFmt 31 "[ERROR]"
8 |
9 | let printMsg (fmt: string) (msg: string) =
10 | System.Console.WriteLine (fmt + " " + msg)
11 |
12 | let printMsgExit fmt msg =
13 | printMsg fmt msg
14 | exit 1
15 |
16 | let info fmt = Printf.kprintf (printMsg infoFmt) fmt
17 |
18 | let warn fmt = Printf.kprintf (printMsg warnFmt) fmt
19 |
20 | let errorNoExit fmt = Printf.kprintf (printMsg errorFmt) fmt
21 |
22 | let error fmt = Printf.kprintf (printMsgExit errorFmt) fmt
23 |
--------------------------------------------------------------------------------
/src/Common/Utils.fs:
--------------------------------------------------------------------------------
1 | module Common.Utils
2 |
3 | open System.IO
4 | open System.Text
5 |
6 | let rec getFiles ret dir =
7 | let dir = new DirectoryInfo (dir)
8 | let dirs = dir.GetDirectories () |> Array.map (fun dir -> dir.FullName)
9 | let files = dir.GetFiles () |> Array.map (fun file -> file.FullName)
10 | Array.fold getFiles (Array.append files ret) dirs
11 |
12 | let inline writeFile name (data: string) =
13 | File.WriteAllBytes (name, Encoding.UTF8.GetBytes data)
14 |
15 | let inline rmFile name = File.Delete (name)
16 |
17 | let getFileName path = Path.GetFileName (path)
18 |
19 | let getDirName path = Path.GetDirectoryName (path)
20 |
21 | let existDir dir = Directory.Exists dir
22 |
23 | let (+/) p1 p2 = Path.Combine (p1, getFileName p2)
24 |
25 | let mkDir dir = Directory.CreateDirectory dir |> ignore; dir
26 |
27 | let checkDir path =
28 | let dir = getDirName path
29 | if existDir dir then path
30 | else mkDir dir |> ignore; path
31 |
32 | let renameFile src dst = File.Move (src, dst)
33 |
--------------------------------------------------------------------------------
/src/Common/lib/Makefile:
--------------------------------------------------------------------------------
1 | all: libexec.dll
2 |
3 | libexec.dll: exec.c
4 | @gcc -O3 -shared -fPIC $< -o$@
5 |
6 | clean:
7 | rm libexec.dll
8 |
--------------------------------------------------------------------------------
/src/Common/lib/exec.c:
--------------------------------------------------------------------------------
1 | #include
2 | #include
3 | #include
4 | #include
5 |
6 | void failwith (char *msg) {
7 | perror (msg);
8 | exit (1);
9 | }
10 |
11 | int readFd (int fd, char *buf, int size){
12 | return read (fd, buf, size);
13 | }
14 |
15 | void closeFd (int fd) {
16 | close (fd);
17 | }
18 |
19 | int waitForExit (int pid){
20 | int status;
21 | while (waitpid (pid, &status, 0) != pid) ;
22 | if (WIFEXITED(status)) return WEXITSTATUS(status);
23 | else if (WIFSIGNALED(status)) return -WTERMSIG(status);
24 | else failwith ("waitForExit fail");
25 | }
26 |
27 | void exec (int argc, char **arg, char *dir, int timeout, int *ret) {
28 | int i, pid;
29 | char **argv = malloc (sizeof(char*) * (argc + 1));
30 | int stdoutPipe[2] = {-1, -1};
31 | int stderrPipe[2] = {-1, -1};
32 |
33 | for (i = 0; i< argc; i++) argv[i] = arg[i];
34 | argv[argc] = NULL;
35 |
36 | if (pipe (stdoutPipe) < 0 || pipe (stderrPipe) < 0)
37 | failwith ("pipe fail");
38 |
39 | pid = vfork ();
40 | while (pid < 0) {
41 | sleep (1);
42 | pid = vfork ();
43 | }
44 |
45 | if (pid < 0) failwith ("vfork fail");
46 | else if (pid == 0) {
47 | close (stdoutPipe[0]);
48 | close (stderrPipe[0]);
49 |
50 | dup2 (stdoutPipe[1], 1); close(stdoutPipe[1]);
51 | dup2 (stderrPipe[1], 2); close(stderrPipe[1]);
52 |
53 | alarm (timeout);
54 | if (chdir (dir) < 0) failwith ("chdir fail");
55 | execv (argv[0], argv);
56 | }
57 |
58 | close (stdoutPipe[1]);
59 | close (stderrPipe[1]);
60 |
61 | ret[0] = pid;
62 | ret[1] = stdoutPipe[0];
63 | ret[2] = stderrPipe[0];
64 |
65 | }
66 |
--------------------------------------------------------------------------------
/src/Fuzzer/Context.fs:
--------------------------------------------------------------------------------
1 | namespace Fuzzer
2 |
3 | open AST
4 | open Analyzer
5 | open Common
6 |
7 | type TypeMap = Map
8 |
9 | type ScopeMap = Map
10 |
11 | type Context = (struct (TypeMap * CountMap * int * ScopeMap list * SyntaxCond))
12 |
13 | module Context =
14 | let empty = struct (Map.empty, CountMap.empty, 0, [], Constraint.emptySyntax)
15 |
16 | let private convTMap tMap id ty =
17 | match Map.tryFind ty tMap with
18 | | Some ids -> Map.add ty (id :: ids) tMap
19 | | None -> Map.add ty [id] tMap
20 |
21 | let inline private toTMap post =
22 | Map.fold convTMap Map.empty post |> Map.mapVal List.toArray
23 |
24 | let private convCMap (cmap, cnt) ty ids =
25 | let length = Array.length ids
26 | Map.add ty length cmap, cnt + length
27 |
28 | let toCMap tMap = Map.fold convCMap (Map.empty, 0) tMap
29 |
30 | let private merger ret ty ids =
31 | match Map.tryFind ty ret with
32 | | Some ids2 -> Map.add ty (Array.append ids2 ids) ret
33 | | None -> Map.add ty ids ret
34 |
35 | let private merger2 ret ty ids =
36 | match Map.tryFind ty ret with
37 | | Some ids2 -> Map.add ty (Array.append ids2 ids |> Array.distinct) ret
38 | | None -> Map.add ty ids ret
39 |
40 | let inline private mergeTMap t1 t2 = Map.fold merger t1 t2
41 |
42 | let inline private mergeTMap2 t1 t2 = Map.fold merger2 t1 t2
43 |
44 | let private delFolder tMap id ty =
45 | Map.add ty (Map.find ty tMap |> Array.remove id) tMap
46 |
47 | let private delTMap tMap dMap =
48 | Map.fold delFolder tMap dMap
49 |
50 | let private scopeMerger cur id (lv, ty) =
51 | match Map.tryFind id cur with
52 | | Some (lv2, ty2) ->
53 | if lv = Pre then Map.add id (lv2, ty) cur
54 | else Map.add id (lv, ty) cur
55 | | _ -> Map.add id (lv, ty) cur
56 |
57 | let private mergeScope cur scope = Map.fold scopeMerger cur scope
58 |
59 | let update struct (tMap, cMap, idx, scopes, syntax) scope dMap post =
60 | let idx = idx + (Map.count post)
61 | let tMap = mergeTMap (delTMap tMap dMap) (toTMap post)
62 | let cMap = toCMap tMap
63 | match scopes with
64 | | [] -> struct (tMap, cMap, idx, scopes, syntax)
65 | | cur :: before ->
66 | struct (tMap, cMap, idx, (mergeScope cur scope) :: before, syntax)
67 |
68 | let inline prepareFilt struct (_, cmap, _, _, syntax) = struct (cmap, syntax)
69 |
70 | let inline preparePickCond struct (cur, (_, _), idx, _, _) = struct (cur, idx)
71 |
72 | let initBlk struct (tMap, cMap, idx, scopes, syntax) guard scope dMap post =
73 | let idx = idx + (Map.count post)
74 | let tMap = mergeTMap (delTMap tMap dMap) (toTMap post)
75 | let cMap = toCMap tMap
76 | struct (tMap, cMap, idx, scope :: scopes,
77 | CodeBrick.setGuardSyntax syntax guard)
78 |
79 | let private rmTMapItem tMap ty id =
80 | let ids = Map.find ty tMap |> Array.remove id
81 | Map.add ty ids tMap
82 |
83 | let private filterScope tMap scope lv =
84 | let folder tMap id (lv2, ty) =
85 | if lv2 = lv then rmTMapItem tMap ty id
86 | else tMap
87 | Map.fold folder tMap scope
88 |
89 | let finiBlk guard ctx0 ctx =
90 | let struct (tMap0, _, _, _, syntax) = ctx0
91 | let struct (tMap, _, idx, scopes, _) = ctx
92 | let scope, scopes = List.partitionFst scopes
93 | let tMap = CodeBrick.getGuardLv guard |> filterScope tMap scope
94 | |> mergeTMap2 tMap0
95 | let cMap = toCMap tMap
96 | struct (tMap, cMap, idx, scopes, syntax)
97 |
--------------------------------------------------------------------------------
/src/Fuzzer/Fuzzer.fs:
--------------------------------------------------------------------------------
1 | module Fuzzer.Fuzzer
2 |
3 | open System
4 | open AST.CodeGen
5 | open Common
6 | open Common.Utils
7 | open Analyzer
8 |
9 | let mkGenerate iBlk sPool gPool (rnd: Random) pBlk =
10 | let genStmt sb ctx =
11 | let struct (stmt, rMap, scope, dMap, post) =
12 | Selector.pickBrick rnd sPool ctx
13 | stmtItemToCode rMap sb stmt
14 | Context.update ctx scope dMap post
15 |
16 | let rec generate sb i d ctx =
17 | if i > 0 then
18 | if d > 0 && rnd.Next (100) < pBlk then
19 | match genBlk sb (d - 1) ctx with
20 | | Some ctx -> generate sb (i - 1) d ctx
21 | | None -> generate sb i d ctx
22 | else genStmt sb ctx |> generate sb (i - 1) d
23 | else ctx
24 |
25 | and genBlk sb d ctx0 =
26 | let ctx = Selector.pickCtx rnd ctx0
27 | match Selector.pickGuard rnd gPool ctx with
28 | | Some (struct (guard, rMap, scope, dMap, post)) ->
29 | let ctx = Context.initBlk ctx guard scope dMap post
30 | CodeBrick.guardToCodeInit rMap sb guard
31 | let ret = generate sb (rnd.Next (1, iBlk)) d ctx
32 | CodeBrick.guardToCodeFini rMap sb guard
33 | Context.finiBlk guard ctx0 ret |> Some
34 | | None -> None
35 |
36 | generate
37 |
38 | let fuzzMain conf sPool gPool rndSeed = async {
39 | let rnd = new Random (rndSeed)
40 | let iMax = conf.IterMax
41 | let dMax = conf.DepthMax
42 | let prefix = sprintf "%s/%d" conf.TmpDir rndSeed
43 | let bugPrefix = sprintf "%s/%d" conf.BugDir rndSeed
44 | let exec = Executor.getAsyncExec conf conf.TmpDir
45 | let isBug = Oracle.getOracle conf.Engine
46 | let generate = mkGenerate conf.IterBlk sPool gPool rnd conf.ProbBlk
47 |
48 | let mutable idx = 0
49 | while true do
50 | let fname = sprintf "%s-%d.js" prefix idx
51 | let sb = new SB ()
52 | generate sb iMax dMax Context.empty |> ignore
53 | sb.ToString() |> writeFile fname |> ignore
54 | let! ret = exec fname
55 | if isBug ret |> not then rmFile fname
56 | else renameFile fname (sprintf "%s-%d.js" bugPrefix idx)
57 | idx <- idx + 1
58 | }
59 |
60 | let fuzz conf bricks =
61 | let loop = Pool.initPools bricks ||> fuzzMain conf
62 | Random.initSeed conf.Jobs
63 | |> Array.map loop
64 | |> Async.Parallel
65 | |> Async.RunSynchronously
66 | |> ignore
67 |
--------------------------------------------------------------------------------
/src/Fuzzer/Fuzzer.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | netstandard2.0
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
--------------------------------------------------------------------------------
/src/Fuzzer/Oracle.fs:
--------------------------------------------------------------------------------
1 | namespace Fuzzer
2 |
3 | open Common
4 |
5 | type Signal =
6 | | Normal
7 | | SIGILL
8 | | SIGABRT
9 | | SIGFPE
10 | | SIGKILL
11 | | SIGSEGV
12 | | SIGALRM
13 | | OTHER
14 |
15 | module Signal =
16 | let ofRet = function
17 | | -4 -> SIGILL
18 | | -6 -> SIGABRT
19 | | -8 -> SIGFPE
20 | | -9 -> SIGKILL
21 | | -11 -> SIGSEGV
22 | | -14 -> SIGALRM
23 | | ret when ret < 0 -> OTHER
24 | | _ -> Normal
25 |
26 | let isCrash = function
27 | | Normal | SIGALRM | SIGKILL | SIGABRT -> false
28 | | _ -> true
29 |
30 | module Oracle =
31 | let v8Table = [|
32 | "Fatal javascript OOM";
33 | "Check failed: args";
34 | |]
35 |
36 | let checkTable table err = Array.exists (String.contains err) table |> not
37 |
38 | let isCrash = Signal.ofRet >> Signal.isCrash
39 |
40 | let isV8Bug (struct (ret, out, err)) = isCrash ret && checkTable v8Table err
41 |
42 | let isChakraBug (struct (ret, out, err)) = isCrash ret
43 |
44 | let isJSCBug (struct (ret, out, err)) =
45 | if isCrash ret then String.contains err "WTFCrash" |> not
46 | else false
47 |
48 | let isMOZBug (struct (ret, out, err)) = isCrash ret
49 |
50 | let getOracle = function
51 | | V8 -> isV8Bug
52 | | Chakra -> isChakraBug
53 | | JSC -> isJSCBug
54 | | MOZ -> isMOZBug
55 |
--------------------------------------------------------------------------------
/src/Fuzzer/Pool.fs:
--------------------------------------------------------------------------------
1 | namespace Fuzzer
2 |
3 | open AST
4 | open Analyzer
5 | open Common
6 |
7 | type CountMap = Map * int
8 |
9 | type Cond = Map
10 |
11 | type ScopeCond = Map
12 |
13 | type StmtBrick = StmtListItem * PreCond * ScopeCond
14 |
15 | type GuardBrick = Guard * PreCond * ScopeCond
16 |
17 | type StmtPool = ((CountMap * SyntaxCond) * (StmtBrick * Cond array) array) array
18 |
19 | type GuardPool = ((CountMap * SyntaxCond) * (GuardBrick * Cond array) array) array
20 |
21 | module CountMap =
22 | let empty = Map.empty, 0
23 |
24 | let private counter ret id ty =
25 | match Map.tryFind ty ret with
26 | | Some v -> Map.add ty (v + 1) ret
27 | | None -> Map.add ty 1 ret
28 |
29 | let ofCond cond = Map.fold counter Map.empty cond, Map.count cond
30 |
31 | let inline private isSubHelper big k v =
32 | match Map.tryFind k big with
33 | | Some x -> x >= v
34 | | None -> false
35 |
36 | let inline isSub big small =
37 | if Map.count big < Map.count small then false
38 | else Map.forall (isSubHelper big) small
39 |
40 | module Pool =
41 |
42 | let toCond post = Map.mapVal fst post
43 |
44 | let toScopeCond post = Map.mapVal snd post
45 |
46 | let addBrickMap hval brick post map =
47 | match Map.tryFind hval map with
48 | | Some (brick, posts) -> Map.add hval (brick, (post :: posts)) map
49 | | None -> Map.add hval (brick, [post]) map
50 |
51 | let addPool pool pre hval body syntax post =
52 | let key = CountMap.ofCond pre, syntax
53 | let brick = body, pre, toScopeCond post
54 | let post = toCond post
55 | match Map.tryFind key pool with
56 | | Some map -> Map.add key (addBrickMap hval brick post map) pool
57 | | None -> Map.add key (Map.init hval (brick, [post])) pool
58 |
59 | let toSStmtPool sPool =
60 | let filter (_, syntax) =
61 | (syntax.Func || syntax.Try || syntax.Loop || syntax.Class || syntax.Gen)
62 | |> not
63 | let mapper ((k, _), arr) =
64 | k, Array.map (fun ((body, pre, _), conds) -> (body, pre), conds) arr
65 |
66 | Array.filter (fst >> filter) sPool
67 | |> Array.map mapper
68 |
69 | let conv pool =
70 | let mapper (_, (brick, conds)) = (brick, List.toArray conds)
71 | Map.mapVal (Map.toArray >> Array.map mapper) pool
72 | |> Map.toArray
73 |
74 | let count pool =
75 | let folder ret (_, arr) =
76 | Array.fold (fun ret v -> (snd v |> Array.length) + ret) ret arr
77 | Array.fold folder 0 pool
78 |
79 | let filterEmptySyntax x = (fst x |> snd) = Constraint.emptySyntax
80 |
81 | let private checkPool pool =
82 | let checker (((map, cnt), _), _) = (map = Map.empty) && (cnt = 0)
83 | Array.exists checker pool
84 |
85 | let private checkPools (ssPool, sPool) gPool =
86 | if (checkPool ssPool) && (checkPool gPool) then
87 | (ssPool, sPool), gPool
88 | else Logger.error "Need more diverse seeds"
89 |
90 | let initPools bricks =
91 | let folder (sPool, gPool) brick =
92 | let cons = brick.Constraint
93 | match brick.Body with
94 | | Guard guard ->
95 | sPool, addPool gPool cons.Pre brick.Hash guard cons.Syntax cons.Post
96 | | StmtListItem stmt ->
97 | addPool sPool cons.Pre brick.Hash stmt cons.Syntax cons.Post, gPool
98 | let sPool, gPool = List.fold folder (Map.empty, Map.empty) bricks
99 | let sPool = conv sPool
100 | checkPools (Array.filter filterEmptySyntax sPool, sPool) (conv gPool)
101 |
--------------------------------------------------------------------------------
/src/Fuzzer/Selector.fs:
--------------------------------------------------------------------------------
1 | module Fuzzer.Selector
2 |
3 | open Common
4 | open Analyzer
5 |
6 | let private getRmapMapper rnd cur ty cnt =
7 | Map.find ty cur |> Random.sampleN rnd cnt
8 |
9 | let inline private adjustHelper vars rmap imap idx id ty =
10 | let rId = Array.get (Map.find ty vars) idx
11 | Map.add id rId rmap, Map.add ty (idx + 1) imap
12 |
13 | let private adjustRMap vars (rmap, imap) id ty =
14 | match Map.tryFind ty imap with
15 | | Some idx -> adjustHelper vars rmap imap idx id ty
16 | | None -> adjustHelper vars rmap imap 0 id ty
17 |
18 | let getReplaceMap rnd cur cmap pre =
19 | let vars = Map.map (getRmapMapper rnd cur) cmap
20 | Map.fold (adjustRMap vars) (Map.empty, Map.empty) pre
21 | |> fst
22 |
23 | let private updater (rMap, post, idx) id ty =
24 | match Map.tryFind id rMap with
25 | | Some x -> (rMap, Map.add x ty post, idx)
26 | | None ->
27 | let nId = sprintf "v%d" idx
28 | (Map.add id nId rMap, Map.add nId ty post, idx + 1)
29 |
30 | let updatePost idx rMap post =
31 | let rMap, post, _ = Map.fold updater (rMap, Map.empty, idx) post
32 | rMap, post
33 |
34 | let getDelMap rMap pre post =
35 | let folder (dMap, post) id ty =
36 | match Map.tryFind id pre with
37 | | Some pTy ->
38 | if pTy = ty then (dMap, Map.remove id post)
39 | else (Map.add (Map.find id rMap) pTy dMap, post)
40 | | None -> (dMap, post)
41 | Map.fold folder (Map.empty, post) post
42 |
43 | let pickCond rnd ctx (cmap, _) ((stmt, pre, scope), posts) =
44 | let struct (cur, idx) = Context.preparePickCond ctx
45 | let rMap = getReplaceMap rnd cur cmap pre
46 | let post = Random.sample rnd posts
47 | let dMap, post = getDelMap rMap pre post
48 | let rMap, post = updatePost idx rMap post
49 | let folder ret id lv =
50 | match Map.tryFind id rMap with
51 | | Some nId ->
52 | match Map.tryFind nId post with
53 | | Some ty -> Map.add nId (lv, ty) ret
54 | | None -> Map.add nId (lv, Map.find id pre) ret
55 | | None -> ret
56 | let scope = Map.fold folder Map.empty scope
57 | struct (stmt, rMap, scope, dMap, post)
58 |
59 | let filtSBrick map cnt (((map2, cnt2), syntax2), _) =
60 | if cnt < cnt2 then false
61 | else CountMap.isSub map map2
62 |
63 | let filtBrick map cnt syntax (((map2, cnt2), syntax2), _) =
64 | if cnt < cnt2 then false
65 | else Constraint.isSubSyntax syntax syntax2 && CountMap.isSub map map2
66 |
67 | let filterPool ctx (ssPool, sPool) =
68 | let struct ((map, cnt), syntax) = Context.prepareFilt ctx
69 | if syntax = Constraint.emptySyntax then
70 | Array.filter (filtSBrick map cnt) ssPool
71 | else Array.filter (filtBrick map cnt syntax) sPool
72 |
73 | let pickBrick rnd pool ctx =
74 | let (cmap, _), cands = filterPool ctx pool |> Random.sample rnd
75 | Random.sample rnd cands |> pickCond rnd ctx cmap
76 |
77 | let pickCtx rnd struct (tMap, (cMap, _), idx, scopes, syntax) =
78 | let folder (tMap2, (cMap2, cnt)) ty ids =
79 | let n = Map.find ty cMap |> Random.nxt rnd
80 | if n = 0 then (tMap2, (cMap2, cnt))
81 | else (Map.add ty (Random.sampleN rnd n ids) tMap2,
82 | (Map.add ty n cMap2, cnt + n))
83 | let tMap, cMap = Map.fold folder (Map.empty, (Map.empty, 0)) tMap
84 | struct (tMap, cMap, idx, scopes, syntax)
85 |
86 | let pickGuard rnd gPool ctx =
87 | let struct ((map, cnt), syntax) = Context.prepareFilt ctx
88 | let gPool = Array.filter (filtBrick map cnt syntax) gPool
89 | if Array.length gPool = 0 then None
90 | else
91 | let (cmap, _), cands = Random.sample rnd gPool
92 | Random.sample rnd cands |> pickCond rnd ctx cmap |> Some
93 |
--------------------------------------------------------------------------------
/src/Main/Main.fs:
--------------------------------------------------------------------------------
1 | module Main.Run
2 |
3 | open Main.Preprocess
4 | open Common
5 | open Fuzzer
6 | open OptParse
7 |
8 | type Opts = {
9 | ProbBlk: int
10 | IterBlk: int
11 | IterMax: int
12 | DepthMax: int
13 | }
14 |
15 | let defaultOpts = {
16 | ProbBlk = 16
17 | IterBlk = 3
18 | IterMax = 8
19 | DepthMax = 3
20 | }
21 |
22 | let spec = [
23 | OptParse.Option (
24 | descr = "",
25 | extra = 1,
26 | callback = (fun (opts: Opts) argv -> { opts with ProbBlk = int argv.[0] }),
27 | long = "--pBlk"
28 | );
29 |
30 | OptParse.Option (
31 | descr = "",
32 | extra = 1,
33 | callback = (fun (opts: Opts) argv -> { opts with IterBlk = int argv.[0] }),
34 | long = "--iBlk"
35 | );
36 |
37 | OptParse.Option (
38 | descr = "",
39 | extra = 1,
40 | callback = (fun (opts: Opts) argv -> { opts with IterMax = int argv.[0] }),
41 | long = "--iMax"
42 | );
43 |
44 | OptParse.Option (
45 | descr = "",
46 | extra = 1,
47 | callback = (fun (opts: Opts) argv -> { opts with DepthMax = int argv.[0] }),
48 | long = "--dMax"
49 | );
50 | ]
51 |
52 | let loadConf fname argv =
53 | let prog = "CodeAlchemist"
54 | let usage () = "[Usage]\n commands [confPath] %o"
55 | let _, opts =
56 | try optParse spec usage "CodeAlchemist" argv defaultOpts
57 | with
58 | | SpecErr msg ->
59 | Logger.error "Invalid spec: %s" msg
60 | | RuntimeErr msg ->
61 | Logger.errorNoExit "Invalid args given by user: %s" msg
62 | usagePrint spec prog usage (fun () -> exit 1)
63 | Conf.load fname opts.ProbBlk opts.IterBlk opts.IterMax opts.DepthMax
64 |
65 | let reproduce conf =
66 | let exec = Executor.getAsyncExec conf "/"
67 | let oracle = Fuzzer.Oracle.getOracle conf.Engine
68 | let checkOne js =
69 | let ret = exec js |> Async.RunSynchronously
70 | if oracle ret then
71 | let struct (ret, out, err) = ret
72 | Logger.info "Reproducess success: %s\nSIGNAL: %d\nSTDOUT:\n%s\nSTDERR:\n%s"
73 | js ret out err
74 | else
75 | Logger.info "Reproduce fail: %s" js
76 | Utils.renameFile js (js + ".not")
77 |
78 | Utils.getFiles [||] conf.BugDir
79 | |> Array.filter (fun str -> str.EndsWith (".js"))
80 | |> Array.iter checkOne
81 |
82 | []
83 | let main argv =
84 | if argv.[0] = "rewrite" then loadConf argv.[1] [||] |> rewriteAll
85 | elif argv.[0] = "instrument" then loadConf argv.[1] [||] |> instruments
86 | elif argv.[0] = "fuzz" then
87 | let conf = loadConf argv.[1] argv.[2..]
88 | loadBricks conf |> Fuzzer.fuzz conf
89 | elif argv.[0] = "reproduce" then loadConf argv.[1] [||] |> reproduce
90 | else ()
91 | 0
92 |
--------------------------------------------------------------------------------
/src/Main/Main.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Exe
5 | netcoreapp2.1
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
--------------------------------------------------------------------------------
/src/Main/Preprocess.fs:
--------------------------------------------------------------------------------
1 | module Main.Preprocess
2 |
3 | open Common
4 | open Common.Utils
5 | open AST.Parser
6 | open AST.Loader
7 | open AST.CodeGen
8 | open Analyzer
9 | open Analyzer.Instrument
10 |
11 | let parseSeed conf =
12 | let jsonDir = conf.PreprocDir +/ "json"
13 | if existDir jsonDir then ()
14 | else mkDir jsonDir |> parseAll (Conf.engineToStr conf.Engine) conf.SeedDir
15 | loads jsonDir
16 |
17 | let rewrite rewriteDir loader ctx (name, ast) = async {
18 | let rewriteName = rewriteDir +/ name
19 | rewriteProg ctx ast |> fst |> progToCode Map.empty
20 | |> String.add loader
21 | |> writeFile rewriteName
22 | }
23 |
24 | let rewrites conf asts =
25 | let rewriteDir = conf.PreprocDir +/ "rewrite" |> mkDir
26 | let loader = mkLoader conf.Engine
27 | let ctx = Context.init conf
28 | Array.map (rewrite rewriteDir loader ctx) asts
29 | |> Async.Parallel
30 | |> Async.RunSynchronously
31 | |> ignore
32 |
33 | []
34 | let startKey = "=== CodeAlchemist Start ==="
35 |
36 | []
37 | let endKey = "=== CodeAlchemist End ==="
38 |
39 |
40 | let splitFst (key: string) (target: string) =
41 | let target = target.Split key
42 | if Array.length target > 1 then Array.get target 0
43 | else ""
44 |
45 | let parseResult (out: string) =
46 | let out = out.Split startKey
47 | if Array.length out > 1 then
48 | Array.map (splitFst endKey) out
49 | |> Array.filter (String.neq "")
50 | |> String.concat "," |> sprintf "[%s]"
51 | else "[]"
52 |
53 | let instruments conf =
54 | let rewriteDir = conf.PreprocDir +/ "rewrite"
55 | let outDir = conf.PreprocDir +/ "type" |> mkDir
56 | let exec = Executor.getAsyncExec conf rewriteDir
57 | let instrument js = async {
58 | let! struct (_, out, _) = exec js
59 | writeFile (outDir +/ js) (parseResult out)
60 | }
61 | getFiles [||] rewriteDir
62 | |> Array.map instrument
63 | |> Async.Parallel
64 | |> Async.RunSynchronously
65 | |> ignore
66 |
67 | let rewriteAll conf = parseSeed conf |> rewrites conf
68 |
69 | let asyncFrag ctx (_, ast) = async {
70 | return rewriteProg ctx ast |> snd
71 | }
72 |
73 | let fragmentize conf asts =
74 | let folder (pool, gMap) (p1, g1) = Map.merge pool p1, Map.merge gMap g1
75 | let ctx = Context.init conf
76 | Array.map (asyncFrag ctx) asts
77 | |> Async.Parallel
78 | |> Async.RunSynchronously
79 | |> Array.fold folder (Map.empty, Map.empty)
80 |
81 | let parseTypes json key =
82 | Json.getPropMap json key |> Map.mapVal JSType.ofStr
83 |
84 | let parseJson ret json =
85 | try
86 | let res = Json.getPropInt64 json "hval", parseTypes json "pre",
87 | parseTypes json "post"
88 | Set.add res ret
89 | with
90 | | LoadJSTypeException (ty) -> Logger.warn "Unknown Type: %s" ty; ret
91 | | e -> Logger.error "parseJson fail: %A" e
92 |
93 | let loadType fname = async {
94 | let! json = Json.asyncLoadJson fname
95 | return Json.toArray json |> Array.fold parseJson Set.empty
96 | }
97 |
98 | let loadTypes dir =
99 | getFiles [||] dir
100 | |> Array.map loadType
101 | |> Async.Parallel
102 | |> Async.RunSynchronously
103 | |> Array.fold Set.union Set.empty
104 |
105 | let loadConst pool gMap ret (hval, pre, post) =
106 | let loader = CodeBrick.loadTypes pre post
107 | match Map.tryFind hval pool, Map.tryFind hval gMap with
108 | | Some brick, Some gHash ->
109 | let guard = Map.find gHash pool
110 | (loader guard) :: (loader brick) :: ret
111 | | Some brick, None -> (loader brick) :: ret
112 | | None, _ -> Logger.error "%d not found" hval
113 |
114 | let loadConsts dir (pool, gMap)=
115 | loadTypes dir
116 | |> Set.fold (loadConst pool gMap) []
117 |
118 | let loadBricks conf =
119 | let jsonDir = conf.PreprocDir +/ "json"
120 | let typeDir = conf.PreprocDir +/ "type"
121 | loads jsonDir
122 | |> fragmentize conf
123 | |> loadConsts typeDir
124 |
--------------------------------------------------------------------------------