├── src ├── ocaml │ ├── Stream.hx │ ├── DynArray.hx │ ├── Exception.hx │ ├── Error.hx │ ├── Sys_error.hx │ ├── Exit.hx │ ├── stream │ │ ├── Failure.hx │ │ └── Error.hx │ ├── Not_found.hx │ ├── Failure.hx │ ├── Invalid_argument.hx │ ├── Ref.hx │ ├── OcamlString.hx │ ├── Option.hx │ ├── FloatUtils.hx │ ├── Cloner.hx │ ├── Hashtbl.hx │ ├── PMap.hx │ ├── Arg.hx │ └── List.hx ├── macros │ ├── HlMacro.hx │ ├── eval │ │ ├── Break.hx │ │ ├── Continue.hx │ │ ├── Sys_exit.hx │ │ └── Return.hx │ └── hlmacro │ │ └── Error.hx ├── compiler │ ├── Version.hx │ ├── displayoutput │ │ └── TypePathHandler.hx │ ├── Server.hx │ └── DisplayOutput.hx ├── typing │ ├── matcher │ │ ├── decisiontree │ │ │ ├── Dt.hx │ │ │ └── T.hx │ │ ├── pattern │ │ │ └── T.hx │ │ ├── Decision_tree.hx │ │ ├── Case.hx │ │ ├── Match.hx │ │ ├── Constructor.hx │ │ └── Useless.hx │ ├── MacroContext.hx │ ├── MagicTypes.hx │ └── Matcher.hx ├── syntax │ ├── parser │ │ ├── Display.hx │ │ ├── ErrorMsg.hx │ │ ├── Error.hx │ │ ├── TypePath.hx │ │ └── TokenCache.hx │ ├── lexer │ │ ├── ErrorMsg.hx │ │ └── Error.hx │ ├── Grammar.hx │ ├── Parser.hx │ └── ParserEntry.hx ├── generators │ ├── Gencs.hx │ ├── Genhl.hx │ ├── Genpy.hx │ ├── Genas3.hx │ ├── Gencpp.hx │ ├── Genjava.hx │ ├── Genlua.hx │ ├── Genswf.hx │ └── Genphp7.hx ├── codegen │ ├── Genxml.hx │ ├── overloads │ │ └── Resolution.hx │ └── Overloads.hx ├── neko │ ├── Nbytecode.hx │ ├── Ncompile.hx │ ├── Nast.hx │ └── Binast.hx ├── context │ ├── common │ │ ├── compilationserver │ │ │ └── T.hx │ │ ├── displaymode │ │ │ └── T.hx │ │ ├── IdentifierType.hx │ │ ├── identifiertype │ │ │ └── T.hx │ │ ├── DisplayMode.hx │ │ └── CompilationServer.hx │ ├── displaytypes │ │ ├── symbolinformation │ │ │ └── T.hx │ │ ├── symbolkind │ │ │ └── T.hx │ │ ├── SymbolInformation.hx │ │ ├── SymbolKind.hx │ │ └── DiagnosticsSeverity.hx │ ├── display │ │ ├── DocumentSymbols.hx │ │ ├── Diagnostics.hx │ │ ├── ImportHandling.hx │ │ ├── DeprecationCheck.hx │ │ ├── ExprPreprocessing.hx │ │ └── DisplayEmitter.hx │ ├── DisplayToplevel.hx │ ├── Display.hx │ └── typecore │ │ └── AbstractCast.hx ├── core │ ├── Numeric.hx │ ├── ast │ │ └── Expr.hx │ ├── Globals.hx │ ├── Timer.hx │ ├── type │ │ ├── StringError.hx │ │ ├── Printer.hx │ │ └── TExprToExpr.hx │ ├── Abstract.hx │ ├── Error.hx │ └── Path.hx ├── filters │ ├── LocalUsage.hx │ ├── VarLazifier.hx │ ├── FiltersCommon.hx │ └── JsExceptions.hx └── optimization │ └── AnalyzerConfig.hx ├── README.md └── TODO.md /src/ocaml/Stream.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Stream {} -------------------------------------------------------------------------------- /src/macros/HlMacro.hx: -------------------------------------------------------------------------------- 1 | package macros; 2 | 3 | class HlMacro { 4 | 5 | } -------------------------------------------------------------------------------- /src/ocaml/DynArray.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | typedef DynArray = Array; -------------------------------------------------------------------------------- /src/ocaml/Exception.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Exception { 4 | 5 | } -------------------------------------------------------------------------------- /src/macros/eval/Break.hx: -------------------------------------------------------------------------------- 1 | package macros.eval; 2 | 3 | class Break { 4 | public function new() {} 5 | } -------------------------------------------------------------------------------- /src/macros/eval/Continue.hx: -------------------------------------------------------------------------------- 1 | package macros.eval; 2 | 3 | class Continue { 4 | public function new() {} 5 | } -------------------------------------------------------------------------------- /src/ocaml/Error.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Error { 4 | public static final instance = new Error(); 5 | public function new() {} 6 | } -------------------------------------------------------------------------------- /src/ocaml/Sys_error.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Sys_error { 4 | public static final instance = new Sys_error(); 5 | function new () {} 6 | } -------------------------------------------------------------------------------- /src/ocaml/Exit.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Exit extends Exception { 4 | public static final instance = new Exit(); 5 | public function new () {} 6 | } -------------------------------------------------------------------------------- /src/ocaml/stream/Failure.hx: -------------------------------------------------------------------------------- 1 | package ocaml.stream; 2 | 3 | class Failure { 4 | public static final instance = new Failure(); 5 | function new () {} 6 | } -------------------------------------------------------------------------------- /src/macros/eval/Sys_exit.hx: -------------------------------------------------------------------------------- 1 | package macros.eval; 2 | 3 | class Sys_exit { 4 | public var i:Int; 5 | public function new (i:Int) { 6 | this.i = i; 7 | } 8 | } -------------------------------------------------------------------------------- /src/compiler/Version.hx: -------------------------------------------------------------------------------- 1 | package compiler; 2 | 3 | import haxe.ds.Option; 4 | 5 | class Version { 6 | public static var version_extra : Option = None; 7 | } -------------------------------------------------------------------------------- /src/ocaml/Not_found.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Not_found extends Exception { 4 | public static final instance = new Not_found(); 5 | function new () {} 6 | } -------------------------------------------------------------------------------- /src/ocaml/stream/Error.hx: -------------------------------------------------------------------------------- 1 | package ocaml.stream; 2 | 3 | class Error { 4 | public final msg:String; 5 | public function new(msg:String) { 6 | this.msg = msg; 7 | } 8 | } -------------------------------------------------------------------------------- /src/macros/eval/Return.hx: -------------------------------------------------------------------------------- 1 | package macros.eval; 2 | 3 | class Return { 4 | public var value:Dynamic; 5 | public function new(value:Dynamic) { 6 | this.value = value; 7 | } 8 | } -------------------------------------------------------------------------------- /src/typing/matcher/decisiontree/Dt.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher.decisiontree; 2 | 3 | typedef Dt = { 4 | dt_t: T, 5 | dt_i: Int, 6 | dt_pos: core.Globals.Pos, 7 | dt_goto_target: Bool 8 | } -------------------------------------------------------------------------------- /src/syntax/parser/Display.hx: -------------------------------------------------------------------------------- 1 | package syntax.parser; 2 | 3 | class Display { 4 | public var expr:core.Ast.Expr; 5 | public function new (expr:core.Ast.Expr) { 6 | this.expr = expr; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Gencs.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Gencs { 4 | public static function generate (com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Genhl.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Genhl { 4 | public static function generate (com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Genpy.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Genpy { 4 | public static function generate (com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Genas3.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Genas3 { 4 | public static function generate (com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Gencpp.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Gencpp { 4 | public static function generate (com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Genjava.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Genjava { 4 | public static function generate (com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Genlua.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Genlua { 4 | public static function generate (com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/generators/Genswf.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | class Genswf { 4 | public static function generate (swf_header, com:context.Common.Context) : Void { 5 | trace("TODO: generate"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/ocaml/Failure.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Failure { 4 | public static final instance = new Failure(""); 5 | public var msg:String; 6 | public function new (msg:String) { 7 | this.msg = msg; 8 | } 9 | } -------------------------------------------------------------------------------- /src/ocaml/Invalid_argument.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Invalid_argument { 4 | public static final instance = new Invalid_argument(""); 5 | public final msg:String; 6 | public function new(msg) { this.msg = msg; } 7 | } -------------------------------------------------------------------------------- /src/codegen/Genxml.hx: -------------------------------------------------------------------------------- 1 | package codegen; 2 | 3 | class Genxml { 4 | public static function gen_type_string (ctx:context.Common.Context, t:core.Type.ModuleType) : String { 5 | trace("TODO: Genxml.gen_type_string"); 6 | throw false; 7 | } 8 | } -------------------------------------------------------------------------------- /src/neko/Nbytecode.hx: -------------------------------------------------------------------------------- 1 | package neko; 2 | 3 | import sys.io.FileOutput; 4 | 5 | class Nbytecode { 6 | public static function write (ch:FileOutput, tmp:Dynamic) : Void { 7 | trace("TODO: neko.Nbytecode.write"); 8 | throw false; 9 | } 10 | } -------------------------------------------------------------------------------- /src/context/common/compilationserver/T.hx: -------------------------------------------------------------------------------- 1 | package context.common.compilationserver; 2 | 3 | import haxe.ds.ImmutableList; 4 | 5 | typedef T = { 6 | cache : context.common.CompilationServer.Cache, 7 | signs : ImmutableList<{s1:String, s2:String}> 8 | } -------------------------------------------------------------------------------- /src/syntax/parser/ErrorMsg.hx: -------------------------------------------------------------------------------- 1 | package syntax.parser; 2 | 3 | enum ErrorMsg { 4 | Unexpected (token:core.Ast.Token); 5 | Duplicate_default; 6 | Missing_semicolon; 7 | Unclosed_macro; 8 | Unimplemented; 9 | Missing_type; 10 | Custom(s:String); 11 | } -------------------------------------------------------------------------------- /src/context/displaytypes/symbolinformation/T.hx: -------------------------------------------------------------------------------- 1 | package context.displaytypes.symbolinformation; 2 | 3 | typedef T = { 4 | name : String, 5 | kind : context.displaytypes.symbolkind.T, 6 | pos : core.Globals.Pos, 7 | container_name : haxe.ds.Option 8 | } 9 | -------------------------------------------------------------------------------- /src/syntax/lexer/ErrorMsg.hx: -------------------------------------------------------------------------------- 1 | package syntax.lexer; 2 | 3 | enum ErrorMsg { 4 | Invalid_character(i:Int); 5 | Unterminated_string; 6 | Unterminated_regexp; 7 | Unclosed_comment; 8 | Unclosed_code; 9 | Invalid_escape(char:Int); 10 | Invalid_option; 11 | } -------------------------------------------------------------------------------- /src/context/displaytypes/symbolkind/T.hx: -------------------------------------------------------------------------------- 1 | package context.displaytypes.symbolkind; 2 | 3 | enum T { 4 | Class; 5 | Interface; 6 | Enum; 7 | Typedef; 8 | Abstract; 9 | Field; 10 | Property; 11 | Method; 12 | Constructor; 13 | Function; 14 | Variable; 15 | } -------------------------------------------------------------------------------- /src/ocaml/Ref.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Ref { 4 | var internal:T; 5 | public function new (t:T) { 6 | internal = t; 7 | } 8 | 9 | public inline function get () : T { 10 | return internal; 11 | } 12 | 13 | public function set (t:T) : T { 14 | return internal = t; 15 | } 16 | } -------------------------------------------------------------------------------- /src/macros/hlmacro/Error.hx: -------------------------------------------------------------------------------- 1 | package macros.hlmacro; 2 | 3 | import haxe.ds.ImmutableList; 4 | 5 | class Error { 6 | public var s:String; 7 | public var p:ImmutableList; 8 | public function new (s:String, p:ImmutableList) { 9 | this.s = s; 10 | this.p = p; 11 | } 12 | } -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haxe in Haxe - WIP 2 | 3 | Attempt at rewriting the haxe compiler directly in haxe. 4 | 5 | The parser is a slightly modified version of haxeparser: https://github.com/Simn/haxeparser 6 | 7 | Based on haxe commit b3cc1d79495acafa0ceabc985cd663efc00a28a5 8 | 9 | Using ImmutableList introduced on https://github.com/HaxeFoundation/haxe/tree/genml -------------------------------------------------------------------------------- /src/context/display/DocumentSymbols.hx: -------------------------------------------------------------------------------- 1 | package context.display; 2 | 3 | import ocaml.DynArray; 4 | 5 | class DocumentSymbols { 6 | 7 | public static function collect_module_symbols(data:Any) : DynArray { 8 | trace("TODO context.display.DocumentSymbols.collect_module_symbols"); 9 | throw false; 10 | } 11 | } -------------------------------------------------------------------------------- /src/ocaml/OcamlString.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class OcamlString { 4 | public static function index_from (str:String, id:Int, c:String) : Int { 5 | if (id < 0 || id > str.length) { 6 | throw new ocaml.Invalid_argument("ocaml.String.index_from"); 7 | } 8 | var id = str.indexOf(c, id); 9 | if (id == -1) { 10 | throw ocaml.Not_found.instance; 11 | } 12 | return id; 13 | 14 | } 15 | } -------------------------------------------------------------------------------- /src/generators/Genphp7.hx: -------------------------------------------------------------------------------- 1 | package generators; 2 | 3 | import core.Path; 4 | 5 | class Genphp7 { 6 | /* Special abstract which enables passing function arguments and return value by reference */ 7 | public static final ref_type_path = new Path(["php"], "Ref"); 8 | 9 | /* 10 | Entry point to Genphp7 11 | */ 12 | public static function generate (com:context.Common.Context) : Void { 13 | trace("TODO: generate"); 14 | throw false; 15 | } 16 | } -------------------------------------------------------------------------------- /src/syntax/parser/Error.hx: -------------------------------------------------------------------------------- 1 | package syntax.parser; 2 | 3 | class Error { 4 | public var error_msg:ErrorMsg; 5 | public var pos:core.Globals.Pos; 6 | public function new (error_msg:ErrorMsg, pos:core.Globals.Pos) { 7 | this.error_msg = error_msg; 8 | this.pos = pos; 9 | } 10 | public static function of(msg:ErrorMsg, pos:{file:String, min:Int, max:Int}) { 11 | return new Error(msg, new core.Globals.Pos(pos.file, pos.min, pos.max)); 12 | } 13 | } -------------------------------------------------------------------------------- /src/typing/matcher/decisiontree/T.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher.decisiontree; 2 | 3 | import haxe.ds.ImmutableList; 4 | 5 | enum T { 6 | Leaf (t:typing.matcher.Case.T); 7 | Switch(subject:core.Type.TExpr, l:ImmutableList<{fst:typing.matcher.Constructor, snd:Bool, trd:Dt}>, d:Dt); 8 | Bind(l:ImmutableList, d:Dt); 9 | Guard(e:core.Type.TExpr, d1:Dt, d2:Dt); 10 | GuardNull(e:core.Type.TExpr, d1:Dt, d2:Dt); 11 | Fail; 12 | } 13 | -------------------------------------------------------------------------------- /src/context/common/displaymode/T.hx: -------------------------------------------------------------------------------- 1 | package context.common.displaymode; 2 | 3 | import haxe.ds.Option; 4 | 5 | enum T { 6 | DMNone; 7 | DMField; 8 | DMUsage (b:Bool); // true = also report definition 9 | DMPosition; 10 | DMToplevel; 11 | DMResolve (s:String); 12 | DMPackage; 13 | DMType; 14 | DMModuleSymbols (s:Option); 15 | DMDiagnostics (b:Bool); /* true = global, false = only in display file */ 16 | DMStatistics; 17 | DMSignature; 18 | } -------------------------------------------------------------------------------- /src/context/displaytypes/SymbolInformation.hx: -------------------------------------------------------------------------------- 1 | package context.displaytypes; 2 | 3 | class SymbolInformation { 4 | 5 | public static function make (name : String, kind : context.displaytypes.symbolkind.T, pos : core.Globals.Pos, container_name : haxe.ds.Option) : context.common.displaytypes.symbolinformation.T { 6 | return { 7 | name : name, 8 | kind : kind, 9 | pos : pos, 10 | container_name : container_name 11 | }; 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /src/neko/Ncompile.hx: -------------------------------------------------------------------------------- 1 | package neko; 2 | 3 | import neko.Nast.Expr; 4 | import neko.Nast.Pos; 5 | 6 | class Error { 7 | public final msg:String; 8 | public final pos:Pos; 9 | 10 | public function new (msg:String, pos:Pos) { 11 | this.msg = msg; this.pos = pos; 12 | } 13 | } 14 | 15 | class Ncompile { 16 | 17 | public static function compile (version:Int, ast:Expr) : Dynamic { 18 | trace("TODO: neko.Ncompile.compile"); 19 | throw false; 20 | } 21 | 22 | } -------------------------------------------------------------------------------- /src/syntax/lexer/Error.hx: -------------------------------------------------------------------------------- 1 | package syntax.lexer; 2 | 3 | class Error { 4 | public var error_msg:ErrorMsg; 5 | public var pos:core.Globals.Pos; 6 | public function new (error_msg:ErrorMsg, pos:core.Globals.Pos) { 7 | this.error_msg = error_msg; 8 | this.pos = pos; 9 | } 10 | 11 | public static function of(error_msg:ErrorMsg, pos:hxparse.Position) : Error { 12 | return new Error(error_msg, new core.Globals.Pos(pos.psource, pos.pmin, pos.pmax)); 13 | } 14 | } -------------------------------------------------------------------------------- /src/typing/matcher/pattern/T.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher.pattern; 2 | 3 | import haxe.ds.ImmutableList; 4 | import typing.matcher.Pattern; 5 | 6 | enum T { 7 | PatConstructor(t:typing.matcher.Constructor, l:ImmutableList); 8 | PatVariable(v:core.Type.TVar); 9 | PatAny; 10 | PatBind(v:core.Type.TVar, p:Pattern); 11 | PatOr(p1:Pattern, p2:Pattern); 12 | PatTuple(l:ImmutableList); 13 | PatExtractor(v:core.Type.TVar, e:core.Type.TExpr, p:Pattern); 14 | } -------------------------------------------------------------------------------- /src/syntax/parser/TypePath.hx: -------------------------------------------------------------------------------- 1 | package syntax.parser; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | // in import 7 | class TypePath { 8 | public var p:ImmutableList; 9 | public var c:Option<{c:String, cur_package:Bool}>; 10 | public var is_import:Bool; 11 | public function new (p:ImmutableList, c:Option<{c:String, cur_package:Bool}>, is_import:Bool) { 12 | this.p = p; 13 | this.c = c; 14 | this.is_import = is_import; 15 | } 16 | } -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - replace switch (smth) { case ? : true; case _: false } by smth.match(?) 2 | - replace switch ({f:..., s:...}) by switch [..., ...] 3 | - ensure var old = ... doesn't require cloning 4 | - ensure equality works as expected 5 | - use strict equality when asked for 6 | - (a || b) in ocaml is (b || a) in haxe 7 | - note: a == [] doesn't work with immutable list 8 | - possible problem in function check_overflow with int32/64 9 | - use the type T as the class definition for typedef use abstract for enum? -------------------------------------------------------------------------------- /src/context/displaytypes/SymbolKind.hx: -------------------------------------------------------------------------------- 1 | package context.displaytypes; 2 | 3 | class SymbolKind { 4 | 5 | public static function toInt (sk:context.displaytypes.symbolkind.T) { 6 | return switch(sk) { 7 | case Class : 1; 8 | case Interface : 2; 9 | case Enum : 3; 10 | case Typedef : 4; 11 | case Abstract : 5; 12 | case Field : 6; 13 | case Property : 7; 14 | case Method : 8; 15 | case Constructor : 9; 16 | case Function : 10; 17 | case Variable : 11; 18 | }; 19 | } 20 | } -------------------------------------------------------------------------------- /src/syntax/parser/TokenCache.hx: -------------------------------------------------------------------------------- 1 | package syntax.parser; 2 | 3 | class TokenCache { 4 | public static var cache:ocaml.DynArray = []; 5 | 6 | public static function add(token:syntax.Lexer.Token) { 7 | cache.push(token); 8 | } 9 | 10 | public static function get(i:Int) { 11 | return cache[i]; 12 | } 13 | 14 | public static function clear () : Void->Void { 15 | var old_cache = cache.copy(); 16 | cache = []; 17 | return function () { 18 | cache = old_cache; 19 | } 20 | } 21 | } -------------------------------------------------------------------------------- /src/context/displaytypes/DiagnosticsSeverity.hx: -------------------------------------------------------------------------------- 1 | package context.displaytypes; 2 | 3 | enum DiagnosticsSeverity_T { 4 | Error; 5 | Warning; 6 | Information; 7 | Hint; 8 | } 9 | 10 | abstract DiagnosticsSeverity(DiagnosticsSeverity_T) from DiagnosticsSeverity_T to DiagnosticsSeverity_T { 11 | public static function toInt (t:context.displaytypes.DiagnosticsSeverity) : Int { 12 | return switch(t) { 13 | case Error : 1; 14 | case Warning : 2; 15 | case Information : 3; 16 | case Hint : 4; 17 | } 18 | } 19 | } -------------------------------------------------------------------------------- /src/context/common/IdentifierType.hx: -------------------------------------------------------------------------------- 1 | package context.common; 2 | 3 | class IdentifierType { 4 | public static function get_name (t:context.common.identifiertype.T) : String { 5 | return switch (t) { 6 | case ITLocal(v) : v.v_name; 7 | case ITMember(_,cf) | ITStatic(_,cf) | ITEnumAbstract(_,cf) : cf.cf_name; 8 | case ITEnum(_,ef) : ef.ef_name; 9 | case ITGlobal(_,s,_) : s; 10 | case ITType(mt) : core.Type.t_infos(mt).mt_path.b; 11 | case ITPackage(s) : s; 12 | case ITLiteral(s) : s; 13 | case ITTimer(s) : s; 14 | } 15 | } 16 | } -------------------------------------------------------------------------------- /src/typing/matcher/Decision_tree.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher; 2 | 3 | enum Type_finiteness { 4 | Infinite; // type has inifite constructors (e.g. Int, String) 5 | CompileTimeFinite; //type is considered finite only at compile-time but has inifite possible run-time values (enum abstracts) 6 | RunTimeFinite; // type is truly finite (Bool, enums) 7 | } 8 | 9 | class Decision_tree { 10 | public static function to_string (tabs:String, dt:typing.matcher.decisiontree.Dt) : String { 11 | trace("TODO: Decision_tree.to_string"); 12 | throw false; 13 | } 14 | } -------------------------------------------------------------------------------- /src/context/common/identifiertype/T.hx: -------------------------------------------------------------------------------- 1 | package context.common.identifiertype; 2 | 3 | enum T { 4 | ITLocal (v:core.Type.TVar); 5 | ITMember (c:core.Type.TClass, field:core.Type.TClassField); 6 | ITStatic (c:core.Type.TClass, field:core.Type.TClassField); 7 | ITEnum (e:core.Type.TEnum, field:core.Type.TEnumField); 8 | ITEnumAbstract (a:core.Type.TAbstract, field:core.Type.TClassField); 9 | ITGlobal (mt:core.Type.ModuleType, s:String, t:core.Type.T); 10 | ITType (mt:core.Type.ModuleType); 11 | ITPackage (s:String); 12 | ITLiteral (s:String); 13 | ITTimer (s:String); 14 | } -------------------------------------------------------------------------------- /src/codegen/overloads/Resolution.hx: -------------------------------------------------------------------------------- 1 | package codegen.overloads; 2 | 3 | import haxe.ds.ImmutableList; 4 | 5 | import core.Globals.Pos; 6 | import core.Type.T; 7 | import core.Type.TExpr; 8 | 9 | 10 | /** 11 | * Overload resolution 12 | */ 13 | class Resolution { 14 | 15 | public static function reduce_compatible (compatible:ImmutableList<{fst:ImmutableList<{fst:TExpr, snd:Bool}>, snd:T, trd:TExpr->Pos->TExpr}>) : ImmutableList<{fst:ImmutableList<{fst:TExpr, snd:Bool}>, snd:T, trd:TExpr->Pos->TExpr}> { 16 | trace("TODO: codegen.overloads.Resolution"); 17 | throw false; 18 | } 19 | } -------------------------------------------------------------------------------- /src/context/display/Diagnostics.hx: -------------------------------------------------------------------------------- 1 | package context.display; 2 | 3 | class Diagnostics { 4 | public static function is_diagnostics_run (ctx:context.Typecore.Typer) : Bool { 5 | return switch (ctx.com.display.dms_kind) { 6 | case DMDiagnostics(true): true; 7 | case DMDiagnostics(false): ctx.is_display_file; 8 | case _: false; 9 | }; 10 | } 11 | public static function secure_generated_code (ctx:context.Typecore.Typer, e:core.Type.TExpr) : core.Type.TExpr { 12 | return if (is_diagnostics_run(ctx)) { 13 | core.Type.mk(TMeta({name:Extern, params:[], pos:e.epos}, e), e.etype, e.epos); 14 | } 15 | else { 16 | e; 17 | } 18 | } 19 | } -------------------------------------------------------------------------------- /src/ocaml/Option.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | class Option { 4 | 5 | public static function may (f:A->Void, opt:haxe.ds.Option) : Void { 6 | switch (opt) { 7 | case Some(a): f(a); 8 | case None: 9 | } 10 | } 11 | 12 | public static function map (f:A->B, opt:haxe.ds.Option) : haxe.ds.Option { 13 | return switch (opt) { 14 | case None: None; 15 | case Some(v): Some(f(v)); 16 | } 17 | } 18 | 19 | public static function map_default(f:A->B, x:B, opt:haxe.ds.Option) : B { 20 | return switch (opt) { 21 | case Some(v): f(v); 22 | case None: x; 23 | } 24 | } 25 | 26 | public static inline function is_some(x:haxe.ds.Option) : Bool { 27 | return x.match(Some(_)); 28 | } 29 | } -------------------------------------------------------------------------------- /src/compiler/displayoutput/TypePathHandler.hx: -------------------------------------------------------------------------------- 1 | package compiler.displayoutput; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | class TypePathHandler { 7 | 8 | public static function complete_type_path (com:context.Common.Context, p:ImmutableList) : Option> { 9 | trace("TODO: compiler.displayoutput.TypePathHandler.complete_type_path"); 10 | throw false; 11 | } 12 | 13 | public static function complete_type_path_inner (com:context.Common.Context, p:ImmutableList, c:String, cur_package:Bool, is_import:Bool) : Option> { 14 | trace("TODO: compiler.displayoutput.TypePathHandler.complete_type_path"); 15 | throw false; 16 | } 17 | } -------------------------------------------------------------------------------- /src/context/display/ImportHandling.hx: -------------------------------------------------------------------------------- 1 | package context.display; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.PMap; 5 | import ocaml.Ref; 6 | 7 | class ImportHandling { 8 | 9 | public static function add_import_position (com:context.Common.Context, p:core.Globals.Pos, path:ImmutableList) { 10 | PMap.add(p, {b:new Ref(false), l:path}, com.shared.shared_display_information.import_positions); 11 | } 12 | 13 | public static function mark_import_position (com:context.Common.Context, p:core.Globals.Pos) : Void { 14 | try { 15 | var r = PMap.find(p, com.shared.shared_display_information.import_positions).b; 16 | r.set(true); 17 | } 18 | catch (_:ocaml.Not_found) {} 19 | } 20 | 21 | public static function maybe_mark_import_position (ctx:context.Typecore.Typer, p:core.Globals.Pos) : Void { 22 | if (context.display.Diagnostics.is_diagnostics_run(ctx)) { 23 | mark_import_position(ctx.com, p); 24 | } 25 | } 26 | } -------------------------------------------------------------------------------- /src/typing/MacroContext.hx: -------------------------------------------------------------------------------- 1 | package typing; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | import ocaml.PMap; 7 | 8 | class MacroContext { 9 | 10 | public static function get_stored_typed_expr (com:context.Common.Context, id:Int) : core.Type.TExpr { 11 | var e = PMap.find(id, com.stored_typed_exprs); 12 | return core.Texpr.duplicate_tvars(e); 13 | } 14 | 15 | public static function call_init_macro (ctx:context.Typecore.Typer, e:String) : Void { 16 | trace("TODO: typing.MacroContext.call_init_macro"); 17 | } 18 | 19 | public static function type_macro (ctx:context.Typecore.Typer, mode:context.Typecore.MacroMode, cpath:core.Path, f:String, els:ImmutableList, p:core.Globals.Pos) : Option { 20 | trace("TODO typing.MacroContext.type_macro"); 21 | throw false; 22 | } 23 | 24 | public static function interpret (ctx:context.Typecore.Typer) : Void { 25 | trace("TODO: typing.MacroContext.interpret"); 26 | throw false; 27 | } 28 | 29 | public static function setup () : Void { 30 | trace("TODO typing.MacroContext.setup"); 31 | } 32 | } -------------------------------------------------------------------------------- /src/core/Numeric.hx: -------------------------------------------------------------------------------- 1 | package core; 2 | 3 | class Numeric { 4 | 5 | /* Taken from OCaml source typing/oprint.ml 6 | 7 | This is a better version of string_of_float which prints without loss of precision 8 | so that float_of_string (float_repres x) = x for all floats x 9 | */ 10 | public static function valid_float_lexeme (s:String) : String { 11 | var l = s.length; 12 | function loop (i:Int) : String { 13 | if (i >= l) { 14 | return s + "."; 15 | } 16 | else { 17 | return switch (s.charAt(i)) { 18 | case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '-': loop(i+1); 19 | case _: s; 20 | } 21 | } 22 | } 23 | return loop(0); 24 | } 25 | 26 | public static function float_repres (f) : String { 27 | return switch(ocaml.FloatUtils.classify_float(f)) { 28 | case FP_nan: "nan"; 29 | case FP_infinite: 30 | (f < 0.0) ? "neg_infinity" : "infinity"; 31 | case _: 32 | var s1 = ocaml.FloatUtils.toString(f, 12); 33 | var float_val = if (f == Std.parseFloat(s1)) { 34 | s1; 35 | } 36 | else { 37 | var s2 = ocaml.FloatUtils.toString(f, 15); 38 | if (f == Std.parseFloat(s2)) { 39 | s2; 40 | } 41 | else { 42 | ocaml.FloatUtils.toString(f, 18); 43 | } 44 | } 45 | valid_float_lexeme(float_val); 46 | } 47 | } 48 | 49 | } -------------------------------------------------------------------------------- /src/context/DisplayToplevel.hx: -------------------------------------------------------------------------------- 1 | package context; 2 | 3 | import core.type.StringError; 4 | import haxe.ds.ImmutableList; 5 | import ocaml.List; 6 | 7 | class DisplayToplevel { 8 | public static function collect(ctx:context.Typecore.Typer, only_types:Bool) : ImmutableList { 9 | trace("TODO: context.DisplayToplevel.collect"); 10 | throw false; 11 | } 12 | 13 | public static function handle_unresolved_identifier (ctx:context.Typecore.Typer, i:String, p, only_types:Bool) { 14 | var l = collect(ctx, only_types); 15 | var cl = List.map(function (it) { 16 | var s = context.common.IdentifierType.get_name(it); 17 | return {fst:{fst:s, snd:it}, snd:StringError.levenshtein(i, s)}; 18 | }, l); 19 | cl = List.sort( function (a1:{fst:{fst:String, snd:context.common.identifiertype.T}, snd:Int}, a2:{fst:{fst:String, snd:context.common.identifiertype.T}, snd:Int}) { 20 | var c1 = a1.snd; var c2 = a2.snd; 21 | if (c1 == c2) { return 0; } 22 | return (c1 > c2) ? 1 : -1; 23 | }, cl); 24 | function filter (el:{fst:String, snd:context.common.identifiertype.T}, r:Int) : Bool { 25 | var s = el.fst; 26 | return r > 0 && r <= Math.min(s.length, (i.length / 3.0)) ; 27 | } 28 | var _cl = StringError.filter_similar(filter, cl); 29 | ctx.com.display_information.unresolved_identifiers = {s:i, pos:p, l:_cl} :: ctx.com.display_information.unresolved_identifiers; 30 | } 31 | } -------------------------------------------------------------------------------- /src/typing/MagicTypes.hx: -------------------------------------------------------------------------------- 1 | package typing; 2 | 3 | class MagicTypes { 4 | 5 | public static function extend_remoting (ctx:context.Typecore.Typer, c:core.Type.TClass, t:core.Ast.TypePath, p:core.Globals.Pos, async:Bool, prot:Bool) { 6 | trace("TODO: typing.MagicTypes.extend_remoting"); 7 | } 8 | 9 | public static function extend_xml_proxy (ctx:context.Typecore.Typer, c:core.Type.TClass, t:core.Ast.ComplexType, file:String, p:core.Globals.Pos) { 10 | trace("TODO: typing.MagicTypes.extend_xml_proxy"); 11 | } 12 | 13 | public static function on_inherit (ctx:context.Typecore.Typer, c:core.Type.TClass, p:core.Globals.Pos, r:{is_extends:Bool, tp:core.Ast.PlacedTypePath}) : Bool { 14 | if (!r.is_extends) { return true; } 15 | return switch(r.tp.tp) { 16 | case { tpackage: ["haxe","remoting"], 17 | tname: "Proxy", 18 | tparams: [TPType({ct:CTPath(t),pos:{pfile:"?", pmin:-1, pmax:-1}})] }: 19 | extend_remoting(ctx, c, t, p, false, true); 20 | false; 21 | case { tpackage: ["haxe","remoting"], 22 | tname: "AsyncProxy", 23 | tparams: [TPType({ct:CTPath(t),pos:{pfile:"?", pmin:-1, pmax:-1}})] }: 24 | extend_remoting(ctx, c, t, p, true, true); 25 | false; 26 | case { tpackage: ["haxe","xml"], 27 | tname: "Proxy", 28 | tparams: [TPExpr({expr:EConst(CString(file)), pos:p}), TPType({ct:t, pos:_})] }: 29 | extend_xml_proxy(ctx, c, t, file, p); 30 | true; 31 | default: 32 | true; 33 | }; 34 | } 35 | } -------------------------------------------------------------------------------- /src/ocaml/FloatUtils.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | enum Fpclass { 4 | FP_normal; // Normal number, none of the below 5 | FP_subnormal; // Number very close to 0.0, has reduced precision 6 | FP_zero; // Number is 0.0 or -0.0 7 | FP_infinite; // Number is positive or negative infinity 8 | FP_nan; // Not a number: result of an undefined operation 9 | } 10 | 11 | class FloatUtils { 12 | 13 | public static final min_int32:Float = -2147483648; 14 | public static final max_int32:Float = 2147483647; 15 | 16 | public static function float_of_string (f:String) : Float { 17 | var _f:Null = Std.parseFloat(f); 18 | if (_f == null) { 19 | throw new Failure("float_of_string"); 20 | } 21 | return _f; 22 | } 23 | 24 | public static function classify_float(f:Float) : Fpclass { 25 | if (Math.isNaN(f)) { return FP_nan; } 26 | if (!Math.isFinite(f)) { return FP_infinite; } 27 | if (f == 0.0) { return FP_zero; } 28 | return FP_normal; 29 | } 30 | 31 | public static function toString(n:Float, precision:Int) : String { 32 | var str = ''+n; 33 | var l = str.length; 34 | var dot = str.indexOf("."); 35 | if (dot < 0) { 36 | return str + "." + [for (_ in 0...precision) "0"].join(""); 37 | } 38 | dot++; 39 | var diff = (dot+precision) - l; 40 | if (diff > 0) { 41 | return str+[for (_ in 0...diff) "0"].join(""); 42 | } 43 | else if (diff == 0) { 44 | return str; 45 | } 46 | else { 47 | return str.substr(0, dot+precision); 48 | } 49 | } 50 | 51 | } -------------------------------------------------------------------------------- /src/core/ast/Expr.hx: -------------------------------------------------------------------------------- 1 | package core.ast; 2 | 3 | import haxe.ds.ImmutableList; 4 | 5 | class Expr { 6 | public static function ensure_block (e:core.Ast.Expr) : core.Ast.Expr { 7 | return switch (e.expr) { 8 | case EBlock(_): e; 9 | case _: {expr:EBlock([e]), pos:e.pos}; 10 | } 11 | } 12 | 13 | public static function field_assoc (name:String, fl:ImmutableList<{name:String, pos:core.Globals.Pos, quotes:core.Ast.QuoteStatus, expr:T}>) : T { 14 | // function loop (fl:ImmutableList) { 15 | function loop (fl:ImmutableList<{name:String, pos:core.Globals.Pos, quotes:core.Ast.QuoteStatus, expr:T}>) { 16 | return switch (fl) { 17 | case {name:name_, expr:e}::fl: 18 | if (name_==name) { 19 | e; 20 | } 21 | else { 22 | loop(fl); 23 | } 24 | case []: throw ocaml.Not_found.instance; 25 | } 26 | } 27 | return loop(fl); 28 | } 29 | 30 | public static function field_mem_assoc (name:String, fl:ImmutableList<{name:String, pos:core.Globals.Pos, quotes:core.Ast.QuoteStatus, expr:T}>) : Bool { 31 | function loop (fl:ImmutableList<{name:String, pos:core.Globals.Pos, quotes:core.Ast.QuoteStatus, expr:T}>) { 32 | return switch (fl) { 33 | case {name:name_, expr:e}::fl: 34 | if (name_==name) { 35 | throw ocaml.Exit.instance; 36 | } 37 | else { 38 | loop(fl); 39 | } 40 | case []: false; 41 | } 42 | } 43 | return try { 44 | loop(fl); 45 | } 46 | catch (_:ocaml.Exit) { 47 | true; 48 | } 49 | } 50 | } -------------------------------------------------------------------------------- /src/neko/Nast.hx: -------------------------------------------------------------------------------- 1 | package neko; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | typedef Pos = { 7 | psource:String, 8 | pline: Int 9 | } 10 | 11 | enum Constant { 12 | True; 13 | False; 14 | Null; 15 | This; 16 | Int(i:Int); 17 | Float(s:String); 18 | String(s:String); 19 | Builtin(s:String); 20 | Ident(s:String); 21 | Int32(i:haxe.Int32); 22 | } 23 | 24 | enum WhileFlag { 25 | NormalWhile; 26 | DoWhile; 27 | } 28 | 29 | typedef EObjectElement = {s:String, e:Expr}; 30 | 31 | enum ExprDecl { 32 | EConst(c:Constant); 33 | EBlock(l:ImmutableList); 34 | EParenthesis(e:Expr); 35 | EField(e:Expr, s:String); 36 | ECall(e:Expr, el:ImmutableList); 37 | EArray(e1:Expr, e2:Expr); 38 | EVars(vl:ImmutableList<{name:String, def:Option}>); 39 | EWhile(e1:Expr, e2:Expr, flag:WhileFlag); 40 | EIf(cond:Expr, ethen:Expr, eelse:Option); 41 | ETry(e1:Expr, s:String, e2:Expr); 42 | EFunction(params:ImmutableList, body:Expr); 43 | EBinop(op:String, e1:Expr, e2:Expr); 44 | EReturn(eo:Option); 45 | EBreak(eo:Option); 46 | EContinue; 47 | ENext(e1:Expr, e2:Expr); 48 | EObject(ol:ImmutableList); 49 | ELabel(s:String); 50 | ESwitch(e:Expr, cases:ImmutableList<{e1:Expr, e2:Expr}>, guard:Option); 51 | ENeko(s:String); 52 | } 53 | 54 | typedef Expr = { 55 | decl:ExprDecl, 56 | pos:Pos 57 | } 58 | 59 | class Nast { 60 | public static inline function pos (e:Expr) : Pos { return e.pos; } 61 | public static final null_pos:Pos = {pline:0, psource:""}; 62 | 63 | } -------------------------------------------------------------------------------- /src/filters/LocalUsage.hx: -------------------------------------------------------------------------------- 1 | package filters; 2 | 3 | import ocaml.List; 4 | 5 | enum Usage { 6 | Block(f:(Usage->Void)->Void); 7 | Loop(f:(Usage->Void)->Void); 8 | Function(f:(Usage->Void)->Void); 9 | Declare(v:core.Type.TVar); 10 | Use(v:core.Type.TVar); 11 | Assign(v:core.Type.TVar); 12 | } 13 | 14 | class LocalUsage { 15 | public static function local_usage(f:Usage->Void, e:core.Type.TExpr) : Void { 16 | switch (e.eexpr) { 17 | case TBinop((OpAssign|OpAssignOp(_)), {eexpr:TLocal(v)}, e2): 18 | local_usage(f, e2); 19 | f(Assign(v)); 20 | case TUnop((OpIncrement|OpDecrement), _, {eexpr:TLocal(v)}): 21 | f(Assign(v)); 22 | case TLocal(v): 23 | f(Use(v)); 24 | case TVar(v, eo): 25 | switch (eo) { case None: case Some(e): local_usage(f, e); } 26 | f(Declare(v)); 27 | case TFunction(tf): 28 | function cc (f) { 29 | List.iter(function (arg) { var v = arg.v; f(Declare(v)); }, tf.tf_args); 30 | local_usage(f, tf.tf_expr); 31 | } 32 | f(Function(cc)); 33 | case TBlock(l): 34 | f(Block(function (f) { List.iter(local_usage.bind(f), l); })); 35 | case TFor(v, it, e): 36 | local_usage(f, it); 37 | f(Loop(function (f) { 38 | f(Declare(v)); 39 | local_usage(f, e); 40 | })); 41 | case TWhile(_): 42 | f(Loop(function (f) { 43 | core.Type.iter(local_usage.bind(f), e); 44 | })); 45 | case TTry(e, catchs): 46 | local_usage(f, e); 47 | List.iter(function (_tmp) { 48 | var v = _tmp.v; var e = _tmp.e; 49 | f(Block(function (f) { 50 | f(Declare(v)); 51 | local_usage(f, e); 52 | })); 53 | }, catchs); 54 | case _: 55 | core.Type.iter(local_usage.bind(f), e); 56 | } 57 | } 58 | } -------------------------------------------------------------------------------- /src/context/Display.hx: -------------------------------------------------------------------------------- 1 | package context; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | enum DisplayFieldKind { 7 | FKVar (t:core.Type.T); 8 | FKMethod (t:core.Type.T); 9 | FKType (t:core.Type.T); 10 | FKModule; 11 | FKPackage; 12 | FKMetadata; 13 | FKTimer (s:String); 14 | } 15 | 16 | enum DisplayException { 17 | Diagnostics (s:String); 18 | Statistics (s:String); 19 | ModuleSymbols (s:String); 20 | Metadata (s:String); 21 | DisplaySignatures (l:ImmutableList<{sig:core.Type.TSignature, doc:core.Ast.Documentation}>, i:Int); 22 | DisplayType (t:core.Type.T, pos:core.Globals.Pos, s:Option); 23 | DisplayPosition (l:ImmutableList); 24 | DisplayFields (l:ImmutableList<{name:String, kind:DisplayFieldKind, doc:core.Ast.Documentation}>); 25 | DisplayToplevel (l:ImmutableList); 26 | DisplayPackage (l:ImmutableList); 27 | } 28 | 29 | class Display { 30 | public static function is_display_file (file:String) : Bool { 31 | return (file != "?") && 32 | (core.Path.unique_full_path(file) == syntax.Parser.resume_display.get().pfile); 33 | } 34 | 35 | public static function encloses_position (p_target:core.Globals.Pos, p:core.Globals.Pos) : Bool { 36 | return p.pmin <= p_target.pmin && p.pmax >= p_target.pmax; 37 | } 38 | 39 | public static function is_display_position (p:core.Globals.Pos) : Bool { 40 | return encloses_position(syntax.Parser.resume_display.get(),p); 41 | } 42 | 43 | public static function display_field_kind_index (dfk:DisplayFieldKind) : Int { 44 | return switch (dfk) { 45 | case FKVar(_): 0; 46 | case FKMethod(_): 1; 47 | case FKType(_): 2; 48 | case FKModule: 3; 49 | case FKPackage: 4; 50 | case FKMetadata: 5; 51 | case FKTimer(_): 6; 52 | } 53 | } 54 | } -------------------------------------------------------------------------------- /src/filters/VarLazifier.hx: -------------------------------------------------------------------------------- 1 | package filters; 2 | 3 | import haxe.ds.Option; 4 | import ocaml.List; 5 | import ocaml.PMap; 6 | 7 | import core.Type; 8 | 9 | using ocaml.Cloner; 10 | 11 | class VarLazifier { 12 | public static function apply (com:context.Common.Context, e:core.Type.TExpr) : core.Type.TExpr { 13 | function loop (var_inits:PMap, e:core.Type.TExpr) : {fst:PMap, snd:core.Type.TExpr} { 14 | return switch (e.eexpr) { 15 | case TVar(v, Some(e1)) if (core.Meta.has(Custom(":extract"), v.v_meta)): 16 | var _tmp = loop(var_inits, e1); 17 | var var_inits = _tmp.fst; var e1 = _tmp.snd; 18 | var_inits = PMap.add(v.v_id, e1, var_inits); 19 | {fst:var_inits, snd:e.with({eexpr:TVar(v, None)})}; 20 | case TLocal(v): 21 | try { 22 | var e_init = PMap.find(v.v_id, var_inits); 23 | var e = e.with({eexpr:TBinop(OpAssign, e, e_init)}); 24 | e = e.with({eexpr:TParenthesis(e)}); 25 | var var_inits = PMap.remove(v.v_id, var_inits); 26 | {fst:var_inits, snd:e}; 27 | } 28 | catch (_:ocaml.Not_found) { 29 | {fst:var_inits, snd:e}; 30 | } 31 | case TIf(e1, e2, eo): 32 | var _tmp = loop(var_inits, e1); 33 | var var_inits = _tmp.fst; var e1 = _tmp.snd; 34 | var e2 = loop(var_inits, e2).snd; 35 | var eo = switch (eo) { case None: None; case Some(e): Some(loop(var_inits, e).snd); } 36 | {fst:var_inits, snd:e.with({eexpr:TIf(e1, e2, eo)})}; 37 | case TSwitch (e1, cases, edef): 38 | var _tmp = loop(var_inits, e1); 39 | var var_inits = _tmp.fst; var e1 = _tmp.snd; 40 | var cases = List.map(function (c) { 41 | var el = c.values; var e = c.e; 42 | var e = loop(var_inits, e).snd; 43 | return {values:el, e:e}; 44 | }, cases); 45 | var edef = switch (edef) { case None: None; case Some(e): Some(loop(var_inits, e).snd); } 46 | {fst:var_inits, snd:e.with({eexpr: TSwitch(e1, cases, edef)})}; 47 | case _: 48 | core.Texpr.foldmap(loop, var_inits, e); 49 | } 50 | } 51 | return loop(PMap.empty(), e).snd; 52 | } 53 | } -------------------------------------------------------------------------------- /src/core/Globals.hx: -------------------------------------------------------------------------------- 1 | package core; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | class Pos { 7 | public final pfile : String; 8 | public final pmin : Int; 9 | public final pmax : Int; 10 | public function new (pfile:String, pmin:Int, pmax:Int) { 11 | this.pfile = pfile; 12 | this.pmin = pmin; 13 | this.pmax = pmax; 14 | } 15 | } 16 | 17 | enum Platform { 18 | Cross; 19 | Js; 20 | Lua; 21 | Neko; 22 | Flash; 23 | Php; 24 | Cpp; 25 | Cs; 26 | Java; 27 | Python; 28 | Hl; 29 | Eval; 30 | } 31 | 32 | class Globals { 33 | public static var version = 4000; 34 | public static var version_major = version / 1000; 35 | public static var version_minor = (version % 1000) / 100; 36 | public static var version_revision = (version % 100); 37 | 38 | public static var macro_platform:Platform = Neko; 39 | 40 | // TODO: how to do that for bytecode target 41 | #if js 42 | public static var is_windows = false; 43 | #else 44 | public static var is_windows = std.Sys.systemName() == "Windows" || std.Sys.systemName() == "Cygwin"; 45 | #end 46 | 47 | public static var platforms:ImmutableList = [Js, Lua, Neko, Flash, Php, Cpp, Cs, Java, Python, Hl, Eval]; 48 | 49 | public static function platform_name (p:Platform) : String { 50 | return switch(p) { 51 | case Cross : "cross"; 52 | case Js : "js"; 53 | case Lua : "lua"; 54 | case Neko : "neko"; 55 | case Flash : "flash"; 56 | case Php : "php"; 57 | case Cpp : "cpp"; 58 | case Cs : "cs"; 59 | case Java : "java"; 60 | case Python : "python"; 61 | case Hl : "hl"; 62 | case Eval : "eval"; 63 | }; 64 | } 65 | 66 | public static function platform_list_help (list:ImmutableList) : String { 67 | return switch (list) { 68 | case []: ""; 69 | case [p]: " (" + platform_name(p) + " only)"; 70 | case pl: " (for " + List.join(",", List.map(platform_name, pl)) + ")"; 71 | }; 72 | } 73 | 74 | public static final null_pos = new Pos("?", -1, -1); 75 | 76 | public static function s_type_path (p:Path) { 77 | return switch (p.a) { 78 | case []: p.b; 79 | case _: List.join(".",p.a) + "." + p.b; 80 | } 81 | } 82 | } -------------------------------------------------------------------------------- /src/filters/FiltersCommon.hx: -------------------------------------------------------------------------------- 1 | package filters; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | class FiltersCommon { 7 | public static function is_removable_class (c:core.Type.TClass) : Bool { 8 | return switch (c.cl_kind) { 9 | case KGeneric: 10 | var _tmp = List.exists(function (param) { 11 | var t = param.t; 12 | return 13 | switch (core.Type.follow(t)) { 14 | case TInst(c,_): 15 | core.Meta.has(Const, c.cl_meta) || core.Type.has_ctor_constraint(c); 16 | case _: false; 17 | } 18 | }, c.cl_params); 19 | _tmp = _tmp || switch (c.cl_super) { 20 | case Some({c:c}): is_removable_class(c); 21 | case _: false; 22 | } 23 | _tmp || core.Meta.has(Remove, c.cl_meta); 24 | case KTypeParameter(_): 25 | // this shouldn't happen, have to investigate (see #4092) 26 | true; 27 | case _: 28 | false; 29 | } 30 | } 31 | 32 | public static function run_expression_filters (ctx:context.Typecore.Typer, filters:ImmutableListcore.Type.TExpr>, t:core.Type.ModuleType) : Void { 33 | function run (e:core.Type.TExpr) { 34 | return List.fold_left(function (e, f) { return f(e); }, e, filters); 35 | } 36 | switch (t) { 37 | case TClassDecl(c) if (is_removable_class(c)): 38 | case TClassDecl(c): 39 | ctx.curclass = c; 40 | function process_field (f:core.Type.TClassField) { 41 | ctx.curfield = f; 42 | switch (f.cf_expr) { 43 | case Some(e) if (!context.Typecore.is_removable_field(ctx, f)): 44 | context.typecore.AbstractCast.cast_stack.set(f::context.typecore.AbstractCast.cast_stack.get()); 45 | f.cf_expr = Some(run(e)); 46 | context.typecore.AbstractCast.cast_stack.set(List.tl(context.typecore.AbstractCast.cast_stack.get())); 47 | case _: 48 | } 49 | List.iter(process_field, f.cf_overloads); 50 | } 51 | List.iter(process_field, c.cl_ordered_fields); 52 | List.iter(process_field, c.cl_ordered_statics); 53 | switch (c.cl_constructor) { 54 | case None: 55 | case Some(f): process_field(f); 56 | } 57 | switch (c.cl_init) { 58 | case None: 59 | case Some(e): 60 | c.cl_init = Some(run(e)); 61 | } 62 | case TEnumDecl(_): 63 | case TTypeDecl(_): 64 | case TAbstractDecl(_): 65 | } 66 | } 67 | } -------------------------------------------------------------------------------- /src/syntax/Grammar.hx: -------------------------------------------------------------------------------- 1 | package syntax; 2 | 3 | import haxe.ds.Option; 4 | 5 | import core.Ast.ExprDef; 6 | import core.Globals.Pos; 7 | import syntax.Lexer.Token; 8 | 9 | // typedef Position = {file:String, min:Int, max:Int}; 10 | 11 | // inspired by https://github.com/Simn/haxeparser/blob/master/src/haxeparser/HaxeParser.hx 12 | // class CondParser extends hxparse.Parser, Token> implements hxparse.ParserBuilder { 13 | // public function new(stream){ 14 | // super(stream); 15 | // } 16 | 17 | // public function parseMacroCond(allowOp:Bool):{tk:Option, expr:core.Ast.Expr} 18 | // { 19 | // return switch stream { 20 | // case [{td:Const(CIdent(t)), pos:p}]: 21 | // parseMacroIdent(allowOp, t, p); 22 | // case [{td:Const(CString(s)), pos:p}]: 23 | // {td:None, expr:{expr:EConst(CString(s)), pos:Pos.of(p)}}; 24 | // case [{tok:Const(CInt(s)), pos:p}]: 25 | // {td:None, expr:{expr:EConst(CInt(s)), pos:Pos.of(p)}}; 26 | // case [{tok:Const(CFloat(s)), pos:p}]: 27 | // {td:None, expr:{expr:EConst(CFloat(s)), pos:Pos.of(p)}}; 28 | // case [{tok:Kwd(k), pos:p}]: 29 | // parseMacroIdent(allowOp, HaxeParser.keywordString(k), p); 30 | // case [{td:POpen, pos:p1}, o = parseMacroCond(true), {tok:PClose, pos:p2}]: 31 | // var e = {expr:EParenthesis(o.expr), pos:HaxeParser.punion(p1, p2)}; 32 | // if (allowOp) parseMacroOp(e) else { tk:None, expr:e }; 33 | // case [{td:Unop(op), pos:p}, o = parseMacroCond(allowOp)]: 34 | // {tk:o.tk, expr:HaxeParser.makeUnop(op, o.expr, p)}; 35 | // } 36 | // } 37 | 38 | // function parseMacroIdent(allowOp:Bool, t:String, p:Position):{tk:Option, expr:core.Ast.Expr} 39 | // { 40 | // var e = {expr:EConst(CIdent(t)), pos:Pos.of(p)}; 41 | // return if (!allowOp) { tk:None, expr:e } else parseMacroOp(e); 42 | // } 43 | 44 | // function parseMacroOp(e:core.Ast.Expr):{tk:Option, expr:core.Ast.Expr} 45 | // { 46 | // return switch peek(0) { 47 | // case {td:Binop(op)}: 48 | // junk(); 49 | // op = switch peek(0) { 50 | // case {td:Binop(OpAssign)} if (op == OpGt): 51 | // junk(); 52 | // OpGte; 53 | // case _: op; 54 | // } 55 | // var o = parseMacroCond(true); 56 | // {tk:o.tk, expr:HaxeParser.makeBinop(op, e, o.expr)}; 57 | // case tk: 58 | // {tk:Some(tk), expr:e}; 59 | // } 60 | // } 61 | // } 62 | 63 | // class Grammar { 64 | // } -------------------------------------------------------------------------------- /src/core/Timer.hx: -------------------------------------------------------------------------------- 1 | package core; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | import ocaml.Ref; 6 | 7 | typedef TimerInfos = { 8 | id : ImmutableList, 9 | start : ImmutableList, 10 | total : Float, 11 | calls : Int 12 | } 13 | 14 | class Timer { 15 | 16 | public static var get_time : Void->Float = std.Sys.time; 17 | public static var htimers : Map = new Map(); 18 | public static var curtime = new Ref>([]); 19 | 20 | public static function new_timer (id:ImmutableList) : TimerInfos { 21 | // let key = String.concat "." id in 22 | var key = List.join(".", id); 23 | var t = htimers.get(key); 24 | if (t != null) { 25 | t.start = get_time() :: t.start; 26 | t.calls++; 27 | return t; 28 | } 29 | else { 30 | t = { 31 | id : id, 32 | start : [get_time()], 33 | total : 0.0, 34 | calls : 1 35 | } 36 | htimers.set(key, t); 37 | return t; 38 | } 39 | } 40 | 41 | public static function close (t:TimerInfos) : Void { 42 | var start = switch (t.start) { 43 | case []: trace("Shall not be seen"); throw false; 44 | case s::l: 45 | t.start = l; 46 | s; 47 | } 48 | var now = get_time(); 49 | var dt = now - start; 50 | t.total = t.total + dt; 51 | function loop() { 52 | switch (curtime.get()) { 53 | case []: throw new ocaml.Failure("Timer " + List.join(".", t.id) + " closed while not active"); 54 | case tt::l: 55 | curtime.set(l); 56 | if (t != tt) { 57 | loop(); 58 | } 59 | } 60 | } 61 | loop(); 62 | // because of rounding errors while adding small times, we need to make sure that we don't have start > now 63 | List.iter(function (ct) { 64 | ct.start = List.map(function (t) { 65 | var s = t + dt; 66 | return (s > now) ? now : s; 67 | }, ct.start); 68 | }, curtime.get()); 69 | } 70 | 71 | public static function timer (id:ImmutableList) : Void->Void { 72 | var t = new_timer(id); 73 | curtime.set(t::curtime.get()); 74 | return function () { core.Timer.close(t); }; 75 | } 76 | 77 | public static function close_times () : Void { 78 | switch (curtime.get()) { 79 | case []: 80 | case t::_: 81 | close(t); 82 | close_times(); 83 | } 84 | } 85 | 86 | public static function report_times (print:String->Void) : Void { 87 | trace("TODO core.Timer.report_times"); 88 | } 89 | 90 | 91 | } -------------------------------------------------------------------------------- /src/context/display/DeprecationCheck.hx: -------------------------------------------------------------------------------- 1 | package context.display; 2 | 3 | import ocaml.Hashtbl; 4 | import ocaml.Ref; 5 | 6 | using equals.Equal; 7 | 8 | class DeprecationCheck { 9 | 10 | public static var curclass = new Ref(core.Type.null_class); 11 | public static var warned_positions = new Hashtbl(); 12 | 13 | public static function print_deprecation_message (com:context.Common.Context, meta:core.Ast.MetadataEntry, s:String, p_usage:core.Globals.Pos) : Void { 14 | var s = switch (meta) { 15 | case {params:[{expr:EConst(CString(s))}]}:s; 16 | case _: 'Usage of this ${s} is deprecated'; 17 | } 18 | if (!Hashtbl.mem(warned_positions, p_usage)) { 19 | Hashtbl.replace(warned_positions, p_usage, true); 20 | com.warning(s, p_usage); 21 | } 22 | } 23 | 24 | public static function check_meta (com:context.Common.Context, meta:core.Ast.Metadata, s:String, p_usage:core.Globals.Pos) : Void { 25 | try { 26 | print_deprecation_message(com, core.Meta.get(Deprecated, meta), s, p_usage); 27 | } 28 | catch (_:ocaml.Not_found) {} 29 | } 30 | 31 | public static function check_cf (com:context.Common.Context, cf:core.Type.TClassField, p:core.Globals.Pos) : Void { 32 | check_meta(com, cf.cf_meta, "field", p); 33 | } 34 | 35 | public static function check_class (com:context.Common.Context, c:core.Type.TClass, p:core.Globals.Pos) : Void { 36 | if (!c.equals(curclass.get())) { 37 | check_meta(com, c.cl_meta, "class", p); 38 | } 39 | } 40 | 41 | public static function check_enum (com:context.Common.Context, en:core.Type.TEnum, p:core.Globals.Pos) : Void { 42 | check_meta(com, en.e_meta, "enum", p); 43 | } 44 | 45 | public static function check_ef (com:context.Common.Context, ef:core.Type.TEnumField, p:core.Globals.Pos) : Void { 46 | check_meta(com, ef.ef_meta, "enum field", p); 47 | } 48 | 49 | public static function check_typedef (com:context.Common.Context, t:core.Type.TDef, p:core.Globals.Pos) : Void { 50 | check_meta(com, t.t_meta, "typedef", p); 51 | } 52 | 53 | public static function check_module_type (com:context.Common.Context, mt:core.Type.ModuleType, p:core.Globals.Pos) : Void { 54 | switch (mt) { 55 | case TClassDecl(c): check_class(com, c, p); 56 | case TEnumDecl(en): check_enum(com, en, p); 57 | case _: 58 | } 59 | } 60 | 61 | public static function run (com:context.Common.Context) : Void { 62 | trace("TODO: context.display.DeprecationCheck.run"); 63 | } 64 | } -------------------------------------------------------------------------------- /src/core/type/StringError.hx: -------------------------------------------------------------------------------- 1 | package core.type; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | class StringError { 7 | // Source: http://en.wikibooks.org/wiki/Algorithm_implementation/Strings/Levenshtein_distance 8 | public static function levenshtein(s1:String, s2:String) : Int { 9 | var len1 = s1.length; 10 | var len2 = s2.length; 11 | var d: Array> = new Array>(); 12 | for(i in 0...(len1+1)) { 13 | d.push([]); 14 | } 15 | d[0][0]=0; 16 | 17 | for(i in 1...(len1+1)) { 18 | d[i][0]=i; 19 | } 20 | for(i in 1...(len2+1)) { 21 | d[0][i]=i; 22 | } 23 | 24 | for(i in 1...(len1+1)) { 25 | for(j in 1...(len2+1)) { 26 | d[i][j] = Std.int(Math.min( Math.min(d[i - 1][j] + 1,d[i][j - 1] + 1), 27 | d[i - 1][j - 1] + (s1.charAt(i - 1) == s2.charAt(j - 1) ? 0 : 1) )); 28 | } 29 | } 30 | return d[len1][len2]; 31 | 32 | } 33 | 34 | public static function filter_similar(f:T->Int->Bool, cl:ImmutableList<{fst:T, snd:Int}>) : ImmutableList { 35 | function loop(sl:ImmutableList<{fst:T, snd:Int}>) : ImmutableList { 36 | return switch (sl) { 37 | case {fst:x, snd:i}::sl if (f(x, i)): 38 | x::loop(sl); 39 | case _: []; 40 | } 41 | } 42 | return loop(cl); 43 | } 44 | 45 | public static function get_similar(s:String, sl:ImmutableList) : ImmutableList { 46 | if (sl == Tl) { return []; } 47 | var cl = List.map(function (s2) { return {fst:s2, snd:levenshtein(s, s2)};}, sl); 48 | cl = List.sort(function (e1:{fst:String, snd:Int}, e2:{fst:String, snd:Int}) { 49 | var c1 = e1.snd; var c2 = e2.snd; 50 | if (c1 == c2) { return 0; } 51 | return (c1 > c2) ? 1 : -1; 52 | }, cl); 53 | return filter_similar(function(s2:String, i:Int) { 54 | return i <= Std.int(Math.min(s.length, s2.length) /3); 55 | }, cl); 56 | } 57 | 58 | public static function string_error_raise(s:String, sl:ImmutableList, msg:String) : String { 59 | if (sl == Tl) { return msg; } 60 | var cl = get_similar(s, sl); 61 | return switch (cl) { 62 | case []: throw ocaml.Not_found.instance; 63 | case [s]: '${msg} (Suggestion: ${s})'; 64 | case sl: '${msg} (Suggestion: ${List.join(", ", sl)})'; 65 | } 66 | } 67 | 68 | public static function string_error(s:String, sl:ImmutableList, msg:String) : String { 69 | try { 70 | return string_error_raise(s, sl, msg); 71 | } 72 | catch (e:ocaml.Not_found) { 73 | return msg; 74 | } 75 | } 76 | } -------------------------------------------------------------------------------- /src/typing/Matcher.hx: -------------------------------------------------------------------------------- 1 | package typing; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | using ocaml.Cloner; 6 | using equals.Equal; 7 | 8 | class Internal_match_failure { 9 | public static final instance = new Internal_match_failure(); 10 | function new () {} 11 | } 12 | 13 | class Matcher { 14 | public static function s_type (t:core.Type.T) : String { 15 | return core.Type.s_type(core.Type.print_context(), t); 16 | } 17 | public static function s_expr_pretty(e:core.Type.TExpr) { 18 | return core.Type.s_expr_pretty(false, "", false, s_type, e); 19 | } 20 | 21 | public static var fake_tuple_type:core.Type.T = TInst(core.Type.mk_class(core.Type.null_module, new core.Path([], "-Tuple"), core.Globals.null_pos, core.Globals.null_pos), []); 22 | public static function tuple_type (tl:core.Type.TParams) : core.Type.T { 23 | return core.Type.tfun(tl, fake_tuple_type); 24 | } 25 | 26 | public static function make_offset_list (left:Int, right:Int, middle:T, other:T) : ImmutableList { 27 | return List.append(List.make(left, other), List.append([middle], List.make(right, other))); 28 | } 29 | 30 | public static function type_field_access (ctx:context.Typecore.Typer, ?resume:Bool=false, e:core.Type.TExpr, name:String) : core.Type.TExpr { 31 | return typing.Typer.acc_get(ctx, typing.Typer.type_field(resume, ctx, e, name, e.epos, MGet), e.epos); 32 | } 33 | 34 | public static function unapply_type_parameters (params:core.Type.TypeParams, monos:core.Type.TParams) : Void { 35 | List.iter2(function (arg, t2) { 36 | var t1 = arg.t; 37 | switch [t2, core.Type.follow(t2)] { 38 | case [TMono(m1), TMono(m2)] if (m1.equals(m2)): 39 | core.Type.unify(t1, t2); 40 | case _: 41 | } 42 | }, params, monos); 43 | } 44 | 45 | public static function get_general_module_type (ctx:context.Typecore.Typer, mt:core.Type.ModuleType, p:core.Globals.Pos) : core.Type.T { 46 | function loop(mt:core.Type.ModuleType):String { 47 | return switch (mt) { 48 | case TClassDecl(_): "Class"; 49 | case TEnumDecl(_): "Enum"; 50 | case TAbstractDecl(a) if (core.Meta.has(RuntimeValue, a.a_meta)): 51 | "Class"; 52 | case TTypeDecl(t): 53 | switch (core.Type.follow(core.Type.monomorphs(t.t_params, t.t_type))) { 54 | case TInst(c, _): loop(TClassDecl(c)); 55 | case TEnum(en, _): loop(TEnumDecl(en)); 56 | case TAbstract(a, _): loop(TAbstractDecl(a)); 57 | case _: core.Error.error("Cannot use this type as a value", p); 58 | } 59 | case _: core.Error.error("Cannot use this type as a value", p); 60 | } 61 | } 62 | return typing.Typeload.load_instance(ctx, {tp:{ 63 | tname:loop(mt), 64 | tpackage:[], 65 | tsub:None, 66 | tparams:[] 67 | }, pos:core.Globals.null_pos}, true, p); 68 | } 69 | } -------------------------------------------------------------------------------- /src/ocaml/Cloner.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | import haxe.Constraints.IMap; 4 | import haxe.EnumTools; 5 | import haxe.ds.ObjectMap; 6 | import haxe.io.Bytes; 7 | // import haxe.rtti.Meta; 8 | 9 | class Cloner { 10 | 11 | public static function with (o:T, change:Dynamic): T { 12 | var res = Reflect.copy(o); 13 | for (field in Reflect.fields(o)) { 14 | if (Reflect.hasField(change, field)) { 15 | Reflect.setField(res, field, Reflect.field(change, field)); 16 | } 17 | } 18 | return res; 19 | } 20 | 21 | static function _clone (v:T, existing:ObjectMap, ?deep:Bool=true) : T { 22 | // return v; // ? 23 | var base:Dynamic = null; 24 | switch (Type.typeof(v)) { 25 | case TNull, TInt, TFloat, TBool, TFunction: // immutable 26 | return v; 27 | case TUnknown: // ?? 28 | return v; 29 | case TEnum(e): 30 | // return v; 31 | if (Std.is(v, haxe.ds.ImmutableList.ListRepr)) { 32 | return v; 33 | } 34 | var index = EnumValueTools.getIndex(cast v); 35 | var params = [ for (p in EnumValueTools.getParameters(cast v)) ((deep) ? _clone(p, existing) : p) ]; 36 | return EnumTools.createByIndex(e, index, params); 37 | case TClass(_): 38 | if (Std.is(v, String)) { return v; } 39 | if (Std.is(v, haxe.ds.ImmutableList)) { return v; } 40 | if (Std.is(v, Array)) { return cast [ for (e in cast(v, Array)) (deep) ? _clone(e, existing) : e]; } 41 | if (Std.is(v, Date)) { return cast Date.fromTime(cast(v, Date).getTime()); } 42 | if (Std.is(v, Bytes)) { return cast Bytes.ofData(cast clone(cast (v, Bytes).getData())); } 43 | if (Std.is(v, IMap)) { 44 | var map = cast(v, IMap); 45 | var res:IMap = map.copy(); 46 | if (deep) { 47 | for (key in map.keys()) { 48 | res.set(key, map.get(key)); 49 | } 50 | } 51 | return cast res; 52 | } 53 | if (Std.is(v, context.Typecore.TyperGlobals) || Std.is(v, context.Common.Context)) { 54 | return v; 55 | } 56 | if (Std.is(v, ocaml.PMap)) { 57 | return v; 58 | } 59 | base = Type.createEmptyInstance(Type.getClass(v)); // class type 60 | case TObject: 61 | base = {} // anonymous type 62 | } 63 | if (existing.exists(v)) { return cast existing.get(v); } 64 | existing.set(v, base); 65 | for (field in Reflect.fields(v)) { 66 | if (deep) { 67 | Reflect.setField(base, field, _clone(Reflect.field(v, field), existing)); 68 | } 69 | else { 70 | Reflect.setField(base, field, Reflect.field(v, field)); 71 | } 72 | } 73 | if (base == null) { throw false; } 74 | return cast base; 75 | } 76 | 77 | public static function clone (v:T, ?deep:Bool=false) : T { 78 | return _clone(v, new ObjectMap(), deep); 79 | } 80 | } -------------------------------------------------------------------------------- /src/ocaml/Hashtbl.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | using equals.Equal; 4 | 5 | class Hashtbl { 6 | var keys:Array = []; 7 | var values:Array = []; 8 | public function new() {} 9 | public static inline function create (i:Int) : Hashtbl { 10 | return new Hashtbl(); 11 | } 12 | 13 | public function indexOf (key:K) : Int { 14 | for (i in 0...keys.length) { 15 | if (keys[i].equals(key)) { 16 | return i; 17 | } 18 | } 19 | return -1; 20 | } 21 | 22 | public function exists(key:K) : Bool { 23 | for (k in keys) { 24 | if (k.equals(key)) { 25 | return true; 26 | } 27 | } 28 | return false; 29 | } 30 | 31 | public function set(key:K, value:V) : Void { 32 | var index = indexOf(key); 33 | if (index < 0) { 34 | keys.push(key); 35 | values.push(value); 36 | } 37 | else { 38 | values[index] = value; 39 | } 40 | } 41 | 42 | public function get(key:K) : V { 43 | for (i in 0...keys.length) { 44 | if (keys[i].equals(key)) { 45 | return values[i]; 46 | } 47 | } 48 | throw ocaml.Not_found.instance; 49 | } 50 | 51 | public function delete(key:K) : Void { 52 | for (i in 0...keys.length) { 53 | if (keys[i].equals(key)) { 54 | if (keys.length > 1) { 55 | keys[i] = keys.pop(); 56 | values[i] = values.pop(); 57 | } 58 | else { 59 | keys.pop(); 60 | values.pop(); 61 | } 62 | return; 63 | } 64 | } 65 | } 66 | 67 | public static function clear (map:Hashtbl) : Void { 68 | map.keys = []; 69 | map.values = []; 70 | } 71 | 72 | public static inline function add (map:Hashtbl, key:A, value:B) : Void { 73 | map.set(key, value); 74 | } 75 | public static inline function replace (map:Hashtbl, key:A, value:B) : Void { 76 | map.set(key, value); 77 | } 78 | public static inline function remove (map:Hashtbl, key:A) : Void { 79 | map.delete(key); 80 | } 81 | public static inline function length (map:Hashtbl) : Int { 82 | return map.keys.length; 83 | } 84 | public static inline function mem (map:Hashtbl, key:A) : Bool { 85 | // TODO fix map; replace Map by haxe.ds.HashMap ? 86 | return map.exists(key); 87 | } 88 | public static inline function find (map:Hashtbl, key:A) : B { 89 | // TODO fix map; replace Map by haxe.ds.HashMap 90 | return map.get(key); 91 | } 92 | 93 | public static function iter (f:A->B->Void, m:Hashtbl) { 94 | // TODO replace Map by haxe.ds.HashMap 95 | for (key in m.keys) { 96 | f(key, m.get(key)); 97 | } 98 | } 99 | 100 | public static function fold (f:A->B->C->C, m:Hashtbl, into:C) : C { 101 | for (key in m.keys) { 102 | into = f(key, m.get(key), into); 103 | } 104 | return into; 105 | } 106 | } -------------------------------------------------------------------------------- /src/typing/matcher/Case.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | import ocaml.List; 7 | import ocaml.PMap; 8 | 9 | typedef T = { 10 | case_guard: Option, 11 | case_expr: Option, 12 | case_pos: core.Globals.Pos 13 | } 14 | 15 | @:structInit 16 | class Case { 17 | public var fst:typing.matcher.Case.T; 18 | // public var snd:ImmutableList<{v:core.Type.TVar, p:core.Globals.Pos, e:core.Type.TExpr}>; 19 | public var snd:ImmutableList; 20 | public var trd:ImmutableList; 21 | 22 | public static function make(ctx:context.Typecore.Typer, t:core.Type.T, el:ImmutableList, eg:Option, eo_ast:Option, with_type:context.Typecore.WithType, p:core.Globals.Pos) : {fst:T, snd:ImmutableList<{v:core.Type.TVar, p:core.Globals.Pos, e:core.Type.TExpr}>, trd:typing.matcher.Pattern} { 23 | function collapse_case (el:ImmutableList) : core.Ast.Expr { 24 | return switch (el) { 25 | case e::[]: 26 | e; 27 | case e::el: 28 | var e2 = collapse_case(el); 29 | {expr:EBinop(OpOr,e, e2), pos:e2.pos}; 30 | case []: 31 | trace("Shall not be seen"); throw false; 32 | } 33 | } 34 | var e = collapse_case(el); 35 | var monos = List.map(function (_) { return core.Type.mk_mono(); }, ctx.type_params); 36 | var map = core.Type.apply_params.bind(ctx.type_params, monos); 37 | var save = context.Typecore.save_locals(ctx); 38 | var old_types = PMap.fold(function (v:core.Type.TVar, acc:ImmutableList<{fst:core.Type.TVar, snd:core.Type.T}>) { 39 | var t_old = v.v_type; 40 | v.v_type = map(v.v_type); 41 | return {fst:v, snd:t_old}::acc; 42 | }, ctx.locals, []); 43 | var old_ret = ctx.ret; 44 | ctx.ret = map(ctx.ret); 45 | var pat = typing.matcher.Pattern.make(ctx, map(t), e); 46 | typing.Matcher.unapply_type_parameters(ctx.type_params, monos); 47 | var eg = switch (eg) { 48 | case None: None; 49 | case Some(e): Some(typing.Typer.type_expr(ctx, e, Value)); 50 | } 51 | var eo = switch [eo_ast, with_type] { 52 | case [None, WithType(t)]: 53 | context.Typecore.unify(ctx, ctx.t.tvoid, t, e.pos); 54 | None; 55 | case [None, _]: 56 | None; 57 | case [Some(e), WithType(t)]: 58 | var e = typing.Typer.type_expr(ctx, e, WithType(map(t))); 59 | var e = context.typecore.AbstractCast.cast_or_unify(ctx, map(t), e, e.epos); 60 | Some(e); 61 | case [Some(e), _]: 62 | var e = typing.Typer.type_expr(ctx, e, with_type); 63 | Some(e); 64 | } 65 | ctx.ret = old_ret; 66 | List.iter(function (arg) { 67 | var v = arg.fst; var t = arg.snd; 68 | v.v_type = t; 69 | }, old_types); 70 | save(); 71 | if (ctx.is_display_file && context.Display.is_display_position(p)) { 72 | switch [eo, eo_ast] { 73 | case [Some(e), Some(e_ast)]: 74 | typing.Typer.display_expr(ctx, e_ast, e, with_type, p); 75 | case [None, None]: 76 | typing.Typer.display_expr(ctx, {expr:EBlock([]), pos:p}, core.Type.mk(TBlock([]), ctx.t.tvoid, p), with_type, p); 77 | case _: 78 | trace("Shall not be seen"); throw false; 79 | } 80 | } 81 | return {fst:{case_guard:eg, case_expr:eo, case_pos:p}, snd:[], trd:pat}; 82 | } 83 | 84 | } -------------------------------------------------------------------------------- /src/core/type/Printer.hx: -------------------------------------------------------------------------------- 1 | package core.type; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | import ocaml.List; 6 | import ocaml.PMap; 7 | 8 | class Printer { 9 | public static inline function s_type (t:core.Type.T) : String { 10 | return core.Type.s_type(core.Type.print_context(), t); 11 | } 12 | 13 | public static inline function s_pair (s1:String, s2:String) : String { 14 | return '($s1,$s2)'; 15 | } 16 | 17 | public static inline function s_record_field (name:String, value:String) : String { 18 | return '$name = $value'; 19 | } 20 | 21 | public static inline function s_pos (p:core.Globals.Pos) : String { 22 | return '${p.pfile}: ${p.pmin}-${p.pmax}'; 23 | } 24 | 25 | public static function s_record_fields (tabs:String, fields:ImmutableList<{fst:String, snd:String}>) : String { 26 | var sl = List.map(function (f) { return s_record_field(f.fst, f.snd); }, fields); 27 | return '{\n${tabs}\t${List.join("\n\t"+tabs, sl)}\n${tabs}}'; 28 | } 29 | 30 | public static inline function s_list (sep:String, f:T->String, l:ImmutableList) : String { 31 | return '[${List.join(sep, List.map(f, l))}]'; 32 | } 33 | 34 | public static inline function s_opt (f:T->String, o:Option) : String { 35 | return switch (o) { 36 | case None: "None"; 37 | case Some(v): f(v); 38 | } 39 | } 40 | 41 | public static inline function s_pmap (fk:K->String, fv:V->String, pm:PMap) : String { 42 | return '{${List.join(", ", PMap.foldi(function (k, v, acc:ImmutableList) : ImmutableList { 43 | return ('${fk(k)} = ${fv(v)}') :: acc; }, pm, [])) 44 | }'; 45 | } 46 | 47 | public static var s_doc = s_opt.bind(function (s:String) { return s; }); 48 | 49 | public static inline function s_metadata_entry (entry:core.Ast.MetadataEntry) : String { 50 | return "@"+core.Meta.to_string(entry.name) + (switch (entry.params) { case []: ""; case el: "("+List.join(", ",List.map(core.Ast.s_expr, el))+")";}); 51 | } 52 | 53 | public static inline function s_metadata (metadata:core.Ast.Metadata) : String { 54 | return s_list(" ", s_metadata_entry, metadata); 55 | } 56 | 57 | public static function s_type_param (tp:{name:String, t:core.Type.T}) : String { 58 | return switch (core.Type.follow(tp.t)) { 59 | case TInst({cl_kind:KTypeParameter(tl1)}, tl2): 60 | switch (tl1) { 61 | case []: tp.name; 62 | case _: '${tp.name}:${List.join(", ", List.map(s_type, tl1))}'; 63 | } 64 | case _: trace("Shall not be seen"); throw false; 65 | } 66 | } 67 | 68 | public static inline function s_type_params (tl:core.Type.TypeParams) : String { 69 | return s_list(", ", s_type_param, tl); 70 | } 71 | 72 | public static function s_tclass_field (tabs:String, cf:core.Type.TClassField) : String { 73 | trace("TODO: core.type.Printer.s_tclass"); 74 | throw false; 75 | } 76 | 77 | public static function s_tclass (tabs:String, c:core.Type.TClass) : String { 78 | trace("TODO: core.type.Printer.s_tclass"); 79 | throw false; 80 | } 81 | public static function s_tabstract (tabs:String, c:core.Type.TAbstract) : String { 82 | trace("TODO: core.type.Printer.s_tabstract"); 83 | throw false; 84 | } 85 | 86 | public static function s_tvar (v:core.Type.TVar) : String { 87 | trace("TODO: core.type.Printer.s_tvar"); 88 | throw false; 89 | } 90 | } -------------------------------------------------------------------------------- /src/core/type/TExprToExpr.hx: -------------------------------------------------------------------------------- 1 | package core.type; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | import ocaml.List; 6 | import ocaml.PMap; 7 | 8 | class TExprToExpr { 9 | 10 | public static function tpath (p:core.Path, mp:core.Path, pl:ImmutableList) : core.Ast.ComplexType { 11 | if (mp.b == p.b) { 12 | return CTPath({ 13 | tpackage: p.a, 14 | tname: p.b, 15 | tparams: List.map(function (t) :core.Ast.TypeParamOrConst { return TPType(t); }, pl), 16 | tsub: None 17 | }); 18 | } 19 | else { 20 | return CTPath({ 21 | tpackage: mp.a, 22 | tname: mp.b, 23 | tparams: List.map(function (t) :core.Ast.TypeParamOrConst { return TPType(t); }, pl), 24 | tsub: Some(p.b) 25 | }); 26 | } 27 | } 28 | 29 | public static function convert_type (tf:core.Type.T) : core.Ast.ComplexType { 30 | return switch (tf) { 31 | case TMono(r): 32 | switch (r.get()) { 33 | case None: throw ocaml.Exit.instance; 34 | case Some(t): convert_type(t); 35 | } 36 | case TInst({cl_private:true, cl_path:{b:name}}, tl), TEnum({e_private:true, e_path:{b:name}}, tl), TType({t_private:true, t_path:{b:name}}, tl), TAbstract({a_private:true, a_path:{b:name}}, tl): 37 | CTPath({tpackage:[], tname:name, tparams:List.map(function(t) : core.Ast.TypeParamOrConst { 38 | return TPType(convert_type_(t)); 39 | }, tl), tsub:None}); 40 | case TEnum(e, pl): 41 | tpath(e.e_path, e.e_module.m_path, List.map(convert_type_, pl)); 42 | case TInst(c={cl_kind:KTypeParameter(_)}, pl): 43 | tpath(new core.Path([],c.cl_path.b), new core.Path([],c.cl_path.b), List.map(convert_type_, pl)); 44 | case TInst(c, pl): 45 | tpath(c.cl_path, c.cl_module.m_path, List.map(convert_type_, pl)); 46 | case TType(t, pl): 47 | // recurse on type-type 48 | if (t.t_path.b.charAt(0) == "#") { 49 | convert_type(core.Type.follow(tf)); 50 | } 51 | else { 52 | tpath(t.t_path, t.t_module.m_path, List.map(convert_type_, pl)); 53 | } 54 | case TAbstract(a, pl): 55 | tpath(a.a_path, a.a_module.m_path, List.map(convert_type_, pl)); 56 | case TFun({args:args, ret:ret}): 57 | CTFunction(List.map(function (arg) { return convert_type_(arg.t); }, args), convert_type_(ret)); 58 | case TAnon(a): 59 | switch (a.a_status.get()) { 60 | case Statics(c): tpath(new core.Path([], "Class"), new core.Path([], "Class"), [{ct:tpath(c.cl_path, c.cl_path, []), pos:core.Globals.null_pos}]); 61 | case EnumStatics(e): tpath(new core.Path([], "Enum"), new core.Path([], "Enum"), [{ct:tpath(e.e_path, e.e_path, []), pos:core.Globals.null_pos}]); 62 | case _: 63 | CTAnonymous(PMap.foldi(function (_, f, acc:ImmutableList) { 64 | return { 65 | cff_name: {pack:f.cf_name,pos:core.Globals.null_pos}, 66 | cff_kind: core.Ast.ClassFieldKind.FVar(mk_type_hint(f.cf_type, core.Globals.null_pos), None), 67 | cff_pos: f.cf_pos, 68 | cff_doc : f.cf_doc, 69 | cff_meta: f.cf_meta, 70 | cff_access: Tl // [] 71 | } :: acc; 72 | }, a.a_fields, Tl)); 73 | } 74 | case TDynamic(t2): 75 | var _path = new core.Path([], "Dynamic"); 76 | tpath(_path, _path, (tf == core.Type.t_dynamic) ? [] : [convert_type_(t2.get())]); 77 | case TLazy(f): convert_type(core.Type.lazy_type(f)); 78 | } 79 | } 80 | 81 | public static function convert_type_ (t:core.Type.T) : core.Ast.TypeHint { 82 | return {ct:convert_type(t), pos:core.Globals.null_pos}; 83 | } 84 | 85 | public static function mk_type_hint (t:core.Type.T, p:core.Globals.Pos) : Option { 86 | return switch (core.Type.follow(t)) { 87 | case TMono(_): None; 88 | case _: 89 | try { 90 | Some({ct:convert_type(t), pos:p}); 91 | } 92 | catch (_:ocaml.Exit) { 93 | None; 94 | } 95 | } 96 | } 97 | } -------------------------------------------------------------------------------- /src/context/common/DisplayMode.hx: -------------------------------------------------------------------------------- 1 | package context.common; 2 | 3 | import haxe.ds.Option; 4 | import ocaml.Ref; 5 | 6 | enum ErrorPolicy { 7 | EPIgnore; 8 | EPCollect; 9 | EPShow; 10 | } 11 | 12 | enum DisplayFilePolicy { 13 | DFPOnly; 14 | DFPAlso; 15 | DFPNo; 16 | } 17 | 18 | typedef Settings = { 19 | dms_kind : context.common.displaymode.T, 20 | dms_display : Bool, 21 | dms_full_typing : Bool, 22 | dms_force_macro_typing : Bool, 23 | dms_error_policy : ErrorPolicy, 24 | dms_collect_data : Bool, 25 | dms_check_core_api : Bool, 26 | dms_inline : Bool, 27 | dms_display_file_policy : DisplayFilePolicy, 28 | dms_exit_during_typing : Bool 29 | } 30 | 31 | class DisplayMode { 32 | 33 | public static function get_default_display_settings() : Settings { 34 | return { 35 | dms_kind : DMField, 36 | dms_display : true, 37 | dms_full_typing : false, 38 | dms_force_macro_typing : false, 39 | dms_error_policy : EPIgnore, 40 | dms_collect_data : false, 41 | dms_check_core_api : false, 42 | dms_inline : false, 43 | dms_display_file_policy : DFPOnly, 44 | dms_exit_during_typing : true 45 | }; 46 | } 47 | 48 | public static function get_default_compilation_settings() : Settings { 49 | return { 50 | dms_kind : DMNone, 51 | dms_display : false, 52 | dms_full_typing : true, 53 | dms_force_macro_typing : true, 54 | dms_error_policy : EPShow, 55 | dms_collect_data : false, 56 | dms_check_core_api : true, 57 | dms_inline : true, 58 | dms_display_file_policy : DFPNo, 59 | dms_exit_during_typing : false 60 | }; 61 | } 62 | 63 | public static function create (dm:context.common.displaymode.T) : Settings { 64 | var settings = get_default_display_settings(); 65 | settings.dms_kind = dm; 66 | return switch (dm) { 67 | case DMNone: 68 | get_default_compilation_settings(); 69 | case DMField, DMPosition, DMResolve(_), DMPackage, DMType, DMSignature: 70 | settings; 71 | case DMUsage(_): 72 | settings.dms_full_typing = true; 73 | settings.dms_collect_data = true; 74 | settings.dms_display_file_policy = DFPAlso; 75 | settings.dms_exit_during_typing = false; 76 | settings; 77 | case DMToplevel: 78 | settings.dms_full_typing = true; 79 | settings; 80 | case DMModuleSymbols(filter): 81 | settings.dms_display_file_policy = (filter == None) ? DFPOnly : DFPNo; 82 | settings.dms_exit_during_typing = false; 83 | settings.dms_force_macro_typing = false; 84 | settings; 85 | case DMDiagnostics(global): 86 | settings.dms_full_typing = true; 87 | settings.dms_error_policy = EPCollect; 88 | settings.dms_collect_data = true; 89 | settings.dms_inline = true; 90 | settings.dms_display_file_policy = (global) ? DFPNo : DFPAlso; 91 | settings.dms_exit_during_typing = false; 92 | settings; 93 | case DMStatistics: 94 | settings.dms_full_typing = true; 95 | settings.dms_collect_data = true; 96 | settings.dms_inline = false; 97 | settings.dms_display_file_policy = DFPAlso; 98 | settings.dms_exit_during_typing = false; 99 | settings; 100 | }; 101 | } 102 | 103 | public static function toString (kind:context.common.displaymode.T) : String { 104 | return switch (kind) { 105 | case DMNone: "none"; 106 | case DMField: "field"; 107 | case DMPosition: "position"; 108 | case DMResolve(s): "resolve " + s; 109 | case DMPackage: "package"; 110 | case DMType: "type"; 111 | case DMUsage(b): (b) ? "rename" : "references"; 112 | case DMToplevel: "toplevel"; 113 | case DMModuleSymbols(s): 114 | switch (s) { 115 | case None: "module-symbols"; 116 | case Some(t): "workspace-symbols " + t; 117 | } 118 | case DMDiagnostics(b) : ((b) ? "global " : "") + "diagnostics"; 119 | case DMStatistics : "statistics"; 120 | case DMSignature : "signature"; 121 | } 122 | } 123 | } -------------------------------------------------------------------------------- /src/codegen/Overloads.hx: -------------------------------------------------------------------------------- 1 | package codegen; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | import ocaml.List; 6 | import ocaml.PMap; 7 | 8 | class Overloads { 9 | public static function same_overload_args (?get_vmtype:Optioncore.Type.T>, t1:core.Type.T, t2:core.Type.T, f1:core.Type.TClassField, f2:core.Type.TClassField) : Bool { 10 | var get_vmtype = switch (get_vmtype) { 11 | case None: function (f) { return f; }; 12 | case Some(f): f; 13 | } 14 | if (List.length(f1.cf_params) != List.length(f2.cf_params)) { 15 | return false; 16 | } 17 | function follow_skip_null (t:core.Type.T) : core.Type.T { 18 | return switch (t) { 19 | case TMono(r): 20 | switch (r.get()) { 21 | case Some(t): follow_skip_null(t); 22 | case _: t; 23 | } 24 | case TLazy(f): 25 | follow_skip_null(core.Type.lazy_type(f)); 26 | case TAbstract(a={a_path:{a:[], b:"Null"}}, [p]): 27 | TAbstract(a, [core.Type.follow(p)]); 28 | case TType (t, tl): 29 | follow_skip_null(core.Type.apply_params(t.t_params, tl, t.t_type)); 30 | case _: t; 31 | } 32 | } 33 | function same_arg (t1:core.Type.T, t2:core.Type.T) : Bool { 34 | var t1 = get_vmtype(follow_skip_null(t1)); 35 | var t2 = get_vmtype(follow_skip_null(t2)); 36 | return switch ({fst:t1, snd:t2}) { 37 | case {fst:TType(_), snd:TType(_)}: core.Type.type_iseq(t1, t2); 38 | case {fst:TType(_)}: false; 39 | case {snd:TType(_)}: false; 40 | case _: core.Type.type_iseq(t1, t2); 41 | } 42 | } 43 | 44 | var _tmp = core.Type.follow(core.Type.apply_params(f1.cf_params, List.map(function (a) { return a.t; }, f2.cf_params), t1)); 45 | return switch ({fst:_tmp, snd:core.Type.follow(t2)}) { 46 | case {fst:TFun(f1), snd:TFun(f2)}: 47 | try { 48 | List.for_all2(function (arg1, arg2) { 49 | return same_arg(arg1.t, arg2.t); 50 | }, f1.args, f2.args); 51 | } 52 | catch (_:ocaml.Invalid_argument) { 53 | false; 54 | } 55 | case _: throw false; 56 | } 57 | } 58 | 59 | // retrieves all overloads from class c and field i, as (Type.t * tclass_field) list 60 | public static function get_overloads (c:core.Type.TClass, i:String) : ImmutableList<{t:core.Type.T, cf:core.Type.TClassField}> { 61 | var ret:ImmutableList<{t:core.Type.T, cf:core.Type.TClassField}> = try { 62 | var f = PMap.find(i, c.cl_fields); 63 | switch (f.cf_kind) { 64 | case Var(_): 65 | // @:libType may generate classes that have a variable field in a superclass of an overloaded method 66 | []; 67 | case Method(_): 68 | {t:f.cf_type, cf:f} :: List.map(function (f:core.Type.TClassField) { return {t:f.cf_type , cf:f}; }, f.cf_overloads); 69 | } 70 | } 71 | catch (_:ocaml.Not_found) { 72 | Tl; // []; 73 | } 74 | var rsup = switch (c.cl_super) { 75 | case None if (c.cl_interface): 76 | var ifaces = List.concat(List.map(function (p1:{c:core.Type.TClass, params:core.Type.TParams}) { 77 | var c = p1.c; var tl = p1.params; 78 | return List.map(function (p2) { 79 | var t = p2.t; var f = p2.cf; 80 | return {t:core.Type.apply_params(c.cl_params, tl, t), cf:f}; 81 | }, get_overloads(c, i)); 82 | }, c.cl_implements)); 83 | List.append(ret, ifaces); 84 | case None: ret; 85 | case Some({c:c, params:tl}): 86 | List.append(ret, List.map(function (p) { 87 | var t = p.t; var f = p.cf; 88 | return {t:core.Type.apply_params(c.cl_params, tl, t), cf:f}; 89 | }, get_overloads(c, i))); 90 | } 91 | 92 | return List.append(ret, List.filter(function (p:{t:core.Type.T, cf:core.Type.TClassField}) { 93 | var t = p.t; var f = p.cf; 94 | return !List.exists(function (p2:{t:core.Type.T, cf:core.Type.TClassField}) { 95 | var t2 = p2.t; var f2 = p2.cf; 96 | return same_overload_args(None, t, t2, f, f2); 97 | }, ret); 98 | }, rsup)); 99 | } 100 | } -------------------------------------------------------------------------------- /src/context/common/CompilationServer.hx: -------------------------------------------------------------------------------- 1 | package context.common; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | typedef Cache = { 7 | c_haxelib : Map, ImmutableList>, 8 | c_files : Map<{file:String, sign:String}, {f:Float, data:core.Ast.Package}>, 9 | c_modules : Map<{path:core.Path, s:String}, core.Type.ModuleDef>, 10 | c_directories : Map> 11 | } 12 | 13 | 14 | enum ContextOptions { 15 | NormalContext; 16 | MacroContext; 17 | NormalAndMacroContext; 18 | } 19 | 20 | 21 | class CompilationServer { 22 | 23 | public static var instance : Option; 24 | 25 | public static function create_cache () : Cache { 26 | return { 27 | c_haxelib : new Map, ImmutableList>(), 28 | c_files : new Map<{file:String, sign:String}, {f:Float, data:core.Ast.Package}>(), 29 | c_modules : new Map<{path:core.Path, s:String}, core.Type.ModuleDef>(), 30 | c_directories : new Map>() 31 | } 32 | } 33 | 34 | public static function create () : context.common.compilationserver.T { 35 | var cs:context.common.compilationserver.T = { 36 | cache : create_cache(), 37 | signs : [] 38 | }; 39 | instance = Some(cs); 40 | return cs; 41 | } 42 | 43 | public static function get () : Option { 44 | return instance; 45 | } 46 | 47 | public static function runs () : Bool { 48 | return instance == None; 49 | } 50 | 51 | // let get_context_files cs signs = 52 | // Hashtbl.fold (fun (file,sign) (_,data) acc -> 53 | // if (List.mem sign signs) then (file,data) :: acc 54 | // else acc 55 | // ) cs.cache.c_files [] 56 | 57 | // (* signatures *) 58 | 59 | // let get_sign cs sign = 60 | // List.assoc sign cs.signs 61 | 62 | // let add_sign cs sign = 63 | // let i = string_of_int (List.length cs.signs) in 64 | // cs.signs <- (sign,i) :: cs.signs; 65 | // i 66 | 67 | // (* modules *) 68 | 69 | // let find_module cs key = 70 | // Hashtbl.find cs.cache.c_modules key 71 | 72 | // let cache_module cs key value = 73 | // Hashtbl.replace cs.cache.c_modules key value 74 | 75 | // let taint_modules cs file = 76 | // Hashtbl.iter (fun _ m -> if m.m_extra.m_file = file then m.m_extra.m_dirty <- Some m) cs.cache.c_modules 77 | 78 | // (* files *) 79 | 80 | // let find_file cs key = 81 | // Hashtbl.find cs.cache.c_files key 82 | 83 | // let cache_file cs key value = 84 | // Hashtbl.replace cs.cache.c_files key value 85 | 86 | // let remove_file cs key = 87 | // Hashtbl.remove cs.cache.c_files key 88 | 89 | // let remove_files cs file = 90 | // List.iter (fun (sign,_) -> remove_file cs (sign,file)) cs.signs 91 | 92 | // (* haxelibs *) 93 | 94 | // let find_haxelib cs key = 95 | // Hashtbl.find cs.cache.c_haxelib key 96 | 97 | // let cache_haxelib cs key value = 98 | // Hashtbl.replace cs.cache.c_haxelib key value 99 | 100 | // (* directories *) 101 | 102 | // let find_directories cs key = 103 | // Hashtbl.find cs.cache.c_directories key 104 | 105 | // let add_directories cs key value = 106 | // Hashtbl.replace cs.cache.c_directories key value 107 | 108 | // let remove_directory cs key value = 109 | // try 110 | // let current = find_directories cs key in 111 | // Hashtbl.replace cs.cache.c_directories key (List.filter (fun (s,_) -> s <> value) current); 112 | // with Not_found -> 113 | // () 114 | 115 | // let has_directory cs key value = 116 | // try 117 | // List.mem_assoc value (find_directories cs key) 118 | // with Not_found -> 119 | // false 120 | 121 | // let add_directory cs key value = 122 | // try 123 | // let current = find_directories cs key in 124 | // add_directories cs key (value :: current) 125 | // with Not_found -> 126 | // add_directories cs key [value] 127 | 128 | // let clear_directories cs key = 129 | // Hashtbl.remove cs.cache.c_directories key 130 | 131 | } -------------------------------------------------------------------------------- /src/context/display/ExprPreprocessing.hx: -------------------------------------------------------------------------------- 1 | package context.display; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | import ocaml.List; 6 | import ocaml.Ref; 7 | 8 | class ExprPreprocessing { 9 | public static function find_enclosing (com:context.Common.Context, e:core.Ast.Expr) : core.Ast.Expr { 10 | var display_pos = new Ref(syntax.Parser.resume_display.get()); 11 | function mk_null (p:core.Globals.Pos) : core.Ast.Expr { 12 | return {expr:EDisplay({expr:EConst(CIdent("null")), pos:p}, false), pos:p}; 13 | } 14 | function encloses_display_pos(p:core.Globals.Pos) : Option { 15 | if (context.Display.encloses_position(display_pos.get(), p)) { 16 | var p = display_pos.get(); 17 | display_pos.set(new core.Globals.Pos("", -2, -2)); 18 | return Some(p); 19 | } 20 | else { 21 | return None; 22 | } 23 | } 24 | function loop(e:core.Ast.Expr) : core.Ast.Expr { 25 | switch (e.expr) { 26 | case EBlock(el): 27 | var p = e.pos; 28 | // We want to find the innermost block which contains the display position. 29 | var el = List.map(loop, el); 30 | var el = switch (encloses_display_pos(p)) { 31 | case None: el; 32 | case Some(p2): 33 | var tmp = ocaml.List.fold_left( function (bel:{fst:Bool, snd:ImmutableList}, e:core.Ast.Expr) : {fst:Bool, snd:ImmutableList} { 34 | var b = bel.fst; var el = bel.snd; 35 | var p = e.pos; 36 | if (b || p.pmax <= p2.pmin) { 37 | return {fst:b, snd:e::el}; 38 | } 39 | else { 40 | var e_d:core.Ast.Expr = {expr:EDisplay(mk_null(p), false), pos:p}; 41 | return {fst:true, snd:e::(e_d::el)}; 42 | } 43 | }, {fst:false, snd:[]}, el); 44 | var b = tmp.fst; var el = tmp.snd; 45 | el = if (b) { 46 | el; 47 | } 48 | else { 49 | mk_null(p) :: el; 50 | }; 51 | List.rev(el); 52 | } 53 | return {expr:EBlock(el), pos:e.pos}; 54 | case _: 55 | return core.Ast.map_expr(loop, e); 56 | } 57 | } 58 | return loop(e); 59 | } 60 | 61 | public static function find_before_pos (com:context.Common.Context, e:core.Ast.Expr) : core.Ast.Expr { 62 | var display_pos = new Ref(syntax.Parser.resume_display.get()); 63 | function is_annotated(p:core.Globals.Pos) : Bool { 64 | if (p.pmin <= display_pos.get().pmin && p.pmax >= display_pos.get().pmax) { 65 | display_pos.set(new core.Globals.Pos("", -2, -2)); 66 | return true; 67 | } 68 | else { 69 | return false; 70 | } 71 | } 72 | function loop(e:core.Ast.Expr) : core.Ast.Expr { 73 | if (is_annotated(e.pos)) { 74 | return {expr:EDisplay(e, false), pos:e.pos}; 75 | } 76 | else { 77 | return e; 78 | } 79 | } 80 | function map(e:core.Ast.Expr) { 81 | return loop(core.Ast.map_expr(map, e)); 82 | } 83 | return map(e); 84 | } 85 | 86 | public static function find_display_call (e:core.Ast.Expr) : core.Ast.Expr { 87 | var found = new Ref(false); 88 | function loop (e:core.Ast.Expr) { 89 | if (found.get()) { 90 | return e; 91 | } 92 | else { 93 | switch (e.expr) { 94 | case ECall(_), ENew(_): 95 | if (context.Display.is_display_position(e.pos)) { 96 | found.set(true); 97 | return {expr:EDisplay(e, true), pos:e.pos}; 98 | } 99 | else { 100 | return e; 101 | } 102 | case _: return e; 103 | } 104 | } 105 | } 106 | function map (e:core.Ast.Expr) : core.Ast.Expr { 107 | return switch (e.expr) { 108 | case EDisplay(_, true): 109 | found.set(true); 110 | e; 111 | case EDisplay(e1, false): 112 | map(e1); 113 | case _: loop(core.Ast.map_expr(map, e)); 114 | } 115 | } 116 | return map(e); 117 | 118 | } 119 | 120 | public static function process_expr (com:context.Common.Context, e:core.Ast.Expr) : core.Ast.Expr { 121 | return switch(com.display.dms_kind) { 122 | case DMToplevel: find_enclosing(com, e); 123 | case DMPosition, DMUsage(_), DMType: find_before_pos(com, e); 124 | case DMSignature: find_display_call(e); 125 | case _: e; 126 | } 127 | } 128 | 129 | } -------------------------------------------------------------------------------- /src/typing/matcher/Match.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | import ocaml.List; 7 | using equals.Equal; 8 | using ocaml.Cloner; 9 | 10 | class Match { 11 | public static function match_expr (ctx:context.Typecore.Typer, e:core.Ast.Expr, cases:ImmutableList, def:Option<{e:Option, pos:core.Globals.Pos}>, with_type:context.Typecore.WithType, p:core.Globals.Pos) : core.Type.TExpr { 12 | var match_debug = core.Meta.has(Custom(":matchDebug"), ctx.curfield.cf_meta); 13 | function loop (e:core.Ast.Expr) : {fst:core.Type.T, snd:ImmutableList} { 14 | return switch (e.expr) { 15 | case EArrayDecl(el) if (switch (el) { case [({expr:EFor(_,_)}|{expr:EWhile(_,_,_)})]: false; case _: true;}): 16 | var el = List.map(function (e:core.Ast.Expr) { return typing.Typer.type_expr(ctx, e, Value); }, el); 17 | var t = typing.Matcher.tuple_type(List.map(function(e:core.Type.TExpr) { return e.etype; }, el)); 18 | {fst:t, snd:el}; 19 | case EParenthesis(e1): 20 | loop(e1); 21 | case _: 22 | var e = typing.Typer.type_expr(ctx, e, Value); 23 | {fst:e.etype, snd:[e]}; 24 | } 25 | } 26 | var _tmp = loop(e); var t = _tmp.fst; var subjects = _tmp.snd; 27 | var subjects = List.rev(subjects); 28 | var cases = switch (def) { 29 | case None: 30 | cases; 31 | case Some({e:eo, pos:p}) : 32 | var _tmp:core.Ast.Case = {values:[{expr:EConst(CIdent("_")), pos:p}], guard:None, expr:eo, pos:p}; 33 | List.append(cases, [_tmp]); 34 | } 35 | var _tmp = switch (with_type) { 36 | case WithType(t): 37 | switch (core.Type.follow(t)) { 38 | case TMono(_): {fst:Some(t), snd:context.Typecore.WithType.Value} 39 | case _: {fst:None, snd:with_type}; 40 | } 41 | case _: {fst:None, snd:with_type}; 42 | } 43 | var tmono = _tmp.fst; var with_type = _tmp.snd; 44 | var cases = List.map(function (c:core.Ast.Case) : typing.matcher.Case { //{fst:typing.matcher.Case.T, snd:ImmutableList, trd:ImmutableList} { 45 | var el = c.values; var eg = c.guard; var eo = c.expr; var p = c.pos; 46 | var p = switch (eo) { 47 | case Some(e) if (p.equals(core.Globals.null_pos)): 48 | e.pos; 49 | case _: 50 | p; 51 | } 52 | var _tmp = typing.matcher.Case.make(ctx, t, el, eg, eo, with_type, p); 53 | var case_ = _tmp.fst; var bindings = _tmp.snd; var pat = _tmp.trd; 54 | return {fst:case_, snd:bindings, trd:[pat]}; 55 | }, cases); 56 | function infer_switch_type () : core.Type.T { 57 | return switch (with_type) { 58 | case NoValue: core.Type.mk_mono(); 59 | case Value: 60 | var el = List.map(function(c:typing.matcher.Case) { 61 | var case_ = c.fst; 62 | return switch (case_.case_expr) { 63 | case Some(e): e; 64 | case None: core.Type.mk(TBlock([]), ctx.t.tvoid, p); 65 | } 66 | }, cases); 67 | typing.Typer.unify_min(ctx, el); 68 | case WithType(t): t; 69 | } 70 | } 71 | if (match_debug) { 72 | Sys.println("CASES BEGIN"); 73 | List.iter(function (c:typing.matcher.Case) { 74 | var patterns = c.trd; 75 | Sys.println(List.join(",", List.map(typing.matcher.Pattern.to_string, patterns))); 76 | }, cases); 77 | Sys.println("CASES END"); 78 | } 79 | var dt = typing.matcher.Compile.compile(ctx, match_debug, subjects, cases, p); 80 | if (match_debug) { 81 | Sys.println("DECISION TREE BEGIN"); 82 | Sys.println(typing.matcher.Decision_tree.to_string("", dt)); 83 | Sys.println("DECISION TREE END"); 84 | } 85 | var e = try { 86 | var t_switch = infer_switch_type(); 87 | switch (tmono) { 88 | case Some(t): context.Typecore.unify(ctx, t_switch, t, p); 89 | case _: 90 | } 91 | typing.matcher.TexprConverter.to_texpr(ctx, t_switch, match_debug, with_type, dt); 92 | } 93 | catch (_:typing.matcher.TexprConverter.Not_exhaustive) { 94 | core.Error.error("Unmatched patterns: _", p); 95 | } 96 | if (match_debug) { 97 | Sys.println("TEXPR BEGIN"); 98 | Sys.println(typing.Matcher.s_expr_pretty(e)); 99 | Sys.println("TEXPR END"); 100 | } 101 | return e.with({epos:p}); 102 | } 103 | } -------------------------------------------------------------------------------- /src/syntax/Parser.hx: -------------------------------------------------------------------------------- 1 | package syntax; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | import ocaml.List; 6 | import ocaml.Ref; 7 | 8 | using equals.Equal; 9 | 10 | enum DeclFlag { 11 | DPrivate; 12 | DExtern; 13 | } 14 | 15 | class Parser { 16 | 17 | public static var special_identifier_files = new Map(); 18 | 19 | public static function decl_flag_to_class_flag (f:DeclFlag) : core.Ast.ClassFlag { 20 | return switch (f) { 21 | case DPrivate: HPrivate; 22 | case DExtern : HExtern; 23 | } 24 | } 25 | public static function decl_flag_to_enum_flag (f:DeclFlag) : core.Ast.EnumFlag { 26 | return switch (f) { 27 | case DPrivate: EPrivate; 28 | case DExtern : EExtern; 29 | } 30 | } 31 | public static function decl_flag_to_abstract_flag (f:DeclFlag) : core.Ast.AbstractFlag { 32 | return switch (f) { 33 | case DPrivate: APrivAbstract; 34 | case DExtern : AExtern; 35 | } 36 | } 37 | 38 | public static function error_msg (msg:syntax.parser.ErrorMsg) : String { 39 | return switch (msg) { 40 | case Unexpected(token): "Unexpected " + core.Ast.s_token(token); 41 | case Duplicate_default: "Duplicate default"; 42 | case Missing_semicolon: "Missing ;"; 43 | case Unclosed_macro: "Unclosed macro"; 44 | case Unimplemented: "Not implemented for current platform"; 45 | case Missing_type: "Missing type declaration"; 46 | case Custom(s): s; 47 | }; 48 | } 49 | 50 | public static function last_token(s:haxeparser.HaxeParser) { 51 | // TODO ("Ensure correct behaviour of syntax.Parser.last_token"); 52 | // var n = s.count; 53 | // return syntax.parser.TokenCache.get((n==0) ? 0 : n-1); 54 | return s.last; 55 | } 56 | 57 | 58 | public static function get_doc (parser:haxeparser.HaxeParser) : Option { 59 | // do the peek first to make sure we fetch the doc 60 | var peeked = parser.npeek(1)[0]; 61 | if (peeked == null) { 62 | return None; 63 | } 64 | 65 | return switch (last_doc) { 66 | case None : None; 67 | case Some(ld): 68 | last_doc = None; 69 | (ld.pos == peeked.pos.pmin) ? Some(ld.doc) : None; 70 | } 71 | } 72 | 73 | public static inline function serror() : Dynamic { 74 | throw ocaml.Error.instance; 75 | } 76 | 77 | public static inline function error(m:syntax.parser.ErrorMsg, p:core.Globals.Pos) : Dynamic { 78 | throw new syntax.parser.Error(m,p); 79 | } 80 | 81 | public static var display_error:syntax.parser.ErrorMsg->core.Globals.Pos->Void = function(error_msg:Dynamic, pos:core.Globals.Pos) : Void { trace("Shall not be seen"); throw false; } 82 | 83 | public static var last_doc : Option<{doc:String, pos:Int}> = None; 84 | public static var use_doc: Bool = false; 85 | public static var resume_display = new Ref(core.Globals.null_pos); 86 | public static var in_macro : Bool = false; 87 | 88 | public static inline function do_resume() : Bool { 89 | return resume_display.get().diff(core.Globals.null_pos); 90 | } 91 | 92 | public static inline function display(e:core.Ast.Expr) : Dynamic { 93 | throw new syntax.parser.Display(e); 94 | } 95 | 96 | 97 | public static function type_path(sl:ImmutableList, in_import:Bool) : Dynamic { 98 | return switch (sl) { 99 | case n::l if (n.charCodeAt(0) >= "A".code && n.charCodeAt(0)<="Z".code): 100 | throw new syntax.parser.TypePath(List.rev(l), Some({c:n, cur_package:false}), in_import); 101 | case _: 102 | throw new syntax.parser.TypePath(List.rev(sl),None,in_import); 103 | } 104 | } 105 | 106 | public static inline function is_resuming_file (file:String) { 107 | return core.Path.unique_full_path(file) == resume_display.get().pfile; 108 | } 109 | 110 | public static inline function is_resuming(p:core.Globals.Pos) { 111 | var p2 = resume_display.get(); 112 | return p.pmax == p2.pmin && is_resuming_file(p.pfile); 113 | } 114 | 115 | public static inline function set_resume(p:core.Globals.Pos) { 116 | resume_display.set(new core.Globals.Pos(core.Path.unique_full_path(p.pfile), p.pmin, p.pmax)); 117 | } 118 | 119 | public static inline function encloses_resume(p:core.Globals.Pos) { 120 | return p.pmin <= resume_display.get().pmin && p.pmax >= resume_display.get().pmax; 121 | } 122 | 123 | public static function would_skip_resume (p1:core.Globals.Pos, s:haxeparser.HaxeParser) { 124 | return switch (s.npeek(1)) { 125 | case [{pos:p2}]: is_resuming_file(p2.pfile) && encloses_resume(core.Ast.punion(p1, p2)); 126 | case _: false; 127 | } 128 | } 129 | } -------------------------------------------------------------------------------- /src/typing/matcher/Constructor.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher; 2 | 3 | import haxe.EnumTools.EnumValueTools; 4 | import haxe.ds.ImmutableList; 5 | 6 | import ocaml.List; 7 | using equals.Equal; 8 | 9 | enum Constructor_T { 10 | ConConst(c:core.Type.TConstant); 11 | ConEnum(e:core.Type.TEnum, ef:core.Type.TEnumField); 12 | ConStatic(c:core.Type.TClass, cf:core.Type.TClassField); 13 | ConTypeExpr(mt:core.Type.ModuleType); 14 | ConFields(l:ImmutableList); 15 | ConArray(i:Int); 16 | } 17 | 18 | abstract Constructor (Constructor_T) from Constructor_T to Constructor_T { 19 | public static function to_string(con:Constructor) : String { 20 | return switch (con) { 21 | case ConConst(ct): core.Type.s_const(ct); 22 | case ConEnum(en, ef): ef.ef_name; 23 | case ConStatic(c, cf): '${core.Globals.s_type_path(switch (c.cl_kind) { case KAbstractImpl(a): a.a_path; case _: c.cl_path;})}.${cf.cf_name}'; 24 | case ConTypeExpr(mt): core.Globals.s_type_path(core.Type.t_infos(mt).mt_path); 25 | case ConFields(fields): '{ ${List.join(", ", fields)} }'; 26 | case ConArray(i): ''; 27 | } 28 | } 29 | 30 | public static function equal(con1:Constructor, con2:Constructor) : Bool { 31 | return switch [con1, con2] { 32 | case [ConConst(ct1), ConConst(ct2)]: 33 | ct1.equals(ct2); 34 | case [ConEnum(en1, ef1), ConEnum(en2, ef2)]: 35 | en1.equals(en2) && ef1.equals(ef2); 36 | case [ConStatic(c1, cf1), ConStatic(c2, cf2)]: 37 | c1.equals(c2) && cf1.equals(cf2); 38 | case [ConTypeExpr(mt1), ConTypeExpr(mt2)]: 39 | mt1.equals(mt2); 40 | case [ConFields(_), ConFields(_)]: true; 41 | case [ConArray(i1), ConArray(i2)]: i1.equals(i2); 42 | case _: false; 43 | } 44 | } 45 | 46 | public static function arity (con:Constructor) : Int { 47 | return switch (con) { 48 | case ConEnum(_, {ef_type:TFun({args:args})}): List.length(args); 49 | case ConEnum(_, _): 0; 50 | case ConConst(_): 0; 51 | case ConFields(fields): List.length(fields); 52 | case ConArray(i): i; 53 | case ConTypeExpr(_): 0; 54 | case ConStatic(_):0; 55 | } 56 | } 57 | 58 | public static function compare(con1:Constructor, con2:Constructor) : Int { 59 | return switch [con1, con2] { 60 | case [ConConst(ct1), ConConst(ct2)]: 61 | switch [ct1, ct2] { 62 | case [TInt(i1), TInt(i2)]: compareInt(i1, i2); 63 | case [TString(s1), TString(s2)], [TFloat(s1), TFloat(s2)]: compareString(s1, s2); 64 | case [TBool(b1), TBool(b2)]: 65 | if (b1 == b2) { 0; } 66 | else if (b1 && !b2) { 1; } 67 | else { -1; } 68 | case [TNull, TNull], [TThis, TThis], [TSuper, TSuper]: 0; 69 | case _: 70 | compareInt(EnumValueTools.getIndex(ct1), EnumValueTools.getIndex(ct2)); 71 | } 72 | case [ConEnum(en1, ef1), ConEnum(en2, ef2)]: 73 | compareInt(ef1.ef_index, ef2.ef_index); 74 | case [ConStatic(c1, cf1), ConStatic(c2, cf2)]: 75 | compareString(cf1.cf_name, cf2.cf_name); 76 | case [ConTypeExpr(mt1), ConTypeExpr(mt2)]: 77 | var e1 = core.Type.t_infos(mt1).mt_path; 78 | var e2 = core.Type.t_infos(mt2).mt_path; 79 | core.Path.compare(e1, e2); 80 | case [ConFields(_), ConFields(_)]: 0; 81 | case [ConArray(i1), ConArray(i2)]: i1 - i2; 82 | case _: -1; // Could assert... 83 | } 84 | } 85 | 86 | public static function to_texpr (ctx:context.Typecore.Typer, match_debug:Bool, p:core.Globals.Pos, con:Constructor) : core.Type.TExpr { 87 | return switch (con) { 88 | case ConEnum(en, ef): 89 | if (core.Meta.has(FakeEnum, en.e_meta)) { 90 | var e_mt = context.Typecore.type_module_expr_ref.get()(ctx, TEnumDecl(en), None, p); 91 | core.Type.mk(TField(e_mt, FEnum(en, ef)), ef.ef_type, p); 92 | } 93 | else if (match_debug) { 94 | core.Type.mk(TConst(TString(ef.ef_name)), ctx.t.tstring, p); 95 | } 96 | else { 97 | core.Type.mk(TConst(TInt(ef.ef_index)), ctx.t.tint, p); 98 | } 99 | case ConConst(ct): core.Texpr.Builder.make_const_texpr(ctx.com.basic, ct, p); 100 | case ConArray(i): core.Texpr.Builder.make_int(ctx.com.basic, i, p); 101 | case ConTypeExpr(mt): typing.Typer.type_module_type(ctx, mt, None, p); 102 | case ConStatic(c, cf): core.Texpr.Builder.make_static_field(c, cf, p); 103 | case ConFields(_): core.Error.error("Something went wrong", p); 104 | } 105 | } 106 | 107 | static function compareInt(i1:Int, i2:Int) : Int { 108 | if (i1 == i2) { 109 | return 0; 110 | } 111 | else if ( i1 < i2 ) { 112 | return -1; 113 | } 114 | else { 115 | return 1; 116 | } 117 | } 118 | static function compareString(s1:String, s2:String) : Int { 119 | if (s1 == s2) { 120 | return 0; 121 | } 122 | else if ( s1 < s2 ) { 123 | return -1; 124 | } 125 | else { 126 | return 1; 127 | } 128 | } 129 | } -------------------------------------------------------------------------------- /src/ocaml/PMap.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | import haxe.ds.ImmutableList; 4 | using equals.Equal; 5 | 6 | class PMap { 7 | public final keys:ImmutableList; 8 | public final values:ImmutableList; 9 | public function new(keys:ImmutableList, values:ImmutableList) { 10 | this.keys = keys; 11 | this.values = values; 12 | } 13 | public static inline function empty () : PMap { 14 | return new PMap(Tl, Tl); 15 | } 16 | 17 | public static inline function is_empty (pmap:PMap) : Bool { 18 | return pmap.keys == Tl; 19 | } 20 | public static inline function size (pmap:PMap) : Int { 21 | return List.length(pmap.keys); 22 | } 23 | 24 | public static function add (key:K, value:V, pmap:PMap) : PMap { 25 | var m = remove(key, pmap); 26 | return new PMap(key::m.keys, value::m.values); 27 | } 28 | public static function remove (key:K, pmap:PMap) : PMap { 29 | var keys = pmap.keys; 30 | var values = pmap.values; 31 | var resKeys:ImmutableList = Tl; 32 | var resValues:ImmutableList = Tl; 33 | while (true) { 34 | switch [keys, values] { 35 | case [Tl, Tl]: break; 36 | case [Hd(k, kl), Hd(_, vl)] if (key.equals(k)): 37 | resKeys = List.append(resKeys, kl); 38 | resValues = List.append(resValues, vl); 39 | break; 40 | case [Hd(k, kl), Hd(v, vl)]: 41 | keys = kl; values = vl; 42 | resKeys = k :: resKeys; 43 | resValues = v :: resValues; 44 | case _: throw "Invalid PMap"; 45 | } 46 | } 47 | return new PMap(resKeys, resValues); 48 | } 49 | 50 | public static function fold (f:V->C->C, pmap:PMap, c:C) : C { 51 | var values = pmap.values; 52 | var res = c; 53 | while (true) { 54 | switch (values) { 55 | case Tl: break; 56 | case Hd(v, tl): 57 | values = tl; 58 | res = f(v, res); 59 | } 60 | } 61 | return res; 62 | } 63 | public static function foldi (f:K->V->C->C, pmap:PMap, c:C) : C { 64 | var keys = pmap.keys; 65 | var values = pmap.values; 66 | var res = c; 67 | while (true) { 68 | switch [keys, values] { 69 | case [Tl, Tl]: break; 70 | case [Hd(k, kl), Hd(v, vl)]: 71 | keys = kl; values = vl; 72 | res = f(k, v, res); 73 | case _: throw "Invalid PMap"; 74 | } 75 | } 76 | return res; 77 | } 78 | 79 | public static function map (f:A->B, pmap:PMap) : PMap { 80 | var keys = pmap.keys; 81 | var values = pmap.values; 82 | var resKeys:ImmutableList = Tl; 83 | var resValues:ImmutableList = Tl; 84 | while (true) { 85 | switch [keys, values] { 86 | case [Tl, Tl]: break; 87 | case [Hd(k, kl), Hd(v, vl)]: 88 | keys = kl; values = vl; 89 | resKeys = k :: resKeys; 90 | resValues = f(v) :: resValues; 91 | case _: throw "Invalid PMap"; 92 | } 93 | } 94 | return new PMap(resKeys, resValues); 95 | } 96 | 97 | public static function mapi (f:A->B->C, pmap:PMap) : PMap { 98 | var keys = pmap.keys; 99 | var values = pmap.values; 100 | var resKeys:ImmutableList = Tl; 101 | var resValues:ImmutableList = Tl; 102 | while (true) { 103 | switch [keys, values] { 104 | case [Tl, Tl]: break; 105 | case [Hd(k, kl), Hd(v, vl)]: 106 | keys = kl; values = vl; 107 | resKeys = k :: resKeys; 108 | resValues = f(k, v) :: resValues; 109 | case _: throw "Invalid PMap"; 110 | } 111 | } 112 | return new PMap(resKeys, resValues); 113 | } 114 | 115 | public static function iter (f:A->B->Void, pmap:PMap) : Void { 116 | List.iter2(f, pmap.keys, pmap.values); 117 | } 118 | 119 | public static function exists (key:A, pmap:PMap) : Bool { 120 | var keys = pmap.keys; 121 | while (true) { 122 | switch (keys) { 123 | case Tl: return false; 124 | case Hd(k, _) if (key.equals(k)): return true; 125 | case Hd(_, kl): keys = kl; 126 | } 127 | } 128 | } 129 | 130 | public static inline function mem (key:A, pmap:PMap) : Bool { 131 | return exists(key, pmap); 132 | } 133 | 134 | public static function find (key:A, pmap:PMap) : B { 135 | var keys = pmap.keys; 136 | var values = pmap.values; 137 | while (true) { 138 | switch [keys, values] { 139 | case [Tl, Tl]: throw ocaml.Not_found.instance; 140 | case [Hd(k, _), Hd(v, _)] if (key.equals(k)): return v; 141 | case [Hd(_, kl), Hd(_, vl)]: 142 | keys = kl; values = vl; 143 | case _: throw "Invalid PMap"; 144 | } 145 | } 146 | } 147 | 148 | public static function for_all (f:(A, B)->Bool, pmap:PMap) : Bool { 149 | var keys = pmap.keys; 150 | var values = pmap.values; 151 | while (true) { 152 | switch [keys, values] { 153 | case [Tl, Tl]: return true; 154 | case [Hd(k, _), Hd(v, _)] if (!f(k,v )): return false; 155 | case [Hd(k, kl), Hd(v, vl)]: 156 | keys = kl; 157 | values = vl; 158 | case _: throw "Invalid PMap"; 159 | } 160 | } 161 | } 162 | 163 | } -------------------------------------------------------------------------------- /src/core/Abstract.hx: -------------------------------------------------------------------------------- 1 | package core; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | import ocaml.Ref; 6 | 7 | class Abstract { 8 | 9 | public static function has_direct_to (ab:core.Type.TAbstract, pl:core.Type.TParams, b:core.Type.T) : Bool { 10 | return List.exists(core.Type.unify_to.bind(ab, pl, b, false), ab.a_to); 11 | } 12 | public static function has_direct_from (ab:core.Type.TAbstract, pl:core.Type.TParams, a:core.Type.T, b:core.Type.T) : Bool { 13 | return List.exists(core.Type.unify_from.bind(ab, pl, a, b, false), ab.a_from); 14 | } 15 | public static function find_field_to (ab:core.Type.TAbstract, pl:core.Type.TParams, b:core.Type.T) : {t:core.Type.T, cf:core.Type.TClassField} { 16 | return List.find(core.Type.unify_to_field.bind(ab, pl, b), ab.a_to_field); 17 | } 18 | public static function find_field_from (ab:core.Type.TAbstract, pl:core.Type.TParams, a:core.Type.T, b:core.Type.T) : {t:core.Type.T, cf:core.Type.TClassField} { 19 | return List.find(core.Type.unify_from_field.bind(ab, pl, a, b), ab.a_from_field); 20 | } 21 | public static function find_to_from (f:core.Type.TAbstract->core.Type.TParams->(Void->{t:core.Type.T, cf:core.Type.TClassField})->core.Type.TExpr, ab_left:core.Type.TAbstract, tl_left:core.Type.TParams, ab_right:core.Type.TAbstract, tl_right:core.Type.TParams, tleft:core.Type.T, tright:core.Type.T) : core.Type.TExpr { 22 | return 23 | if (has_direct_to(ab_right, tl_right, tleft) || has_direct_from(ab_left, tl_left, tright, tleft)) { 24 | throw ocaml.Not_found.instance; 25 | } 26 | else { 27 | try { 28 | f(ab_right, tl_right, function () { return find_field_to(ab_right, tl_right, tleft); }); 29 | } 30 | catch (_:ocaml.Not_found) { 31 | f(ab_left, tl_left, function() { return find_field_from(ab_left, tl_left, tright, tleft); } ); 32 | } 33 | } 34 | } 35 | public static function find_to (ab:core.Type.TAbstract, pl:core.Type.TParams, b:core.Type.T) : {t:core.Type.T, cf:core.Type.TClassField} { 36 | return 37 | if (core.Type.follow(b) == core.Type.t_dynamic) { 38 | List.find(function (arg:{t:core.Type.T, cf:core.Type.TClassField}) { var t = arg.t; return core.Type.follow(t) == core.Type.t_dynamic; }, ab.a_to_field); 39 | } 40 | else if (has_direct_to(ab, pl , b)) { 41 | throw ocaml.Not_found.instance; // legacy compatibility 42 | } 43 | else { 44 | find_field_to(ab, pl , b); 45 | } 46 | } 47 | public static function find_from (ab:core.Type.TAbstract, pl:core.Type.TParams, a:core.Type.T, b:core.Type.T) : {t:core.Type.T, cf:core.Type.TClassField}{ 48 | return 49 | if (core.Type.follow(a) == core.Type.t_dynamic) { 50 | List.find(function (arg:{t:core.Type.T, cf:core.Type.TClassField}) { var t = arg.t; return core.Type.follow(t) == core.Type.t_dynamic; }, ab.a_from_field); 51 | } 52 | else if (has_direct_from(ab, pl, a, b)) { 53 | throw ocaml.Not_found.instance; // legacy compatibility 54 | } 55 | else { 56 | find_field_from(ab, pl, a, b); 57 | } 58 | } 59 | 60 | public static var underlying_type_stack = new Ref([]); 61 | 62 | public static function get_underlying_type (a:core.Type.TAbstract, pl:core.Type.TParams) : core.Type.T { 63 | function maybe_recurse (t:core.Type.T) { 64 | underlying_type_stack.set((TAbstract(a, pl) : core.Type.T) ::underlying_type_stack.get()); 65 | function loop (t:core.Type.T) : core.Type.T { 66 | return switch(t) { 67 | case TMono(r): 68 | switch (r.get()) { 69 | case Some(t): loop(t); 70 | case _: t; 71 | } 72 | case TLazy(f): 73 | loop(core.Type.lazy_type(f)); 74 | case TAbstract(a={a_path:{a:[], b:"Null"}}, [t1]): 75 | TAbstract(a, [loop(t1)]); 76 | case TType(t, tl): 77 | loop(core.Type.apply_params(t.t_params, tl, t.t_type)); 78 | case TAbstract(a, tl) if (!core.Meta.has(CoreType, a.a_meta)): 79 | if (List.exists(core.Type.fast_eq.bind(t), underlying_type_stack.get())) { 80 | var pctx = core.Type.print_context(); 81 | var s = List.join("->", List.map(function (t) { return core.Type.s_type(pctx, t); }, List.rev(t::underlying_type_stack.get()))); 82 | underlying_type_stack.set([]); 83 | core.Error.error("Abstract chain detected: "+s, a.a_pos); 84 | } 85 | get_underlying_type(a, tl); 86 | case _: t; 87 | } 88 | } 89 | var t = loop(t); 90 | underlying_type_stack.set(List.tl(underlying_type_stack.get())); 91 | return t; 92 | } 93 | return 94 | try { 95 | if (!core.Meta.has(MultiType, a.a_meta)) { throw ocaml.Not_found.instance; } 96 | var m = core.Type.mk_mono(); 97 | find_to(a, pl, m); 98 | maybe_recurse(core.Type.follow(m)); 99 | } 100 | catch (_:ocaml.Not_found) { 101 | if (core.Meta.has(CoreType, a.a_meta)) { 102 | core.Type.t_dynamic; 103 | } 104 | else { 105 | maybe_recurse(core.Type.apply_params(a.a_params, pl, a.a_this)); 106 | } 107 | } 108 | } 109 | 110 | public static function follow_with_abstracts (t:core.Type.T) : core.Type.T { 111 | return switch (core.Type.follow(t)) { 112 | case TAbstract(a, tl) if (!core.Meta.has(CoreType, a.a_meta)): 113 | follow_with_abstracts(get_underlying_type(a, tl)); 114 | case t: t; 115 | } 116 | } 117 | } -------------------------------------------------------------------------------- /src/context/display/DisplayEmitter.hx: -------------------------------------------------------------------------------- 1 | package context.display; 2 | 3 | import haxe.ds.Option; 4 | import ocaml.List; 5 | 6 | class DisplayEmitter { 7 | public static function display_module_type (dm:context.common.DisplayMode.Settings, mt, p:core.Globals.Pos) : Void { 8 | switch (dm.dms_kind) { 9 | case DMPosition: throw context.Display.DisplayException.DisplayPosition([core.Type.t_infos(mt).mt_pos]); 10 | case DMUsage(_): 11 | var ti = core.Type.t_infos(mt); 12 | ti.mt_meta = ({name:Usage, params:[], pos:ti.mt_pos} : core.Ast.MetadataEntry) :: ti.mt_meta; 13 | case DMType: throw context.Display.DisplayException.DisplayType(core.Type.type_of_module_type(mt), p, None); 14 | case _: 15 | } 16 | } 17 | 18 | public static function display_type (dm:context.common.DisplayMode.Settings, t:core.Type.T, p:core.Globals.Pos) : Void { 19 | switch (dm.dms_kind) { 20 | case DMType: throw context.Display.DisplayException.DisplayType(t, p, None); 21 | case _: 22 | } 23 | try { 24 | display_module_type(dm, core.Type.module_type_of_type(t), p); 25 | } 26 | catch (_:ocaml.Exit) { 27 | var f1 = core.Type.follow(t); 28 | var f2 = core.Type.follow(core.Type.t_dynamic_def.get()); 29 | switch (f2) { 30 | case TDynamic(_): // sanity check in case it's still t_dynamic 31 | case _: 32 | } 33 | switch (f1) { 34 | case TDynamic(_): display_type(dm, core.Type.t_dynamic_def.get(), p); 35 | case _: 36 | } 37 | } 38 | } 39 | 40 | public static function check_display_type (ctx:context.Typecore.Typer, t:core.Type.T, p:core.Globals.Pos) { 41 | function add_type_hint () { 42 | ctx.com.shared.shared_display_information.type_hints.set(p, t); 43 | } 44 | function maybe_display_type () { 45 | if (ctx.is_display_file && context.Display.is_display_position(p)) { 46 | display_type(ctx.com.display, t, p); 47 | } 48 | } 49 | switch (ctx.com.display.dms_kind) { 50 | case DMStatistics: add_type_hint(); 51 | case DMUsage(_): add_type_hint(); maybe_display_type(); 52 | case _: maybe_display_type(); 53 | } 54 | } 55 | 56 | public static function display_variable (dm:context.common.DisplayMode.Settings, v:core.Type.TVar, p:core.Globals.Pos) : Void { 57 | switch (dm.dms_kind) { 58 | case DMPosition: throw context.Display.DisplayException.DisplayPosition([v.v_pos]); 59 | case DMUsage(_): 60 | v.v_meta = ({name:Usage, params:[], pos:v.v_pos} : core.Ast.MetadataEntry ) :: v.v_meta; 61 | case DMType: throw context.Display.DisplayException.DisplayType(v.v_type,p,None); 62 | case _: 63 | } 64 | } 65 | 66 | public static function display_field (dm:context.common.DisplayMode.Settings, cf:core.Type.TClassField, p:core.Globals.Pos) { 67 | switch (dm.dms_kind) { 68 | case DMPosition: throw context.Display.DisplayException.DisplayPosition([cf.cf_pos]); 69 | case DMUsage(_): cf.cf_meta = ({name:Usage, params:[], pos:cf.cf_pos} : core.Ast.MetadataEntry) :: cf.cf_meta; 70 | case DMType: throw context.Display.DisplayException.DisplayType(cf.cf_type, p, cf.cf_doc); 71 | case _: 72 | } 73 | } 74 | 75 | public static function maybe_display_field (ctx:context.Typecore.Typer, p:core.Globals.Pos, cf:core.Type.TClassField) { 76 | if (context.Display.is_display_position(p)) { 77 | display_field(ctx.com.display, cf, p); 78 | } 79 | } 80 | 81 | public static function display_enum_field (dm:context.common.DisplayMode.Settings, ef:core.Type.TEnumField, p:core.Globals.Pos) : Void { 82 | switch (dm.dms_kind) { 83 | case DMPosition: throw context.Display.DisplayException.DisplayPosition([p]); 84 | case DMUsage(_): ef.ef_meta = ({name:Usage, params:[], pos:p} : core.Ast.MetadataEntry) :: ef.ef_meta; 85 | case DMType: throw context.Display.DisplayException.DisplayType(ef.ef_type, p, ef.ef_doc); 86 | case _: 87 | } 88 | } 89 | 90 | public static function display_meta (dm:context.common.DisplayMode.Settings, meta:core.Meta.StrictMeta) : Void { 91 | switch (dm.dms_kind) { 92 | case DMType: 93 | switch (meta) { 94 | case Custom(_), Dollar(_): 95 | case _: 96 | switch (core.Meta.get_documentation(meta)) { 97 | case None: 98 | case Some(s): 99 | // TODO: hack until we support proper output for hover display mode 100 | throw context.Display.DisplayException.Metadata(""+s.b+""); 101 | } 102 | } 103 | case DMField: 104 | var all = core.Meta.get_documentation_list().a; 105 | var all = List.map(function (e) { 106 | var s = e.a; var doc = e.b; 107 | return {name:s, kind:context.Display.DisplayFieldKind.FKMetadata, doc:Some(doc)}; 108 | }, all); 109 | throw context.Display.DisplayException.DisplayFields(all); 110 | case _: 111 | } 112 | } 113 | 114 | public static function check_display_metadata (ctx:context.Typecore.Typer, meta:core.Ast.Metadata) : Void { 115 | List.iter(function (m) { 116 | var meta = m.name; var args = m.params; var p = m.pos; 117 | if (context.Display.is_display_position(p)) { 118 | display_meta(ctx.com.display, meta); 119 | } 120 | List.iter( function (e) { 121 | if (context.Display.is_display_position(e.pos)) { 122 | var e = context.display.ExprPreprocessing.process_expr(ctx.com, e); 123 | context.Typecore.delay(ctx, PTypeField, function () { context.Typecore.type_expr(ctx, e, Value); }); 124 | } 125 | }, m.params); 126 | }, meta); 127 | } 128 | 129 | } -------------------------------------------------------------------------------- /src/compiler/Server.hx: -------------------------------------------------------------------------------- 1 | package compiler; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | import context.Common; 7 | import context.Common.CompilerMessage; 8 | 9 | import core.Globals.*; 10 | 11 | typedef Context = { 12 | com : context.Common.Context, 13 | flush : Void -> Void, 14 | setup : Void -> Void, 15 | messages : ImmutableList, 16 | has_next : Bool, 17 | has_error : Bool 18 | } 19 | 20 | class Server { 21 | 22 | public static var measure_times : Bool = false; 23 | public static var prompt : Bool = false; 24 | public static var start_time : Float = core.Timer.get_time(); 25 | 26 | public static function do_connect (host:String, port:Int, args:ImmutableList) : Void { 27 | } 28 | 29 | public static function parse_hxml (file:String) : ImmutableList { 30 | trace("TODO: Server.parse_hxml"); 31 | throw false; 32 | } 33 | 34 | public static function is_debug_run () : Bool { 35 | // Sys.getenv "HAXEDEBUG" = "1" with _ -> false 36 | try { 37 | return std.Sys.getEnv("HAXEDEBUG") == "1"; 38 | } 39 | catch (_:Dynamic) { 40 | return false; 41 | } 42 | } 43 | 44 | public static function s_version () : String { 45 | var str = version_major + "." + version_minor + "." + version_revision; 46 | str += switch (compiler.Version.version_extra) { 47 | case Some(v) : " " + v; 48 | case None : ""; 49 | }; 50 | return str; 51 | } 52 | 53 | public static function default_flush (ctx:Context) { 54 | 55 | var messages = List.rev(ctx.messages); 56 | 57 | List.iter(function(msg:context.CompilerMessage) { 58 | switch (msg) { 59 | case CMInfo(_): 60 | std.Sys.println(context.Common.compiler_message_string(msg)); 61 | case CMWarning(_), CMError(_): 62 | var stderr = std.Sys.stderr(); 63 | stderr.writeString(context.Common.compiler_message_string(msg)+"\n"); 64 | stderr.flush(); 65 | stderr.close(); 66 | } 67 | }, messages); 68 | if (ctx.has_error && prompt) { 69 | std.Sys.println("Press enter to exit..."); 70 | //ignore(read_line()); 71 | std.Sys.stdout().flush(); 72 | std.Sys.stdout().close(); 73 | std.Sys.stdin().readLine(); 74 | std.Sys.stdin().close(); 75 | } 76 | if (ctx.has_error) { 77 | std.Sys.exit(1); 78 | } 79 | } 80 | 81 | public static function createContext(params:ImmutableList) : Context { 82 | var ctx:Context = { 83 | com : Common.create(version, s_version, params), 84 | flush : function () {}, 85 | setup : function () {}, 86 | messages : [], 87 | has_next : false, 88 | has_error : false 89 | }; 90 | ctx.flush = function () { 91 | default_flush(ctx); 92 | }; 93 | return ctx; 94 | } 95 | 96 | public static function wait_loop (process_params:Dynamic, verbose:Bool, accept:Dynamic) : Dynamic { 97 | trace("TODO: Server.wait_loop"); 98 | throw false; 99 | } 100 | 101 | public static function init_wait_stdio () : Dynamic { 102 | trace("TODO: Server.init_wait_stdio"); 103 | throw false; 104 | // set_binary_mode_in stdin true; 105 | // set_binary_mode_out stderr true; 106 | 107 | // let chin = IO.input_channel stdin in 108 | // let cherr = IO.output_channel stderr in 109 | 110 | // let berr = Buffer.create 0 in 111 | // let read = fun () -> 112 | // let len = IO.read_i32 chin in 113 | // IO.really_nread_string chin len 114 | // in 115 | // let write = Buffer.add_string berr in 116 | // let close = fun() -> 117 | // IO.write_i32 cherr (Buffer.length berr); 118 | // IO.nwrite_string cherr (Buffer.contents berr); 119 | // IO.flush cherr 120 | // in 121 | // fun() -> 122 | // Buffer.clear berr; 123 | // read, write, close 124 | } 125 | 126 | public static function init_wait_socket (verbose:Bool, host:String, port:Int) : Dynamic { 127 | trace("TODO: Server.init_wait_socket"); 128 | throw false; 129 | // let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in 130 | // (try Unix.setsockopt sock Unix.SO_REUSEADDR true with _ -> ()); 131 | // (try Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_of_string host,port)) with _ -> failwith ("Couldn't wait on " ^ host ^ ":" ^ string_of_int port)); 132 | // if verbose then print_endline ("Waiting on " ^ host ^ ":" ^ string_of_int port); 133 | // Unix.listen sock 10; 134 | // let bufsize = 1024 in 135 | // let tmp = Bytes.create bufsize in 136 | // let accept() = ( 137 | // let sin, _ = Unix.accept sock in 138 | // Unix.set_nonblock sin; 139 | // if verbose then print_endline "Client connected"; 140 | // let b = Buffer.create 0 in 141 | // let rec read_loop count = 142 | // try 143 | // let r = Unix.recv sin tmp 0 bufsize [] in 144 | // if r = 0 then 145 | // failwith "Incomplete request" 146 | // else begin 147 | // if verbose then Printf.printf "Reading %d bytes\n" r; 148 | // Buffer.add_subbytes b tmp 0 r; 149 | // if Bytes.get tmp (r-1) = '\000' then 150 | // Buffer.sub b 0 (Buffer.length b - 1) 151 | // else 152 | // read_loop 0 153 | // end 154 | // with Unix.Unix_error((Unix.EWOULDBLOCK|Unix.EAGAIN),_,_) -> 155 | // if count = 100 then 156 | // failwith "Aborting inactive connection" 157 | // else begin 158 | // if verbose then print_endline "Waiting for data..."; 159 | // ignore(Unix.select [] [] [] 0.05); (* wait a bit *) 160 | // read_loop (count + 1); 161 | // end 162 | // in 163 | // let read = fun() -> (let s = read_loop 0 in Unix.clear_nonblock sin; s) in 164 | // let write s = ssend sin (Bytes.unsafe_of_string s) in 165 | // let close() = Unix.close sin in 166 | // read, write, close 167 | // ) in 168 | // accept 169 | } 170 | } -------------------------------------------------------------------------------- /src/core/Error.hx: -------------------------------------------------------------------------------- 1 | package core; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | enum CallError { 7 | Not_enough_arguments (l:ImmutableList); 8 | Too_many_arguments; 9 | Could_not_unify (error_msg:ErrorMsg); 10 | Cannot_skip_non_nullable (s:String); 11 | } 12 | 13 | enum ErrorMsg { 14 | Module_not_found (path:core.Path); 15 | Type_not_found (path:core.Path, s:String); 16 | Unify (l:ImmutableList); 17 | Custom (s:String); 18 | Unknown_ident (s:String); 19 | Stack (e1:ErrorMsg, e2:ErrorMsg); 20 | Call_error (ce:CallError); 21 | No_constructor (mt:core.Type.ModuleType); 22 | } 23 | 24 | 25 | // ocaml: exception Error 26 | // class ErrorException { 27 | // public var error_msg:ErrorMsg; 28 | // public var pos:core.Globals.Pos; 29 | // public function new(error_msg:ErrorMsg, pos:core.Globals.Pos) { 30 | // this.error_msg = error_msg; 31 | // this.pos = pos; 32 | // } 33 | // } 34 | 35 | class Fatal_error { 36 | public var s:String; 37 | public var pos:core.Globals.Pos; 38 | public function new(s:String, pos:core.Globals.Pos) { 39 | this.s = s; 40 | this.pos = pos; 41 | } 42 | } 43 | 44 | class Error { 45 | public var msg:ErrorMsg; 46 | public var pos:core.Globals.Pos; 47 | public function new(msg:ErrorMsg, pos:core.Globals.Pos) { 48 | this.msg = msg; 49 | this.pos = pos; 50 | } 51 | 52 | // public static function of(msg:ErrorMsg, pos:{file:String, min:Int, max:Int}) { 53 | // return new Error(msg, new core.Globals.Pos(pos.file, pos.min, pos.max)); 54 | // } 55 | public static function string_source(t:core.Type.T) : ImmutableList { 56 | return switch (t) { 57 | case TInst(c, _): List.map(function (cf) {return cf.cf_name;}, c.cl_ordered_fields); 58 | case TAnon(a): ocaml.PMap.fold(function (cf, acc:ImmutableList) {return cf.cf_name :: acc;}, a.a_fields, []); 59 | case TAbstract({a_impl:Some(c)}, _): List.map(function (cf) {return cf.cf_name;}, c.cl_ordered_statics); 60 | case _: []; 61 | }; 62 | } 63 | 64 | public static function short_type (ctx, t:core.Type.T) : String { 65 | var tstr = core.Type.s_type(ctx, t); 66 | return (tstr.length > 150) ? tstr.substr(0 ,147) + "..." : tstr; 67 | } 68 | 69 | public static function unify_error_msg (ctx, err:core.Type.UnifyError) : String { 70 | return switch (err) { 71 | case Cannot_unify (t1, t2): 72 | core.Type.s_type(ctx, t1) + " should be " + core.Type.s_type(ctx, t2); 73 | case Invalid_field_type (s): 74 | "Invalid type for field " + s + " :"; 75 | case Has_no_field (t, n): 76 | core.type.StringError.string_error(n, string_source(t), short_type(ctx, t)) + " has no field "+n; 77 | case Has_no_runtime_field (t, n): 78 | core.Type.s_type(ctx, t)+"."+n+" is not accessible at runtime"; 79 | case Has_extra_field (t, n): 80 | short_type(ctx, t) + " has extra field "+n; 81 | case Invalid_kind (f, a, b): 82 | switch ({fst:a, snd:b}) { 83 | case {fst:Var(va), snd:Var(vb)}: 84 | var name:String; var stra:String; var strb:String; 85 | if (va.v_read.equals(vb.v_read)) { 86 | name = "setter"; stra = core.Type.s_access(false, va.v_write); strb = core.Type.s_access(false, vb.v_write); 87 | } 88 | else if (va.v_write.equals(vb.v_write)) { 89 | name = "getter"; stra = core.Type.s_access(true, va.v_read); strb = core.Type.s_access(true, vb.v_read); 90 | } 91 | else { 92 | name = "access"; stra = "("+core.Type.s_access(true, va.v_read)+","+core.Type.s_access(false, va.v_write)+")"; strb = "("+core.Type.s_access(true, vb.v_read)+","+core.Type.s_access(false, vb.v_write)+")"; 93 | } 94 | "Inconsistent " + name + " for field " + f + " : " + stra + " should be " + strb; 95 | case _: 96 | "Field " + f + " is " + core.Type.s_kind(a) + " but should be " + core.Type.s_kind(b); 97 | } 98 | case Invalid_visibility (n): 99 | "The field " + n + " is not public"; 100 | case Not_matching_optional (n): 101 | "Optional attribute of parameter " + n + " differs"; 102 | case Cant_force_optional: 103 | "Optional parameters can't be forced"; 104 | case Invariant_parameter (_): 105 | "Type parameters are invariant"; 106 | case Constraint_failure (name): 107 | "Constraint check failure for " + name; 108 | case Missing_overload (cf, t): 109 | cf.cf_name + " has no overload for " + core.Type.s_type(ctx, t); 110 | case Unify_custom (msg): 111 | msg; 112 | }; 113 | } 114 | 115 | public static function error_msg (m:ErrorMsg) : String { 116 | return switch (m) { 117 | case Module_not_found(m): "Type not found : "+core.Globals.s_type_path(m); 118 | case Type_not_found(m, t): "Module "+core.Globals.s_type_path(m)+" does not define type "+t; 119 | case Unify(l): 120 | var ctx = core.Type.print_context(); 121 | List.join("\n", List.map(unify_error_msg.bind(ctx), l)); 122 | case Unknown_ident(s): "Unknown identifier : "+s; 123 | case Custom(s): s; 124 | case Stack(m1, m2): 125 | error_msg(m1) + "\n" + error_msg(m2); 126 | case Call_error(err): s_call_error(err); 127 | case No_constructor(mt): core.Globals.s_type_path(core.Type.t_infos(mt).mt_path) + " does not have a constructor"; 128 | 129 | } 130 | } 131 | 132 | public static function s_call_error (e:CallError) : String { 133 | return switch (e) { 134 | case Not_enough_arguments(tl): 135 | var pctx = core.Type.print_context(); 136 | "Not enough arguments, expected "+List.join(", ",List.map(function (arg) { return arg.name + ":"+short_type(pctx, arg.t); }, tl)); 137 | case Too_many_arguments: "Too many arguments"; 138 | case Could_not_unify (err): error_msg(err); 139 | case Cannot_skip_non_nullable(s): "Cannot skip non-nullable argument "+s; 140 | } 141 | } 142 | 143 | public static function error(msg:String, p:core.Globals.Pos) : Dynamic { 144 | throw new Error(Custom(msg),p); 145 | } 146 | 147 | public static function raise_error(err:ErrorMsg, p:core.Globals.Pos) : Dynamic { 148 | throw new Error(err, p); 149 | } 150 | 151 | } -------------------------------------------------------------------------------- /src/optimization/AnalyzerConfig.hx: -------------------------------------------------------------------------------- 1 | package optimization; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | using ocaml.Cloner; 6 | 7 | enum Debug_kind { 8 | DebugNone; 9 | DebugDot; 10 | DebugFull; 11 | } 12 | 13 | @:structInit 14 | class AnalyzerConfig { 15 | public function new (optimize:Bool, const_propagation:Bool, copy_propagation:Bool, local_dce:Bool, fusion:Bool, purity_inference:Bool, debug_kind:Debug_kind, detail_times:Bool, user_var_fusion:Bool, fusion_debug:Bool) { 16 | this.optimize = optimize; 17 | this.const_propagation = const_propagation; 18 | this.copy_propagation = copy_propagation; 19 | this.local_dce = local_dce; 20 | this.fusion = fusion; 21 | this.purity_inference = purity_inference; 22 | this.debug_kind = debug_kind; 23 | this.detail_times = detail_times; 24 | this.user_var_fusion = user_var_fusion; 25 | this.fusion_debug = fusion_debug; 26 | } 27 | public final optimize : Bool; 28 | public final const_propagation : Bool; 29 | public final copy_propagation : Bool; 30 | public final local_dce : Bool; 31 | public final fusion : Bool; 32 | public final purity_inference : Bool; 33 | public final debug_kind : Debug_kind; 34 | public final detail_times : Bool; 35 | public final user_var_fusion : Bool; 36 | public final fusion_debug : Bool; 37 | 38 | 39 | public static final flag_optimize = "optimize"; 40 | public static final flag_const_propagation = "const_propagation"; 41 | public static final flag_copy_propagation = "copy_propagation"; 42 | public static final flag_local_dce = "local_dce"; 43 | public static final flag_fusion = "fusion"; 44 | public static final flag_ignore = "ignore"; 45 | public static final flag_dot_debug = "dot_debug"; 46 | public static final flag_full_debug = "full_debug"; 47 | public static final flag_user_var_fusion = "user_var_fusion"; 48 | public static final flag_fusion_debug = "fusion_debug"; 49 | 50 | public static final all_flags = List.fold_left(function (acc:ImmutableList, flag:String) { 51 | return flag :: ("no_" + flag) :: acc; 52 | }, [], [flag_optimize,flag_const_propagation,flag_copy_propagation,flag_local_dce,flag_fusion,flag_ignore,flag_dot_debug,flag_user_var_fusion]); 53 | 54 | public static function has_analyzer_option (meta:core.Ast.Metadata, s:String) : Bool { 55 | return 56 | try { 57 | function loop (ml:core.Ast.Metadata) { 58 | return switch (ml) { 59 | case {name:Analyzer, params:el} :: ml: 60 | if (List.exists(function (expr:core.Ast.Expr) { 61 | var e = expr.expr; var p = expr.pos; 62 | return 63 | switch (e) { 64 | case EConst(CIdent(s2)) if (s == s2): true; 65 | case _: false; 66 | } 67 | }, el)) { 68 | true; 69 | } 70 | else { 71 | loop(ml); 72 | } 73 | case _::ml: loop(ml); 74 | case []: false; 75 | } 76 | } 77 | loop(meta); 78 | } 79 | catch (_:ocaml.Not_found) { 80 | false; 81 | } 82 | } 83 | 84 | public static inline function is_ignored (meta:core.Ast.Metadata) : Bool { 85 | return has_analyzer_option(meta, flag_ignore); 86 | } 87 | 88 | public static function get_base_config (com:context.Common.Context) : AnalyzerConfig { 89 | return { 90 | optimize: context.Common.raw_defined(com, "analyzer-optimize"), 91 | const_propagation: !context.Common.raw_defined(com, "analyzer-no-const-propagation"), 92 | copy_propagation: !context.Common.raw_defined(com, "analyzer-no-copy-propagation"), 93 | local_dce: !context.Common.raw_defined(com, "analyzer-no-local-dce"), 94 | fusion: !context.Common.raw_defined(com, "analyzer-no-fusion"), 95 | purity_inference: !context.Common.raw_defined(com, "analyzer-no-purity-inference"), 96 | debug_kind: DebugNone, 97 | detail_times: context.Common.raw_defined(com, "analyzer-times"), 98 | user_var_fusion: com.platform.match(Flash|Java) && (context.Common.raw_defined(com, "analyzer-user-var-fusion") || (!com.debug && !context.Common.raw_defined(com, "analyzer-no-user-var-fusion"))), 99 | fusion_debug: false 100 | }; 101 | } 102 | 103 | public static function update_config_from_meta (com:context.Common.Context, config:AnalyzerConfig, meta:core.Ast.Metadata) : AnalyzerConfig { 104 | return List.fold_left(function (config:AnalyzerConfig, meta:core.Ast.MetadataEntry) { 105 | return switch (meta) { 106 | case {name:Analyzer, params:el}: 107 | List.fold_left(function (config:AnalyzerConfig, e:core.Ast.Expr) { 108 | return switch (e.expr) { 109 | case EConst(CIdent(s)): 110 | switch (s) { 111 | case "optimize": config.with({optimize:true}); 112 | case "no_optimize": config.with({optimize:false}); 113 | case "const_propagation": config.with({const_propagation:true}); 114 | case "no_const_propagation": config.with({const_propagation:false}); 115 | case "copy_propagation": config.with({copy_propagation:true}); 116 | case "no_copy_propagation": config.with({copy_propagation:false}); 117 | case "local_dce": config.with({local_dce:true}); 118 | case "no_local_dce": config.with({local_dce:false}); 119 | case "fusion": config.with({fusion:true}); 120 | case "no_fusion": config.with({fusion:false}); 121 | case "user_var_fusion": config.with({use_var_fusion:true}); 122 | case "no_user_var_fusion": config.with({use_var_fusion:false}); 123 | case "dot_debug": config.with({debug_kind:DebugDot}); 124 | case "full_debug": config.with({debug_kind:DebugFull}); 125 | case "fusion_debug": config.with({fusion_debug:true}); 126 | case "as_var": config; 127 | case _: 128 | com.warning(core.type.StringError.string_error(s, all_flags, "Unrecognized analyzer option: " + s), e.pos); 129 | config; 130 | } 131 | case _: 132 | var s = core.Ast.s_expr(e); 133 | com.warning(core.type.StringError.string_error(s, all_flags, "Unrecognized analyzer option: " +s), e.pos); 134 | config; 135 | } 136 | }, config, el); 137 | case {name:HasUntyped}: 138 | config.with({optimize:false}); 139 | case _: config; 140 | } 141 | }, config, meta); 142 | } 143 | 144 | public static function get_class_config (com:context.Common.Context, c:core.Type.TClass) : AnalyzerConfig { 145 | var config = get_base_config(com); 146 | return update_config_from_meta(com, config, c.cl_meta); 147 | } 148 | 149 | public static function get_field_config (com:context.Common.Context, c:core.Type.TClass, cf:core.Type.TClassField) : AnalyzerConfig { 150 | var config = get_class_config(com, c); 151 | return update_config_from_meta(com, config, cf.cf_meta); 152 | } 153 | } -------------------------------------------------------------------------------- /src/core/Path.hx: -------------------------------------------------------------------------------- 1 | package core; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | using equals.Equal; 7 | 8 | class Path { 9 | 10 | public var a : ImmutableList; 11 | public var b : String; 12 | public function new (a:ImmutableList, b:String) { 13 | this.a = a; 14 | this.b = b; 15 | } 16 | 17 | public static function compare (a:Path, b:Path) : Int { 18 | if (a.equals(b)) { return 0; } 19 | 20 | var _a:Array = a.a; 21 | var _b:Array = b.a; 22 | var la = _a.length; 23 | var lb = _a.length; 24 | for (i in 0...Std.int(Math.min(la, lb))) { 25 | if (_a[i] > _b[i]) { 26 | return 1; 27 | } 28 | if (_a[i] < _b[i]) { 29 | return -1; 30 | } 31 | } 32 | if (la > lb) { return 1; } 33 | if (la < lb) { return -1; } 34 | 35 | if (a.b > b.b) { return 1; } 36 | if (a.b < b.b) { return -1; } 37 | return 0; 38 | } 39 | 40 | /* 41 | * this function is quite weird: it tries to determine whether the given 42 | * argument is a .hx file path with slashes or a dotted module path and 43 | * based on that it returns path "parts", which are basically a list of 44 | * either folders or packages (which are folders too) appended by the module name 45 | * 46 | * TODO: i started doubting my sanity while writing this comment, let's somehow 47 | * refactor this stuff so it doesn't mix up file and module paths and doesn't introduce 48 | * the weird "path part" entity. 49 | */ 50 | public static function get_path_parts (f:String) : ImmutableList { 51 | var l = f.length; 52 | if (l > 3 && f.substr(l-3, 3) == ".hx"){ 53 | var ff = f.substr(0, l-3); /// strip the .hx; 54 | return ~/[\/\\]/g.split(ff); 55 | // let f = String.sub f 0 (l-3) in (* strip the .hx *) 56 | // ExtString.String.nsplit (String.concat "/" (ExtString.String.nsplit f "\\")) "/" (* TODO: wouldn't it be faster to Str.split here? *) 57 | } 58 | else { 59 | return f.split('.'); 60 | } 61 | } 62 | 63 | 64 | public static function parse_path(f:String) : Path { 65 | var cl = get_path_parts(f); 66 | function error (msg) : Path { 67 | var msg = "Could not process argument "+f+"\n"+msg; 68 | throw new ocaml.Failure(msg); 69 | } 70 | function invalid_char (x:String) { 71 | for (i in 1...x.length) { 72 | var c = x.charCodeAt(i); 73 | if ( (c>="A".code && c<="Z".code) || 74 | (c>="a".code && c<="z".code) || 75 | (c>="0".code && c<="9".code) || 76 | (c=="_".code) || (c<=".".code)) { 77 | } 78 | else { 79 | error("invalid character: " + x.charAt(i)); 80 | } 81 | } 82 | } 83 | 84 | function loop (l:ImmutableList) : core.Path { 85 | return switch (l) { 86 | case []: error("empty part"); 87 | case [x]: 88 | invalid_char(x); 89 | new Path([], x); 90 | case x::l: 91 | if (x.length == 0) { 92 | error("empty part"); 93 | } 94 | else if (x.charCodeAt(0) < 'a'.code || x.charCodeAt(0) > 'z'.code) { 95 | error("Package name must start with a lower case character"); 96 | } 97 | invalid_char(x); 98 | var path = loop(l); 99 | new Path(x::path.a, path.b); 100 | } 101 | } 102 | return loop(cl); 103 | } 104 | 105 | public static function starts_uppercase (x:String) : Bool { 106 | var c = x.charCodeAt(0); 107 | return (c == "_".code || (c >= "A".code && c <= "Z".code)); 108 | } 109 | 110 | public static function check_uppercase (x:String) : Void { 111 | if (x.length == 0) { 112 | throw new ocaml.Failure("empty part"); 113 | } 114 | else if (!starts_uppercase(x)) { 115 | throw new ocaml.Failure("Class name must start with uppercase character"); 116 | } 117 | } 118 | 119 | public static function parse_type_path (s:String) : Path { 120 | var path = parse_path(s); 121 | check_uppercase(path.b); 122 | return path; 123 | } 124 | 125 | public static var path_sep : String = core.Globals.is_windows ? "\\" : "/"; 126 | 127 | /** Returns absolute path. Doesn't fix path case on Windows. */ 128 | public static function get_full_path (f:String) { 129 | if (f != null && sys.FileSystem.exists(f)) { 130 | return sys.FileSystem.absolutePath(f); 131 | } 132 | else { 133 | return f; 134 | } 135 | } 136 | 137 | /** 138 | * Returns absolute path (on Windows ensures proper case with drive letter upper-cased) 139 | * Use for returning positions from IDE support functions 140 | */ 141 | public static function get_real_path () : String->String { 142 | if (core.Globals.is_windows) { 143 | return function (p:String) : String { 144 | if (p != null && sys.FileSystem.exists(p) ) { 145 | return sys.FileSystem.absolutePath(p); 146 | } 147 | else { 148 | return p; 149 | } 150 | }; 151 | } 152 | else { 153 | return get_full_path; 154 | } 155 | } 156 | 157 | /* 158 | * Returns absolute path guaranteed to be the same for different letter case. 159 | * Use where equality comparison is required, lowercases the path on Windows 160 | */ 161 | public static var unique_full_path (get, never) : String->String; 162 | public static function get_unique_full_path () : String->String { 163 | if (core.Globals.is_windows) { 164 | return function(f:String) { 165 | return get_full_path(f).toLowerCase(); 166 | } 167 | } 168 | else { 169 | return get_full_path; 170 | } 171 | } 172 | 173 | public static function add_trailing_slash (p:String) : String { 174 | // var l = p.length; 175 | // if (l == 0) { 176 | // return "./"; 177 | // } 178 | // else { 179 | // return switch (p.charAt(l-1)) { 180 | // case "\\", "/": p; 181 | // default: p + "/"; 182 | // }; 183 | // } 184 | return haxe.io.Path.addTrailingSlash(p); 185 | } 186 | 187 | public static function flat_path (path:Path) : String { 188 | var p = path.a; var s = path.b; 189 | // Replace _ with _$ in paths to prevent name collisions. 190 | function escape (str:String) { 191 | return str.split("_").join("_$"); 192 | } 193 | return switch (p) { 194 | case []: escape(s); 195 | case _: List.join("_", List.map(escape, p)) + "_" + escape(s); 196 | } 197 | } 198 | 199 | public static function mkdir_recursive (base:String, dir_list:ImmutableList) : Void { 200 | switch (dir_list) { 201 | case []: 202 | case dir :: remaining: 203 | var path = switch (base) { 204 | case "": dir; 205 | case "/": "/"+dir; 206 | case _: base + "/" + dir; 207 | } 208 | var path_len = path.length; 209 | path = if (path_len > 0 && (path.charAt(path_len -1) == "/" || path.charAt(path_len-1) == "\\")) { 210 | path.substr(0, path_len-1); 211 | } 212 | else { 213 | path; 214 | } 215 | if (!(path=="" || (path_len==2 && path.substr(1,1) == ":"))) { 216 | if (!sys.FileSystem.exists(path)) { 217 | sys.FileSystem.createDirectory(path); 218 | } 219 | } 220 | mkdir_recursive((path=="") ? "/" : path, remaining); 221 | } 222 | } 223 | 224 | public static function mkdir_from_path (path:String) : Void { 225 | var r = ~/[\/\\]+/g; 226 | var parts:ImmutableList = r.split(path); 227 | switch (parts) { 228 | case []: /* path was "" */ 229 | case _: 230 | var dir_list = List.rev(List.tl(List.rev(parts))); 231 | mkdir_recursive("", dir_list); 232 | } 233 | } 234 | } -------------------------------------------------------------------------------- /src/neko/Binast.hx: -------------------------------------------------------------------------------- 1 | package neko; 2 | 3 | import haxe.ds.Option; 4 | 5 | import neko.Nast.Constant; 6 | import neko.Nast.Expr; 7 | 8 | import ocaml.Hashtbl; 9 | import ocaml.List; 10 | 11 | import sys.io.FileOutput; 12 | 13 | typedef Context = { 14 | ch: FileOutput, 15 | curfile: String, 16 | curline: Int, 17 | scount: Int, 18 | strings: Hashtbl 19 | } 20 | 21 | class Binast { 22 | 23 | public static function b (ctx:Context, n:Int) : Void { 24 | ctx.ch.writeByte(n); 25 | } 26 | 27 | public static function write_ui24 (ctx:Context, n:Int) : Void { 28 | // ctx.ch.writeByte(n); 29 | // ctx.ch.writeByte(n >>> 8); 30 | // ctx.ch.writeByte(n >>> 16); 31 | ctx.ch.writeByte(n & 255); 32 | ctx.ch.writeByte((n >> 8) & 255); 33 | ctx.ch.writeByte((n >> 16) & 255); 34 | } 35 | 36 | public static function write_string (ctx:Context, s:String) : Void { 37 | try { 38 | var x = ctx.scount - Hashtbl.find(ctx.strings, s); 39 | if (x > 0xFF) { throw ocaml.Not_found.instance; } 40 | b(ctx, x); 41 | } 42 | catch (_:ocaml.Not_found) { 43 | Hashtbl.replace(ctx.strings, s, ctx.scount); 44 | ctx.scount++; 45 | b(ctx, 0); 46 | ctx.ch.writeUInt16(s.length); 47 | ctx.ch.writeString(s); 48 | } 49 | } 50 | 51 | public static function write_constant (ctx:Context, c:Constant) : Void { 52 | switch (c) { 53 | case True: b(ctx, 0); 54 | case False: b(ctx, 1); 55 | case Null: b(ctx, 2); 56 | case This: b(ctx, 3); 57 | case Int(n): 58 | if (n >= 0 && n <= 0xFF) { 59 | b(ctx, 4); 60 | b(ctx, n); 61 | } 62 | else { 63 | b(ctx, 5); 64 | ctx.ch.writeInt32(n); 65 | } 66 | case Float(s): 67 | b(ctx, 6); 68 | write_string(ctx, s); 69 | case String(s): 70 | b(ctx, 7); 71 | write_string(ctx, s); 72 | case Builtin(s): 73 | b(ctx, 8); 74 | write_string(ctx, s); 75 | case Ident(s): 76 | b(ctx, 9); 77 | write_string(ctx, s); 78 | case Int32(n): 79 | b(ctx, 5); // same as Int 80 | ctx.ch.writeInt32(n); 81 | } 82 | } 83 | 84 | public static function write_op (ctx:Context, op:String) : Void { 85 | b(ctx, switch(op) { 86 | case "+": 0; 87 | case "-": 1; 88 | case "/": 2; 89 | case "*": 3; 90 | case "%": 4; 91 | case "<<": 5; 92 | case ">>": 6; 93 | case ">>>": 7; 94 | case "|": 8; 95 | case "&": 9; 96 | case "^": 10; 97 | case "==": 11; 98 | case "!=": 12; 99 | case ">": 13; 100 | case ">=": 14; 101 | case "<": 15; 102 | case "<=": 16; 103 | case "=": 17; 104 | case "&&": 18; 105 | case "||": 19; 106 | case "++=": 20; 107 | case "--=": 21; 108 | case "+=": 22; 109 | case "-=": 23; 110 | case "/=": 24; 111 | case "*=": 25; 112 | case "%=": 26; 113 | case "<<=": 27; 114 | case ">>=": 28; 115 | case ">>>=": 29; 116 | case "|=": 30; 117 | case "&=": 31; 118 | case "^=": 32; 119 | case op: throw "Invalid neko ast op " + op; 120 | }); 121 | } 122 | 123 | public static function write_expr_opt(ctx:Context, opt:Option) : Void { 124 | switch (opt) { 125 | case None: b(ctx, 0); 126 | case Some(e): 127 | b(ctx, 1); 128 | write_expr(ctx, e); 129 | } 130 | } 131 | 132 | public static function write_expr (ctx:Context, expr:Expr) : Void { 133 | var e = expr.decl; var p = expr.pos; 134 | if (p.psource != ctx.curfile) { 135 | b(ctx, 0); 136 | write_string(ctx, p.psource); 137 | write_ui24(ctx, p.pline); 138 | ctx.curfile = p.psource; 139 | ctx.curline = p.pline; 140 | } 141 | else if (p.pline != ctx.curline) { 142 | b(ctx, 1); 143 | write_ui24(ctx, p.pline); 144 | ctx.curline = p.pline; 145 | } 146 | switch (e) { 147 | case EConst(c): 148 | b(ctx, 2); 149 | write_constant(ctx, c); 150 | case EBlock(el): 151 | var n = List.length(el); 152 | if (n <= 0xFF) { 153 | b(ctx, 3); 154 | b(ctx, n); 155 | } 156 | else { 157 | b(ctx, 4); 158 | write_ui24(ctx, n); 159 | } 160 | List.iter(write_expr.bind(ctx), el); 161 | case EParenthesis(e): 162 | b(ctx, 5); 163 | write_expr(ctx, e); 164 | case EField(e, f): 165 | b(ctx, 6); 166 | write_expr(ctx, e); 167 | write_string(ctx, f); 168 | case ECall(e, el): 169 | var n = List.length(el); 170 | if (n <= 0xFF) { 171 | b(ctx, 7); 172 | write_expr(ctx, e); 173 | b(ctx, n); 174 | } 175 | else { 176 | b(ctx, 28); 177 | write_expr(ctx, e); 178 | write_ui24(ctx, n); 179 | } 180 | List.iter(write_expr.bind(ctx), el); 181 | case EArray(e1, e2): 182 | b(ctx, 8); 183 | write_expr(ctx, e1); 184 | write_expr(ctx, e2); 185 | case EVars(vl): 186 | b(ctx, 9); 187 | b(ctx, List.length(vl)); 188 | List.iter(function (tmp) { 189 | var v = tmp.name; var e = tmp.def; 190 | write_string(ctx, v); 191 | write_expr_opt(ctx, e); 192 | }, vl); 193 | case EWhile(e1, e2, NormalWhile): 194 | b(ctx, 10); 195 | write_expr(ctx, e1); 196 | write_expr(ctx, e2); 197 | case EWhile(e1, e2, DoWhile): 198 | b(ctx, 11); 199 | write_expr(ctx, e1); 200 | write_expr(ctx, e2); 201 | case EIf(e1, e2, eo): 202 | b(ctx, 12); 203 | write_expr(ctx, e1); 204 | write_expr(ctx, e2); 205 | write_expr_opt(ctx, eo); 206 | case ETry(e1, v, e2): 207 | b(ctx, 13); 208 | write_expr(ctx, e1); 209 | write_string(ctx, v); 210 | write_expr(ctx, e2); 211 | case EFunction(pl, e): 212 | b(ctx, 14); 213 | b(ctx, List.length(pl)); 214 | List.iter(write_string.bind(ctx), pl); 215 | write_expr(ctx, e); 216 | case EBinop(op, e1, e2): 217 | b(ctx, 15); 218 | write_op(ctx, op); 219 | write_expr(ctx, e1); 220 | write_expr(ctx, e2); 221 | case EReturn(None): 222 | b(ctx, 16); 223 | case EReturn(Some(e)): 224 | b(ctx, 17); 225 | write_expr(ctx, e); 226 | case EBreak(None): 227 | b(ctx, 18); 228 | case EBreak(Some(e)): 229 | b(ctx, 19); 230 | write_expr(ctx, e); 231 | case EContinue: 232 | b(ctx, 20); 233 | case ENext(e1, e2): 234 | b(ctx, 21); 235 | write_expr(ctx, e1); 236 | write_expr(ctx, e2); 237 | case EObject(fl): 238 | var n = List.length(fl); 239 | if (n <= 0xFF) { 240 | b(ctx, 22); 241 | b(ctx, n); 242 | } 243 | else { 244 | b(ctx, 23); 245 | write_ui24(ctx, n); 246 | } 247 | List.iter(function (tmp) { 248 | var f = tmp.s; var e = tmp.e; 249 | write_string(ctx, f); 250 | write_expr(ctx, e); 251 | }, fl); 252 | case ELabel(l): 253 | b(ctx, 24); 254 | write_string(ctx, l); 255 | case ESwitch(e, cases, eo): 256 | var n = List.length(cases); 257 | if (n <= 0xFF) { 258 | b(ctx, 25); 259 | b(ctx, n); 260 | } 261 | else { 262 | b(ctx, 26); 263 | write_ui24(ctx, n); 264 | } 265 | write_expr(ctx, e); 266 | List.iter(function (tmp) { 267 | var e1 = tmp.e1; var e2 = tmp.e2; 268 | write_expr(ctx, e1); 269 | write_expr(ctx, e2); 270 | }, cases); 271 | write_expr_opt(ctx, eo); 272 | case ENeko(s): 273 | b(ctx, 27); 274 | write_ui24(ctx, s.length); 275 | ctx.ch.writeString(s); 276 | 277 | } 278 | } 279 | 280 | public static function write (ch:FileOutput, e:Expr) : Void { 281 | var ctx:Context = { 282 | ch: ch, 283 | curfile: "", 284 | curline: -1, 285 | scount: 0, 286 | strings: Hashtbl.create(0) 287 | }; 288 | ch.writeString("NBA\u0001"); // neko "NBA\001" ??? 289 | write_expr(ctx, e); 290 | } 291 | } -------------------------------------------------------------------------------- /src/filters/JsExceptions.hx: -------------------------------------------------------------------------------- 1 | package filters; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | import core.Type.TExprExpr; 6 | 7 | import ocaml.List; 8 | using equals.Equal; 9 | using ocaml.Cloner; 10 | 11 | class JsExceptions { 12 | public static inline function follow (t:core.Type.T) { 13 | return core.Abstract.follow_with_abstracts(t); 14 | } 15 | 16 | public static function is_js_error (c:core.Type.TClass) : Bool { 17 | return switch (c) { 18 | case {cl_path:{a:["js"], b:"Error"}}: true; 19 | case {cl_super: Some({c:csup})}: is_js_error(csup); 20 | case _: false; 21 | } 22 | } 23 | 24 | public static function find_cl (com:context.Common.Context, path:core.Path) : core.Type.TClass { 25 | return List.find_map(function (mt:core.Type.ModuleType) { 26 | return switch (mt) { 27 | case TClassDecl(c) if (c.cl_path.equals(path)): Some(c); 28 | case _: None; 29 | } 30 | }, com.types); 31 | } 32 | 33 | public static function init (ctx:context.Typecore.Typer) : core.Type.TExpr->core.Type.TExpr { 34 | var cJsError = find_cl(ctx.com, new core.Path(["js"], "Error")); 35 | var cHaxeError = find_cl(ctx.com, new core.Path(["js", "_Boot"], "HaxeError")); 36 | var cStd = find_cl(ctx.com, new core.Path([], "Std")); 37 | var cBoot = find_cl(ctx.com, new core.Path(["js"], "Boot")); 38 | var cSyntax = find_cl(ctx.com, new core.Path(["js"], "Syntax")); 39 | 40 | function dynamic_wrap (e:core.Type.TExpr) : core.Type.TExpr { 41 | var eHaxeError = context.Typecore.make_static_this(cHaxeError, e.epos); 42 | return core.Texpr.Builder.fcall(eHaxeError, "wrap", [e], TInst(cJsError, []), e.epos); 43 | } 44 | 45 | function static_wrap (e:core.Type.TExpr) : core.Type.TExpr { 46 | return e.with({eexpr:TNew(cHaxeError, [], [e]), etype:core.Type.T.TInst(cHaxeError, [])}); 47 | } 48 | 49 | function loop (vrethrow:Option, e:core.Type.TExpr) : core.Type.TExpr { 50 | return switch (e.eexpr) { 51 | case TThrow(eexc): 52 | var eexc = loop(vrethrow, eexc); 53 | var eexc = switch (core.Type.follow(eexc.etype)) { 54 | case TDynamic(_), TMono(_): 55 | switch(eexc.eexpr) { 56 | case TConst((TInt(_)|TFloat(_)|TString(_)|TBool(_)|TNull)): static_wrap(eexc); 57 | case _: dynamic_wrap(eexc); 58 | } 59 | case TInst(c, _) if (is_js_error(c)): 60 | eexc; 61 | case _: 62 | static_wrap(eexc); 63 | } 64 | e.with({eexpr:TThrow(eexc)}); 65 | case TCall({eexpr:TField(_, FStatic({cl_path:{a:["js"], b:"Lib"}}, {cf_name:"getOriginalException"}))}, _): 66 | switch (vrethrow) { 67 | case Some(erethrowvar): erethrowvar; 68 | case None: context.Common.abort("js.Lib.getOriginalException can only be called inside a catch block", e.epos); 69 | } 70 | case TCall({eexpr:TField(_, FStatic({cl_path:{a:["js"], b:"Lib"}}, {cf_name:"rethrow"}))}, _): 71 | switch (vrethrow) { 72 | case Some(erethrowvar): e.with({eexpr:TThrow(erethrowvar)}); 73 | case None: context.Common.abort("js.Lib.rethrow can only be called inside a catch block", e.epos); 74 | } 75 | case TTry(etry, catches): 76 | var etry = loop(vrethrow, etry); 77 | 78 | var catchall_name = switch (catches) { case [{v:v}]: v.v_name; case _: "e"; } 79 | var vcatchall = core.Type.alloc_var(catchall_name, core.Type.t_dynamic, e.epos); 80 | var ecatchall = core.Texpr.Builder.make_local(vcatchall, e.epos); 81 | var erethrow = core.Type.mk(TThrow(ecatchall), core.Type.t_dynamic, e.epos); 82 | 83 | var eSyntax = context.Typecore.make_static_this(cSyntax, e.epos); 84 | var eHaxeError = context.Typecore.make_static_this(cHaxeError, e.epos); 85 | var eInstanceof = core.Texpr.Builder.fcall(eSyntax, "instanceof", [ecatchall, eHaxeError], ctx.com.basic.tbool, e.epos); 86 | var eval = core.Texpr.Builder.field(ecatchall.with({etype:core.Type.T.TInst(cHaxeError, [])}), "val", core.Type.t_dynamic, e.epos); 87 | var eunwrap = core.Type.mk(TIf(eInstanceof, eval, Some(ecatchall)), core.Type.t_dynamic, e.epos); 88 | 89 | var vunwrapped = core.Type.alloc_var(catchall_name, core.Type.t_dynamic, e.epos); 90 | vunwrapped.v_meta = ({name:CompilerGenerated, params:[], pos:core.Globals.null_pos} : core.Ast.MetadataEntry) :: vunwrapped.v_meta; 91 | var eunwrapped = core.Texpr.Builder.make_local(vunwrapped, e.epos); 92 | 93 | var ecatch = List.fold_left(function (acc, c:{v:core.Type.TVar, e:core.Type.TExpr}) { 94 | var v = c.v; var ecatch = c.e; 95 | var ecatch = loop(Some(ecatchall), ecatch); 96 | // it's not really compiler-generated, but it kind of is, since it was used as catch identifier and we add a TVar for it 97 | v.v_meta = ({name:CompilerGenerated, params:[], pos:core.Globals.null_pos} : core.Ast.MetadataEntry) :: v.v_meta; 98 | 99 | return 100 | switch (core.Type.follow(v.v_type)) { 101 | case TDynamic(_): 102 | ecatch.with({eexpr:TBlock([ 103 | core.Type.mk(TVar(v, Some(eunwrapped)), ctx.com.basic.tvoid, ecatch.epos), 104 | ecatch 105 | ])}); 106 | case t: 107 | var etype = core.Texpr.Builder.make_typeexpr(core.Type.module_type_of_type(t), e.epos); 108 | var args:ImmutableList = [eunwrapped, etype]; 109 | var echeck = switch (optimization.Optimizer.api_inline(ctx, cStd, "is", args, e.epos)) { 110 | case Some(e): e; 111 | case None: 112 | var eBoot = core.Texpr.Builder.make_static_this(cBoot, e.epos); 113 | core.Texpr.Builder.fcall(eBoot, "__instanceof", [eunwrapped, etype], ctx.com.basic.tbool, e.epos); 114 | } 115 | var ecatch = ecatch.with({eexpr:TBlock([ 116 | core.Type.mk(TVar(v, Some(eunwrapped)), ctx.com.basic.tvoid, ecatch.epos), 117 | ecatch 118 | ])}); 119 | core.Type.mk(TIf(echeck, ecatch, Some(acc)), e.etype, e.epos); 120 | } 121 | }, erethrow, List.rev(catches)); 122 | 123 | ecatch = ecatch.with({ 124 | eexpr:TBlock([ 125 | core.Type.mk(TVar(vunwrapped, Some(eunwrap)), ctx.com.basic.tvoid, e.epos), 126 | ecatch 127 | ]) 128 | }); 129 | 130 | e.with({eexpr:TTry(etry, [{v:vcatchall, e:ecatch}])}); 131 | case _: 132 | core.Type.map_expr(loop.bind(vrethrow), e); 133 | } 134 | } 135 | 136 | return loop.bind(None); 137 | } 138 | 139 | public static function inject_callstack (com:context.Common.Context, type_filters:ImmutableList<(context.Typecore.Typer, core.Type.ModuleType)->Void>) : ImmutableList<(context.Typecore.Typer, core.Type.ModuleType)->Void> { 140 | var cCallStack = if (context.Common.has_dce(com)) { 141 | if (context.Common.has_feature(com, "haxe.CallStack.lastException")) { 142 | Some(find_cl(com, new core.Path(["haxe"], "CallStack"))); 143 | } 144 | else { 145 | None; 146 | } 147 | } 148 | else { 149 | try { 150 | Some(find_cl(com, new core.Path(["haxe"], "CallStack"))); 151 | } 152 | catch (_:ocaml.Not_found) { 153 | None; 154 | } 155 | } 156 | return 157 | switch (cCallStack) { 158 | case Some(cCallStack): 159 | function loop (e:core.Type.TExpr) : core.Type.TExpr { 160 | return switch (e.eexpr) { 161 | case TTry(etry, [{v:v, e:ecatch}]): 162 | var etry = loop(etry); 163 | var ecatch = loop(ecatch); 164 | 165 | var eCallStack = core.Texpr.Builder.make_static_this(cCallStack, ecatch.epos); 166 | var elastException = core.Texpr.Builder.field(eCallStack, "lastException", core.Type.t_dynamic, ecatch.epos); 167 | var elocal = core.Texpr.Builder.make_local(v, ecatch.epos); 168 | var eStoreException = core.Type.mk(TBinop(OpAssign, elastException, elocal), ecatch.etype, ecatch.epos); 169 | var ecatch = core.Type.concat(eStoreException, ecatch); 170 | e.with({eexpr:TTry(etry, [{v:v, e:ecatch}])}); 171 | case TTry(_,_): 172 | // this should be handled by the filter above 173 | trace("Shall not be seen"); std.Sys.exit(255); throw false; 174 | case _: 175 | core.Type.map_expr(loop, e); 176 | } 177 | } 178 | List.append(type_filters, [function (ctx, t) { return FiltersCommon.run_expression_filters(ctx, [loop], t); }]); 179 | case None: 180 | type_filters; 181 | } 182 | } 183 | } -------------------------------------------------------------------------------- /src/syntax/ParserEntry.hx: -------------------------------------------------------------------------------- 1 | package syntax; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | import ocaml.Hashtbl; 6 | using equals.Equal; 7 | 8 | // eval 9 | enum Small_type { 10 | TNull; 11 | TBool(b:Bool); 12 | TFloat(f:Float); 13 | TString(s:String); 14 | } 15 | 16 | class ParserEntry { 17 | 18 | public static inline function is_true(a:Small_type) { 19 | return haxeparser.HaxeParser.HaxeTokenSource.isTrue(a); 20 | } 21 | 22 | public static inline function eval(ctx:core.Define, e:core.Ast.Expr) : Small_type { 23 | return haxeparser.HaxeParser.HaxeTokenSource.eval(ctx, e); 24 | } 25 | 26 | public static function parse (ctx:core.Define, code:{fst:byte.ByteData, snd:String}) : {pack:ImmutableList, decls:ImmutableList} { 27 | return new haxeparser.HaxeParser(code.fst, code.snd, ctx).parse(); 28 | } 29 | 30 | public static function parse_string (com:core.Define, s:String, p:core.Globals.Pos, error:(String, core.Globals.Pos)->Dynamic, inlined:Bool) : {pack:ImmutableList, decls:ImmutableList} { 31 | var old = syntax.Lexer.save(); 32 | var old_file = try { Some(Hashtbl.find(syntax.Lexer.all_files, p.pfile)); } 33 | catch (_:ocaml.Not_found) { None; } 34 | var old_display = syntax.Parser.resume_display.get(); 35 | var old_de = syntax.Parser.display_error; 36 | function restore () { 37 | switch (old_file) { 38 | case None: 39 | case Some(f): Hashtbl.replace(syntax.Lexer.all_files, p.pfile, f); 40 | } 41 | if (!inlined) { syntax.Parser.resume_display.set(old_display); } 42 | syntax.Lexer.restore(old); 43 | syntax.Parser.display_error = old_de; 44 | } 45 | syntax.Lexer.init(p.pfile, true); 46 | syntax.Parser.display_error = function (e:syntax.parser.ErrorMsg, p:core.Globals.Pos) { throw new syntax.parser.Error(e, p); } 47 | if (!inlined) { syntax.Parser.resume_display.set(core.Globals.null_pos); } 48 | var _tmp = try { 49 | parse(com, {fst:byte.ByteData.ofString(s), snd:p.pfile}); 50 | } 51 | catch (err:syntax.parser.Error) { 52 | var e = err.error_msg; var pe = err.pos; 53 | restore(); 54 | core.Error.error(syntax.Parser.error_msg(e), (inlined) ? pe : p); 55 | } 56 | catch (err:syntax.lexer.Error) { 57 | var e = err.error_msg; var pe = err.pos; 58 | restore(); 59 | core.Error.error(syntax.Lexer.error_msg(e), (inlined) ? pe : p); 60 | } 61 | restore(); 62 | return _tmp; 63 | } 64 | 65 | public static function parse_expr_string(com:core.Define, s:String, p:core.Globals.Pos, error:(String, core.Globals.Pos)->Dynamic, inl:Bool) : core.Ast.Expr { 66 | var head = "class X{static function main() "; 67 | var head = (p.pmin > head.length) ? head + StringTools.lpad("", " ", p.pmin + head.length) : head; 68 | function loop (e:core.Ast.Expr) : core.Ast.Expr { 69 | var e = core.Ast.map_expr(loop, e); 70 | return {expr:e.expr, pos:p}; 71 | } 72 | return 73 | switch (parse_string(com, head+s+";}", p, error, inl)) { 74 | case {decls:[{decl:EClass({d_data:[{cff_name:{pack:"main", pos:null_pos}, cff_kind:FFun({f_expr:Some(e)})}]})}]}: // capturing in null_pos why ? 75 | (inl) ? e : loop(e); 76 | case _: 77 | throw ocaml.Exit.instance; 78 | } 79 | } 80 | 81 | // public static function cmp(a:Small_type, b:Small_type) { 82 | // return switch [a, b] { 83 | // case [TNull, TNull]: 0; 84 | // case [TFloat(a), TFloat(b)]: Reflect.compare(a, b); 85 | // case [TString(a), TString(b)]: Reflect.compare(a, b); 86 | // case [TBool(a), TBool(b)]: Reflect.compare(a, b); 87 | // case [TString(a), TFloat(b)]: Reflect.compare(Std.parseFloat(a), b); 88 | // case [TFloat(a), TString(b)]: Reflect.compare(a, Std.parseFloat(b)); 89 | // case _: throw ocaml.Exit.instance; // alway false 90 | // } 91 | // } 92 | 93 | // public static function eval(ctx:core.Define, e:core.Ast.Expr) : Small_type { 94 | // return switch (e.expr) { 95 | // case EConst(CIdent(i)): 96 | // try { 97 | // TString(core.Define.raw_defined_value(ctx, i)); 98 | // } 99 | // catch (_:ocaml.Not_found) { 100 | // TNull; 101 | // } 102 | // case EConst(CString(s)): TString(s); 103 | // case EConst(CInt(n)), EConst(CFloat(n)): TFloat(Std.parseFloat(n)); 104 | // case EBinop(OpBoolAnd, e1, e2): TBool(isTrue(eval(ctx, e1)) && isTrue(eval(ctx, e2))); 105 | // case EBinop(OpBoolOr, e1, e2): TBool(isTrue(eval(ctx, e1)) || isTrue(eval(ctx, e2))); 106 | // case EUnop(OpNot, _, e): TBool(!isTrue(eval(ctx, e))); 107 | // case EParenthesis(e): eval(ctx, e); 108 | // case EBinop(op, e1, e2): 109 | // var v1 = eval(ctx, e1); 110 | // var v2 = eval(ctx, e2); 111 | // function compare (op:Int->Int->Bool) :Small_type { 112 | // return try { 113 | // return TBool(op(cmp(v1, v2), 0)); 114 | // } 115 | // catch (_:Dynamic) { 116 | // return TBool(false); 117 | // } 118 | // } 119 | // switch (op) { 120 | // case OpEq: compare(function (a, b) { return a == b;}); 121 | // case OpNotEq: compare(function (a, b) { return a != b;}); 122 | // case OpGt: compare(function (a, b) { return a > b;}); 123 | // case OpGte: compare(function (a, b) { return a >= b;}); 124 | // case OpLt: compare(function (a, b) { return a < b;}); 125 | // case OpLte: compare(function (a, b) { return a <= b;}); 126 | // case _: syntax.Parser.error(Custom("Unsupported operation"), e.pos); 127 | // } 128 | // case _: syntax.Parser.error(Custom("Invalid condition expression"), e.pos); 129 | // } 130 | // } 131 | 132 | // parse main 133 | // public static function parse (ctx:core.Define, code:haxeparser.HaxeLexer) { 134 | // trace("TODO: syntax.ParserEntry.parse"); 135 | // var old = Lexer.save(); 136 | // var restore_cache = syntax.parser.TokenCache.clear(); 137 | // var mstack = []; 138 | // syntax.Parser.last_doc = None; 139 | // syntax.Parser.in_macro = core.Define.defined(ctx, Macro); 140 | // try { 141 | // code.token(syntax.Lexer.skip_header); 142 | // }catch (e:hxparse.ParserError) { 143 | // } 144 | 145 | // var sraw = function (_:Int) { return Some(code.token(syntax.Lexer.token)); }; 146 | // var process_token:syntax.Lexer.Token -> syntax.Lexer.Token; 147 | // var skip_tokens:{file:String, min:Int, max:Int}->Bool->syntax.Lexer.Token; 148 | // var enter_macro:{file:String, min:Int, max:Int}->syntax.Lexer.Token; 149 | 150 | // function next_token () { 151 | // return process_token(code.token(syntax.Lexer.token)); 152 | // } 153 | 154 | // process_token = function (tk:syntax.Lexer.Token) { 155 | // return switch (tk.td) { 156 | // case Comment(s): 157 | // var ntk = next_token(); 158 | // if (syntax.Parser.use_doc) { 159 | // var l = s.length; 160 | // if (l > 0 && s.charAt(0) == "*") { 161 | // syntax.Parser.last_doc = Some({ 162 | // a:s.substr(1, (l - ((l > 1 && s.charAt(l-1) == "*") ? 2 : 1))), 163 | // b:tk.pos.min 164 | // }); 165 | // } 166 | // } 167 | // ntk; 168 | // case CommentLine(s): next_token(); 169 | // case Sharp("end"): 170 | // if (mstack.length == 0) { 171 | // tk; 172 | // } 173 | // else { 174 | // mstack.shift(); 175 | // next_token(); 176 | // } 177 | // case Sharp("else"), Sharp("elseif"): 178 | // if (mstack.length == 0) { 179 | // tk; 180 | // } 181 | // else { 182 | // mstack.shift(); 183 | // process_token(skip_tokens(tk.pos, false)); 184 | // } 185 | // case Sharp("if"): 186 | // process_token(enter_macro(tk.pos)); 187 | // case Sharp("error"): 188 | // var ntk = code.token(syntax.Lexer.token); 189 | // switch (ntk.td) { 190 | // case Const(CInt(s)): throw syntax.parser.Error.of(Custom(s), ntk.pos); 191 | // default: throw syntax.parser.Error.of(Unimplemented,tk.pos); 192 | // } 193 | // case Sharp("line"): 194 | // var ntk = next_token(); 195 | // var line:Int = switch (ntk.td) { 196 | // case Const(CInt(s)): 197 | // var i = Std.parseInt(s); 198 | // if (i == null) { 199 | // throw syntax.parser.Error.of(Custom("Could not parse ridiculous line number "+s), ntk.pos); 200 | // } 201 | // else { 202 | // i; 203 | // } 204 | // default: throw syntax.parser.Error.of(Unexpected(ntk.td), ntk.pos); 205 | // } 206 | // syntax.Lexer.cur.lline = line - 1; 207 | // next_token(); 208 | // default: 209 | // tk; 210 | // } 211 | // }; 212 | 213 | // enter_macro = function (p) { 214 | // return null; 215 | // }; 216 | // return null; 217 | // } 218 | } -------------------------------------------------------------------------------- /src/ocaml/Arg.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | // from https://github.com/lucasaiu/ocaml/blob/master/stdlib/arg.ml 4 | 5 | enum ArgError { 6 | Unknown(s:String); 7 | Missing(s:String); 8 | Wrong(opt:String, arg:String, expected:String); 9 | Message(s:String); 10 | } 11 | 12 | class Bad { 13 | public var s:String; 14 | public function new (s:String) { 15 | this.s = s; 16 | } 17 | } 18 | 19 | class Help { 20 | public var s:String; 21 | public function new (s:String) { 22 | this.s = s; 23 | } 24 | } 25 | 26 | class Stop { 27 | public var e:ArgError; 28 | public function new (e:ArgError) { 29 | this.e = e; 30 | } 31 | } 32 | 33 | enum Spec { 34 | S_Unit(f:Void->Void); // Call the function with unit argument 35 | S_Bool(f:Bool->Void); // Call the function with a bool argument 36 | S_Set (b:Bool); // Set the reference to true 37 | S_Clear (b:Bool); // Set the reference to false 38 | S_String (f:String->Void); // Call the function with a string argument 39 | S_Set_string (s:String); // Set the reference to the string argument 40 | S_Int (f:Int->Void); // Call the function with an int argument 41 | S_Set_int (i:Int); // Set the reference to the int argument 42 | S_Float(f:Float->Void); // Call the function with a float argument 43 | S_Set_float(f:Float); // Set the reference to the float argument 44 | S_Tuple (l:Array); // Take several arguments according to the spec list 45 | S_Symbol (l:Array, f:String->Void); // Take one of the symbols as argument and call the function with the symbol. 46 | S_Rest (f:String->Void); // Stop interpreting keywords and call the function with each remaining argument 47 | } 48 | 49 | class Arg { 50 | 51 | public static function assoc3(x:String, l:Array<{arg:String, spec:Spec, doc:String}>) : Spec { 52 | if (l.length == 0) { 53 | throw Not_found.instance; 54 | } 55 | else { 56 | for (s in l) { 57 | if (s.arg == x) { 58 | return s.spec; 59 | } 60 | } 61 | } 62 | throw Not_found.instance; 63 | } 64 | 65 | public static function make_symlist(prefix:String, sep:String, suffix:String, l:Array) : String { 66 | if (l.length == 0) { 67 | return ""; 68 | } 69 | else { 70 | var x = prefix + l[0]; 71 | for (i in 1...l.length) { 72 | x = x + sep + l[i]; 73 | } 74 | return x; 75 | } 76 | } 77 | 78 | public static function print_spec(buf:StringBuf, spec:{arg:String, spec:Spec, doc:String}) { 79 | if (spec.doc.length > 0) { 80 | buf.add(" "); 81 | buf.add(spec.arg); 82 | switch (spec.spec) { 83 | case S_Symbol(l,_): 84 | buf.add(make_symlist("{", "|", "}", l)); 85 | default: 86 | } 87 | buf.add(spec.doc); 88 | buf.add("\n"); 89 | } 90 | } 91 | 92 | public static function help_action () { 93 | throw new Stop(Unknown("-help")); 94 | } 95 | 96 | public static function add_help(speclist:Array<{arg:String, spec:Spec, doc:String}>) { 97 | try { 98 | assoc3("-help", speclist); 99 | } 100 | catch (e:Not_found) { 101 | speclist.push({arg:"-help", spec:S_Unit(help_action), doc:" Display this list of options"}); 102 | } 103 | try { 104 | assoc3("--help", speclist); 105 | } 106 | catch (e:Not_found) { 107 | speclist.push({arg:"--help", spec:S_Unit(help_action), doc:" Display this list of options"}); 108 | } 109 | return speclist; 110 | 111 | } 112 | 113 | public static function usage_b (buf:StringBuf, speclist:Array<{arg:String, spec:Spec, doc:String}>, errmsg:String) { 114 | buf.add(errmsg); 115 | buf.add("\n"); 116 | for (s in add_help(speclist)) { 117 | print_spec(buf, s); 118 | } 119 | } 120 | 121 | public static function usage_string (speclist:Array<{arg:String, spec:Spec, doc:String}>, errmsg:String) { 122 | var b = new StringBuf(); 123 | usage_b(b, speclist, errmsg); 124 | return b.toString(); 125 | } 126 | 127 | public static function parse_argv(?current:Int=0, argv:Array, speclist:Array<{arg:String, spec:Spec, doc:String}>, anon_fun:String->Void, errmsg:String) : Int { 128 | var l = argv.length; 129 | var b = new StringBuf(); 130 | var initpos = current; 131 | var stop = function (error:ArgError) : Void { 132 | var progname = (initpos < l) ? argv[initpos] : "(?)"; 133 | switch (error) { 134 | case Unknown(s): 135 | switch(s) { 136 | case "-help", "--help": 137 | default: 138 | b.add(progname); 139 | b.add(": unknown option `"); 140 | b.add(s); 141 | b.add("'.\n"); 142 | } 143 | case Missing(s): 144 | b.add(progname); 145 | b.add(": option `"); 146 | b.add(s); 147 | b.add("' needs an argument.\n"); 148 | case Wrong(opt, arg, expected): 149 | b.add(progname); 150 | b.add(": wrong argument `"); 151 | b.add(arg); 152 | b.add("'; option `"); 153 | b.add(opt); 154 | b.add("' expects "); 155 | b.add(expected); 156 | b.add(".\n"); 157 | case Message(s): 158 | b.add(progname); 159 | b.add(": "); 160 | b.add(s); 161 | b.add(".\n"); 162 | }; 163 | usage_b(b,speclist,errmsg); 164 | switch (error) { 165 | case Unknown(s): 166 | if (s == "-help" || s == "--help") { 167 | throw new Help(b.toString()); 168 | } 169 | else { 170 | throw new Bad(b.toString()); 171 | } 172 | default: 173 | throw new Bad(b.toString()); 174 | } 175 | }; 176 | current++; 177 | while (current < l) { 178 | var s = argv[current]; 179 | if (s.length >= 1 && s.charAt(0) == "-") { 180 | var action : Spec = null; 181 | try { 182 | action = assoc3(s, speclist); 183 | } 184 | catch (e:Exception) { 185 | stop(Unknown(s)); 186 | } 187 | 188 | try { 189 | function treat_action (action:Spec) { 190 | switch (action) { 191 | case S_Unit(f): f(); 192 | case S_Bool (f): 193 | if (current + 1 < l) { 194 | current++; 195 | var arg = argv[current]; 196 | f((arg == "true") ? true : (arg == "false") ? false : throw new Stop(Wrong(s, arg, "a boolean"))); 197 | } 198 | else { 199 | throw new Stop(Missing(s)); 200 | } 201 | case S_Set(_): trace("S_Set do not work in haxe AFAIK"); Sys.exit(1); 202 | case S_Clear(_): trace("S_Clear do not work in haxe AFAIK"); Sys.exit(1); 203 | case S_String(f): 204 | if (current + 1 < l) { 205 | current++; 206 | f(argv[current]); 207 | } 208 | else { 209 | throw new Stop(Missing(s)); 210 | } 211 | case S_Symbol (symb, f): 212 | if (current + 1 < l) { 213 | var arg = argv[current+1]; 214 | if (symb.indexOf(arg) != -1) { 215 | f(arg); 216 | current++; 217 | } 218 | else { 219 | throw new Stop(Wrong(s, arg, "one of: "+make_symlist("", " ", "", symb))); 220 | } 221 | } 222 | else { 223 | throw new Stop(Missing(s)); 224 | } 225 | case S_Set_string (_): trace("S_Set_string do not work in haxe AFAIK"); Sys.exit(1); 226 | case S_Int (f): 227 | if (current + 1 < l) { 228 | current++; 229 | var arg = argv[current]; 230 | var v = Std.parseInt(arg); 231 | if (v != null) { 232 | f(v); 233 | } 234 | else { 235 | throw new Stop(Wrong(s, arg, "an integer")); 236 | } 237 | } 238 | else { 239 | throw new Stop(Missing(s)); 240 | } 241 | case S_Set_int (_): trace("S_Set_int do not work in haxe AFAIK"); Sys.exit(1); 242 | case S_Float (f): 243 | if (current + 1 < l) { 244 | current++; 245 | var arg = argv[current]; 246 | var v = Std.parseFloat(arg); 247 | if (v != Math.NaN) { 248 | f(v); 249 | } 250 | else { 251 | throw new Stop(Wrong(s, arg, "a float")); 252 | } 253 | } 254 | else { 255 | throw new Stop(Missing(s)); 256 | } 257 | case S_Set_float (_): trace("S_Set_float do not work in haxe AFAIK"); Sys.exit(1); 258 | case S_Tuple (specs): 259 | for (a in specs) { 260 | treat_action(a); 261 | } 262 | case S_Rest (f): 263 | while (current < l -1) { 264 | current++; 265 | f(argv[current]); 266 | } 267 | } 268 | } 269 | treat_action(action); 270 | } 271 | catch (e:Bad) { 272 | stop(Message(e.s)); 273 | } 274 | catch (e:Stop) { 275 | stop(e.e); 276 | } 277 | } 278 | else { 279 | try { 280 | anon_fun(s); 281 | } 282 | catch (e:Bad) { 283 | stop(Message(e.s)); 284 | } 285 | } 286 | current++; 287 | } 288 | return current; 289 | } 290 | } -------------------------------------------------------------------------------- /src/ocaml/List.hx: -------------------------------------------------------------------------------- 1 | package ocaml; 2 | 3 | import haxe.ds.Option; 4 | import haxe.ds.ImmutableList; 5 | using equals.Equal; 6 | 7 | class List { 8 | public static function hd (l:ImmutableList) : T { 9 | return switch (l) { 10 | case Tl: throw new ocaml.Failure("List.hd"); 11 | case Hd(v, _): v; 12 | } 13 | } 14 | 15 | public static function append (a : ImmutableList, b : ImmutableList ) : ImmutableList { 16 | return switch (a) { 17 | case Tl: b; 18 | case Hd(v, tl): 19 | v::append(tl, b); 20 | } 21 | } 22 | 23 | public static function concat(l:ImmutableList>) : ImmutableList { 24 | return switch (l) { 25 | case Tl: Tl; 26 | case Hd(v, tl): append(v, concat(tl)); 27 | } 28 | } 29 | 30 | public static function length (l:ImmutableList) : Int { 31 | return switch (l) { 32 | case Tl: 0; 33 | case Hd(_, tl): 1 + length(tl); 34 | } 35 | } 36 | public static function tl (l:ImmutableList) : ImmutableList { 37 | return switch (l) { 38 | case Tl: throw new ocaml.Failure("List.tl"); 39 | case Hd(_, tl): tl; 40 | } 41 | } 42 | 43 | public static function nth (l:ImmutableList, n:Int) : T { 44 | if (n < 0) { throw new ocaml.Invalid_argument("List.nth"); } 45 | var list = l; 46 | while (true) { 47 | switch (list) { 48 | case Hd(v, _) if (n == 0): return v; 49 | case Hd(_, tl): list = tl; n--; 50 | case Tl: throw new ocaml.Failure("List.nth"); 51 | } 52 | } 53 | } 54 | 55 | public static function init (length:Int, f:Int->T): ImmutableList { 56 | if (length < 0) { throw new ocaml.Invalid_argument("List.init"); } 57 | var arr = [for (i in 0...length) f(i)]; 58 | return arr; 59 | } 60 | 61 | public static function make (count:Int, x:T) : ImmutableList { 62 | return (count <= 0) ? Tl : Hd(x, make(count-1, x)); 63 | } 64 | public static function join (sep:String, l:ImmutableList) : String { 65 | var buf = new StringBuf(); 66 | function loop (l:ImmutableList) { 67 | switch (l) { 68 | case Tl: return; 69 | case Hd(v, Tl): 70 | buf.add(v); 71 | case Hd(v, tl): 72 | buf.add(v); 73 | buf.add(sep); 74 | loop(tl); 75 | } 76 | } 77 | loop(l); 78 | return buf.toString(); 79 | } 80 | 81 | public static function sort (f:T->T->Int, l:ImmutableList) : ImmutableList { 82 | var _tmp:Array = l; 83 | _tmp.sort(f); 84 | return _tmp; 85 | } 86 | 87 | public static function iter (f:T->Void, l:ImmutableList) : Void { 88 | switch (l) { 89 | case Tl: 90 | case Hd(v, tl): 91 | f(v); 92 | iter(f, tl); 93 | } 94 | } 95 | 96 | public static function iter2 (f:A->B->Void, l1:ImmutableList, l2:ImmutableList) : Void { 97 | if (length(l1) != length(l2)) { throw new Invalid_argument("List.iter2"); } 98 | switch [l1, l2] { 99 | case [Tl, Tl]: 100 | case [Hd(v1, tl1), Hd(v2, tl2)]: 101 | f(v1, v2); 102 | iter2(f, tl1, tl2); 103 | case _: throw new Invalid_argument("List.iter2"); 104 | } 105 | } 106 | 107 | public static function for_all (f:T->Bool, l:ImmutableList) : Bool { 108 | return switch (l) { 109 | case Tl: true; 110 | case Hd(v, tl): f(v) && for_all(f, tl); 111 | } 112 | } 113 | public static function for_all2 (f:A->B->Bool, l1:ImmutableList, l2:ImmutableList) : Bool { 114 | if (length(l1) != length(l2)) { throw new Invalid_argument("List.forall2"); } 115 | return switch [l1, l2] { 116 | case [Tl, Tl]: true; 117 | case [Hd(v1, tl1), Hd(v2, tl2)]: 118 | if (f(v1, v2)) { 119 | for_all2(f, tl1, tl2); 120 | } 121 | else { 122 | false; 123 | } 124 | case _: throw new Invalid_argument("List.forall2"); 125 | } 126 | } 127 | 128 | public static inline function map (f:A->B, l:ImmutableList) : ImmutableList { 129 | return switch (l) { 130 | case Tl: Tl; 131 | case Hd(v, tl): 132 | return Hd(f(v), map(f, tl)); 133 | } 134 | } 135 | public static inline function mapi (f:Int->A->B, l:ImmutableList, ?index:Int=0) : ImmutableList { 136 | return switch (l) { 137 | case Tl: Tl; 138 | case Hd(v, tl): 139 | return Hd(f(index, v), mapi(f, tl, index+1)); 140 | } 141 | } 142 | 143 | public static function rev_map (f:A->B, l:ImmutableList) : ImmutableList { 144 | var res = Tl; 145 | var curr = l; 146 | while (true) { 147 | switch (curr) { 148 | case Tl: break; 149 | case Hd(v, tl): 150 | curr = tl; 151 | res = Hd(f(v), res); 152 | } 153 | } 154 | return res; 155 | } 156 | 157 | public static function map2 (f:A->B->C, l1:ImmutableList, l2:ImmutableList) : ImmutableList { 158 | if (length(l1) != length(l2)) { throw new Invalid_argument("List.map2"); } 159 | return switch ({f:l1, s:l2}) { 160 | case {f:Tl, s:Tl}: Tl; 161 | case {f:Hd(v1, tl1), s:Hd(v2, tl2)}: 162 | Hd(f(v1, v2), map2(f, tl1, tl2)); 163 | case _: throw new Invalid_argument("List.map2"); 164 | } 165 | } 166 | 167 | public static function filter (f:T->Bool, l:ImmutableList) : ImmutableList { 168 | return switch (l) { 169 | case Tl: Tl; 170 | case Hd(v, tl): 171 | (f(v)) ? v::filter(f, tl) : filter(f, tl); 172 | } 173 | } 174 | 175 | public static function find_map (f:A->Option, l:ImmutableList): B { 176 | return switch (l) { 177 | case Tl: throw ocaml.Not_found.instance; 178 | case Hd(v, tl): 179 | switch (f(v)) { 180 | case None: find_map(f, tl); 181 | case Some(b): b; 182 | } 183 | } 184 | } 185 | public static function filter_map (f:A->Option, l:ImmutableList): ImmutableList { 186 | return switch (l) { 187 | case Tl: Tl; 188 | case Hd(v, tl): 189 | switch (f(v)) { 190 | case None: filter_map(f, tl); 191 | case Some(b): Hd(b, filter_map(f, tl)); 192 | } 193 | } 194 | } 195 | 196 | public static function mem (a:T, l:ImmutableList) : Bool { 197 | return switch (l) { 198 | case Tl: false; 199 | case Hd(v, tl): a.equals(v) || mem(a, tl); 200 | } 201 | } 202 | 203 | // Same as List.mem, but uses physical equality instead of structural equality to compare list elements. 204 | public static function memq (a:T, l:ImmutableList) : Bool { 205 | return switch (l) { 206 | case Tl: false; 207 | case Hd(v, tl): (a == v) || mem(a, tl); 208 | } 209 | } 210 | 211 | public static function rev (a:ImmutableList) : ImmutableList { 212 | var res = Tl; 213 | var l = a; 214 | while (true) { 215 | switch (l) { 216 | case Tl: break; 217 | case Hd(v, tl): 218 | l = tl; 219 | res = Hd(v, res); 220 | } 221 | } 222 | return res; 223 | } 224 | 225 | public static function fold_left(f:A->B->A, a:A, l:ImmutableList) : A { 226 | return switch (l) { 227 | case Tl: a; 228 | case Hd(v, tl): 229 | fold_left(f, f(a, v), tl); 230 | } 231 | } 232 | 233 | public static function fold_right(f:A->B->B, l:ImmutableList, b:B) : B { 234 | return switch (l) { 235 | case Tl: b; 236 | case Hd(v, tl): 237 | f(v, fold_right(f, tl, b)); 238 | } 239 | } 240 | 241 | public static function fold_left2(f:A->B->C->A, a:A, l1:ImmutableList, l2:ImmutableList) : A { 242 | if (length(l1) != length(l2)) { throw new Invalid_argument("List.fold_left2"); } 243 | return switch [l1, l2] { 244 | case [Tl, Tl]: a; 245 | case [Hd(v1, tl1), Hd(v2, tl2)]: 246 | fold_left2(f, f(a, v1, v2), tl1, tl2); 247 | case _: throw new Invalid_argument("List.fold_left2"); 248 | } 249 | } 250 | 251 | public static function exists (f:T->Bool, l:ImmutableList) : Bool { 252 | return switch (l) { 253 | case Tl: false; 254 | case Hd(v, tl): f(v) || exists(f, tl); 255 | } 256 | } 257 | public static function find (f:T->Bool, l:ImmutableList) : T { 258 | return switch (l) { 259 | case Tl: throw ocaml.Not_found.instance; 260 | case Hd(v, tl): f(v) ? v : find(f, tl); 261 | } 262 | } 263 | 264 | public static function assoc (a:A, b:ImmutableList<{fst:A, snd:B}>) : B { 265 | return switch (b) { 266 | case Tl: throw ocaml.Not_found.instance; 267 | case Hd(v, tl): 268 | (a.equals(v.fst)) ? v.snd : assoc(a, tl); 269 | } 270 | } 271 | 272 | public static function assq (a:A, b:ImmutableList<{fst:A, snd:B}>) : B { 273 | return switch (b) { 274 | case Tl: throw ocaml.Not_found.instance; 275 | case Hd(v, tl): 276 | (a == v.fst) ? v.snd : assq(a, tl); 277 | } 278 | } 279 | 280 | public static function assoc_typeparams (a:String, l:core.Type.TypeParams ) : core.Type.T { 281 | return switch (l) { 282 | case Tl: throw ocaml.Not_found.instance; 283 | case Hd(v, tl): 284 | (a == v.name) ? v.t : assoc_typeparams(a, tl); 285 | } 286 | } 287 | } -------------------------------------------------------------------------------- /src/typing/matcher/Useless.hx: -------------------------------------------------------------------------------- 1 | package typing.matcher; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | enum EUseless { 7 | False; 8 | Pos(p:core.Globals.Pos); 9 | True; 10 | } 11 | 12 | typedef ListListPattern = ImmutableList>; 13 | typedef ListPattern = ImmutableList; 14 | 15 | class Useless { 16 | 17 | // U part 18 | 19 | public static function specialize (is_tuple:Bool, con:Constructor, pM:ListListPattern) : ListListPattern{ 20 | function loop (acc:ListListPattern, pM:ListListPattern) { 21 | return switch (pM) { 22 | case patterns :: pM: 23 | switch (patterns) { 24 | case {t:PatConstructor(con_, patterns1)} :: patterns2 if (!is_tuple && Constructor.equal(con, con_)): 25 | loop(List.append(patterns1, patterns2) :: acc, pM); 26 | case {t:PatTuple(patterns1)} :: patterns2 if (is_tuple): 27 | loop(List.append(patterns1, patterns2) :: acc, pM); 28 | case {t:PatAny, pos:p} :: patterns2: 29 | var patterns1 = List.make(Constructor.arity(con), ({t:PatAny, pos:p} : Pattern)); 30 | loop(List.append(patterns1, patterns2) :: acc, pM); 31 | case {t:PatBind(_, pat1)} :: patterns2: 32 | loop(acc, (pat1::patterns)::pM); 33 | case _: loop(acc, pM); 34 | } 35 | case []: 36 | List.rev(acc); 37 | } 38 | } 39 | return loop([], pM); 40 | } 41 | 42 | public static function _default (pM:ListListPattern) : ListListPattern { 43 | function loop (acc:ListListPattern, pM:ListListPattern) { 44 | return switch (pM) { 45 | case patterns :: pM: 46 | switch (patterns) { 47 | case {t:(PatConstructor(_)|PatTuple(_))} :: _: 48 | loop(acc, pM); 49 | case {t:(PatVariable(_)|PatAny)} :: patterns: 50 | loop(patterns::acc, pM); 51 | case _: 52 | loop(acc, pM); 53 | } 54 | case []: 55 | List.rev(acc); 56 | } 57 | } 58 | return loop([], pM); 59 | } 60 | 61 | public static function u(pM:ListListPattern, q:ListPattern) : Bool { 62 | return switch [q, pM] { 63 | case [[], []]: true; 64 | case [[], _]: false; 65 | case [q1::ql, _]: 66 | function loop (pat:Pattern) : Bool { 67 | return switch (pat.t) { 68 | case PatConstructor(con, patterns): 69 | var s = specialize(false, con, pM); 70 | u(s, List.append(patterns, ql)); 71 | case PatTuple(patterns): 72 | var s = specialize(true, ConConst(TNull), pM); 73 | u(s, List.append(patterns, ql)); 74 | case (PatVariable(_)| PatAny): 75 | var d = _default(pM); 76 | u(d, ql); 77 | case PatOr(pat1, pat2): 78 | u(pM, pat1::ql) || u(pM, pat2::ql); 79 | case PatBind(_, pat1): 80 | loop(pat1); 81 | case PatExtractor(_): 82 | true; // ? 83 | } 84 | } 85 | loop(q1); 86 | } 87 | } 88 | 89 | // U' part 90 | public static function transfer_column (source:ListListPattern, target:ListListPattern) : {fst:ListListPattern, snd:ListListPattern} { 91 | var _tmp = List.fold_left2 (function (tmp:{fst:ListListPattern, snd:ListListPattern}, patterns1:ListPattern, patterns2:ListPattern) { 92 | var source = tmp.fst; var target = tmp.snd; 93 | return switch (patterns1) { 94 | case pat :: patterns: 95 | {fst:patterns :: source, snd: (pat::patterns2) :: target}; 96 | case []: {fst:source, snd:target}; 97 | } 98 | }, {fst:Tl, snd:Tl}, source, target); 99 | var source = _tmp.fst; var target = _tmp.snd; 100 | return {fst:List.rev(source), snd:List.rev(target)}; 101 | } 102 | 103 | public static function copy (p:ListListPattern) : ListListPattern { 104 | return List.map(function (_) { return Tl; }, p); 105 | } 106 | 107 | public static function specialize_(is_tuple:Bool, con:Constructor, pM:ListListPattern, qM:ListListPattern, rM:ListListPattern) : {fst:ListListPattern, snd:ListListPattern, trd:ListListPattern} { 108 | var arity = Constructor.arity(con); 109 | function loop (pAcc:ListListPattern, qAcc:ListListPattern, rAcc:ListListPattern, pM:ListListPattern, qM:ListListPattern, rM:ListListPattern) { 110 | return switch [pM, qM, rM] { 111 | case [p1::pM, q1::qM, r1::rM]: 112 | function loop2 (p1:ListPattern) { 113 | return switch (p1) { 114 | case ({t:PatConstructor(con_, patterns1)}) :: patterns2 if (!is_tuple && Constructor.equal(con, con_)): 115 | loop((List.append(patterns1, patterns2)::pAcc), q1::qAcc, r1::rAcc, pM, qM, rM); 116 | case {t:PatTuple(patterns1)} :: patterns2 if (is_tuple): 117 | loop((List.append(patterns1, patterns2)::pAcc), q1::qAcc, r1::rAcc, pM, qM, rM); 118 | case {t:(PatVariable(_)|PatAny), pos:p} :: patterns2: 119 | var patterns1 = List.make(arity, ({t:PatAny, pos:p} : Pattern)); 120 | loop((List.append(patterns1, patterns2)::pAcc), q1::qAcc, r1::rAcc, pM, qM, rM); 121 | case {t:PatOr(pat1, pat2)} :: patterns2: 122 | loop(pAcc, qAcc, rAcc, (pat1 :: patterns2) :: (pat2::patterns2) :: pM, q1::q1::qM, r1::r1::rM); 123 | case{t:PatBind(_, pat1)} :: patterns2: 124 | loop2(pat1::patterns2); 125 | case _: 126 | loop(pAcc, qAcc, rAcc, pM, qM, rM); 127 | } 128 | } 129 | loop2(p1); 130 | case [[], _, _]: 131 | {fst:List.rev(pAcc), snd:List.rev(qAcc), trd:List.rev(rAcc)}; 132 | case _: 133 | trace("Shall not be seen"); std.Sys.exit(255); throw false; 134 | } 135 | } 136 | return loop(Tl, Tl, Tl, pM, qM, rM); 137 | } 138 | 139 | public static function combine (et1:{et:EUseless, p:core.Globals.Pos}, et2:{et:EUseless, p:core.Globals.Pos}) : EUseless{ 140 | return switch [et1.et, et2.et] { 141 | case [True, True]: True; 142 | case [False, False]: False; 143 | case [True, False]: Pos(et2.p); 144 | case [False, True]: Pos(et1.p); 145 | case [True, Pos(_)]: et2.et; 146 | case [Pos(_), True]: et1.et; 147 | case [False, Pos(_)]: Pos(et1.p); 148 | case [Pos(_), _]: et1.et; 149 | } 150 | } 151 | 152 | public static function u_ (pM:ListListPattern, qM:ListListPattern, rM:ListListPattern, p:ListPattern, q:ListPattern, r:ListPattern) : EUseless { 153 | return switch (p) { 154 | case []: 155 | switch (r) { 156 | case []: 157 | (u(qM, q)) ? True : False; 158 | case _: 159 | List.fold_left(function (tmp:{fst:Int, snd:EUseless}, pat:Pattern) { 160 | var i = tmp.fst; var et = tmp.snd; 161 | return switch (pat.t) { 162 | case PatOr(pat1, pat2): 163 | function process_row(i:Int, l:ListPattern, q:ListPattern) : {fst:Pattern, snd:ListPattern} { 164 | function loop(acc:ListPattern, k:Int, l:ListPattern) : {fst:Pattern, snd:ListPattern} { 165 | return switch (l) { 166 | case x :: l if (i == k): 167 | {fst:x, snd:List.append(List.rev(acc), List.append(l, q))}; 168 | case x :: l: 169 | loop(x::acc, k+1, l); 170 | case []: trace("Shall not be seen"); std.Sys.exit(255); throw false; 171 | } 172 | } 173 | return loop(Tl, 0, l); 174 | } 175 | var _tmp = List.fold_left2 (function (tmp:{fst:ListListPattern, snd:ListListPattern}, r:ListPattern, q:ListPattern) { 176 | var col = tmp.fst; var mat = tmp.snd; 177 | var _tmp = process_row(i, r, q); 178 | var x = _tmp.fst; var l = _tmp.snd; 179 | return {fst:([x] : ListPattern)::col, snd:l::mat}; 180 | }, {fst:Tl, snd:Tl}, rM, qM); 181 | var col = _tmp.fst; var mat = _tmp.snd; 182 | var col = List.rev(col); var mat = List.rev(mat); 183 | var r = process_row(i, r, q).snd; 184 | var et1 = u_(col, mat, copy(mat), [pat1], r, []); 185 | var qM = List.append(mat, [r]); 186 | var et2 = u_(List.append(col, [[pat1]]), qM, copy(qM), [pat2], r, []); 187 | var et3 = combine({et:et1, p:pat1.pos}, {et:et2, p:pat2.pos}); 188 | var p = core.Ast.punion(pat1.pos, pat2.pos); 189 | var et = combine({et:et, p:p}, {et:et3, p:p}); 190 | {fst:i+1, snd:et}; 191 | case _: trace("Shall not be seen"); std.Sys.exit(255); throw false; 192 | } 193 | }, {fst:0, snd:True}, r).snd; 194 | } 195 | case (pat :: pl): 196 | function loop (pat:Pattern) : EUseless { 197 | return switch (pat.t) { 198 | case PatConstructor(con, patterns): 199 | var _tmp = specialize_(false, con, pM, qM, rM); 200 | var pM = _tmp.fst; var qM = _tmp.snd; var rM = _tmp.trd; 201 | u_(pM, qM, rM, List.append(patterns, pl), q, r); 202 | case PatTuple(patterns): 203 | var _tmp = specialize_(true, ConConst(TNull), pM, qM, rM); 204 | var pM = _tmp.fst; var qM = _tmp.snd; var rM = _tmp.trd; 205 | u_(pM, qM, rM, List.append(patterns, pl), q, r); 206 | case PatAny, PatVariable(_): 207 | var _tmp = transfer_column(pM, qM); 208 | var pM = _tmp.fst; var qM = _tmp.snd; 209 | u_(pM, qM, rM, pl, pat::q, r); 210 | case PatOr(_): 211 | var _tmp = transfer_column(pM, rM); 212 | var pM = _tmp.fst; var rM = _tmp.snd; 213 | u_(pM, qM, rM, pl, q, pat::r); 214 | case PatBind(_, pat1): 215 | loop(pat1); 216 | case PatExtractor(_): 217 | True; 218 | } 219 | } 220 | loop(pat); 221 | } 222 | } 223 | // Sane part 224 | 225 | public static function check_case (com:context.Common.Context, p:ImmutableList, c:Case) { 226 | var _case = c.fst; var bindings = c.snd; var patterns = c.trd; 227 | var p = List.map(function (c:Case) { var patterns = c.trd; return patterns; }, p); 228 | switch (u_(p, copy(p), copy(p), patterns, Tl, Tl)) { 229 | case False: com.warning("This case is unused", _case.case_pos); 230 | case Pos(p): com.warning("This pattern is unused", p); 231 | case True: 232 | } 233 | } 234 | 235 | public static function check (com:context.Common.Context, cases) : Void { 236 | List.fold_left(function (acc:ImmutableList, c:Case) { 237 | var case_ = c.fst; var bindings = c.snd; var patterns = c.trd; 238 | check_case(com, acc, (c)); 239 | return 240 | if (case_.case_guard == None) { 241 | List.append(acc, [c]); 242 | } 243 | else { 244 | acc; 245 | } 246 | }, [], cases); 247 | } 248 | } -------------------------------------------------------------------------------- /src/compiler/DisplayOutput.hx: -------------------------------------------------------------------------------- 1 | package compiler; 2 | 3 | import haxe.ds.ImmutableList; 4 | import ocaml.List; 5 | 6 | using equals.Equal; 7 | 8 | enum DOException { 9 | Completion(s:String); 10 | } 11 | 12 | typedef DOField = {name:String, kind:context.Display.DisplayFieldKind, doc:String} 13 | 14 | class DisplayOutput { 15 | 16 | public static inline function htmlescape (s:String) : String{ 17 | return StringTools.htmlEscape(s); 18 | } 19 | 20 | public static function get_timer_fields (start_time:Float) : ImmutableList<{a:String, b:String}> { 21 | var tot = 0.0; 22 | for (value in core.Timer.htimers) { 23 | tot += value.total; 24 | } 25 | var td = core.Timer.get_time() - start_time; 26 | var fields = [{a:"@TOTAL", b:Std.int(td)+ "." + (Std.int(td*1000)%1000) + "s"}]; 27 | if (tot > 0.0) { 28 | for (value in core.Timer.htimers) { 29 | fields.unshift({ 30 | a:List.join(".",value.id), 31 | b:Std.int(value.total)+ "." + (Std.int(value.total*1000)%1000) + "s (" + Std.int(value.total * 100.0 / tot) + "%)" 32 | }); 33 | } 34 | } 35 | return fields; 36 | } 37 | 38 | public static function print_fields (fields:ImmutableList) { 39 | var b = new StringBuf(); 40 | b.add("\n"); 41 | var f = List.sort(function (a:DOField, b:DOField){ 42 | var av = context.Display.display_field_kind_index(a.kind); 43 | var bv = context.Display.display_field_kind_index(b.kind); 44 | if (av == bv) { 45 | if (a.name == b.name) { return 0; } 46 | return (a.name > b.name) ? 1 : -1; 47 | } 48 | return (av > bv) ? 1 : -1; 49 | 50 | }, fields); 51 | List.iter(function (element:DOField) { 52 | var s_kind:String; 53 | var t:String; 54 | switch (element.kind) { 55 | case FKVar(s) : 56 | s_kind = "var"; 57 | t = core.Type.s_type(core.Type.print_context(), s); 58 | case FKMethod(s): 59 | s_kind = "method"; 60 | t = core.Type.s_type(core.Type.print_context(), s); 61 | case FKType(s): 62 | s_kind = "type"; 63 | t = core.Type.s_type(core.Type.print_context(), s); 64 | case FKPackage: 65 | s_kind = "package"; 66 | t = ""; 67 | case FKModule: 68 | s_kind = "type"; // is "type" in ocaml maybe should be "module"? 69 | t = ""; 70 | case FKMetadata: 71 | s_kind = "metadata"; 72 | t = ""; 73 | case FKTimer(s): 74 | s_kind = "timer"; 75 | t = s; 76 | } 77 | b.add(''); 82 | b.add(htmlescape(t)); 83 | b.add(''); 84 | b.add(htmlescape(element.doc)); 85 | b.add('\n'); 86 | }, f); 87 | b.add("\n"); 88 | return b.toString(); 89 | } 90 | 91 | public static function print_toplevel (il:ImmutableList) : String { 92 | trace("TDOO: compiler.DisplayOutput.print_toplevel"); 93 | throw false; 94 | } 95 | 96 | public static function print_type (t:core.Type.T, p:core.Globals.Pos, doc:String) : String { 97 | trace("TODO finish compiler.DisplayOutput.print_type"); 98 | var b = new StringBuf(); 99 | var null_pos = core.Globals.null_pos; 100 | // if (p.pfile == null_pos.pfile && p.pmin == null_pos.pmin && p.pmax == null_pos.pmax) { 101 | if (p.equals(null_pos)) { 102 | b.add("\n"; 119 | // Buffer.add_string b (htmlescape (s_type (print_context()) t)); 120 | // Buffer.add_string b "\n\n"; 121 | // Buffer.contents b 122 | } 123 | 124 | public static function print_signatures (tl:ImmutableList<{sig:core.Type.TSignature, doc:core.Ast.Documentation}>) : String { 125 | var b = new StringBuf(); 126 | List.iter(function (element:{sig:core.Type.TSignature, doc:core.Ast.Documentation}) { 127 | b.add("\n"); 136 | b.add(htmlescape(core.Type.s_type(core.Type.print_context(), TFun(element.sig)))); 137 | b.add("\n\n"); 138 | }, tl); 139 | return b.toString(); 140 | } 141 | 142 | public static function print_positions(pl:ImmutableList) : String { 143 | var b = new StringBuf(); 144 | var error_printer = function(file:String, line:Int) : String { 145 | return core.Path.get_real_path()(file) + ":" + line + ":"; 146 | }; 147 | b.add("\n"); 148 | List.iter(function (p) { 149 | b.add(""); 150 | b.add(syntax.Lexer.get_error_pos(error_printer, p)); 151 | b.add(""); 152 | }, pl); 153 | b.add(""); 154 | return b.toString(); 155 | } 156 | 157 | public static function print_signature (tl:ImmutableList<{sig:core.Type.TSignature, doc:core.Ast.Documentation}>, display_arg:Int) : String { 158 | trace("TODO compiler.DisplayOutput.print_signature"); 159 | throw false; 160 | } 161 | 162 | public static function unquote(v:String) : String { 163 | var len = v.length; 164 | if (len > 0 && v.charAt(0) == '"' && v.charAt(len - 1) == '"') { 165 | return v.substr(1, len - 2); 166 | } 167 | else { 168 | return v; 169 | } 170 | } 171 | 172 | public static function handle_display_argument (com:context.Common.Context, file_pos:String, pre_compilation:Dynamic, did_something:Bool) { 173 | trace("TODO: compiler.DisplayOutput.handle_display_argument"); 174 | // match file_pos with 175 | // | "classes" -> 176 | // pre_compilation := (fun() -> raise (Parser.TypePath (["."],None,true))) :: !pre_compilation; 177 | // | "keywords" -> 178 | // raise (Completion (print_keywords ())) 179 | // | "memory" -> 180 | // did_something := true; 181 | // (try display_memory com with e -> prerr_endline (Printexc.get_backtrace ())); 182 | // | "diagnostics" -> 183 | // Common.define com Define.NoCOpt; 184 | // com.display <- DisplayMode.create (DMDiagnostics true); 185 | // Common.display_default := DMDiagnostics true; 186 | // | _ -> 187 | // let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in 188 | // let file = unquote file in 189 | // let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in 190 | // let mode = match smode with 191 | // | "position" -> 192 | // Common.define com Define.NoCOpt; 193 | // DMPosition 194 | // | "usage" -> 195 | // Common.define com Define.NoCOpt; 196 | // DMUsage false 197 | // (*| "rename" -> 198 | // Common.define com Define.NoCOpt; 199 | // DMUsage true*) 200 | // | "package" -> 201 | // DMPackage 202 | // | "type" -> 203 | // Common.define com Define.NoCOpt; 204 | // DMType 205 | // | "toplevel" -> 206 | // Common.define com Define.NoCOpt; 207 | // DMToplevel 208 | // | "module-symbols" -> 209 | // Common.define com Define.NoCOpt; 210 | // DMModuleSymbols None; 211 | // | "diagnostics" -> 212 | // Common.define com Define.NoCOpt; 213 | // DMDiagnostics false; 214 | // | "statistics" -> 215 | // Common.define com Define.NoCOpt; 216 | // DMStatistics 217 | // | "signature" -> 218 | // DMSignature 219 | // | "" -> 220 | // DMField 221 | // | _ -> 222 | // let smode,arg = try ExtString.String.split smode "@" with _ -> pos,"" in 223 | // match smode with 224 | // | "resolve" -> 225 | // DMResolve arg 226 | // | "workspace-symbols" -> 227 | // Common.define com Define.NoCOpt; 228 | // DMModuleSymbols (Some arg) 229 | // | _ -> 230 | // DMField 231 | // in 232 | // let pos = try int_of_string pos with _ -> failwith ("Invalid format: " ^ pos) in 233 | // com.display <- DisplayMode.create mode; 234 | // Common.display_default := mode; 235 | // Common.define_value com Define.Display (if smode <> "" then smode else "1"); 236 | // Parser.use_doc := true; 237 | // Parser.resume_display := { 238 | // pfile = Path.unique_full_path file; 239 | // pmin = pos; 240 | // pmax = pos; 241 | // } 242 | } 243 | 244 | public static function process_display_file (com:context.Common.Context, classes:ImmutableList ){ 245 | trace("TODO: compiler.DisplayOutput.process_display_file"); 246 | // let get_module_path_from_file_path com spath = 247 | // let rec loop = function 248 | // | [] -> None 249 | // | cp :: l -> 250 | // let cp = (if cp = "" then "./" else cp) in 251 | // let c = Path.add_trailing_slash (Path.get_real_path cp) in 252 | // let clen = String.length c in 253 | // if clen < String.length spath && String.sub spath 0 clen = c then begin 254 | // let path = String.sub spath clen (String.length spath - clen) in 255 | // (try 256 | // let path = Path.parse_path path in 257 | // (match loop l with 258 | // | Some x as r when String.length (s_type_path x) < String.length (s_type_path path) -> r 259 | // | _ -> Some path) 260 | // with _ -> loop l) 261 | // end else 262 | // loop l 263 | // in 264 | // loop com.class_path 265 | // in 266 | // match com.display.dms_display_file_policy with 267 | // | DFPNo -> 268 | // () 269 | // | dfp -> 270 | // if dfp = DFPOnly then begin 271 | // classes := []; 272 | // com.main_class <- None; 273 | // end; 274 | // let real = Path.get_real_path (!Parser.resume_display).pfile in 275 | // (match get_module_path_from_file_path com real with 276 | // | Some path -> 277 | // if com.display.dms_kind = DMPackage then raise (DisplayPackage (fst path)); 278 | // classes := path :: !classes 279 | // | None -> 280 | // if not (Sys.file_exists real) then failwith "Display file does not exist"; 281 | // (match List.rev (ExtString.String.nsplit real Path.path_sep) with 282 | // | file :: _ when file.[0] >= 'a' && file.[0] <= 'z' -> failwith ("Display file '" ^ file ^ "' should not start with a lowercase letter") 283 | // | _ -> ()); 284 | // failwith "Display file was not found in class path" 285 | // ); 286 | // Common.log com ("Display file : " ^ real); 287 | // Common.log com ("Classes found : [" ^ (String.concat "," (List.map s_type_path !classes)) ^ "]") 288 | } 289 | 290 | public static function process_global_display_mode (com:context.Common.Context, tctx:context.Typecore.Typer) : Void { 291 | trace("TODO: compiler.DisplayOutput.process_global_display_mode"); 292 | } 293 | 294 | public static function find_doc (t:core.Type.T) : String { 295 | trace("TODO: compiler.DisplayOutput.find_doc"); 296 | throw false; 297 | } 298 | 299 | } -------------------------------------------------------------------------------- /src/context/typecore/AbstractCast.hx: -------------------------------------------------------------------------------- 1 | package context.typecore; 2 | 3 | import haxe.ds.ImmutableList; 4 | import haxe.ds.Option; 5 | 6 | import ocaml.List; 7 | import ocaml.PMap; 8 | import ocaml.Ref; 9 | 10 | using ocaml.Cloner; 11 | using equals.Equal; 12 | 13 | class AbstractCast { 14 | 15 | public static var cast_stack = new Ref>([]); 16 | 17 | public static function make_static_call (ctx:context.Typecore.Typer, c:core.Type.TClass, cf:core.Type.TClassField, a:core.Type.TAbstract, pl:ImmutableList, args:ImmutableList, t:core.Type.T, p:core.Globals.Pos) : core.Type.TExpr { 18 | return 19 | if (cf.cf_kind.match(Method(MethMacro))) { 20 | switch (args) { 21 | case [e]: 22 | var _tmp = context.Typecore.push_this(ctx, e); 23 | var e = _tmp.fst; var f = _tmp.snd; 24 | ctx.with_type_stack = context.Typecore.WithType.WithType(t) :: ctx.with_type_stack; 25 | var e = switch(ctx.g.do_macro(ctx, MExpr, c.cl_path, cf.cf_name, [e], p)) { 26 | case Some(e): context.Typecore.type_expr(ctx, e, Value); 27 | case None: context.Typecore.type_expr(ctx, {expr:EConst(CIdent("null")), pos:p}, Value); 28 | } 29 | ctx.with_type_stack = List.tl(ctx.with_type_stack); 30 | f(); 31 | e; 32 | case _: trace("Shall not be seen"); Sys.exit(255); throw false; 33 | } 34 | } 35 | else { 36 | context.Typecore.make_static_call(ctx, c, cf, core.Type.apply_params.bind(a.a_params, pl), args, t, p); 37 | } 38 | } 39 | 40 | public static function do_check_cast (ctx:context.Typecore.Typer, tleft:core.Type.T, eright:core.Type.TExpr, p:core.Globals.Pos) : core.Type.TExpr { 41 | function recurse(cf:core.Type.TClassField, f:Void->core.Type.TExpr) : core.Type.TExpr { 42 | if (cf == ctx.curfield || List.mem(cf, cast_stack.get())) { 43 | core.Error.error("Recursive implicit cast", p); 44 | } 45 | cast_stack.set(cf::cast_stack.get()); 46 | var r = f(); 47 | cast_stack.set(List.tl(cast_stack.get())); 48 | return r; 49 | } 50 | function find (a:core.Type.TAbstract, tl:core.Type.TParams, f:Void->{cf:core.Type.TClassField, t:core.Type.T}) : core.Type.TExpr { 51 | var _tmp = f(); 52 | var tcf = _tmp.t; var cf = _tmp.cf; 53 | return 54 | if (core.Meta.has(MultiType, a.a_meta)) { 55 | core.Type.mk_cast(eright, tleft, p); 56 | } 57 | else { 58 | switch (a.a_impl) { 59 | case Some(c): recurse(cf, function () { 60 | var ret = make_static_call(ctx, c, cf, a, tl, [eright], tleft, p); 61 | return ret.with({eexpr: core.Type.TExprExpr.TMeta({name:ImplicitCast, params:[], pos:ret.epos}, ret)}); 62 | }); 63 | case None: trace("Shall not be seen"); throw false; 64 | } 65 | } 66 | } 67 | return 68 | if (core.Type.type_iseq(tleft, eright.etype)) { 69 | eright; 70 | } 71 | else { 72 | function loop (tleft:core.Type.T, tright:core.Type.T): core.Type.TExpr { 73 | return 74 | switch [core.Type.follow(tleft), core.Type.follow(tright)] { 75 | case [TAbstract(a1, tl1), TAbstract(a2, tl2)]: 76 | core.Abstract.find_to_from(find, a1, tl1, a2, tl2, tleft, eright.etype); 77 | case [TAbstract(a, tl), _]: 78 | try { 79 | find(a, tl, function () { return core.Abstract.find_from(a, tl, eright.etype, tleft); }); 80 | } 81 | catch (_:ocaml.Not_found) { 82 | function loop2(tcl:core.Type.TParams) { 83 | return switch (tcl) { 84 | case tc::tcl: 85 | if (!core.Type.type_iseq(tc, tleft)) { 86 | loop(core.Type.apply_params(a.a_params, tl, tc), tright); 87 | } 88 | else { 89 | loop2(tcl); 90 | } 91 | case []: throw ocaml.Not_found.instance; 92 | } 93 | } 94 | loop2(a.a_from); 95 | } 96 | case [_, TAbstract(a, tl)]: 97 | try { 98 | find(a, tl, function () { return core.Abstract.find_to(a, tl, tleft); }); 99 | } 100 | catch (_:ocaml.Not_found) { 101 | function loop2(tcl) { 102 | return switch (tcl:core.Type.TParams) { 103 | case tc::tcl: 104 | if (!core.Type.type_iseq(tc, tright)) { 105 | loop(tleft, core.Type.apply_params(a.a_params, tl, tc)); 106 | } 107 | else { 108 | loop2(tcl); 109 | } 110 | case []: throw ocaml.Not_found.instance; 111 | } 112 | } 113 | loop2(a.a_to); 114 | } 115 | case _: 116 | throw ocaml.Not_found.instance; 117 | } 118 | } 119 | loop(tleft, eright.etype); 120 | } 121 | } 122 | 123 | public static function cast_or_unify_raise (ctx:context.Typecore.Typer, tleft:core.Type.T, eright:core.Type.TExpr, p:core.Globals.Pos) : core.Type.TExpr { 124 | return try { 125 | // can't do that anymore because this might miss macro calls (#4315) 126 | // if ctx.com.display <> DMNone then raise Not_found; 127 | do_check_cast(ctx, tleft, eright, p); 128 | } 129 | catch (_:ocaml.Not_found) { 130 | context.Typecore.unify_raise(ctx, eright.etype, tleft, p); 131 | eright; 132 | } 133 | } 134 | public static function cast_or_unify (ctx:context.Typecore.Typer, tleft:core.Type.T, eright:core.Type.TExpr, p:core.Globals.Pos) : core.Type.TExpr { 135 | return try { 136 | cast_or_unify_raise(ctx, tleft, eright, p); 137 | } 138 | catch (err:core.Error) { 139 | var p = err.pos; 140 | switch (err.msg) { 141 | case Unify(l): 142 | context.Typecore.raise_or_display(ctx, l, p); 143 | eright; 144 | case _: throw err; 145 | } 146 | } 147 | } 148 | 149 | public static function find_array_access_raise(ctx:context.Typecore.Typer, a:core.Type.TAbstract, tl:core.Type.TParams, e1:core.Type.TExpr, e2o:Option, p:core.Globals.Pos) : {cf:core.Type.TClassField, tf:core.Type.T, r:core.Type.T, e1:core.Type.TExpr, e2o:Option} { 150 | trace("TODO: context.typecore.AbstractCast.find_array_access_raise"); 151 | throw false; 152 | } 153 | 154 | public static function find_array_access(ctx:context.Typecore.Typer, a:core.Type.TAbstract, tl:core.Type.TParams, e1:core.Type.TExpr, e2o:Option, p:core.Globals.Pos) : {cf:core.Type.TClassField, tf:core.Type.T, r:core.Type.T, e1:core.Type.TExpr, e2o:Option} { 155 | return try { 156 | find_array_access_raise(ctx, a, tl, e1, e2o, p); 157 | } 158 | catch (_:ocaml.Not_found) { 159 | switch (e2o) { 160 | case None: 161 | core.Error.error('No @:arrayAccess function accepts argument of ${core.Type.s_type(core.Type.print_context(), e1.etype)}', p); 162 | case Some(e2): 163 | core.Error.error('No @:arrayAccess function accepts argument of ${core.Type.s_type(core.Type.print_context(), e1.etype)} and ${core.Type.s_type(core.Type.print_context(), e2.etype)}', p); 164 | } 165 | } 166 | } 167 | 168 | public static function find_multitype_specialization (com:context.Common.Context, a:core.Type.TAbstract, pl:core.Type.TParams, p:core.Globals.Pos) : {fst:core.Type.TClassField, snd:core.Type.T} { 169 | trace("TODO: find_multitype_specialization"); 170 | throw false; 171 | } 172 | 173 | public static function handle_abstract_casts (ctx:context.Typecore.Typer, e:core.Type.TExpr) : core.Type.TExpr { 174 | function loop (ctx:context.Typecore.Typer, e:core.Type.TExpr) : core.Type.TExpr { 175 | return switch (e.eexpr) { 176 | case TNew(c={cl_kind:KAbstractImpl(a)}, pl, el): 177 | if (!core.Meta.has(MultiType, a.a_meta)) { 178 | /* This must have been a @:generic expansion with a { new } constraint (issue #4364). In this case 179 | let's construct the underlying type. */ 180 | switch (core.Abstract.get_underlying_type(a, pl)) { 181 | case t=TInst(c, tl): e.with({{eexpr:core.Type.TExprExpr.TNew(c, tl, el), etype:t}}); 182 | case _: core.Error.error("Cannot construct "+core.Type.s_type(core.Type.print_context(), TAbstract(a, pl)), e.epos); 183 | } 184 | } 185 | else { 186 | // a TNew of an abstract implementation is only generated if it is a multi type abstract 187 | var _tmp = find_multitype_specialization(ctx.com, a, pl, e.epos); 188 | var cf = _tmp.fst; var m = _tmp.snd; 189 | var e = make_static_call(ctx, c, cf, a, pl, core.Type.mk(TConst(TNull), TAbstract(a, pl), e.epos)::el, m, e.epos); 190 | e.with({etype:m}); 191 | } 192 | case TCall({eexpr:TField(_, FStatic({cl_path:{a:[], b:"Std"}}, {cf_name:"string"}))}, [e1]) if ( switch (core.Type.follow(e1.etype)) { case TAbstract({a_impl:Some(_)}, _): true; case _: false; }): 193 | switch (core.Type.follow(e1.etype)) { 194 | case TAbstract(a={a_impl:Some(c)}, tl): 195 | try { 196 | var cf = PMap.find("toString", c.cl_statics); 197 | make_static_call(ctx, c, cf, a, tl, [e1], ctx.t.tstring, e.epos); 198 | } 199 | catch (_:ocaml.Not_found) { 200 | e; 201 | } 202 | case _: 203 | trace("Shall not be seen"); throw false; 204 | } 205 | case TCall(e1, el): 206 | try { 207 | function find_abstract(e:core.Type.TExpr, t:core.Type.T) : {fst:core.Type.TAbstract, snd:core.Type.TParams, trd:core.Type.TExpr} { 208 | return switch [core.Type.follow(t), e.eexpr] { 209 | case [TAbstract(a, pl), _] if (core.Meta.has(MultiType, a.a_meta)): 210 | {fst:a, snd:pl, trd:e}; 211 | case [_, TCast(e1, None)]: 212 | find_abstract(e1, e1.etype); 213 | case [_, TLocal({v_extra:Some({expr:Some(e_)})})]: 214 | switch (core.Type.follow(e_.etype)) { 215 | case TAbstract(a, pl) if (core.Meta.has(MultiType, a.a_meta)): 216 | {fst:a, snd:pl, trd:core.Type.mk(TCast(e, None), e_.etype, e.epos)}; 217 | case _: throw ocaml.Not_found.instance; 218 | } 219 | case _: throw ocaml.Not_found.instance; 220 | } 221 | } 222 | function find_field (e1:core.Type.TExpr) : core.Type.TExpr { 223 | return switch (e1.eexpr) { 224 | case TCast(e2, None): 225 | e1.with({eexpr:core.Type.TExprExpr.TCast(find_field(e2), None)}); 226 | case TField(e2, fa): 227 | var _tmp = find_abstract(e2, e2.etype); 228 | var a = _tmp.fst; var pl = _tmp.snd; var e2 = _tmp.trd; 229 | var m = core.Abstract.get_underlying_type(a, pl); 230 | var fname = core.Type.field_name(fa); 231 | var el = List.map(loop.bind(ctx), el); 232 | try { 233 | var fa = core.Type.quick_field(m, fname); 234 | function get_fun_type(t:core.Type.T) { 235 | return switch (core.Type.follow(t)) { 236 | case tf=TFun({ret:tr}): {fst:tf, snd:tr}; 237 | case _: throw ocaml.Not_found.instance; 238 | } 239 | } 240 | var _tmp = switch (fa) { 241 | case FStatic(_, cf): get_fun_type(cf.cf_type); 242 | case FInstance(c, tl, cf): get_fun_type(core.Type.apply_params(c.cl_params, tl, cf.cf_type)); 243 | case FAnon(cf): get_fun_type(cf.cf_type); 244 | case _: throw ocaml.Not_found.instance; 245 | } 246 | var tf = _tmp.fst; var tr = _tmp.snd; 247 | var ef = core.Type.mk(TField(e2.with({etype:m}), fa), tf, e2.epos); 248 | var ecall = context.Typecore.make_call(ctx, ef, el, tr, e.epos); 249 | if (!core.Type.type_iseq(ecall.etype, e.etype)) { 250 | core.Type.mk(core.Type.TExprExpr.TCast(ecall, None), e.etype, e.epos); 251 | } 252 | else { 253 | ecall; 254 | } 255 | } 256 | catch (_:ocaml.Not_found) { 257 | // quick_field raises Not_found if m is an abstract, we have to replicate the 'using' call here 258 | switch (core.Type.follow(m)) { 259 | case TAbstract(a={a_impl:Some(c)}, pl): 260 | var cf = PMap.find(fname, c.cl_statics); 261 | make_static_call(ctx, c, cf, a, pl, e2::el, e.etype, e.epos); 262 | case _: throw ocaml.Not_found.instance; 263 | } 264 | } 265 | case _: throw ocaml.Not_found.instance; 266 | } 267 | } 268 | find_field(e1); 269 | } 270 | catch (_:ocaml.Not_found) { 271 | core.Type.map_expr(loop.bind(ctx), e); 272 | } 273 | case _: core.Type.map_expr(loop.bind(ctx), e); 274 | } 275 | } 276 | return loop(ctx, e); 277 | } 278 | } --------------------------------------------------------------------------------