diff options
40 files changed, 2365 insertions, 1878 deletions
diff --git a/doc/rust.texi b/doc/rust.texi index a5352061..4461fe03 100644 --- a/doc/rust.texi +++ b/doc/rust.texi @@ -224,6 +224,67 @@ mechanisms or restrictions of crates. Modules and crates serve different roles. @sp 1 +@item Static control over memory allocation, packing and aliasing. + +Many values in Rust are allocated @emph{within} their containing stack-frame +or parent strucure. Numbers, records, tuples and tags are all allocated this +way. To allocate such values in the heap, they must be explicitly +@emph{boxed}. A @dfn{box} is a pointer to a heap allocation that holds another +value, its @emph{content}. If the content of a box is a @emph{state} value -- +the sort that may contain mutable members -- then the heap allocation is also +subject to garbage collection. + +Boxing and unboxing in Rust is explicit, though in many cases (arithmetic +operations, name-component dereferencing) Rust will automatically ``reach +through'' the box to access its content. Box values can be passed and assigned +independently, like pointers in C; the difference is that in Rust they always +point to live contents, and are not subject to pointer arithmetic. + +In addition to boxes, Rust supports a kind of pass-by-reference slot called an +alias. Forming or releasing an alias does not perform reference-count +operations; aliases can only be formed on referents that will provably outlive +the alias, and are therefore only used for passing arguments to +functions. Aliases are not ``general values'', in the sense that they cannot +be independently manipulated. They are more like C++ references, except that +like boxes, aliases are safe: they always point to live values. + +In addition, every slot (stack-local allocation or alias) has a static +initialization state that is calculated by the typestate system. This permits +late initialization of slots in functions with complex control-flow, while +still guaranteeing that every use of a slot occurs after it has been +initialized. + +@sp 1 +@item Static control over mutability. + +Types in Rust are classified as either immutable or mutable. By default, +all types are immutable. + +If a type is declared as @code{mutable}, then the type is a @code{state} type +and must be declared as such. Any type directly marked as @code{mutable} +@emph{or indirectly containing} a state type is also a state type. + +This classification of data types in Rust interacts with the memory allocation +and transmission rules. In particular: + +@itemize +@item Only immutable (non-state) values can be sent over channels. +@item Only immutable (non-state) objects can have destructor functions. +@end itemize + +Boxed state values are subject to local (per-task) garbage-collection. Garbage +collection costs are therefore also task-local and do not interrupt or suspend +other tasks. + +Boxed immutable values are reference-counted and have a deterministic +destruction order: top-down, immediately upon release of the last live +reference. + +State values can refer to immutable values, but not vice-versa. Rust therefore +encourages the programmer to write in a style that consists primarily of +immutable types, but also permits limited, local (per-task) mutability. + +@sp 1 @item Stack-based iterators Rust provides a type of function-like multiple-invocation iterator that is @@ -278,15 +339,15 @@ Rust has a lightweight object system based on structural object types: there is no ``class hierarchy'' nor any concept of inheritance. Method overriding and object restriction are performed explicitly on object values, which are little more than order-insensitive records of methods sharing a common private -value. Objects can be mutable or immutable, and immutable objects can have +value. Objects can be state or non-state, and only non-state objects can have destructors. @sp 1 @item Dynamic type -Rust includes support for slots of a top type, @code{any}, that can hold any -type of value whatsoever. An @code{any} slot is a pair of a type code and an -exterior value of that type. Injection into an @code{any} and projection by +Rust includes support for values of a top type, @code{any}, that can hold any +type of value whatsoever. An @code{any} value is a pair of a type code and a +boxed value of that type. Injection into an @code{any} and projection by type-case-selection is integrated into the language. @sp 1 @@ -331,100 +392,41 @@ and/or objects are otherwise freed from data structures holding them. The same destructors are run in the same order whether the object is deleted by unwinding during failure or normal execution. -Similarly, the rules for freeing immutable memory are deterministic and -predictable: on scope-exit or structure-release, interior slots are released -immediately, exterior slots have their reference count decreased and are -released if the count drops to zero. Alias slots are not affected by scope -exit. - -Mutable memory is local to a task, and is subject to per-task garbage -collection. As a result, unreferenced mutable memory is not necessarily freed -immediately; if it is acyclic it is freed when the last reference to it drops, -but if it is part of a reference cycle it will be freed when the GC collects -it (or when the owning task terminates, at the latest). - -Mutable memory can point to immutable memory but not vice-versa. Doing so -merely delays (to an undefined future time) the moment when the deterministic, -top-down destruction sequence for the referenced immutable memory -@emph{starts}. In other words, the immutable ``leaves'' of a mutable structure -are released in a locally-predictable order, even if the ``interior'' of the -mutable structure is released in an unpredictable order. +Similarly, the rules for freeing immutable values are deterministic and +predictable: on scope-exit or structure-release, local slots are released +immediately. Referenced boxes have their reference count decreased and are +released if the count drops to zero. Aliases are silently forgotten. + +State values are local to a task, and are subject to per-task garbage +collection. As a result, unreferenced state boxes are not necessarily freed +immediately; if an unreferenced state box is part of an acyclic graph, it is +freed when the last reference to it drops, but if it is part of a reference +cycle it will be freed when the GC collects it (or when the owning task +terminates, at the latest). + +State values can point to immutable values but not vice-versa. Doing so merely +delays (to an undefined future time) the moment when the deterministic, +top-down destruction sequence for the referenced immutable values +@emph{start}. In other words, the immutable ``leaves'' of a state value are +released in a locally-predictable order, even if the ``interior'' of the state +value is released in an unpredictable order. @sp 1 @item Typestate system -Every storage slot in Rust participates in not only a conventional structural -static type system, describing the interpretation of memory in the slot, but -also a @emph{typestate} system. The static typestates of a program describe -the set of @emph{pure, dynamic predicates} that provably hold over some set of -slots, at each point in the program's control flow graph. The static -calculation of the typestates of a program is a dataflow problem, and handles -user-defined predicates in a similar fashion to the way the type system -permits user-defined types. +Every storage slot in a Rust frame participates in not only a conventional +structural static type system, describing the interpretation of memory in the +slot, but also a @emph{typestate} system. The static typestates of a program +describe the set of @emph{pure, dynamic predicates} that provably hold over +some set of slots, at each point in the program's control flow graph within +each frame. The static calculation of the typestates of a program is a +function-local dataflow problem, and handles user-defined predicates in a +similar fashion to the way the type system permits user-defined types. A short way of thinking of this is: types statically model the kinds of values held in slots, typestates statically model @emph{assertions that hold} before and after statements. -@sp 1 -@item Static control over memory allocation, packing and aliasing. - -Every variable or field in Rust is a combination of a type, a mutability flag -and a @emph{mode}; this combination is called a @emph{slot}. There are 3 kinds -of @dfn{slot mode}, denoting 3 ways of referring to a value: - -@itemize -@item ``interior'' (slot contains value) -@item ``exterior'', (slot points to to managed heap allocation) -@item ``alias'', (slot points directly to provably-live address) -@end itemize - -Interior slots declared as variables in a function are allocated very quickly -on the stack, as part of a local activation frame, as in C or C++. Alias slots -permit efficient by-reference parameter passing without adjusting heap -reference counts or interacting with garbage collection, as alias lifetimes -are statically guaranteed to outlive callee lifetimes. - -Copying data between slots of different modes may cause either a simple -address assignment or reference-count adjustment, or may cause a value to be -``transplanted'': copied by value from the interior of one memory structure to -another, or between stack and heap. Transplanting, when necessary, is -predictable and automatic, as part of the definition of the copy operator -(@code{=}). - -In addition, slots have a static initialization state that is calculated by -the typestate system. This permits late initialization of variables in -functions with complex control-flow, while still guaranteeing that every use -of a slot occurs after it has been initialized. - -@sp 1 -@item Static control over mutability. - -Slots in Rust are classified as either immutable or mutable. By default, -all slots are immutable. - -If a slot within a type is declared as @code{mutable}, the type is a -@code{state} type and must be declared as such. - -This classification of data types in Rust interacts with the memory allocation -and transmission rules. In particular: - -@itemize -@item Only immutable (non-state) values can be sent over channels. -@item Only immutable (non-state) objects can have destructor functions. -@end itemize - -State values are subject to local (per-task) garbage-collection. Garbage -collection costs are therefore also task-local and do not interrupt or suspend -other tasks. - -Immutable values are reference-counted and have a deterministic destruction -order: top-down, immediately upon release of the last live reference. - -State values can refer to immutable values, but not vice-versa. Rust therefore -encourages the programmer to write in a style that consists primarily of -immutable types, but also permits limited, local (per-task) mutability. - @end itemize @@ -549,7 +551,6 @@ Additional specific influences can be seen from the following languages: * Ref.Run:: Organization of runtime services. @end menu -@page @node Ref.Lex @section Ref.Lex @c * Ref.Lex:: Lexical structure. @@ -581,39 +582,40 @@ Unicode characters. * Ref.Lex.Sym:: Special symbol tokens. @end menu -@page @node Ref.Lex.Ignore @subsection Ref.Lex.Ignore @c * Ref.Lex.Ignore:: Ignored tokens. -The classes of @emph{whitespace} and @emph{comment} is ignored, and are not -considered as tokens. +Characters considered to be @emph{whitespace} or @emph{comment} are ignored, +and are not considered as tokens. They serve only to delimit tokens. Rust is +otherwise a free-form language. @dfn{Whitespace} is any of the following Unicode characters: U+0020 (space), U+0009 (tab, @code{'\t'}), U+000A (LF, @code{'\n'}), U+000D (CR, @code{'\r'}). @dfn{Comments} are any sequence of Unicode characters beginning with U+002F -U+002F (@code{//}) and extending to the next U+000a character, +U+002F (@code{"//"}) and extending to the next U+000A character, @emph{excluding} cases in which such a sequence occurs within a string literal token or a syntactic extension token. -@page @node Ref.Lex.Ident @subsection Ref.Lex.Ident @c * Ref.Lex.Ident:: Identifier tokens. Identifiers follow the pattern of C identifiers: they begin with a -@emph{letter} or underscore character @code{_} (Unicode character U+005f), and -continue with any combination of @emph{letters}, @emph{digits} and -underscores, and must not be equal to any keyword. @xref{Ref.Lex.Key}. +@emph{letter} or @emph{underscore}, and continue with any combination of +@emph{letters}, @emph{decimal digits} and underscores, and must not be equal +to any keyword. @xref{Ref.Lex.Key}. A @emph{letter} is a Unicode character in the ranges U+0061-U+007A and -U+0041-U+005A (@code{a-z} and @code{A-Z}). +U+0041-U+005A (@code{'a'}-@code{'z'} and @code{'A'}-@code{'Z'}). -A @emph{digit} is a Unicode character in the range U+0030-U0039 (@code{0-9}). +An @dfn{underscore} is the character U+005F ('_'). + +A @dfn{decimal digit} is a character in the range U+0030-U+0039 +(@code{'0'}-@code{'9'}). -@page @node Ref.Lex.Key @subsection Ref.Lex.Key @c * Ref.Lex.Key:: Keyword tokens. @@ -642,9 +644,10 @@ The keywords are: @tab @code{type} @tab @code{true} @tab @code{false} -@item @code{any} -@tab @code{int} +@tab @code{any} +@item @code{int} @tab @code{uint} +@tab @code{float} @tab @code{char} @tab @code{bool} @item @code{u8} @@ -694,34 +697,98 @@ The keywords are: @tab @code{be} @end multitable -@page @node Ref.Lex.Num @subsection Ref.Lex.Num @c * Ref.Lex.Num:: Numeric tokens. -@emph{TODO: describe numeric literals}. +A @dfn{number literal} is either an @emph{integer literal} or a +@emph{floating-point literal}. + +@sp 1 +An @dfn{integer literal} has one of three forms: +@enumerate +@item A @dfn{decimal literal} starts with a @emph{decimal digit} and continues +with any mixture of @emph{decimal digits} and @emph{underscores}. + +@item A @dfn{hex literal} starts with the character sequence U+0030 +U+0078 (@code{"0x"}) and continues as any mixture @emph{hex digits} +and @emph{underscores}. + +@item A @dfn{binary literal} starts with the character sequence U+0030 +U+0062 (@code{"0b"}) and continues as any mixture @emph{binary digits} +and @emph{underscores}. + +@end enumerate + +@sp 1 +A @dfn{floating point literal} has one of two forms: +@enumerate +@item Two @emph{decimal literals} separated by a period +character U+002E ('.'), with an optional @emph{exponent} trailing after the +second @emph{decimal literal}. +@item A single @emph{decimal literal} followed by an @emph{exponent}. +@end enumerate + +@sp 1 +A @dfn{hex digit} is either a @emph{decimal digit} or else a character in the +ranges U+0061-U+0066 and U+0041-U+0046 (@code{'a'}-@code{'f'}, +@code{'A'}-@code{'F'}). + +A @dfn{binary digit} is either the character U+0030 or U+0031 (@code{'0'} or +@code{'1'}). + +An @dfn{exponent} begins with either of the characters U+0065 or U+0045 +(@code{'e'} or @code{'E'}), followed by an optional @emph{sign character}, +followed by a trailing @emph{decimal literal}. + +A @dfn{sign character} is either U+002B or U+002D (@code{'+'} or @code{'-'}). -@page @node Ref.Lex.Text @subsection Ref.Lex.Text @c * Ref.Lex.Key:: String and character tokens. -@emph{TODO: describe string and character literals}. +A @dfn{character literal} is a single Unicode character enclosed within two +U+0027 (single-quote) characters, with the exception of U+0027 itself, which +must be @emph{escaped} by a preceding U+005C character ('\'). + +A @dfn{string literal} is a sequence of any Unicode characters enclosed +within two U+0022 (double-quote) characters, with the exception of U+0022 +itself, which must be @emph{escaped} by a preceding U+005C character +('\'). + +Some additional @emph{escapes} are available in either character or string +literals. An escape starts with a U+005C ('\') and continues with one +of the following forms: +@itemize +@item An @dfn{8-bit codepoint escape} escape starts with U+0078 ('x') and is +followed by exactly two @dfn{hex digits}. It denotes the Unicode codepoint +equal to the provided hex value. +@item A @dfn{16-bit codepoint escape} starts with U+0075 ('u') and is followed + by exactly four @dfn{hex digits}. It denotes the Unicode codepoint equal to +the provided hex value. +@item A @dfn{32-bit codepoint escape} starts with U+0055 ('U') and is followed + by exactly eight @dfn{hex digits}. It denotes the Unicode codepoint equal to +the provided hex value. +@item A @dfn{whitespace escape} is one of the characters U+006E, U+0072, or +U+0074, denoting the unicode values U+000A (LF), U+000D (CR) or U+0009 (HT) +respectively. +@item The @dfn{backslash escape} is the character U+005C ('\') which must be +escaped in order to denote @emph{itself}. +@end itemize -@page @node Ref.Lex.Syntax @subsection Ref.Lex.Syntax @c * Ref.Lex.Syntax:: Syntactic extension tokens. -Syntactic extensions are marked with the @emph{pound} sigil @code{#} (U+0023), +Syntactic extensions are marked with the @emph{pound} sigil U+0023 (@code{#}), followed by a qualified name of a compile-time imported module item, an -optional parenthesized list of @emph{tokens}, and an optional brace-enclosed -region of free-form text (with brace-matching and brace-escaping used to -determine the limit of the region). @xref{Ref.Comp.Syntax}. +optional parenthesized list of @emph{parsed expressions}, and an optional +brace-enclosed region of free-form text (with brace-matching and +brace-escaping used to determine the limit of the +region). @xref{Ref.Comp.Syntax}. @emph{TODO: formalize those terms more}. -@page @node Ref.Lex.Sym @subsection Ref.Lex.Sym @c * Ref.Lex.Sym:: Special symbol tokens. @@ -817,9 +884,10 @@ Paths fall into two important categories: @emph{names} and A @dfn{name} denotes an item, and is statically resolved to its referent at compile time. -An @dfn{lval} denotes a slot, and is statically resolved to a sequence of -memory operations and primitive (arithmetic) expressions required to load or -store to the slot at compile time. +An @dfn{lval} denotes a slot or some component of a value held within a slot, +and is statically resolved at compile time to a sequence of memory operations +and primitive (arithmetic) expressions that will be executed to load or store +the associated value, starting from the task stack frame, at run time. In some contexts, the Rust grammar accepts a general @emph{path}, but a subsequent syntactic restriction requires the path to be an lval or a name. In @@ -880,7 +948,6 @@ successful produces a single crate in executable form. * Ref.Comp.Syntax:: Syntax extensions. @end menu -@page @node Ref.Comp.Crate @subsection Ref.Comp.Crate @c * Ref.Comp.Crate:: Units of compilation and linking. @@ -971,7 +1038,6 @@ mod bar @{ @} @end example -@page @node Ref.Comp.Meta @subsection Ref.Comp.Meta @@ -982,7 +1048,6 @@ directives, denoted by @code{syntax} and @code{use} keywords respectively. Alternatively, metadata can serve as a simple form of documentation. -@page @node Ref.Comp.Syntax @subsection Ref.Comp.Syntax @c * Ref.Comp.Syntax:: Syntax extension. @@ -1039,17 +1104,17 @@ A Rust task's memory consists of a static set of @emph{items}, a set of tasks each with its own @emph{stack}, and a @emph{heap}. Immutable portions of the heap may be shared between tasks, mutable portions may not. -Allocations in the stack and the heap consist of @emph{slots}. +Allocations in the stack consist of @emph{slots}, and allocations in the heap +consist of @emph{boxes}. @menu * Ref.Mem.Alloc:: Memory allocation model. * Ref.Mem.Own:: Memory ownership model. -* Ref.Mem.Slot:: Memory containment and reference model. -* Ref.Mem.Init:: Initialization state of memory. +* Ref.Mem.Slot:: Stack memory model. +* Ref.Mem.Box:: Heap memory model. * Ref.Mem.Acct:: Memory accounting model. @end menu -@page @node Ref.Mem.Alloc @subsection Ref.Mem.Alloc @c * Ref.Mem.Alloc:: Memory allocation model. @@ -1063,95 +1128,79 @@ A task's @dfn{stack} consists of activation frames automatically allocated on entry to each function as the task executes. A stack allocation is reclaimed when control leaves the frame containing it. -The @dfn{heap} is a general term that describes two separate sets of exterior -allocations: @emph{local heap} allocations and the @emph{shared heap} -allocations. - -Exterior allocations of mutable types are @dfn{local heap} allocations, -owned by the task. Such @dfn{local allocations} cannot pass over channels and -do not outlive the task that owns them. When unreferenced, they are collected -using a general (cycle-aware) garbage-collector local to each task. Garbage -collection within a local heap does not interrupt execution of other tasks. +The @dfn{heap} is a general term that describes two separate sets of boxes: +@emph{task-local} state boxes and the @emph{shared} non-state boxes. -Exterior allocations of immutable types are @dfn{shared heap} allocations, -and can be multiply-referenced by many different tasks. Such @dfn{shared -allocations} can pass over channels, and live as long as the last task -referencing them. When unreferenced, they are collected immediately using -reference-counting. +State boxes are @dfn{task-local}, owned by the task. Like any other state +value, they cannot pass over channels. State boxes do not outlive the task +that owns them. When unreferenced, they are collected using a general +(cycle-aware) garbage-collector local to each task. Garbage collection within +a local heap does not interrupt execution of other tasks. +Non-state boxes are @dfn{shared}, and can be multiply-referenced by many +different tasks. Like any other immutable type, they can pass over channels, +and live as long as the last task referencing them within a given domain. When +unreferenced, they are destroyed immediately (due to reference-counting) and +returned to the heap memory allocator. Destruction of an immutable box also +executes within the context of task that drops the last reference to a shared +heap allocation, so executing a long-running destructor does not interrupt +execution of other tasks. -@page @node Ref.Mem.Own @subsection Ref.Mem.Own @c * Ref.Mem.Own:: Memory ownership model. -A task @emph{owns} all the interior allocations in its stack and @emph{local} -exterior allocations. A task @emph{shares} ownership of @emph{shared} exterior -allocations. A task does not own any items. +A task @emph{owns} all the @emph{stack-local} slot allocations in its stack +and @emph{task-local} boxes accessible from its stack. A task @emph{shares} +ownership of @emph{shared} boxes accessible from its stack. A task does not +own any items. @dfn{Ownership} of an allocation means that the owning task is the only task that can access the allocation. @dfn{Sharing} of an allocation means that the same allocation may be -concurrently referenced by multiple tasks. The only shared allocations are -those that are immutable. +concurrently read by multiple tasks. The only shared allocations are those +that are non-state. -When a stack frame is exited, its interior allocations are all released, and -its references to heap allocations (both shared and owned) are dropped. +When a stack frame is exited, its local allocations are all released, and its +references to boxes (both shared and owned) are dropped. -When a task finishes, its stack is necessarily empty. The task's interior -slots are released as the task itself is released, and its references to heap -allocations are dropped. +When a task finishes, its stack is necessarily empty and it therefore has no +references to any boxes. -@page @node Ref.Mem.Slot @subsection Ref.Mem.Slot -@c * Ref.Mem.Slot:: Memory containment and reference model. - -A @dfn{slot} is a component of an allocation. A slot either holds a value or -the address of another allocation. Every slot has one of three possible -@emph{modes}. - -The possible @dfn{modes} of a slot are: - -@itemize -@sp 1 -@item @dfn{Interior mode} +@c * Ref.Mem.Slot:: Stack memory model. -The slot holds the value of the slot. +A task's stack contains slots. -@sp 1 -@item @dfn{Exterior mode} - -The slot holds the address of a heap allocation that holds the value of the -slot. +A @dfn{slot} is a component of a stack frame. A slot is either @emph{local} or +an @emph{alias}. -Exterior slots are indicated by the @emph{at} sigil @code{@@}. +A @dfn{local} slot (or @emph{stack-local} allocation) holds a value directly, +allocated within the stack's memory. The value is a part of the stack frame. -For example, the following code allocates an exterior record, copies it by -counted-reference to a second exterior slot, then modifies the record through -the second exterior slot that points to the same exterior allocation. -@example -type point3d = rec(int x, int y, int z); -let @@point3d pt1 = rec(x=1, y=2, z=3); -let @@point3d pt2 = pt1; -pt2.z = 4; -@end example +An @dfn{alias} references a value outside the frame. An alias may refer to a +value allocated in another frame @emph{or} a boxed value in the heap. The +alias-formation rules ensure that the referent of an alias will outlive the +alias. -@sp 1 -@item @dfn{Alias mode} +Local slots are always implicitly mutable. -The slot holds the address of a value. The referenced value may reside within -a stack allocation @emph{or} a heap allocation. +Local slots are not initialized when allocated; the entire frame worth of +local slots are allocated at once, on frame-entry, in an uninitialized +state. Subsequent statements within a function may or may not initialize the +local slots. Local slots can only be used after they have been initialized; +this condition is guaranteed by the typestate system. -Alias slots can @emph{only} be declared as members of a function or iterator -signature, bound to the lifetime of a stack frame. Alias slots cannot be -declared as members of general data types. +Aliases can @emph{only} be declared as arguments in a function or iterator +signature, bound to the lifetime of a stack frame. Aliases are not general +values and cannot be held in boxed allocations or other general data types. Alias slots are indicated by the @emph{ampersand} sigil @code{&}. -The following example function accepts a single read-only alias parameter: +An example function that accepts an alias parameter: @example type point3d = rec(int x, int y, int z); @@ -1160,30 +1209,68 @@ fn extract_z(&point3d p) -> int @{ @} @end example -The following example function accepts a single mutable alias -parameter: +An example function that accepts an alias to a mutable value: @example -fn incr(mutable &int i) @{ +fn incr(& mutable int i) @{ i = i + 1; @} @end example +@node Ref.Mem.Box +@subsection Ref.Mem.Box +@c * Ref.Mem.Box:: Heap memory model. + +A @dfn{box} is a reference to a reference-counted heap allocation holding +another value. + +Box types and values are constructed by the @emph{at} sigil @code{@@}. + +An example of constructing a box type and value: +@example +let @@int x = @@10; +@end example + +Some operations implicitly dereference boxes. Examples of such @dfn{implicit +dereference} operations are: +@itemize +@item arithmetic operators (@code{x + y - z}) +@item name-component selection (@code{x.y.z}) @end itemize -@page -@node Ref.Mem.Init -@subsection Ref.Mem.Init -@c * Ref.Mem.Init:: Initialization state of memory. - -A slot is either initialized or uninitialized at every point in a program. An -@dfn{initialized} slot is one that holds a value. An @dfn{uninitialized} slot -is one that has not yet had a value written into it, or has had its value -deleted, and so holds undefined memory. The typestate system ensures that an -uninitialized slot cannot be read, but can be written to. A slot becomes -initialized in any statement that writes to it, and remains initialized until -explicitly destroyed or until its enclosing allocation is destroyed. +An example of an implicit-dereference operation performed on box values: +@example +let @@int x = @@10; +let @@int y = @@12; +check (x + y == 22); +@end example + +Other operations act on box values as single-word-sized address values, +automatically adjusting reference counts on the associated heap +allocation. For these operations, to access the value held in the box requires +an explicit dereference of the box value. Explicitly dereferencing a box is +indicated with the @emph{star} sigil @code{*}. Examples of such @dfn{explicit +dererence} operations are: +@itemize +@item copying box values (@code{x = y}) +@item passing box values to functions (@code{f(x,y)}) +@end itemize + +An example of an explicit-dereference operation performed on box values: +@example +fn takes_boxed(@@int b) @{ +@} + +fn takes_unboxed(int b) @{ +@} + +fn main() @{ + let @@int x = @@10; + takes_boxed(x); + takes_unboxed(*x); +@} +@end example + -@page @node Ref.Mem.Acct @subsection Ref.Mem.Acct @c * Ref.Mem.Acct:: Memory accounting model. @@ -1210,7 +1297,7 @@ cost is transferred to the receiving domain. @section Ref.Task @c * Ref.Task:: Semantic model of tasks. -A executing Rust program consists of a tree of tasks. A Rust @dfn{task} +An executing Rust program consists of a tree of tasks. A Rust @dfn{task} consists of an entry function, a stack, a set of outgoing communication channels and incoming communication ports, and ownership of some portion of the heap of a single operating-system process. @@ -1229,7 +1316,6 @@ operating-system processes. * Ref.Task.Sched:: Task scheduling model. @end menu -@page @node Ref.Task.Comm @subsection Ref.Task.Comm @c * Ref.Task.Comm:: Inter-task communication. @@ -1245,10 +1331,10 @@ messages. Ports receive messages from channels. A @dfn{channel} is a communication endpoint that can @emph{send} messages. Channels send messages to ports. -Each port has a unique identity and cannot be replicated. If a port value is -copied from one slot to another, both slots refer to the @emph{same} port, -even if the slots are declared as interior-mode. New ports can be constructed -dynamically and stored in data structures. +Each port is implicitly boxed and mutable; as such a port has has a unique +per-task identity and cannot be replicated or transmitted. If a port value is +copied, both copies refer to the @emph{same} port. New ports can be +constructed dynamically and stored in data structures. Each channel is bound to a port when the channel is constructed, so the destination port for a channel must exist before the channel itself. A channel @@ -1283,7 +1369,6 @@ The asynchronous message-send operator is @code{<+}. The semi-synchronous message-send operator is @code{<|}. @xref{Ref.Stmt.Send}. The message-receive operator is @code{<-}. @xref{Ref.Stmt.Recv}. -@page @node Ref.Task.Life @subsection Ref.Task.Life @c * Ref.Task.Life:: Task lifecycle and state transitions. @@ -1325,7 +1410,6 @@ A task in the @emph{dead} state cannot transition to other states; it exists only to have its termination status inspected by other tasks, and/or to await reclamation when the last reference to it drops. -@page @node Ref.Task.Dom @subsection Ref.Task.Dom @c * Ref.Task.Dom:: Task domains @@ -1347,7 +1431,6 @@ Tasks can own sub-domains, which in turn own their own tasks. Every domain owns one @emph{root task}, which is the root of the tree of tasks owned by the domain. -@page @node Ref.Task.Sched @subsection Ref.Task.Sched @c * Ref.Task.Sched:: Task scheduling model. @@ -1401,7 +1484,6 @@ are no general parametric types. * Ref.Item.Type:: Items defining the types of values and slots. @end menu -@page @node Ref.Item.Mod @subsection Ref.Item.Mod @c * Ref.Item.Mod:: Items defining sub-modules. @@ -1439,7 +1521,6 @@ and outside of it. * Ref.Item.Mod.Export:: Declarations for restricting visibility. @end menu -@page @node Ref.Item.Mod.Import @subsubsection Ref.Item.Mod.Import @c * Ref.Item.Mod.Import:: Declarations for module-local synonyms. @@ -1462,7 +1543,6 @@ fn main() @{ @} @end example -@page @node Ref.Item.Mod.Export @subsubsection Ref.Item.Mod.Export @c * Ref.Item.Mod.Import:: Declarations for restricting visibility. @@ -1495,8 +1575,6 @@ fn main() @{ @end example - -@page @node Ref.Item.Fn @subsection Ref.Item.Fn @c * Ref.Item.Fn:: Items defining functions. @@ -1532,7 +1610,6 @@ fn add(int x, int y) -> int @{ @} @end example -@page @node Ref.Item.Iter @subsection Ref.Item.Iter @c * Ref.Item.Iter:: Items defining iterators. @@ -1571,7 +1648,6 @@ for each (int x = range(0,100)) @{ @end example -@page @node Ref.Item.Obj @subsection Ref.Item.Obj @c * Ref.Item.Obj:: Items defining objects. @@ -1603,7 +1679,6 @@ c.incr(); check (c.get() == 3); @end example -@page @node Ref.Item.Type @subsection Ref.Item.Type @c * Ref.Item.Type:: Items defining the types of values and slots. @@ -1647,16 +1722,17 @@ built-in type or type-constructor name is reserved as a @emph{keyword} in Rust; they cannot be used as user-defined identifiers in any context. @menu -* Ref.Type.Any:: An open sum of every possible type. +* Ref.Type.Any:: An open union of every possible type. * Ref.Type.Mach:: Machine-level types. * Ref.Type.Int:: The machine-dependent integer types. +* Ref.Type.Float:: The machine-dependent floating-point types. * Ref.Type.Prim:: Primitive types. * Ref.Type.Big:: The arbitrary-precision integer type. * Ref.Type.Text:: Strings and characters. * Ref.Type.Rec:: Labeled products of heterogeneous types. * Ref.Type.Tup:: Unlabeled products of homogeneous types. * Ref.Type.Vec:: Open products of homogeneous types. -* Ref.Type.Tag:: Disjoint sums of heterogeneous types. +* Ref.Type.Tag:: Disjoint unions of heterogeneous types. * Ref.Type.Fn:: Subroutine types. * Ref.Type.Iter:: Scoped coroutine types. * Ref.Type.Port:: Unique inter-task message-receipt endpoints. @@ -1667,19 +1743,17 @@ Rust; they cannot be used as user-defined identifiers in any context. * Ref.Type.Type:: Types describing types. @end menu -@page @node Ref.Type.Any @subsection Ref.Type.Any The type @code{any} is the union of all possible Rust types. A value of type -@code{any} is represented in memory as a pair consisting of an exterior value -of some non-@code{any} type @var{T} and a reflection of the type @var{T}. +@code{any} is represented in memory as a pair consisting of a boxed value of +some non-@code{any} type @var{T} and a reflection of the type @var{T}. Values of type @code{any} can be used in an @code{alt type} statement, in which the reflection is used to select a block corresponding to a particular type extraction. @xref{Ref.Stmt.Alt}. -@page @node Ref.Type.Mach @subsection Ref.Type.Mach @@ -1727,7 +1801,6 @@ The IEEE 754 single-precision and double-precision floating point types: @code{f32} and @code{f64}, respectively. @end itemize -@page @node Ref.Type.Int @subsection Ref.Type.Int @@ -1742,9 +1815,21 @@ The Rust type @code{int}@footnote{A Rust @code{int} is analogous to a C99 target-machine-dependent size. Its size, in bits, is equal to the size of the rust type @code{uint} on the same target machine. +@node Ref.Type.Float +@subsection Ref.Type.Float + +The Rust type @code{float} is a machine-specific type equal to one of the +supported Rust floating-point machine types (@code{f32} or @code{f64}). It is +the largest floating-point type that is directly supported by hardware on the +target machine, or if the target machine has no floating-point hardware +support, the largest floating-point type supported by the software +floating-point library used to support the other floating-point machine types. + +Note that due to the preference for hardware-supported floating point, the +type @code{float} may not be equal to the largest @emph{supported} +floating-point type. -@page @node Ref.Type.Prim @subsection Ref.Type.Prim @@ -1754,20 +1839,19 @@ The primitive types are the following: @item The ``nil'' type @code{()}, having the single ``nil'' value @code{()}.@footnote{The ``nil'' value @code{()} is @emph{not} a sentinel -``null pointer'' value for alias or exterior slots; the ``nil'' type is the -implicit return type from functions otherwise lacking a return type, and can -be used in other contexts (such as message-sending or type-parametric code) as -a zero-byte type.} +``null pointer'' value for alias slots; the ``nil'' type is the implicit +return type from functions otherwise lacking a return type, and can be used in +other contexts (such as message-sending or type-parametric code) as a +zero-size type.} @item The boolean type @code{bool} with values @code{true} and @code{false}. @item The machine types. @item -The machine-dependent integer types. +The machine-dependent integer and floating-point types. @end itemize -@page @node Ref.Type.Big @subsection Ref.Type.Big @@ -1781,7 +1865,6 @@ A Rust @code{big} grows to accommodate extra binary digits as they are needed, by taking extra memory from the memory budget available to each Rust task, and should only exhaust its range due to memory exhaustion. -@page @node Ref.Type.Text @subsection Ref.Type.Text @@ -1793,12 +1876,11 @@ unsigned word holding a UCS-4 codepoint. A value of type @code{str} is a Unicode string, represented as a vector of 8-bit unsigned bytes holding a sequence of UTF-8 codepoints. -@page @node Ref.Type.Rec @subsection Ref.Type.Rec The record type-constructor @code{rec} forms a new heterogeneous product of -slots.@footnote{The @code{rec} type-constructor is analogous to the +values.@footnote{The @code{rec} type-constructor is analogous to the @code{struct} type-constructor in the Algol/C family, the @emph{record} types of the ML family, or the @emph{structure} types of the Lisp family.} Fields of a @code{rec} type are accessed by name and are arranged in memory in the order @@ -1811,15 +1893,14 @@ let point p = rec(x=10, y=11); let int px = p.x; @end example -@page @node Ref.Type.Tup @subsection Ref.Type.Tup The tuple type-constructor @code{tup} forms a new heterogeneous product of -slots exactly as the @code{rec} type-constructor does, with the difference -that tuple slots are automatically assigned implicit field names, given by +values exactly as the @code{rec} type-constructor does, with the difference +that tuple members are automatically assigned implicit field names, given by ascending integers prefixed by the underscore character: @code{_0}, @code{_1}, -@code{_2}, etc. The fields of a tuple are laid out in memory contiguously, +@code{_2}, etc. The members of a tuple are laid out in memory contiguously, like a record, in order specified by the tuple type. An example of a tuple type and its use: @@ -1832,14 +1913,13 @@ check (p._1 == "world"); @end example -@page @node Ref.Type.Vec @subsection Ref.Type.Vec The vector type-constructor @code{vec} represents a homogeneous array of -slots. A vector has a fixed size, and may or may not have mutable member -slots. If the slots of a vector are mutable, the vector is a @emph{state} -type. +values of a given type. A vector has a fixed size. If the member-type of a +vector is a state type, then vector is a @emph{state} type, like any type +containing another type. Vectors can be sliced. A slice expression builds a new vector by copying a contiguous range -- given by a pair of indices representing a half-open @@ -1854,8 +1934,8 @@ let vec[int] v2 = v.(0,1); // Form a slice. Vectors always @emph{allocate} a storage region sufficient to store the first power of two worth of elements greater than or equal to the size of the -largest slice sharing the storage. This behaviour supports idiomatic in-place -``growth'' of a mutable slot holding a vector: +vector. This behaviour supports idiomatic in-place ``growth'' of a mutable +slot holding a vector: @example let mutable vec[int] v = vec(1, 2, 3); @@ -1871,11 +1951,10 @@ All accessible elements of a vector are always initialized, and access to a vector is always bounds-checked. -@page @node Ref.Type.Tag @subsection Ref.Type.Tag -The @code{tag} type-constructor forms new heterogeneous disjoint sum +The @code{tag} type-constructor forms new heterogeneous disjoint union types.@footnote{The @code{tag} type is analogous to a @code{data} constructor declaration in ML or a @emph{pick ADT} in Limbo.} A @code{tag} type consists of a number of @emph{variants}, each of which is independently named and takes @@ -1888,8 +1967,8 @@ a @code{tag} type may refer to type definitions that include the defined @item Recursive types can only be introduced through @code{tag} types. @item A recursive @code{tag} type must have at least one non-recursive variant (in order to give the recursion a basis case). -@item The recursive slots of recursive variants must be @emph{exterior} -slots (in order to bound the in-memory size of the variant). +@item The recursively-typed members of recursive variants must be @emph{box} +values (in order to bound the in-memory size of the variant). @item Recursive type definitions can cross module boundaries, but not module @emph{visibility} boundaries, nor crate boundaries (in order to simplify the module system). @@ -1910,7 +1989,6 @@ let list[int] a = cons(7, cons(13, nil)); @end example -@page @node Ref.Type.Fn @subsection Ref.Type.Fn @@ -1932,7 +2010,6 @@ let binop bo = add; x = bo(5,7); @end example -@page @node Ref.Type.Iter @subsection Ref.Type.Iter @@ -1955,7 +2032,6 @@ for each (int i = range(5,7)) @{ @end example -@page @node Ref.Type.Port @subsection Ref.Type.Port @@ -1977,7 +2053,6 @@ let vec[str] v; v <- p; @end example -@page @node Ref.Type.Chan @subsection Ref.Type.Chan @@ -2012,7 +2087,6 @@ let vec[str] v = vec("hello", "world"); c <| v; @end example -@page @node Ref.Type.Task @subsection Ref.Type.Task @@ -2028,12 +2102,11 @@ Like ports, tasks are modeled as mutable native types with built-in meaning to the language. They cannot be transmitted over channels or otherwise replicated, and are always local to the task that spawns them. -If all references to a task are dropped (due to the release of any slots +If all references to a task are dropped (due to the release of any structure holding those references), the released task immediately fails. @xref{Ref.Task.Life}. -@page @node Ref.Type.Obj @subsection Ref.Type.Obj @c * Ref.Type.Obj:: Object types. @@ -2099,7 +2172,6 @@ give_ints(t2); -@page @node Ref.Type.Constr @subsection Ref.Type.Constr @c * Ref.Type.Constr:: Constrained types. @@ -2125,7 +2197,6 @@ let ordered_range rng2 = rec(low=15, high=17); // implicit: 'check less_than(rng2.low, rng2.high);' @end example -@page @node Ref.Type.Type @subsection Ref.Type.Type @c * Ref.Type.Type:: Types describing types. @@ -2163,7 +2234,7 @@ actions. @menu * Ref.Stmt.Stat:: The static typestate system of statement analysis. * Ref.Stmt.Decl:: Statement declaring an item or slot. -* Ref.Stmt.Copy:: Statement for copying a value between two slots. +* Ref.Stmt.Copy:: Statement for copying a value. * Ref.Stmt.Spawn:: Statements for creating new tasks. * Ref.Stmt.Send:: Statements for sending a value into a channel. * Ref.Stmt.Flush:: Statement for flushing a channel queue. @@ -2188,7 +2259,6 @@ actions. * Ref.Stmt.IfCheck:: Statement for dynamic testing of typestate. @end menu -@page @node Ref.Stmt.Stat @subsection Ref.Stmt.Stat @c * Ref.Stmt.Stat:: The static typestate system of statement analysis. @@ -2198,7 +2268,7 @@ on a statement-by-statement basis, the @emph{effects} the statement has on its environment, as well the @emph{legality} of the statement in its environment. The legality of a statement is partly governed by syntactic rules, partly by -its conformance to the types of slots it affects, and partly by a +its conformance to the types of value it affects, and partly by a statement-oriented static dataflow analysis. This section describes the statement-oriented static dataflow analysis, also called the @emph{typestate} system. @@ -2212,7 +2282,6 @@ system. * Ref.Stmt.Stat.Check:: Relating dynamic state to static typestate. @end menu -@page @node Ref.Stmt.Stat.Point @subsubsection Ref.Stmt.Stat.Point @c * Ref.Stmt.Stat.Point:: Inter-statement positions of logical judgements. @@ -2244,7 +2313,6 @@ concerned with constraining the possible states of a task's memory at ``at'' a statement, as each statement is likely to change the contents of memory. -@page @node Ref.Stmt.Stat.CFG @subsubsection Ref.Stmt.Stat.CFG @c * Ref.Stmt.Stat.CFG:: The control flow graph formed by statements. @@ -2258,7 +2326,6 @@ might occur during execution. This implicit graph is called the @dfn{control flow graph}, or @dfn{CFG}. -@page @node Ref.Stmt.Stat.Constr @subsubsection Ref.Stmt.Stat.Constr @c * Ref.Stmt.Stat.Constr:: Predicates applied to slots. @@ -2289,7 +2356,6 @@ Predicates can only apply to slots holding immutable values. The slots a predicate applies to can themselves be mutable, but the types of values held in those slots must be immutable. -@page @node Ref.Stmt.Stat.Cond @subsubsection Ref.Stmt.Stat.Cond @c * Ref.Stmt.Stat.Cond:: Constraints required and implied by a statement. @@ -2308,7 +2374,6 @@ enforces in the point after the statement. Any constraint present in the precondition and @emph{absent} in the postcondition is considered to be @emph{dropped} by the statement. -@page @node Ref.Stmt.Stat.Typestate @subsubsection Ref.Stmt.Stat.Typestate @c * Ref.Stmt.Stat.Typestate:: Constraints that hold at points. @@ -2357,7 +2422,6 @@ prestate. If any preconditions are not satisfied, the mismatch is considered a static (compile-time) error. -@page @node Ref.Stmt.Stat.Check @subsubsection Ref.Stmt.Stat.Check @c * Ref.Stmt.Stat.Check:: Relating dynamic state to static typestate. @@ -2389,7 +2453,6 @@ and constrained types, and the responsibility to @code{check} a constraint pushed further and further away from the site at which the program requires it to hold in order to execute properly. -@page @node Ref.Stmt.Decl @subsection Ref.Stmt.Decl @c * Ref.Stmt.Decl:: Statement declaring an item or slot. @@ -2404,7 +2467,6 @@ before and after the declaration. * Ref.Stmt.Decl.Slot:: Statement declaring a slot. @end menu -@page @node Ref.Stmt.Decl.Item @subsubsection Ref.Stmt.Decl.Item @c * Ref.Stmt.Decl.Item:: Statement declaring an item. @@ -2419,7 +2481,6 @@ block. Note: there is no implicit capture of the function's dynamic environment when declaring a function-local item. -@page @node Ref.Stmt.Decl.Slot @subsubsection Ref.Stmt.Decl.Slot @c * Ref.Stmt.Decl.Slot:: Statement declaring an slot. @@ -2427,13 +2488,13 @@ declaring a function-local item. A @code{slot declaration statement} has one one of two forms: @itemize -@item @code{let} @var{mode-and-type} @var{slot} @var{optional-init}; +@item @code{let} @var{type} @var{slot} @var{optional-init}; @item @code{auto} @var{slot} @var{optional-init}; @end itemize -Where @var{mode-and-type} is a slot mode and type expression, @var{slot} is -the name of the slot being declared, and @var{optional-init} is either the -empty string or an equals sign (@code{=}) followed by a primitive expression. +Where @var{type} is a type expression, @var{slot} is the name of the slot +being declared, and @var{optional-init} is either the empty string or an +equals sign (@code{=}) followed by a primitive expression. Both forms introduce a new slot into the containing block scope. The new slot is visible across the entire scope, but is initialized only at the point @@ -2441,28 +2502,29 @@ following the declaration statement. The latter (@code{auto}) form of slot declaration causes the compiler to infer the static type of the slot through unification with the types of values -assigned to the slot in the the remaining code in the block scope. Inferred -slots always have @emph{interior} mode. @xref{Ref.Mem.Slot}. +assigned to the slot in the the remaining code in the block scope. Inference +only occurs on frame-local slots, not argument slots. Function, iterator and +object signatures must always declared types for all argument slots. +@xref{Ref.Mem.Slot}. -@page @node Ref.Stmt.Copy @subsection Ref.Stmt.Copy -@c * Ref.Stmt.Copy:: Statement for copying a value between two slots. +@c * Ref.Stmt.Copy:: Statement for copying a value. -A @dfn{copy statement} consists of an @emph{lval} -- a name denoting a slot -- -followed by an equals-sign (@code{=}) and a primitive -expression. @xref{Ref.Expr}. +A @dfn{copy statement} consists of an @emph{lval} followed by an equals-sign +(@code{=}) and a primitive expression. @xref{Ref.Expr}. Executing a copy statement causes the value denoted by the expression -- -either a value in a slot or a primitive combination of values held in slots -- -to be copied into the slot denoted by the @emph{lval}. +either a value or a primitive combination of values -- to be copied into the +memory location denoted by the @emph{lval}. -A copy may entail the formation of references, the adjustment of reference -counts, execution of destructors, or similar adjustments in order to respect -the @code{lval} slot mode and any existing value held in it. All such -adjustment is automatic and implied by the @code{=} operator. +A copy may entail the the adjustment of reference counts, execution of +destructors, or similar adjustments in order to respect the path through the +memory graph implied by the @code{lval}, as well as any existing value held in +the memory being written-to. All such adjustment is automatic and implied by +the @code{=} operator. An example of three different copy statements: @example @@ -2471,7 +2533,6 @@ x.y = z; x.y = z + 2; @end example -@page @node Ref.Stmt.Spawn @subsection Ref.Stmt.Spawn @c * Ref.Stmt.Spawn:: Statements creating new tasks. @@ -2483,8 +2544,8 @@ function. The called function is referred to as the @dfn{entry function} for the spawned task, and its arguments are copied form the spawning task to the spawned task before the spawned task begins execution. -Only arguments of interior or exterior mode are permitted in the function -called by a spawn statement, not arguments with alias mode. +Functions taking alias-slot arguments, or returning non-nil values, cannot be +spawned. Iterators cannot be spawned. The result of a @code{spawn} statement is a @code{task} value. @@ -2502,7 +2563,6 @@ auto result <- out; @end example -@page @node Ref.Stmt.Send @subsection Ref.Stmt.Send @c * Ref.Stmt.Send:: Statements for sending a value into a channel. @@ -2533,7 +2593,6 @@ chan[str] c = @dots{}; c <| "hello, world"; @end example -@page @node Ref.Stmt.Flush @subsection Ref.Stmt.Flush @c * Ref.Stmt.Flush:: Statement for flushing a channel queue. @@ -2550,7 +2609,6 @@ flush c; @end example -@page @node Ref.Stmt.Recv @subsection Ref.Stmt.Recv @c * Ref.Stmt.Recv:: Statement for receiving a value from a channel. @@ -2561,8 +2619,8 @@ expression denoting a port, and applies the @emph{receive operator} @var{lval}. The statement causes the receiving task to enter the @emph{blocked reading} state until a task is sending a value to the port, at which point the runtime pseudo-randomly selects a sending task and copies a value from the -head of one of the task queues to the receiving slot, and un-blocks the -receiving task. @xref{Ref.Run.Comm}. +head of one of the task queues to the receiving location in memory, and +un-blocks the receiving task. @xref{Ref.Run.Comm}. An example of a @emph{receive}: @example @@ -2570,13 +2628,13 @@ port[str] p = @dots{}; let str s <- p; @end example -@page @node Ref.Stmt.Call @subsection Ref.Stmt.Call @c * Ref.Stmt.Call:: Statement for calling a function. A @dfn{call statement} invokes a function, providing a tuple of input slots -and a reference to an output slot. If the function eventually returns, then +and an alias slot to serve as the function's output, bound to the @var{lval} +on the right hand side of the call. If the function eventually returns, then the statement completes. A call statement statically requires that the precondition declared in the @@ -2588,7 +2646,6 @@ An example of a call statement: let int x = add(1, 2); @end example -@page @node Ref.Stmt.Bind @subsection Ref.Stmt.Bind @c * Ref.Stmt.Bind:: Statement for binding arguments to functions. @@ -2596,7 +2653,7 @@ let int x = add(1, 2); A @dfn{bind statement} constructs a new function from an existing function.@footnote{The @code{bind} statement is analogous to the @code{bind} expression in the Sather language.} The new function has zero or more of its -arguments @emph{bound} into a new, hidden exterior tuple that holds the +arguments @emph{bound} into a new, hidden boxed tuple that holds the bindings. For each concrete argument passed in the @code{bind} statement, the corresponding parameter in the existing function is @emph{omitted} as a parameter of the new function. For each argument passed the placeholder symbol @@ -2624,11 +2681,9 @@ check (add(4,5) == add5(4)); @end example A @code{bind} statement generally stores a copy of the bound arguments in the -hidden exterior tuple. For bound interior slots and alias slots in the bound -function signature, an interior slot is allocated in the hidden tuple and -populated with a copy of the bound value. For bound exterior slots in the -bound function signature, an exterior slot is allocated in the hidden tuple -and populated with a copy of the bound value, an exterior (pointer) value. +hidden, boxed tuple, owned by the resulting first-class function. For each +bound slot in the bound function's signature, space is allocated in the hidden +tuple and populated with a copy of the bound value. The @code{bind} statement is a lightweight mechanism for simulating the more elaborate construct of @emph{lexical closures} that exist in other @@ -2636,16 +2691,14 @@ languages. Rust has no support for lexical closures, but many realistic uses of them can be achieved with @code{bind} statements. -@page @node Ref.Stmt.Ret @subsection Ref.Stmt.Ret @c * Ref.Stmt.Ret:: Statement for stopping and producing a value. -Executing a @code{ret} statement@footnote{A @code{ret} statement is -analogous to a @code{return} statement in the C family.} copies a -value into the return slot of the current function, destroys the -current function activation frame, and transfers control to the caller -frame. +Executing a @code{ret} statement@footnote{A @code{ret} statement is analogous +to a @code{return} statement in the C family.} copies a value into the output +slot of the current function, destroys the current function activation frame, +and transfers control to the caller frame. An example of a @code{ret} statement: @example @@ -2657,7 +2710,6 @@ fn max(int a, int b) -> int @{ @} @end example -@page @node Ref.Stmt.Be @subsection Ref.Stmt.Be @c * Ref.Stmt.Be:: Statement for stopping and executing a tail call. @@ -2687,27 +2739,25 @@ copy of itself. -@page @node Ref.Stmt.Put @subsection Ref.Stmt.Put @c * Ref.Stmt.Put:: Statement for pausing and producing a value. -Executing a @code{put} statement copies a value into the put slot of the +Executing a @code{put} statement copies a value into the output slot of the current iterator, suspends execution of the current iterator, and transfers control to the current put-recipient frame. A @code{put} statement is only valid within an iterator. @footnote{A -@code{put} statement is analogous to a @code{yield} statement in the CLU, -Sather and Objective C 2.0 languages, or in more recent languages providing a -``generator'' facility, such as Python, Javascript or C#. Like the generators -of CLU, Sather and Objective C 2.0, but @emph{unlike} these later languages, -Rust's iterators reside on the stack and obey a strict stack discipline.} The -current put-recipient will eventually resume the suspended iterator containing -the @code{put} statement, either continuing execution after the @code{put} -statement, or terminating its execution and destroying the iterator frame. +@code{put} statement is analogous to a @code{yield} statement in the CLU, and +Sather languages, or in more recent languages providing a ``generator'' +facility, such as Python, Javascript or C#. Like the generators of CLU and +Sather but @emph{unlike} these later languages, Rust's iterators reside on the +stack and obey a strict stack discipline.} The current put-recipient will +eventually resume the suspended iterator containing the @code{put} statement, +either continuing execution after the @code{put} statement, or terminating its +execution and destroying the iterator frame. -@page @node Ref.Stmt.Fail @subsection Ref.Stmt.Fail @c * Ref.Stmt.Fail:: Statement for causing task failure. @@ -2717,7 +2767,6 @@ state. In the @emph{failing} state, a task unwinds its stack, destroying all frames and freeing all resources until it reaches its entry frame, at which point it halts execution in the @emph{dead} state. -@page @node Ref.Stmt.Log @subsection Ref.Stmt.Log @c * Ref.Stmt.Log:: Statement for logging values to diagnostic buffers. @@ -2735,7 +2784,6 @@ contains a log statement. @example @end example -@page @node Ref.Stmt.Note @subsection Ref.Stmt.Note @c * Ref.Stmt.Note:: Statement for logging values during failure. @@ -2772,15 +2820,13 @@ In this example, if the task fails while attempting to open or read a file, the runtime will log the path name that was being read. If the function completes normally, the runtime will not log the path. -A slot that is marked by a @code{note} statement does @emph{not} have its -value copied aside when control passes through the @code{note}. In other -words, if a @code{note} statement notes a particular slot, and code after the -@code{note} that slot, and then a subsequent failure occurs, the -@emph{mutated} value will be logged during unwinding, @emph{not} the original -value that was held in the slot at the moment control passed through the -@code{note} statement. +A value that is marked by a @code{note} statement is @emph{not} copied aside +when control passes through the @code{note}. In other words, if a @code{note} +statement notes a particular @var{lval}, and code after the @code{note} that +slot, and then a subsequent failure occurs, the @emph{mutated} value will be +logged during unwinding, @emph{not} the original value that was denoted by the +@var{lval} at the moment control passed through the @code{note} statement. -@page @node Ref.Stmt.While @subsection Ref.Stmt.While @c * Ref.Stmt.While:: Statement for simple conditional looping. @@ -2815,7 +2861,6 @@ do @{ @} while (i < 10); @end example -@page @node Ref.Stmt.Break @subsection Ref.Stmt.Break @c * Ref.Stmt.Break:: Statement for terminating a loop. @@ -2823,7 +2868,6 @@ do @{ Executing a @code{break} statement immediately terminates the innermost loop enclosing it. It is only permitted in the body of a loop. -@page @node Ref.Stmt.Cont @subsection Ref.Stmt.Cont @c * Ref.Stmt.Cont:: Statement for terminating a single loop iteration. @@ -2838,7 +2882,6 @@ loop. A @code{cont} statement is only permitted in the body of a loop. -@page @node Ref.Stmt.For @subsection Ref.Stmt.For @c * Ref.Stmt.For:: Statement for looping over strings and vectors. @@ -2871,7 +2914,6 @@ for (&foo e in v) @{ @} @end example -@page @node Ref.Stmt.Foreach @subsection Ref.Stmt.Foreach @c * Ref.Stmt.Foreach:: Statement for general conditional looping. @@ -2890,7 +2932,6 @@ for each (&str s = _str.split(txt, "\n")) @{ @end example -@page @node Ref.Stmt.If @subsection Ref.Stmt.If @c * Ref.Stmt.If:: Statement for simple conditional branching. @@ -2903,7 +2944,6 @@ to @code{true}, the consequent block is executed and any @code{else} block is skipped. If the condition expression evaluates to @code{false}, the consequent block is skipped and any @code{else} block is executed. -@page @node Ref.Stmt.Alt @subsection Ref.Stmt.Alt @c * Ref.Stmt.Alt:: Statement for complex conditional branching. @@ -2926,7 +2966,6 @@ statement following the @code{alt} when the case block completes. * Ref.Stmt.Alt.Type:: Statement for branching on types. @end menu -@page @node Ref.Stmt.Alt.Comm @subsubsection Ref.Stmt.Alt.Comm @c * Ref.Stmt.Alt.Comm:: Statement for branching on communication events. @@ -2960,7 +2999,6 @@ alt @{ @} @end example -@page @node Ref.Stmt.Alt.Pat @subsubsection Ref.Stmt.Alt.Pat @c * Ref.Stmt.Alt.Pat:: Statement for branching on pattern matches. @@ -3000,7 +3038,6 @@ alt (x) @{ @end example -@page @node Ref.Stmt.Alt.Type @subsubsection Ref.Stmt.Alt.Type @c * Ref.Stmt.Alt.Type:: Statement for branching on type. @@ -3034,7 +3071,6 @@ alt type (x) @{ @end example -@page @node Ref.Stmt.Prove @subsection Ref.Stmt.Prove @c * Ref.Stmt.Prove:: Statement for static assertion of typestate. @@ -3044,7 +3080,6 @@ check (and document) that its argument constraint holds at its statement entry point. If its argument typestate does not hold, under the typestate algorithm, the program containing it will fail to compile. -@page @node Ref.Stmt.Check @subsection Ref.Stmt.Check @c * Ref.Stmt.Check:: Statement for dynamic assertion of typestate. @@ -3086,7 +3121,6 @@ fn test() @{ @} @end example -@page @node Ref.Stmt.IfCheck @subsection Ref.Stmt.IfCheck @c * Ref.Stmt.IfCheck:: Statement for dynamic testing of typestate. @@ -3124,7 +3158,7 @@ if check even(x) @{ The Rust @dfn{runtime} is a relatively compact collection of C and Rust code that provides fundamental services and datatypes to all Rust tasks at run-time. It is smaller and simpler than many modern language runtimes. It is -tightly integrated into the language's execution model of slots, tasks, +tightly integrated into the language's execution model of memory, tasks, communication, reflection, logging and signal handling. @menu @@ -3136,7 +3170,6 @@ communication, reflection, logging and signal handling. * Ref.Run.Sig:: Runtime signal handler. @end menu -@page @node Ref.Run.Mem @subsection Ref.Run.Mem @c * Ref.Run.Mem:: Runtime memory management service. @@ -3149,9 +3182,8 @@ of the C runtime functions @code{malloc} and @code{free}. The runtime memory-management system in turn supplies Rust tasks with facilities for allocating, extending and releasing stacks, as well as -allocating and freeing exterior values. +allocating and freeing boxed values. -@page @node Ref.Run.Type @subsection Ref.Run.Type @c * Ref.Run.Mem:: Runtime built-in type services. @@ -3168,7 +3200,6 @@ The runtime provides C and Rust code to manage several built-in types: Support for other built-in types such as simple types, tuples, records, and tags is open-coded by the Rust compiler. -@page @node Ref.Run.Comm @subsection Ref.Run.Comm @c * Ref.Run.Comm:: Runtime communication service. @@ -3179,7 +3210,6 @@ queues, as well as code to copy values between queues and their recipients and to serialize values for transmission over operating-system inter-process communication facilities. -@page @node Ref.Run.Refl @subsection Ref.Run.Refl @c * Ref.Run.Refl:: Runtime reflection system. @@ -3188,7 +3218,6 @@ The runtime reflection system is driven by the DWARF tables emitted into a crate at compile-time. Reflecting on a slot or item allocates a Rust data structure corresponding to the DWARF DIE for that slot or item. -@page @node Ref.Run.Log @subsection Ref.Run.Log @c * Ref.Run.Log:: Runtime logging system. @@ -3219,7 +3248,6 @@ ownership-path-prefix basis. Logging is integrated into the language for efficiency reasons, as well as the need to filter logs based on these two built-in dimensions. -@page @node Ref.Run.Sig @subsection Ref.Run.Sig @c * Ref.Run.Sig:: Runtime signal handler. diff --git a/src/Makefile b/src/Makefile index 2c06b5f5..fa02a2a2 100644 --- a/src/Makefile +++ b/src/Makefile @@ -356,6 +356,7 @@ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \ complex.rs \ dead-code-one-arm-if.rs \ deep.rs \ + deref.rs \ div-mod.rs \ drop-on-ret.rs \ else-if.rs \ @@ -544,6 +545,9 @@ check: tidy \ $(TEST_RPASS_OUTS_X86) $(TEST_RFAIL_OUTS_X86) \ $(TEST_CFAIL_OUTS_X86) +compile-check: tidy \ + $(TEST_RPASS_EXES_X86) $(TEST_RFAIL_EXES_X86) + ifeq ($(VARIANT),llvm) ALL_TEST_CRATES += $(TEST_CFAIL_CRATES_LLVM) \ @@ -565,27 +569,33 @@ endif REQ := $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) BOOT := $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -test/run-pass/%.out: test/run-pass/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME) +# Cancel the implicit .out rule in GNU make. +%.out: % + +%.out: %.out.tmp + $(CFG_QUIET)mv $< $@ + +test/run-pass/%.out.tmp: test/run-pass/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME) @$(call CFG_ECHO, run: $<) $(CFG_QUIET)$(call CFG_RUN_TARG, $<) > $@ -test/run-fail/%.out: test/run-fail/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME) +test/run-fail/%.out.tmp: test/run-fail/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME) @$(call CFG_ECHO, run: $<) $(CFG_QUIET)rm -f $@ $(CFG_QUIET)$(call CFG_RUN_TARG, $<) >$@ 2>&1 ; X=$$? ; \ if [ $$X -eq 0 ] ; then exit 1 ; else exit 0 ; fi $(CFG_QUIET)grep --text --quiet \ "`awk -F: '/error-pattern/ { print $$2 }' \ - $(basename $(basename $@)).rs | tr -d '\n\r'`" $@ + $(basename $(basename $(basename $@))).rs | tr -d '\n\r'`" $@ -test/compile-fail/%.x86.out: test/compile-fail/%.rs $(REQ) +test/compile-fail/%.x86.out.tmp: test/compile-fail/%.rs $(REQ) @$(call CFG_ECHO, compile [x86]: $<) $(CFG_QUIET)rm -f $@ $(BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true $(CFG_QUIET)grep --text --quiet \ "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@ -test/compile-fail/%.llvm.out: test/compile-fail/%.rs $(REQ) +test/compile-fail/%.llvm.out.tmp: test/compile-fail/%.rs $(REQ) @$(call CFG_ECHO, compile [llvm]: $<) $(CFG_QUIET)rm -f $@ $(BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true diff --git a/src/boot/be/abi.ml b/src/boot/be/abi.ml index 9108a182..44f9761b 100644 --- a/src/boot/be/abi.ml +++ b/src/boot/be/abi.ml @@ -26,20 +26,20 @@ let frame_glue_fns_field_mark = 0;; let frame_glue_fns_field_drop = 1;; let frame_glue_fns_field_reloc = 2;; -let exterior_rc_slot_field_refcnt = 0;; -let exterior_rc_slot_field_body = 1;; +let box_rc_slot_field_refcnt = 0;; +let box_rc_slot_field_body = 1;; -let exterior_gc_slot_alloc_base = (-3);; -let exterior_gc_slot_field_prev = (-3);; -let exterior_gc_slot_field_next = (-2);; -let exterior_gc_slot_field_ctrl = (-1);; -let exterior_gc_slot_field_refcnt = 0;; -let exterior_gc_slot_field_body = 1;; +let box_gc_slot_alloc_base = (-3);; +let box_gc_slot_field_prev = (-3);; +let box_gc_slot_field_next = (-2);; +let box_gc_slot_field_ctrl = (-1);; +let box_gc_slot_field_refcnt = 0;; +let box_gc_slot_field_body = 1;; -let exterior_rc_header_size = 1;; -let exterior_gc_header_size = 4;; +let box_rc_header_size = 1;; +let box_gc_header_size = 4;; -let exterior_gc_malloc_return_adjustment = 3;; +let box_gc_malloc_return_adjustment = 3;; let stk_field_valgrind_id = 0 + 1;; let stk_field_limit = stk_field_valgrind_id + 1;; diff --git a/src/boot/be/x86.ml b/src/boot/be/x86.ml index 182096ed..d18cf11f 100644 --- a/src/boot/be/x86.ml +++ b/src/boot/be/x86.ml @@ -829,7 +829,7 @@ let sweep_gc_chain emit (Il.jmp Il.JE (codefix exit_jmp_fix)); (* if nonzero *) mov (rc ecx) (* Load GC ctrl word *) - (c (edi_n Abi.exterior_gc_slot_field_ctrl)); + (c (edi_n Abi.box_gc_slot_field_ctrl)); mov (rc eax) (ro ecx); band (rc eax) (immi 1L); (* Extract mark to eax. *) band (* Clear mark in ecx. *) @@ -839,7 +839,7 @@ let sweep_gc_chain if clear_mark then mov (* Write-back cleared. *) - ((edi_n Abi.exterior_gc_slot_field_ctrl)) + ((edi_n Abi.box_gc_slot_field_ctrl)) (ro ecx); emit (Il.cmp (ro eax) (immi 0L)); @@ -870,7 +870,7 @@ let sweep_gc_chain mark skip_jmp_fix; mov (rc edi) (* Advance down chain *) - (c (edi_n Abi.exterior_gc_slot_field_next)); + (c (edi_n Abi.box_gc_slot_field_next)); emit (Il.jmp Il.JMP (codefix repeat_jmp_fix)); (* loop *) mark exit_jmp_fix; @@ -901,7 +901,7 @@ let gc_glue (* The sweep pass has two sub-passes over the GC chain: * * - In pass #1, 'severing', we goes through and disposes of all - * mutable exterior slots in each record. That is, rc-- the referent, + * mutable box slots in each record. That is, rc-- the referent, * and then null-out. If the rc-- gets to zero, that just means the * mutable is part of the garbage set currently being collected. But * a mutable may be live-and-outside; this detaches the garbage set diff --git a/src/boot/driver/llvm/glue.ml b/src/boot/driver/llvm/glue.ml index ef5c1c86..30fce0cd 100644 --- a/src/boot/driver/llvm/glue.ml +++ b/src/boot/driver/llvm/glue.ml @@ -16,8 +16,8 @@ let alt_pipeline sess sem_cx crate = [| Resolve.process_crate; Type.process_crate; - Effect.process_crate; Typestate.process_crate; + Effect.process_crate; Loop.process_crate; Alias.process_crate; Dead.process_crate; diff --git a/src/boot/driver/main.ml b/src/boot/driver/main.ml index 8cfe4048..5655604d 100644 --- a/src/boot/driver/main.ml +++ b/src/boot/driver/main.ml @@ -316,8 +316,8 @@ let main_pipeline _ = exit_if_failed ()) [| Resolve.process_crate; Type.process_crate; - Effect.process_crate; Typestate.process_crate; + Effect.process_crate; Loop.process_crate; Alias.process_crate; Dead.process_crate; diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml index 770b57bf..92aad667 100644 --- a/src/boot/fe/ast.ml +++ b/src/boot/fe/ast.ml @@ -9,11 +9,6 @@ open Common;; open Fmt;; -(* - * Slot names are given by a dot-separated path within the current - * module namespace. - *) - type ident = string ;; @@ -70,11 +65,11 @@ and ty = | TY_str | TY_tup of ty_tup - | TY_vec of slot + | TY_vec of ty | TY_rec of ty_rec (* - * Note that ty_idx is only valid inside a slot of a ty_iso group, not + * Note that ty_idx is only valid inside a ty of a ty_iso group, not * in a general type term. *) | TY_tag of ty_tag @@ -93,18 +88,25 @@ and ty = | TY_named of name | TY_type + | TY_box of ty + | TY_mutable of ty + | TY_constrained of (ty * constrs) +(* + * FIXME: this should be cleaned up to be a different + * type definition. Only args can be by-ref, only locals + * can be auto. The structure here is historical. + *) + and mode = - MODE_exterior - | MODE_interior + | MODE_local | MODE_alias and slot = { slot_mode: mode; - slot_mutable: bool; slot_ty: ty option; } -and ty_tup = slot array +and ty_tup = ty array (* In closed type terms a constraint may refer to components of the term by * anchoring off the "formal symbol" '*', which represents "the term this @@ -147,7 +149,7 @@ and constr = and constrs = constr array -and ty_rec = (ident * slot) array +and ty_rec = (ident * ty) array (* ty_tag is a sum type. * @@ -185,9 +187,9 @@ and ty_obj = (effect * ((ident,ty_fn) Hashtbl.t)) and check_calls = (lval * (atom array)) array -and rec_input = (ident * mode * bool * atom) +and rec_input = (ident * atom) -and tup_input = (mode * bool * atom) +and tup_input = atom and stmt' = @@ -195,10 +197,11 @@ and stmt' = STMT_spawn of (lval * domain * lval * (atom array)) | STMT_init_rec of (lval * (rec_input array) * lval option) | STMT_init_tup of (lval * (tup_input array)) - | STMT_init_vec of (lval * slot * (atom array)) + | STMT_init_vec of (lval * atom array) | STMT_init_str of (lval * string) | STMT_init_port of lval | STMT_init_chan of (lval * (lval option)) + | STMT_init_box of (lval * atom) | STMT_copy of (lval * expr) | STMT_copy_binop of (lval * binop * atom) | STMT_call of (lval * lval * (atom array)) @@ -334,6 +337,7 @@ and lit = and lval_component = COMP_named of name_component | COMP_atom of atom + | COMP_deref (* identifying the name_base here is sufficient to identify the full lval *) @@ -406,7 +410,7 @@ and obj = and ty_param = ident * (ty_param_idx * effect) and mod_item' = - MOD_ITEM_type of ty + MOD_ITEM_type of (effect * ty) | MOD_ITEM_tag of (header_tup * ty_tag * node_id) | MOD_ITEM_mod of (mod_view * mod_items) | MOD_ITEM_fn of fn @@ -516,24 +520,36 @@ and fmt_name (ff:Format.formatter) (n:name) : unit = fmt ff "."; fmt_name_component ff nc -and fmt_mutable (ff:Format.formatter) (m:bool) : unit = - if m - then fmt ff "mutable "; - and fmt_mode (ff:Format.formatter) (m:mode) : unit = match m with - MODE_exterior -> fmt ff "@@" | MODE_alias -> fmt ff "&" - | MODE_interior -> () + | MODE_local -> () and fmt_slot (ff:Format.formatter) (s:slot) : unit = match s.slot_ty with None -> fmt ff "auto" | Some t -> - fmt_mutable ff s.slot_mutable; fmt_mode ff s.slot_mode; fmt_ty ff t +and fmt_tys + (ff:Format.formatter) + (tys:ty array) + : unit = + fmt_bracketed_arr_sep "(" ")" "," fmt_ty ff tys + +and fmt_ident_tys + (ff:Format.formatter) + (entries:(ident * ty) array) + : unit = + fmt_bracketed_arr_sep "(" ")" "," + (fun ff (ident, ty) -> + fmt_ty ff ty; + fmt ff " "; + fmt_ident ff ident) + ff + entries + and fmt_slots (ff:Format.formatter) (slots:slot array) @@ -594,7 +610,7 @@ and fmt_tag (ff:Format.formatter) (ttag:ty_tag) : unit = then first := false else fmt ff ",@ "); fmt_name ff name; - fmt_slots ff ttup None + fmt_tys ff ttup end ttag; fmt ff "@])@]" @@ -623,19 +639,15 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit = | TY_char -> fmt ff "char" | TY_str -> fmt ff "str" - | TY_tup slots -> (fmt ff "tup"; fmt_slots ff slots None) - | TY_vec s -> (fmt ff "vec["; fmt_slot ff s; fmt ff "]") + | TY_tup tys -> (fmt ff "tup"; fmt_tys ff tys) + | TY_vec t -> (fmt ff "vec["; fmt_ty ff t; fmt ff "]") | TY_chan t -> (fmt ff "chan["; fmt_ty ff t; fmt ff "]") | TY_port t -> (fmt ff "port["; fmt_ty ff t; fmt ff "]") - | TY_rec slots -> - let (idents, slots) = - let (idents, slots) = List.split (Array.to_list slots) in - (Array.of_list idents, Array.of_list slots) - in - fmt ff "@[rec"; - fmt_slots ff slots (Some idents); - fmt ff "@]" + | TY_rec entries -> + fmt ff "@[rec"; + fmt_ident_tys ff entries; + fmt ff "@]" | TY_param (i, e) -> (fmt_effect ff e; if e <> PURE then fmt ff " "; @@ -644,6 +656,14 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit = | TY_named n -> fmt_name ff n | TY_type -> fmt ff "type" + | TY_box t -> + fmt ff "@@"; + fmt_ty ff t + + | TY_mutable t -> + fmt ff "mutable "; + fmt_ty ff t + | TY_fn tfn -> fmt_ty_fn ff None tfn | TY_task -> fmt ff "task" | TY_tag ttag -> fmt_tag ff ttag @@ -843,24 +863,23 @@ and fmt_atom_opts (ff:Format.formatter) (az:(atom option) array) : unit = az; fmt ff ")" -and fmt_lval_component (ff:Format.formatter) (lvc:lval_component) : unit = - match lvc with - COMP_named nc -> fmt_name_component ff nc - | COMP_atom a -> - begin - fmt ff "("; - fmt_atom ff a; - fmt ff ")" - end - and fmt_lval (ff:Format.formatter) (l:lval) : unit = match l with LVAL_base nbi -> fmt_name_base ff nbi.node | LVAL_ext (lv, lvc) -> begin - fmt_lval ff lv; - fmt ff "."; - fmt_lval_component ff lvc + match lvc with + COMP_named nc -> + fmt_lval ff lv; + fmt ff "."; + fmt_name_component ff nc + | COMP_atom a -> + fmt_lval ff lv; + fmt ff "."; + fmt_bracketed "(" ")" fmt_atom ff a; + | COMP_deref -> + fmt ff "*"; + fmt_lval ff lv end and fmt_stmt (ff:Format.formatter) (s:stmt) : unit = @@ -964,7 +983,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = fmt_lval ff lv; fmt ff " "; fmt_binop ff binop; - fmt ff "="; + fmt ff "= "; fmt_atom ff at; fmt ff ";" @@ -999,11 +1018,9 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = do if i != 0 then fmt ff ", "; - let (ident, mode, mut, atom) = entries.(i) in + let (ident, atom) = entries.(i) in fmt_ident ff ident; fmt ff " = "; - fmt_mutable ff mut; - fmt_mode ff mode; fmt_atom ff atom; done; begin @@ -1015,7 +1032,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = end; fmt ff ");" - | STMT_init_vec (dst, _, atoms) -> + | STMT_init_vec (dst, atoms) -> fmt_lval ff dst; fmt ff " = vec("; for i = 0 to (Array.length atoms) - 1 @@ -1028,15 +1045,12 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = | STMT_init_tup (dst, entries) -> fmt_lval ff dst; - fmt ff " = ("; + fmt ff " = tup("; for i = 0 to (Array.length entries) - 1 do if i != 0 then fmt ff ", "; - let (mode, mut, atom) = entries.(i) in - fmt_mutable ff mut; - fmt_mode ff mode; - fmt_atom ff atom; + fmt_atom ff entries.(i); done; fmt ff ");"; @@ -1153,6 +1167,12 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = fmt_lval ff t; fmt ff ";" + | STMT_init_box (lv, at) -> + fmt_lval ff lv; + fmt ff " = @@"; + fmt_atom ff at; + fmt ff ";" + | STMT_alt_tag _ -> fmt ff "?stmt_alt_tag?" | STMT_alt_type _ -> fmt ff "?stmt_alt_type?" | STMT_alt_port _ -> fmt ff "?stmt_alt_port?" @@ -1160,6 +1180,13 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = | STMT_slice _ -> fmt ff "?stmt_slice?" end +and fmt_decl_param (ff:Format.formatter) (param:ty_param) : unit = + let (ident, (i, e)) = param in + fmt_effect ff e; + if e <> PURE then fmt ff " "; + fmt_ident ff ident; + fmt ff "=<p#%d>" i + and fmt_decl_params (ff:Format.formatter) (params:ty_param array) : unit = if Array.length params = 0 then () @@ -1170,11 +1197,7 @@ and fmt_decl_params (ff:Format.formatter) (params:ty_param array) : unit = do if i <> 0 then fmt ff ", "; - let (ident, (i, e)) = params.(i) in - fmt_effect ff e; - if e <> PURE then fmt ff " "; - fmt_ident ff ident; - fmt ff "=<p#%d>" i + fmt_decl_param ff params.(i) done; fmt ff "]" end; @@ -1192,6 +1215,10 @@ and fmt_ident_and_params fmt_ident ff id; fmt_decl_params ff params +and fmt_effect_qual (ff:Format.formatter) (e:effect) : unit = + fmt_effect ff e; + if e <> PURE then fmt ff " "; + and fmt_fn (ff:Format.formatter) (id:ident) @@ -1199,8 +1226,7 @@ and fmt_fn (f:fn) : unit = fmt_obox ff; - fmt_effect ff f.fn_aux.fn_effect; - if f.fn_aux.fn_effect <> PURE then fmt ff " "; + fmt_effect_qual ff f.fn_aux.fn_effect; fmt ff "%s "(if f.fn_aux.fn_is_iter then "iter" else "fn"); fmt_ident_and_params ff id params; fmt_header_slots ff f.fn_input_slots; @@ -1220,8 +1246,7 @@ and fmt_obj (obj:obj) : unit = fmt_obox ff; - fmt_effect ff obj.obj_effect; - if obj.obj_effect <> PURE then fmt ff " "; + fmt_effect_qual ff obj.obj_effect; fmt ff "obj "; fmt_ident_and_params ff id params; fmt_header_slots ff obj.obj_state; @@ -1257,7 +1282,8 @@ and fmt_mod_item (ff:Format.formatter) (id:ident) (item:mod_item) : unit = let params = Array.map (fun i -> i.node) params in begin match item.node.decl_item with - MOD_ITEM_type ty -> + MOD_ITEM_type (e, ty) -> + fmt_effect_qual ff e; fmt ff "type "; fmt_ident_and_params ff id params; fmt ff " = "; @@ -1316,22 +1342,24 @@ and fmt_crate (ff:Format.formatter) (c:crate) : unit = let sprintf_expr = sprintf_fmt fmt_expr;; let sprintf_name = sprintf_fmt fmt_name;; +let sprintf_name_component = sprintf_fmt fmt_name_component;; let sprintf_lval = sprintf_fmt fmt_lval;; -let sprintf_lval_component = sprintf_fmt fmt_lval_component;; let sprintf_atom = sprintf_fmt fmt_atom;; let sprintf_slot = sprintf_fmt fmt_slot;; let sprintf_slot_key = sprintf_fmt fmt_slot_key;; -let sprintf_mutable = sprintf_fmt fmt_mutable;; let sprintf_ty = sprintf_fmt fmt_ty;; let sprintf_effect = sprintf_fmt fmt_effect;; let sprintf_tag = sprintf_fmt fmt_tag;; let sprintf_carg = sprintf_fmt fmt_carg;; let sprintf_constr = sprintf_fmt fmt_constr;; -let sprintf_stmt = sprintf_fmt fmt_stmt;; let sprintf_mod_items = sprintf_fmt fmt_mod_items;; +let sprintf_decl_param = sprintf_fmt fmt_decl_param;; let sprintf_decl_params = sprintf_fmt fmt_decl_params;; let sprintf_app_args = sprintf_fmt fmt_app_args;; +(* You probably want this one; stmt has a leading \n *) +let sprintf_stmt = sprintf_fmt fmt_stmt_body;; + (* * Local Variables: * fill-column: 78; diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml index 3efd4e2a..130909e2 100644 --- a/src/boot/fe/item.ml +++ b/src/boot/fe/item.ml @@ -128,6 +128,13 @@ and parse_auto_slot_and_init and parse_stmts (ps:pstate) : Ast.stmt array = let apos = lexpos ps in + let ensure_mutable slot = + match slot.Ast.slot_ty with + None -> slot + | Some (Ast.TY_mutable _) -> slot + | Some t -> { slot with Ast.slot_ty = Some (Ast.TY_mutable t) } + in + let rec name_to_lval (apos:pos) (bpos:pos) (name:Ast.name) : Ast.lval = match name with @@ -235,8 +242,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array = match name with Ast.NAME_base (Ast.BASE_ident ident) -> let slot = - { Ast.slot_mode = Ast.MODE_interior; - Ast.slot_mutable = false; + { Ast.slot_mode = Ast.MODE_local; Ast.slot_ty = None } in Ast.PAT_slot @@ -456,7 +462,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array = bump ps; let (stmts, slot, ident) = ctxt "stmt slot" parse_slot_and_ident_and_init ps in - let slot = Pexp.apply_mutability slot true in + let slot = ensure_mutable slot in let bpos = lexpos ps in let decl = Ast.DECL_slot (Ast.KEY_ident ident, (span ps apos bpos slot)) @@ -467,7 +473,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array = bump ps; let (stmts, slot, ident) = ctxt "stmt slot" parse_auto_slot_and_init ps in - let slot = Pexp.apply_mutability slot true in + let slot = ensure_mutable slot in let bpos = lexpos ps in let decl = Ast.DECL_slot (Ast.KEY_ident ident, (span ps apos bpos slot)) @@ -754,6 +760,20 @@ and parse_obj_item span ps apos bpos (decl params (Ast.MOD_ITEM_obj obj))) +and parse_type_item + (ps:pstate) + (apos:pos) + (effect:Ast.effect) + : (Ast.ident * Ast.mod_item) = + expect ps TYPE; + let (ident, params) = parse_ident_and_params ps "type" in + let _ = expect ps EQ in + let ty = ctxt "mod type item: ty" Pexp.parse_ty ps in + let _ = expect ps SEMI in + let bpos = lexpos ps in + let item = Ast.MOD_ITEM_type (effect, ty) in + (ident, span ps apos bpos (decl params item)) + and parse_mod_item (ps:pstate) : (Ast.ident * Ast.mod_item) = let apos = lexpos ps in @@ -769,13 +789,15 @@ and parse_mod_item (ps:pstate) : (Ast.ident * Ast.mod_item) = | _ -> ps.pstate_infer_lib_name ident in + match peek ps with - IO | STATE | UNSAFE | OBJ | FN | ITER -> + IO | STATE | UNSAFE | TYPE | OBJ | FN | ITER -> let effect = Pexp.parse_effect ps in begin match peek ps with OBJ -> parse_obj_item ps apos effect + | TYPE -> parse_type_item ps apos effect | _ -> let is_iter = (peek ps) = ITER in bump ps; @@ -789,16 +811,6 @@ and parse_mod_item (ps:pstate) : (Ast.ident * Ast.mod_item) = (decl params (Ast.MOD_ITEM_fn fn))) end - | TYPE -> - bump ps; - let (ident, params) = parse_ident_and_params ps "type" in - let _ = expect ps EQ in - let ty = ctxt "mod type item: ty" Pexp.parse_ty ps in - let _ = expect ps SEMI in - let bpos = lexpos ps in - let item = Ast.MOD_ITEM_type ty in - (ident, span ps apos bpos (decl params item)) - | MOD -> bump ps; let (ident, params) = parse_ident_and_params ps "mod" in @@ -958,7 +970,8 @@ and parse_mod_item_from_signature (ps:pstate) in expect ps SEMI; let bpos = lexpos ps in - (ident, span ps apos bpos (decl params (Ast.MOD_ITEM_type t))) + (ident, span ps apos bpos + (decl params (Ast.MOD_ITEM_type (Ast.UNSAFE, t)))) | _ -> raise (unexpected ps) @@ -979,7 +992,9 @@ and expand_tags (ps, "unexpected name type while expanding tag")) in let header = - Array.map (fun slot -> (clone_span ps item slot)) tup + Array.map (fun ty -> (clone_span ps item + { Ast.slot_mode = Ast.MODE_alias; + Ast.slot_ty = Some ty})) tup in let tag_item' = Ast.MOD_ITEM_tag (header, ttag, id) in let cloned_params = @@ -1000,7 +1015,7 @@ and expand_tags | _ -> [| |] in match item.node.Ast.decl_item with - Ast.MOD_ITEM_type tyd -> handle_ty_decl item.id tyd + Ast.MOD_ITEM_type (_, tyd) -> handle_ty_decl item.id tyd | _ -> [| |] diff --git a/src/boot/fe/lexer.mll b/src/boot/fe/lexer.mll index fb4d58c5..6430821d 100644 --- a/src/boot/fe/lexer.mll +++ b/src/boot/fe/lexer.mll @@ -79,6 +79,7 @@ ("int", INT); ("uint", UINT); + ("float", FLOAT); ("char", CHAR); ("str", STR); @@ -121,9 +122,10 @@ } let hexdig = ['0'-'9' 'a'-'f' 'A'-'F'] -let bin = "0b" ['0' '1']['0' '1' '_']* -let hex = "0x" hexdig ['0'-'9' 'a'-'f' 'A'-'F' '_']* -let dec = ['0'-'9']+ +let decdig = ['0'-'9'] +let bin = '0' 'b' ['0' '1' '_']* +let hex = '0' 'x' ['0'-'9' 'a'-'f' 'A'-'F' '_']* +let dec = decdig ['0'-'9' '_']* let exp = ['e''E']['-''+']? dec let flo = (dec '.' dec (exp?)) | (dec exp) @@ -160,7 +162,7 @@ rule token = parse | ">>>" { ASR } | '~' { TILDE } | '{' { LBRACE } -| '_' (dec as n) { IDX (int_of_string n) } +| '_' (decdig+ as n) { IDX (int_of_string n) } | '_' { UNDERSCORE } | '}' { RBRACE } diff --git a/src/boot/fe/parser.ml b/src/boot/fe/parser.ml index 5df44303..ab7ff56c 100644 --- a/src/boot/fe/parser.ml +++ b/src/boot/fe/parser.ml @@ -180,14 +180,12 @@ let err (str:string) (ps:pstate) = let (slot_nil:Ast.slot) = - { Ast.slot_mode = Ast.MODE_interior; - Ast.slot_mutable = false; + { Ast.slot_mode = Ast.MODE_local; Ast.slot_ty = Some Ast.TY_nil } ;; let (slot_auto:Ast.slot) = - { Ast.slot_mode = Ast.MODE_interior; - Ast.slot_mutable = true; + { Ast.slot_mode = Ast.MODE_local; Ast.slot_ty = None } ;; diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml index e859d135..14065466 100644 --- a/src/boot/fe/pexp.ml +++ b/src/boot/fe/pexp.ml @@ -22,7 +22,7 @@ type pexp' = | PEXP_bind of (pexp * pexp option array) | PEXP_rec of ((Ast.ident * pexp) array * pexp option) | PEXP_tup of (pexp array) - | PEXP_vec of (Ast.slot * (pexp array)) + | PEXP_vec of (pexp array) | PEXP_port | PEXP_chan of (pexp option) | PEXP_binop of (Ast.binop * pexp * pexp) @@ -33,7 +33,7 @@ type pexp' = | PEXP_lit of Ast.lit | PEXP_str of string | PEXP_mutable of pexp - | PEXP_exterior of pexp + | PEXP_box of pexp | PEXP_custom of Ast.name * (pexp array) * (string option) and plval = @@ -41,6 +41,7 @@ and plval = | PLVAL_app of (Ast.ident * (Ast.ty array)) | PLVAL_ext_name of (pexp * Ast.name_component) | PLVAL_ext_pexp of (pexp * pexp) + | PLVAL_ext_deref of pexp and pexp = pexp' Common.identified ;; @@ -261,11 +262,10 @@ and parse_atomic_ty (ps:pstate) : Ast.ty = | VEC -> bump ps; - Ast.TY_vec (bracketed LBRACKET RBRACKET (parse_slot false) ps) + Ast.TY_vec (bracketed LBRACKET RBRACKET parse_ty ps) | IDENT _ -> Ast.TY_named (parse_name ps) - | TAG -> bump ps; let htab = Hashtbl.create 4 in @@ -273,7 +273,7 @@ and parse_atomic_ty (ps:pstate) : Ast.ty = let ident = parse_ident ps in let tup = match peek ps with - LPAREN -> paren_comma_list (parse_slot false) ps + LPAREN -> paren_comma_list parse_ty ps | _ -> raise (err "tag variant missing argument list" ps) in htab_put htab (Ast.NAME_base (Ast.BASE_ident ident)) tup @@ -287,9 +287,8 @@ and parse_atomic_ty (ps:pstate) : Ast.ty = | REC -> bump ps; let parse_rec_entry ps = - let mut = parse_mutability ps in - let (slot, ident) = parse_slot_and_ident false ps in - (ident, apply_mutability slot mut) + let (ty, ident) = parse_ty_and_ident ps in + (ident, ty) in let entries = paren_comma_list parse_rec_entry ps in let labels = Array.map (fun (l, _) -> l) entries in @@ -300,8 +299,8 @@ and parse_atomic_ty (ps:pstate) : Ast.ty = | TUP -> bump ps; - let slots = paren_comma_list (parse_slot false) ps in - Ast.TY_tup slots + let tys = paren_comma_list parse_ty ps in + Ast.TY_tup tys | MACH m -> bump ps; @@ -333,6 +332,14 @@ and parse_atomic_ty (ps:pstate) : Ast.ty = | _ -> raise (unexpected ps) end + | AT -> + bump ps; + Ast.TY_box (parse_ty ps) + + | MUTABLE -> + bump ps; + Ast.TY_mutable (parse_ty ps) + | LPAREN -> begin bump ps; @@ -353,24 +360,15 @@ and flag (ps:pstate) (tok:token) : bool = then (bump ps; true) else false -and parse_mutability (ps:pstate) : bool = - flag ps MUTABLE - -and apply_mutability (slot:Ast.slot) (mut:bool) : Ast.slot = - { slot with Ast.slot_mutable = mut } - and parse_slot (aliases_ok:bool) (ps:pstate) : Ast.slot = - let mut = parse_mutability ps in let mode = match (peek ps, aliases_ok) with - (AT, _) -> bump ps; Ast.MODE_exterior - | (AND, true) -> bump ps; Ast.MODE_alias + (AND, true) -> bump ps; Ast.MODE_alias | (AND, false) -> raise (err "alias slot in prohibited context" ps) - | _ -> Ast.MODE_interior + | _ -> Ast.MODE_local in let ty = parse_ty ps in { Ast.slot_mode = mode; - Ast.slot_mutable = mut; Ast.slot_ty = Some ty } and parse_slot_and_ident @@ -381,6 +379,13 @@ and parse_slot_and_ident let ident = ctxt "slot and ident: ident" parse_ident ps in (slot, ident) +and parse_ty_and_ident + (ps:pstate) + : (Ast.ty * Ast.ident) = + let ty = ctxt "ty and ident: ty" parse_ty ps in + let ident = ctxt "ty and ident: ident" parse_ident ps in + (ty, ident) + and parse_slot_and_optional_ignored_ident (aliases_ok:bool) (ps:pstate) @@ -477,7 +482,7 @@ and parse_bottom_pexp (ps:pstate) : pexp = bump ps; let inner = parse_pexp ps in let bpos = lexpos ps in - span ps apos bpos (PEXP_exterior inner) + span ps apos bpos (PEXP_box inner) | TUP -> bump ps; @@ -494,16 +499,9 @@ and parse_bottom_pexp (ps:pstate) : pexp = | VEC -> bump ps; begin - let slot = - match peek ps with - LBRACKET -> bracketed LBRACKET RBRACKET (parse_slot false) ps - | _ -> { Ast.slot_mode = Ast.MODE_interior; - Ast.slot_mutable = false; - Ast.slot_ty = None } - in let pexps = ctxt "vec pexp: exprs" parse_pexp_list ps in let bpos = lexpos ps in - span ps apos bpos (PEXP_vec (slot, pexps)) + span ps apos bpos (PEXP_vec pexps) end @@ -588,6 +586,13 @@ and parse_bottom_pexp (ps:pstate) : pexp = end end + + | STAR -> + bump ps; + let inner = parse_pexp ps in + let bpos = lexpos ps in + span ps apos bpos (PEXP_lval (PLVAL_ext_deref inner)) + | (INT | UINT | CHAR | BOOL) as tok -> begin bump ps; @@ -1030,6 +1035,11 @@ let rec desugar_lval (ps:pstate) (pexp:pexp) : (Ast.stmt array * Ast.lval) = (Array.append base_stmts ext_stmts, Ast.LVAL_ext (base_lval, Ast.COMP_atom (clone_atom ps ext_atom))) + | PEXP_lval (PLVAL_ext_deref base_pexp) -> + let (base_stmts, base_atom) = desugar_expr_atom ps base_pexp in + let base_lval = atom_lval ps base_atom in + (base_stmts, Ast.LVAL_ext (base_lval, Ast.COMP_deref)) + | _ -> let (stmts, atom) = desugar_expr_atom ps pexp in (stmts, atom_lval ps atom) @@ -1088,7 +1098,9 @@ and desugar_expr_atom | PEXP_call _ | PEXP_bind _ | PEXP_spawn _ - | PEXP_custom _ -> + | PEXP_custom _ + | PEXP_box _ + | PEXP_mutable _ -> let (_, tmp, decl_stmt) = build_tmp ps slot_auto apos bpos in let stmts = desugar_expr_init ps tmp pexp in (Array.append [| decl_stmt |] stmts, @@ -1101,31 +1113,6 @@ and desugar_expr_atom let (stmts, lval) = desugar_lval ps pexp in (stmts, Ast.ATOM_lval lval) - | PEXP_exterior _ -> - raise (err "exterior symbol in atom context" ps) - - | PEXP_mutable _ -> - raise (err "mutable keyword in atom context" ps) - - -and desugar_expr_mode_mut_atom - (ps:pstate) - (pexp:pexp) - : (Ast.stmt array * (Ast.mode * bool * Ast.atom)) = - let desugar_inner mode mut e = - let (stmts, atom) = desugar_expr_atom ps e in - (stmts, (mode, mut, atom)) - in - match pexp.node with - PEXP_mutable {node=(PEXP_exterior e); id=_} -> - desugar_inner Ast.MODE_exterior true e - | PEXP_exterior e -> - desugar_inner Ast.MODE_exterior false e - | PEXP_mutable e -> - desugar_inner Ast.MODE_interior true e - | _ -> - desugar_inner Ast.MODE_interior false pexp - and desugar_expr_atoms (ps:pstate) (pexps:pexp array) @@ -1138,12 +1125,6 @@ and desugar_opt_expr_atoms : (Ast.stmt array * Ast.atom option array) = arj1st (Array.map (desugar_opt_expr_atom ps) pexps) -and desugar_expr_mode_mut_atoms - (ps:pstate) - (pexps:pexp array) - : (Ast.stmt array * (Ast.mode * bool * Ast.atom) array) = - arj1st (Array.map (desugar_expr_mode_mut_atom ps) pexps) - and desugar_expr_init (ps:pstate) (dst_lval:Ast.lval) @@ -1253,10 +1234,10 @@ and desugar_expr_init Array.map begin fun (ident, pexp) -> - let (stmts, (mode, mut, atom)) = - desugar_expr_mode_mut_atom ps pexp + let (stmts, atom) = + desugar_expr_atom ps pexp in - (stmts, (ident, mode, mut, atom)) + (stmts, (ident, atom)) end args end @@ -1278,19 +1259,19 @@ and desugar_expr_init end | PEXP_tup args -> - let (arg_stmts, arg_mode_atoms) = - desugar_expr_mode_mut_atoms ps args + let (arg_stmts, arg_atoms) = + desugar_expr_atoms ps args in - let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_mode_atoms)) in + let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_atoms)) in aa arg_stmts [| stmt |] | PEXP_str s -> let stmt = ss (Ast.STMT_init_str (dst_lval, s)) in [| stmt |] - | PEXP_vec (slot, args) -> + | PEXP_vec args -> let (arg_stmts, arg_atoms) = desugar_expr_atoms ps args in - let stmt = ss (Ast.STMT_init_vec (dst_lval, slot, arg_atoms)) in + let stmt = ss (Ast.STMT_init_vec (dst_lval, arg_atoms)) in aa arg_stmts [| stmt |] | PEXP_port -> @@ -1315,11 +1296,19 @@ and desugar_expr_init in aa port_stmts [| chan_stmt |] - | PEXP_exterior _ -> - raise (err "exterior symbol in initialiser context" ps) + | PEXP_box arg -> + let (arg_stmts, arg_mode_atom) = + desugar_expr_atom ps arg + in + let stmt = ss (Ast.STMT_init_box (dst_lval, arg_mode_atom)) in + aa arg_stmts [| stmt |] - | PEXP_mutable _ -> - raise (err "mutable keyword in initialiser context" ps) + | PEXP_mutable arg -> + (* Initializing a local from a "mutable" atom is the same as + * initializing it from an immutable one; all locals are mutable + * anyways. So this is just a fall-through. + *) + desugar_expr_init ps dst_lval arg | PEXP_custom (n, a, b) -> let (arg_stmts, args) = desugar_expr_atoms ps a in diff --git a/src/boot/fe/token.ml b/src/boot/fe/token.ml index 636e1ac2..446e5262 100644 --- a/src/boot/fe/token.ml +++ b/src/boot/fe/token.ml @@ -118,6 +118,7 @@ type token = | BOOL | INT | UINT + | FLOAT | CHAR | STR | MACH of Common.ty_mach @@ -267,6 +268,7 @@ let rec string_of_tok t = | BOOL -> "bool" | INT -> "int" | UINT -> "uint" + | FLOAT -> "float" | CHAR -> "char" | STR -> "str" | MACH m -> Common.string_of_ty_mach m diff --git a/src/boot/llvm/lltrans.ml b/src/boot/llvm/lltrans.ml index 7a62bb73..a7daa371 100644 --- a/src/boot/llvm/lltrans.ml +++ b/src/boot/llvm/lltrans.ml @@ -253,16 +253,24 @@ let trans_crate fn_ty void_ty (Array.append [| lloutptr; lltaskty |] llins) | Ast.TY_tup slots -> - s (Array.map (trans_slot None) slots) + s (Array.map trans_ty slots) | Ast.TY_rec entries -> - s (Array.map (fun e -> trans_slot None (snd e)) entries) + s (Array.map (fun (_, e) -> trans_ty e) entries) | Ast.TY_constrained (ty', _) -> trans_ty ty' | Ast.TY_chan _ | Ast.TY_port _ | Ast.TY_task -> p rc_opaque_ty + | Ast.TY_box t -> + (* FIXME: wrong, this needs to point to a refcounted cell. *) + p (trans_ty t) + + | Ast.TY_mutable t -> + (* FIXME: No idea if 'mutable' translates to LLVM-type. *) + (trans_ty t) + | Ast.TY_native _ -> word_ty @@ -286,10 +294,9 @@ let trans_crate in let base_llty = trans_ty ty in match slot.Ast.slot_mode with - Ast.MODE_exterior _ | Ast.MODE_alias _ -> Llvm.pointer_type base_llty - | Ast.MODE_interior _ -> base_llty + | Ast.MODE_local _ -> base_llty in let get_element_ptr @@ -320,14 +327,14 @@ let trans_crate | _ -> trans_free llbuilder lltask ptr in - let rec iter_ty_slots_full + let rec iter_ty_parts_full (llbuilder:Llvm.llbuilder ref) (ty:Ast.ty) (dst_ptr:Llvm.llvalue) (src_ptr:Llvm.llvalue) (f:(Llvm.llvalue -> Llvm.llvalue - -> Ast.slot + -> Ast.ty -> (Ast.ty_iso option) -> unit)) (curr_iso:Ast.ty_iso option) @@ -338,38 +345,38 @@ let trans_crate match ty with Ast.TY_rec entries -> - iter_rec_slots gep dst_ptr src_ptr entries f curr_iso + iter_rec_parts gep dst_ptr src_ptr entries f curr_iso - | Ast.TY_tup slots -> - iter_tup_slots gep dst_ptr src_ptr slots f curr_iso + | Ast.TY_tup tys -> + iter_tup_parts gep dst_ptr src_ptr tys f curr_iso | Ast.TY_tag _ | Ast.TY_iso _ | Ast.TY_fn _ | Ast.TY_obj _ -> - bug () "unimplemented ty in Lltrans.iter_ty_slots_full" + bug () "unimplemented ty in Lltrans.iter_ty_parts_full" | _ -> () - and iter_ty_slots + and iter_ty_parts (llbuilder:Llvm.llbuilder ref) (ty:Ast.ty) (ptr:Llvm.llvalue) - (f:Llvm.llvalue -> Ast.slot -> (Ast.ty_iso option) -> unit) + (f:Llvm.llvalue -> Ast.ty -> (Ast.ty_iso option) -> unit) (curr_iso:Ast.ty_iso option) : unit = - iter_ty_slots_full llbuilder ty ptr ptr + iter_ty_parts_full llbuilder ty ptr ptr (fun _ src_ptr slot curr_iso -> f src_ptr slot curr_iso) curr_iso and drop_ty (llbuilder:Llvm.llbuilder ref) (lltask:Llvm.llvalue) - (ty:Ast.ty) (ptr:Llvm.llvalue) + (ty:Ast.ty) (curr_iso:Ast.ty_iso option) : unit = - iter_ty_slots llbuilder ty ptr (drop_slot llbuilder lltask) curr_iso + iter_ty_parts llbuilder ty ptr (drop_ty llbuilder lltask) curr_iso and drop_slot (llbuilder:Llvm.llbuilder ref) @@ -446,7 +453,7 @@ let trans_crate llbuilder := if_ptr_in_slot_not_null (decr_refcnt_and_if_zero - Abi.exterior_rc_slot_field_refcnt + Abi.box_rc_slot_field_refcnt free_and_null_out_slot) (!llbuilder) @@ -454,14 +461,14 @@ let trans_crate llbuilder := if_ptr_in_slot_not_null (decr_refcnt_and_if_zero - Abi.exterior_rc_slot_field_refcnt + Abi.box_rc_slot_field_refcnt free_and_null_out_slot) (!llbuilder) | MEM_interior when Semant.type_is_structured ty -> (* FIXME: to handle recursive types, need to call drop glue here, not inline. *) - drop_ty llbuilder lltask ty slot_ptr curr_iso + drop_ty llbuilder lltask slot_ptr ty curr_iso | _ -> () end @@ -555,7 +562,7 @@ let trans_crate Array.iteri build_arg (Llvm.params llfn); (* Allocate space for all the blocks' slots. - * and zero the exteriors. *) + * and zero the box pointers. *) let init_block (block_id:node_id) : unit = let init_slot (key:Ast.slot_key) @@ -757,7 +764,7 @@ let trans_crate Ast.STMT_init_tup (dest, atoms) -> let zero = const_i32 0 in let lldest = trans_lval dest in - let trans_tup_atom idx (_, _, atom) = + let trans_tup_atom idx atom = let indices = [| zero; const_i32 idx |] in let gep_id = anon_llid "init_tup_gep" in let ptr = @@ -814,17 +821,18 @@ let trans_crate | Ast.STMT_log a -> begin - match Semant.atom_type sem_cx a with - (* NB: If you extend this, be sure to update the - * typechecking code in type.ml as well. *) - Ast.TY_str -> trans_log_str a - | Ast.TY_int | Ast.TY_uint | Ast.TY_bool | Ast.TY_char - | Ast.TY_mach (TY_u8) | Ast.TY_mach (TY_u16) - | Ast.TY_mach (TY_u32) | Ast.TY_mach (TY_i8) - | Ast.TY_mach (TY_i16) | Ast.TY_mach (TY_i32) -> - trans_log_int a - | _ -> Semant.bugi sem_cx head.id - "unimplemented logging type" + let aty = Semant.atom_type sem_cx a in + match Semant.simplified_ty aty with + (* NB: If you extend this, be sure to update the + * typechecking code in type.ml as well. *) + Ast.TY_str -> trans_log_str a + | Ast.TY_int | Ast.TY_uint | Ast.TY_bool | Ast.TY_char + | Ast.TY_mach (TY_u8) | Ast.TY_mach (TY_u16) + | Ast.TY_mach (TY_u32) | Ast.TY_mach (TY_i8) + | Ast.TY_mach (TY_i16) | Ast.TY_mach (TY_i32) -> + trans_log_int a + | _ -> Semant.bugi sem_cx head.id + "unimplemented logging type" end; trans_tail () diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml index 25d4ed04..2c507335 100644 --- a/src/boot/me/alias.ml +++ b/src/boot/me/alias.ml @@ -29,7 +29,7 @@ let alias_analysis_visitor let alias_atom at = match at with Ast.ATOM_lval lv -> alias lv - | _ -> err None "aliasing literal" + | _ -> () (* Aliasing a literal is harmless, if weird. *) in let alias_call_args dst callee args = @@ -67,7 +67,7 @@ let alias_analysis_visitor | Ast.STMT_recv (dst, _) -> alias dst | Ast.STMT_init_port (dst) -> alias dst | Ast.STMT_init_chan (dst, _) -> alias dst - | Ast.STMT_init_vec (dst, _, _) -> alias dst + | Ast.STMT_init_vec (dst, _) -> alias dst | Ast.STMT_init_str (dst, _) -> alias dst | Ast.STMT_for_each sfe -> let (slot, _) = sfe.Ast.for_each_slot in diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml index b7fdf309..5fd8638f 100644 --- a/src/boot/me/dwarf.ml +++ b/src/boot/me/dwarf.ml @@ -1210,6 +1210,8 @@ let (abbrev_typedef:abbrev) = (DW_TAG_typedef, DW_CHILDREN_yes, [| (DW_AT_name, DW_FORM_string); + (DW_AT_mutable, DW_FORM_flag); + (DW_AT_pure, DW_FORM_flag); (DW_AT_type, DW_FORM_ref_addr) |]) ;; @@ -1307,56 +1309,66 @@ let (abbrev_alias_slot:abbrev) = (DW_TAG_reference_type, DW_CHILDREN_no, [| (DW_AT_type, DW_FORM_ref_addr); - (DW_AT_mutable, DW_FORM_flag); |]) ;; -let (abbrev_exterior_slot:abbrev) = - (DW_TAG_reference_type, DW_CHILDREN_no, +(* FIXME: Perverse, but given dwarf's vocabulary it seems at least plausible + * that a "mutable const type" is a correct way of saying "mutable". + * Or else we make up our own. Revisit perhaps. + *) + +let (abbrev_mutable_type:abbrev) = + (DW_TAG_const_type, DW_CHILDREN_no, [| (DW_AT_type, DW_FORM_ref_addr); (DW_AT_mutable, DW_FORM_flag); + |]) +;; + +let (abbrev_box_type:abbrev) = + (DW_TAG_pointer_type, DW_CHILDREN_no, + [| + (DW_AT_type, DW_FORM_ref_addr); (DW_AT_data_location, DW_FORM_block1); |]) ;; let (abbrev_struct_type:abbrev) = - (DW_TAG_structure_type, DW_CHILDREN_yes, - [| - (DW_AT_byte_size, DW_FORM_block4) - |]) + (DW_TAG_structure_type, DW_CHILDREN_yes, + [| + (DW_AT_byte_size, DW_FORM_block4) + |]) ;; let (abbrev_struct_type_member:abbrev) = - (DW_TAG_member, DW_CHILDREN_no, - [| - (DW_AT_name, DW_FORM_string); - (DW_AT_type, DW_FORM_ref_addr); - (DW_AT_mutable, DW_FORM_flag); - (DW_AT_data_member_location, DW_FORM_block4); - (DW_AT_byte_size, DW_FORM_block4) - |]) + (DW_TAG_member, DW_CHILDREN_no, + [| + (DW_AT_name, DW_FORM_string); + (DW_AT_type, DW_FORM_ref_addr); + (DW_AT_data_member_location, DW_FORM_block4); + (DW_AT_byte_size, DW_FORM_block4) + |]) ;; let (abbrev_variant_part:abbrev) = - (DW_TAG_variant_part, DW_CHILDREN_yes, - [| - (DW_AT_discr, DW_FORM_ref_addr) - |]) + (DW_TAG_variant_part, DW_CHILDREN_yes, + [| + (DW_AT_discr, DW_FORM_ref_addr) + |]) ;; let (abbrev_variant:abbrev) = - (DW_TAG_variant, DW_CHILDREN_yes, - [| - (DW_AT_discr_value, DW_FORM_udata) - |]) + (DW_TAG_variant, DW_CHILDREN_yes, + [| + (DW_AT_discr_value, DW_FORM_udata) + |]) ;; let (abbrev_subroutine_type:abbrev) = - (DW_TAG_subroutine_type, DW_CHILDREN_yes, - [| - (DW_AT_type, DW_FORM_ref_addr); (* NB: output type. *) + (DW_TAG_subroutine_type, DW_CHILDREN_yes, + [| + (DW_AT_type, DW_FORM_ref_addr); (* NB: output type. *) (DW_AT_mutable, DW_FORM_flag); (DW_AT_pure, DW_FORM_flag); (DW_AT_rust_iterator, DW_FORM_flag); @@ -1541,33 +1553,8 @@ let dwarf_visitor in match slot.Ast.slot_mode with - Ast.MODE_exterior -> - let fix = new_fixup "exterior DIE" in - let body_off = - word_sz_int * Abi.exterior_rc_slot_field_body - in - emit_die (DEF (fix, SEQ [| - uleb (get_abbrev_code abbrev_exterior_slot); - (* DW_AT_type: DW_FORM_ref_addr *) - (ref_type_die (slot_ty slot)); - (* DW_AT_mutable: DW_FORM_flag *) - BYTE (if slot.Ast.slot_mutable - then 1 else 0); - (* DW_AT_data_location: DW_FORM_block1 *) - (* This is a DWARF expression for moving - from the address of an exterior - allocation to the address of its - body. *) - dw_form_block1 - [| DW_OP_push_object_address; - DW_OP_lit body_off; - DW_OP_plus; - DW_OP_deref |] - |])); - ref_addr_for_fix fix - - (* FIXME (issue #72): encode mutable-ness of interiors. *) - | Ast.MODE_interior -> ref_type_die (slot_ty slot) + | Ast.MODE_local -> + ref_type_die (slot_ty slot) | Ast.MODE_alias -> let fix = new_fixup "alias DIE" in @@ -1575,8 +1562,6 @@ let dwarf_visitor uleb (get_abbrev_code abbrev_alias_slot); (* DW_AT_type: DW_FORM_ref_addr *) (ref_type_die (slot_ty slot)); - (* DW_AT_mutable: DW_FORM_flag *) - BYTE (if slot.Ast.slot_mutable then 1 else 0) |])); ref_addr_for_fix fix @@ -1708,15 +1693,13 @@ let dwarf_visitor emit_die die; Array.iteri begin - fun i (ident, slot) -> + fun i (ident, ty) -> emit_die (SEQ [| uleb (get_abbrev_code abbrev_struct_type_member); (* DW_AT_name: DW_FORM_string *) ZSTRING ident; (* DW_AT_type: DW_FORM_ref_addr *) - (ref_slot_die slot); - (* DW_AT_mutable: DW_FORM_flag *) - BYTE (if slot.Ast.slot_mutable then 1 else 0); + (ref_type_die ty); (* DW_AT_data_member_location: DW_FORM_block4 *) size_block4 (Il.get_element_offset word_bits rtys i) @@ -1904,10 +1887,6 @@ let dwarf_visitor unspecified_ptr_with_ref rust_ty (ref_type_die ty) in - let unspecified_ptr_with_ref_slot rust_ty slot = - unspecified_ptr_with_ref rust_ty (ref_slot_die slot) - in - let unspecified_ptr rust_ty = unspecified_ptr_with_ref rust_ty (unspecified_anon_struct ()) in @@ -1974,9 +1953,7 @@ let dwarf_visitor (* DW_AT_name: DW_FORM_string *) ZSTRING "tag"; (* DW_AT_type: DW_FORM_ref_addr *) - (ref_slot_die (interior_slot Ast.TY_uint)); - (* DW_AT_mutable: DW_FORM_flag *) - BYTE 0; + (ref_type_die Ast.TY_uint); (* DW_AT_data_member_location: DW_FORM_block4 *) size_block4 (Il.get_element_offset word_bits rtys 0) @@ -2038,6 +2015,40 @@ let dwarf_visitor ref_addr_for_fix (Stack.top iso_stack).(i) in + let box_type t = + let fix = new_fixup "box DIE" in + let body_off = + word_sz_int * Abi.box_rc_slot_field_body + in + emit_die (DEF (fix, SEQ [| + uleb (get_abbrev_code abbrev_box_type); + (* DW_AT_type: DW_FORM_ref_addr *) + (ref_type_die t); + (* DW_AT_data_location: DW_FORM_block1 *) + (* This is a DWARF expression for moving from the + address of a box allocation to the address of + its body. *) + dw_form_block1 + [| DW_OP_push_object_address; + DW_OP_lit body_off; + DW_OP_plus; + DW_OP_deref |] + |])); + ref_addr_for_fix fix + in + + let mutable_type t = + let fix = new_fixup "mutable DIE" in + emit_die (DEF (fix, SEQ [| + uleb (get_abbrev_code abbrev_mutable_type); + (* DW_AT_type: DW_FORM_ref_addr *) + (ref_type_die t); + (* DW_AT_mutable: DW_FORM_flag *) + BYTE 1; + |])); + ref_addr_for_fix fix + in + match ty with Ast.TY_nil -> unspecified_struct DW_RUST_nil | Ast.TY_bool -> base ("bool", DW_ATE_boolean, 1) @@ -2058,7 +2069,7 @@ let dwarf_visitor | Ast.TY_tag ttag -> tag_type None ttag | Ast.TY_iso tiso -> iso_type tiso | Ast.TY_idx i -> idx_type i - | Ast.TY_vec s -> unspecified_ptr_with_ref_slot DW_RUST_vec s + | Ast.TY_vec t -> unspecified_ptr_with_ref_ty DW_RUST_vec t | Ast.TY_chan t -> unspecified_ptr_with_ref_ty DW_RUST_chan t | Ast.TY_port t -> unspecified_ptr_with_ref_ty DW_RUST_port t | Ast.TY_task -> unspecified_ptr DW_RUST_task @@ -2067,6 +2078,8 @@ let dwarf_visitor | Ast.TY_native i -> native_ptr_type i | Ast.TY_param p -> rust_type_param p | Ast.TY_obj ob -> obj_type ob + | Ast.TY_mutable t -> mutable_type t + | Ast.TY_box t -> box_type t | _ -> bug () "unimplemented dwarf encoding for type %a" Ast.sprintf_ty ty @@ -2308,6 +2321,7 @@ let dwarf_visitor let emit_typedef_die (id:Ast.ident) + (e:Ast.effect) (ty:Ast.ty) : unit = let abbrev_code = get_abbrev_code abbrev_typedef in @@ -2316,6 +2330,7 @@ let dwarf_visitor uleb abbrev_code; (* DW_AT_name: DW_FORM_string *) ZSTRING id; + encode_effect e; (* DW_AT_type: DW_FORM_ref_addr *) (ref_type_die ty); |]) @@ -2377,13 +2392,13 @@ let dwarf_visitor (Hashtbl.find cx.ctxt_fn_fixups item.id); emit_type_param_decl_dies item.node.Ast.decl_params; end - | Ast.MOD_ITEM_type _ -> + | Ast.MOD_ITEM_type (e, _) -> begin log cx "walking typedef '%s' with %d type params" (path_name()) (Array.length item.node.Ast.decl_params); emit_typedef_die - id (Hashtbl.find cx.ctxt_all_type_items item.id); + id e (Hashtbl.find cx.ctxt_all_type_items item.id); emit_type_param_decl_dies item.node.Ast.decl_params; end | _ -> () @@ -2452,7 +2467,7 @@ let dwarf_visitor then get_abbrev_code abbrev_formal else get_abbrev_code abbrev_variable in - let resolved_slot = referent_to_slot cx s.id in + let resolved_slot = get_slot cx s.id in let emit_var_die slot_loc = let var_die = SEQ [| @@ -2893,7 +2908,7 @@ let rec extract_mod_items | DW_TAG_pointer_type when is_rust_type die DW_RUST_vec -> - Ast.TY_vec (get_referenced_slot die) + Ast.TY_vec (get_referenced_ty die) | DW_TAG_pointer_type when is_rust_type die DW_RUST_type_param -> @@ -2903,6 +2918,13 @@ let rec extract_mod_items when is_rust_type die DW_RUST_native -> Ast.TY_native (get_opaque_of (get_native_id die)) + | DW_TAG_pointer_type -> + Ast.TY_box (get_referenced_ty die) + + | DW_TAG_const_type + when ((get_num die DW_AT_mutable) = 1) -> + Ast.TY_mutable (get_referenced_ty die) + | DW_TAG_string_type -> Ast.TY_str | DW_TAG_base_type -> @@ -2953,13 +2975,13 @@ let rec extract_mod_items assert ((Array.length members) > 0); if is_num_idx (get_name members.(0)) then - let slots = Array.map get_referenced_slot members in - Ast.TY_tup slots + let tys = Array.map get_referenced_ty members in + Ast.TY_tup tys else let entries = Array.map (fun member_die -> ((get_name member_die), - (get_referenced_slot member_die))) + (get_referenced_ty member_die))) members in Ast.TY_rec entries @@ -2989,23 +3011,11 @@ let rec extract_mod_items match die.die_tag with DW_TAG_reference_type -> let ty = get_referenced_ty die in - let mut = get_flag die DW_AT_mutable in - let mode = - (* Exterior slots have a 'data_location' attr. *) - match atab_search die.die_attrs DW_AT_data_location with - Some _ -> Ast.MODE_exterior - | None -> Ast.MODE_alias - in - { Ast.slot_mode = mode; - Ast.slot_mutable = mut; + { Ast.slot_mode = Ast.MODE_alias; Ast.slot_ty = Some ty } | _ -> let ty = get_ty die in - (* FIXME (issue #28): encode mutability of interior slots - * properly. - *) - { Ast.slot_mode = Ast.MODE_interior; - Ast.slot_mutable = false; + { Ast.slot_mode = Ast.MODE_local; Ast.slot_ty = Some ty } and get_referenced_ty die = @@ -3094,9 +3104,10 @@ let rec extract_mod_items let die = Hashtbl.find dies i in match die.die_tag with DW_TAG_typedef -> + let effect = get_effect die in let ident = get_name die in let ty = get_referenced_ty die in - let tyi = Ast.MOD_ITEM_type ty in + let tyi = Ast.MOD_ITEM_type (effect, ty) in let (params, islots) = get_formals die in assert ((Array.length islots) = 0); htab_put mis ident (decl params tyi) diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml index ad9a4cb3..795f1990 100644 --- a/src/boot/me/effect.ml +++ b/src/boot/me/effect.ml @@ -33,12 +33,23 @@ let mutability_checking_visitor | _ -> () in - let check_write id dst = - let dst_slot = lval_slot cx dst in - if (dst_slot.Ast.slot_mutable or - (Hashtbl.mem cx.ctxt_copy_stmt_is_init id)) + let check_write s dst = + let _ = + iflog cx + (fun _ -> log cx "checking write to lval #%d = %a" + (int_of_node (lval_base_id dst)) Ast.sprintf_lval dst) + in + let dst_ty = lval_ty cx dst in + let is_mutable = + match dst_ty with + Ast.TY_mutable _ -> true + | _ -> false + in + if (is_mutable or (Hashtbl.mem cx.ctxt_copy_stmt_is_init s.id)) then () - else err (Some id) "writing to non-mutable slot" + else err (Some s.id) + "writing to non-mutable slot of type %a in statement %a" + Ast.sprintf_ty dst_ty Ast.sprintf_stmt s in (* FIXME (issue #75): enforce the no-write-alias-to-immutable-slot * rule. @@ -46,10 +57,10 @@ let mutability_checking_visitor let visit_stmt_pre s = begin match s.node with - Ast.STMT_copy (dst, _) -> check_write s.id dst - | Ast.STMT_copy_binop (dst, _, _) -> check_write s.id dst - | Ast.STMT_call (dst, _, _) -> check_write s.id dst - | Ast.STMT_recv (dst, _) -> check_write s.id dst + Ast.STMT_copy (dst, _) -> check_write s dst + | Ast.STMT_copy_binop (dst, _, _) -> check_write s dst + | Ast.STMT_call (dst, _, _) -> check_write s dst + | Ast.STMT_recv (dst, _) -> check_write s dst | _ -> () end; inner.Walk.visit_stmt_pre s @@ -144,15 +155,14 @@ let function_effect_propagation_visitor | Ast.STMT_call (_, fn, _) -> let lower_to_callee_ty t = - match t with + match simplified_ty t with Ast.TY_fn (_, taux) -> lower_to s taux.Ast.fn_effect; | _ -> bug () "non-fn callee" in if lval_is_slot cx fn then - let t = lval_slot cx fn in - lower_to_callee_ty (slot_ty t) + lower_to_callee_ty (lval_ty cx fn) else begin let item = lval_item cx fn in diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml index 6c4567fd..365acbf9 100644 --- a/src/boot/me/layout.ml +++ b/src/boot/me/layout.ml @@ -140,7 +140,7 @@ let layout_visitor (slots:node_id array) : unit = let accum (off,align) id : (size * size) = - let slot = referent_to_slot cx id in + let slot = get_slot cx id in let rt = slot_referent_type cx.ctxt_abi slot in let (elt_size, elt_align) = rty_layout rt in if vregs_ok @@ -221,7 +221,7 @@ let layout_visitor let offset = let word_sz = cx.ctxt_abi.Abi.abi_word_sz in let word_n (n:int) = Int64.mul word_sz (Int64.of_int n) in - SIZE_fixed (word_n (Abi.exterior_rc_slot_field_body + SIZE_fixed (word_n (Abi.box_rc_slot_field_body + 1 (* the state tydesc. *))) in log cx "laying out object-state for node #%d at offset %s" @@ -262,7 +262,7 @@ let layout_visitor *) let glue_callsz = - let word = interior_slot Ast.TY_int in + let word = local_slot Ast.TY_int in let glue_fn = mk_simple_ty_fn (Array.init Abi.worst_case_glue_call_args (fun _ -> word)) diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml index cafb69b1..641df884 100644 --- a/src/boot/me/resolve.ml +++ b/src/boot/me/resolve.ml @@ -270,7 +270,7 @@ let type_reference_and_tag_extracting_visitor let visit_mod_item_pre id params item = begin match item.node.Ast.decl_item with - Ast.MOD_ITEM_type ty -> + Ast.MOD_ITEM_type (_, ty) -> begin log cx "extracting references for type node %d" (int_of_node item.id); @@ -395,7 +395,7 @@ and lookup_type_by_name | Some (scopes', id) -> let ty, params = match htab_search cx.ctxt_all_defns id with - Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type t; + Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type (_, t); Ast.decl_params = params }) -> (t, Array.map (fun p -> p.node) params) | Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_obj ob; @@ -543,7 +543,7 @@ let type_resolving_visitor begin try match item.node.Ast.decl_item with - Ast.MOD_ITEM_type ty -> + Ast.MOD_ITEM_type (_, ty) -> let ty = resolve_type cx (!scopes) recursive_tag_groups all_tags empty_recur_info ty @@ -570,7 +570,7 @@ let type_resolving_visitor header_slots in let output_slot = - interior_slot (ty_iso_of cx recursive_tag_groups + local_slot (ty_iso_of cx recursive_tag_groups all_tags nid) in let ty = @@ -636,7 +636,8 @@ let type_resolving_visitor Ast.LVAL_ext (base, ext) -> let ext = match ext with - Ast.COMP_named (Ast.COMP_ident _) + Ast.COMP_deref + | Ast.COMP_named (Ast.COMP_ident _) | Ast.COMP_named (Ast.COMP_idx _) | Ast.COMP_atom (Ast.ATOM_literal _) -> ext | Ast.COMP_atom (Ast.ATOM_lval lv) -> @@ -837,7 +838,7 @@ let resolve_recursion then begin match Hashtbl.find cx.ctxt_all_defns id with DEFN_item - { Ast.decl_item = Ast.MOD_ITEM_type (Ast.TY_tag _) } -> + { Ast.decl_item = Ast.MOD_ITEM_type (_, (Ast.TY_tag _)) } -> log cx "type %d is a recursive tag" (int_of_node id); Hashtbl.replace recursive_tag_types id () | _ -> diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 95a5c792..8d2ed8ac 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -21,10 +21,10 @@ type glue = | GLUE_exit_main_task | GLUE_exit_task | GLUE_copy of Ast.ty (* One-level copy. *) - | GLUE_drop of Ast.ty (* De-initialize interior memory. *) - | GLUE_free of Ast.ty (* Drop body + free() exterior ptr. *) - | GLUE_sever of Ast.ty (* Null all exterior state slots. *) - | GLUE_mark of Ast.ty (* Mark all exterior state slots. *) + | GLUE_drop of Ast.ty (* De-initialize local memory. *) + | GLUE_free of Ast.ty (* Drop body + free() box ptr. *) + | GLUE_sever of Ast.ty (* Null all box state slots. *) + | GLUE_mark of Ast.ty (* Mark all box state slots. *) | GLUE_clone of Ast.ty (* Deep copy. *) | GLUE_compare of Ast.ty | GLUE_hash of Ast.ty @@ -91,6 +91,7 @@ type ctxt = ctxt_slot_is_arg: (node_id,unit) Hashtbl.t; ctxt_slot_keys: (node_id,Ast.slot_key) Hashtbl.t; ctxt_node_referenced: (node_id, unit) Hashtbl.t; + ctxt_auto_deref_lval: (node_id, bool) Hashtbl.t; ctxt_all_item_names: (node_id,Ast.name) Hashtbl.t; ctxt_all_item_types: (node_id,Ast.ty) Hashtbl.t; ctxt_all_lval_types: (node_id,Ast.ty) Hashtbl.t; @@ -181,6 +182,7 @@ let new_ctxt sess abi crate = ctxt_slot_is_arg = Hashtbl.create 0; ctxt_slot_keys = Hashtbl.create 0; ctxt_node_referenced = Hashtbl.create 0; + ctxt_auto_deref_lval = Hashtbl.create 0; ctxt_all_item_names = Hashtbl.create 0; ctxt_all_item_types = Hashtbl.create 0; ctxt_all_lval_types = Hashtbl.create 0; @@ -306,18 +308,32 @@ let referent_is_item (cx:ctxt) (id:node_id) : bool = | _ -> false ;; -(* coerce an lval definition id to a slot *) -let referent_to_slot (cx:ctxt) (id:node_id) : Ast.slot = - match Hashtbl.find cx.ctxt_all_defns id with - DEFN_slot slot -> slot - | _ -> bugi cx id "unknown slot" +let rec lval_base_id (lv:Ast.lval) : node_id = + match lv with + Ast.LVAL_base nbi -> nbi.id + | Ast.LVAL_ext (lv, _) -> lval_base_id lv +;; + +let get_item (cx:ctxt) (node:node_id) : Ast.mod_item_decl = + match htab_search cx.ctxt_all_defns node with + Some (DEFN_item item) -> item + | Some _ -> bugi cx node "defn is not an item" + | None -> bugi cx node "missing defn" +;; + +let get_slot (cx:ctxt) (node:node_id) : Ast.slot = + match htab_search cx.ctxt_all_defns node with + Some (DEFN_slot slot) -> slot + | Some _ -> bugi cx node "defn is not a slot" + | None -> bugi cx node "missing defn" ;; (* coerce an lval reference id to its definition slot *) -let lval_to_slot (cx:ctxt) (id:node_id) : Ast.slot = - match resolve_lval_id cx id with - DEFN_slot slot -> slot - | _ -> bugi cx id "unknown slot" +let lval_base_to_slot (cx:ctxt) (lval:Ast.lval) : Ast.slot identified = + let lid = lval_base_id lval in + let rid = lval_to_referent cx lid in + let slot = get_slot cx rid in + { node = slot; id = rid } ;; let get_stmt_depth (cx:ctxt) (id:node_id) : int = @@ -534,22 +550,6 @@ let rec lval_to_name (lv:Ast.lval) : Ast.name = Ast.NAME_ext (lval_to_name lv, comp) ;; -let rec lval_base_id (lv:Ast.lval) : node_id = - match lv with - Ast.LVAL_base nbi -> nbi.id - | Ast.LVAL_ext (lv, _) -> lval_base_id lv -;; - -let rec lval_base_slot (cx:ctxt) (lv:Ast.lval) : node_id option = - match lv with - Ast.LVAL_base nbi -> - let referent = lval_to_referent cx nbi.id in - if referent_is_slot cx referent - then Some referent - else None - | Ast.LVAL_ext (lv, _) -> lval_base_slot cx lv -;; - let rec lval_slots (cx:ctxt) (lv:Ast.lval) : node_id array = match lv with Ast.LVAL_base nbi -> @@ -557,7 +557,8 @@ let rec lval_slots (cx:ctxt) (lv:Ast.lval) : node_id array = if referent_is_slot cx referent then [| referent |] else [| |] - | Ast.LVAL_ext (lv, Ast.COMP_named _) -> lval_slots cx lv + | Ast.LVAL_ext (lv, Ast.COMP_named _) + | Ast.LVAL_ext (lv, Ast.COMP_deref) -> lval_slots cx lv | Ast.LVAL_ext (lv, Ast.COMP_atom a) -> Array.append (lval_slots cx lv) (atom_slots cx a) @@ -582,15 +583,13 @@ let atoms_slots (cx:ctxt) (az:Ast.atom array) : node_id array = ;; let tup_inputs_slots (cx:ctxt) (az:Ast.tup_input array) : node_id array = - Array.concat (List.map - (fun (_,_,a) -> atom_slots cx a) - (Array.to_list az)) + Array.concat (List.map (atom_slots cx) (Array.to_list az)) ;; let rec_inputs_slots (cx:ctxt) (inputs:Ast.rec_input array) : node_id array = Array.concat (List.map - (fun (_, _, _, atom) -> atom_slots cx atom) + (fun (_, atom) -> atom_slots cx atom) (Array.to_list inputs)) ;; @@ -605,33 +604,47 @@ let expr_slots (cx:ctxt) (e:Ast.expr) : node_id array = (* Type extraction. *) -let interior_slot_full mut ty : Ast.slot = - { Ast.slot_mode = Ast.MODE_interior; - Ast.slot_mutable = mut; - Ast.slot_ty = Some ty } +let local_slot_full mut ty : Ast.slot = + let ty = + if mut + then Ast.TY_mutable ty + else ty + in + { Ast.slot_mode = Ast.MODE_local; + Ast.slot_ty = Some ty } ;; -let exterior_slot_full mut ty : Ast.slot = - { Ast.slot_mode = Ast.MODE_exterior; - Ast.slot_mutable = mut; +let box_slot_full mut ty : Ast.slot = + let ty = + match ty with + Ast.TY_box _ -> ty + | _ -> Ast.TY_box ty + in + let ty = + if mut + then Ast.TY_mutable ty + else ty + in + { Ast.slot_mode = Ast.MODE_local; Ast.slot_ty = Some ty } ;; -let interior_slot ty : Ast.slot = interior_slot_full false ty +let local_slot ty : Ast.slot = local_slot_full false ty ;; -let exterior_slot ty : Ast.slot = exterior_slot_full false ty +let box_slot ty : Ast.slot = box_slot_full false ty ;; (* General folds of Ast.ty. *) -type ('ty, 'slot, 'slots, 'tag) ty_fold = +type ('ty, 'tys, 'slot, 'slots, 'tag) ty_fold = { - (* Functions that correspond to interior nodes in Ast.ty. *) - ty_fold_slot : (Ast.mode * bool * 'ty) -> 'slot; + (* Functions that correspond to local nodes in Ast.ty. *) + ty_fold_slot : (Ast.mode * 'ty) -> 'slot; ty_fold_slots : ('slot array) -> 'slots; - ty_fold_tags : (Ast.name, 'slots) Hashtbl.t -> 'tag; + ty_fold_tys : ('ty array) -> 'tys; + ty_fold_tags : (Ast.name, 'tys) Hashtbl.t -> 'tag; (* Functions that correspond to the Ast.ty constructors. *) ty_fold_any: unit -> 'ty; @@ -642,9 +655,9 @@ type ('ty, 'slot, 'slots, 'tag) ty_fold = ty_fold_uint : unit -> 'ty; ty_fold_char : unit -> 'ty; ty_fold_str : unit -> 'ty; - ty_fold_tup : 'slots -> 'ty; - ty_fold_vec : 'slot -> 'ty; - ty_fold_rec : (Ast.ident * 'slot) array -> 'ty; + ty_fold_tup : 'tys -> 'ty; + ty_fold_vec : 'ty -> 'ty; + ty_fold_rec : (Ast.ident * 'ty) array -> 'ty; ty_fold_tag : 'tag -> 'ty; ty_fold_iso : (int * 'tag array) -> 'ty; ty_fold_idx : int -> 'ty; @@ -659,21 +672,32 @@ type ('ty, 'slot, 'slots, 'tag) ty_fold = ty_fold_param : (int * Ast.effect) -> 'ty; ty_fold_named : Ast.name -> 'ty; ty_fold_type : unit -> 'ty; + ty_fold_box : 'ty -> 'ty; + ty_fold_mutable : 'ty -> 'ty; ty_fold_constrained : ('ty * Ast.constrs) -> 'ty } ;; -let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty = +let rec fold_ty + (f:('ty, 'tys, 'slot, 'slots, 'tag) ty_fold) + (ty:Ast.ty) + : 'ty = let fold_slot (s:Ast.slot) : 'slot = f.ty_fold_slot (s.Ast.slot_mode, - s.Ast.slot_mutable, fold_ty f (slot_ty s)) in + let fold_slots (slots:Ast.slot array) : 'slots = f.ty_fold_slots (Array.map fold_slot slots) in + + let fold_tys (tys:Ast.ty array) : 'tys = + f.ty_fold_tys (Array.map (fold_ty f) tys) + in + let fold_tags (ttag:Ast.ty_tag) : 'tag = - f.ty_fold_tags (htab_map ttag (fun k v -> (k, fold_slots v))) + f.ty_fold_tags (htab_map ttag (fun k v -> (k, fold_tys v))) in + let fold_sig tsig = (fold_slots tsig.Ast.sig_input_slots, tsig.Ast.sig_input_constrs, @@ -692,13 +716,15 @@ let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty = | Ast.TY_char -> f.ty_fold_char () | Ast.TY_str -> f.ty_fold_str () - | Ast.TY_tup t -> f.ty_fold_tup (fold_slots t) - | Ast.TY_vec s -> f.ty_fold_vec (fold_slot s) - | Ast.TY_rec r -> f.ty_fold_rec (Array.map (fun (k,v) -> (k,fold_slot v)) r) + | Ast.TY_tup t -> f.ty_fold_tup (fold_tys t) + | Ast.TY_vec t -> f.ty_fold_vec (fold_ty f t) + | Ast.TY_rec r -> + f.ty_fold_rec (Array.map (fun (k,v) -> (k,fold_ty f v)) r) | Ast.TY_tag tt -> f.ty_fold_tag (fold_tags tt) - | Ast.TY_iso ti -> f.ty_fold_iso (ti.Ast.iso_index, - (Array.map fold_tags ti.Ast.iso_group)) + | Ast.TY_iso ti -> + f.ty_fold_iso (ti.Ast.iso_index, + (Array.map fold_tags ti.Ast.iso_group)) | Ast.TY_idx i -> f.ty_fold_idx i | Ast.TY_fn (tsig,taux) -> f.ty_fold_fn (fold_sig tsig, taux) @@ -713,16 +739,20 @@ let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty = | Ast.TY_named n -> f.ty_fold_named n | Ast.TY_type -> f.ty_fold_type () + | Ast.TY_box t -> f.ty_fold_box (fold_ty f t) + | Ast.TY_mutable t -> f.ty_fold_mutable (fold_ty f t) + | Ast.TY_constrained (t, constrs) -> f.ty_fold_constrained (fold_ty f t, constrs) ;; -type 'a simple_ty_fold = ('a, 'a, 'a, 'a) ty_fold +type 'a simple_ty_fold = ('a, 'a, 'a, 'a, 'a) ty_fold ;; let ty_fold_default (default:'a) : 'a simple_ty_fold = - { ty_fold_slot = (fun _ -> default); + { ty_fold_tys = (fun _ -> default); + ty_fold_slot = (fun _ -> default); ty_fold_slots = (fun _ -> default); ty_fold_tags = (fun _ -> default); ty_fold_any = (fun _ -> default); @@ -748,19 +778,22 @@ let ty_fold_default (default:'a) : 'a simple_ty_fold = ty_fold_param = (fun _ -> default); ty_fold_named = (fun _ -> default); ty_fold_type = (fun _ -> default); + ty_fold_box = (fun _ -> default); + ty_fold_mutable = (fun _ -> default); ty_fold_constrained = (fun _ -> default) } ;; let ty_fold_rebuild (id:Ast.ty -> Ast.ty) - : (Ast.ty, Ast.slot, Ast.slot array, Ast.ty_tag) ty_fold = + : (Ast.ty, Ast.ty array, Ast.slot, Ast.slot array, Ast.ty_tag) ty_fold = let rebuild_fn ((islots, constrs, oslot), aux) = ({ Ast.sig_input_slots = islots; Ast.sig_input_constrs = constrs; Ast.sig_output_slot = oslot }, aux) in - { ty_fold_slot = (fun (mode, mut, t) -> + { + ty_fold_tys = (fun ts -> ts); + ty_fold_slot = (fun (mode, t) -> { Ast.slot_mode = mode; - Ast.slot_mutable = mut; Ast.slot_ty = Some t }); ty_fold_slots = (fun slots -> slots); ty_fold_tags = (fun htab -> htab); @@ -773,7 +806,7 @@ let ty_fold_rebuild (id:Ast.ty -> Ast.ty) ty_fold_char = (fun _ -> id Ast.TY_char); ty_fold_str = (fun _ -> id Ast.TY_str); ty_fold_tup = (fun slots -> id (Ast.TY_tup slots)); - ty_fold_vec = (fun slot -> id (Ast.TY_vec slot)); + ty_fold_vec = (fun t -> id (Ast.TY_vec t)); ty_fold_rec = (fun entries -> id (Ast.TY_rec entries)); ty_fold_tag = (fun tag -> id (Ast.TY_tag tag)); ty_fold_iso = (fun (i, tags) -> id (Ast.TY_iso { Ast.iso_index = i; @@ -791,6 +824,8 @@ let ty_fold_rebuild (id:Ast.ty -> Ast.ty) ty_fold_param = (fun (i, mut) -> id (Ast.TY_param (i, mut))); ty_fold_named = (fun n -> id (Ast.TY_named n)); ty_fold_type = (fun _ -> id (Ast.TY_type)); + ty_fold_box = (fun t -> id (Ast.TY_box t)); + ty_fold_mutable = (fun t -> id (Ast.TY_mutable t)); ty_fold_constrained = (fun (t, constrs) -> id (Ast.TY_constrained (t, constrs))) } ;; @@ -891,8 +926,9 @@ let associative_binary_op_ty_fold fn islots oslot in { base with + ty_fold_tys = (fun ts -> reduce (Array.to_list ts)); ty_fold_slots = (fun slots -> reduce (Array.to_list slots)); - ty_fold_slot = (fun (_, _, a) -> a); + ty_fold_slot = (fun (_, a) -> a); ty_fold_tags = (fun tab -> reduce (htab_vals tab)); ty_fold_tup = (fun a -> a); ty_fold_vec = (fun a -> a); @@ -906,6 +942,8 @@ let associative_binary_op_ty_fold reduce (List.map reduce_fn (htab_vals fns))); ty_fold_chan = (fun a -> a); ty_fold_port = (fun a -> a); + ty_fold_box = (fun a -> a); + ty_fold_mutable = (fun a -> a); ty_fold_constrained = (fun (a, _) -> a) } let ty_fold_bool_and (default:bool) : bool simple_ty_fold = @@ -957,13 +995,9 @@ let lower_effect_of x y = ;; let type_effect (t:Ast.ty) : Ast.effect = - let fold_slot ((*mode*)_, mut, eff) = - if mut - then lower_effect_of Ast.STATE eff - else eff - in + let fold_mutable _ = Ast.STATE in let fold = associative_binary_op_ty_fold Ast.PURE lower_effect_of in - let fold = { fold with ty_fold_slot = fold_slot } in + let fold = { fold with ty_fold_mutable = fold_mutable } in fold_ty fold t ;; @@ -1036,16 +1070,28 @@ let check_concrete params thing = else bug () "unhandled parametric binding" ;; +let rec strip_mutable_or_constrained_ty (t:Ast.ty) : Ast.ty = + match t with + Ast.TY_mutable t + | Ast.TY_constrained (t, _) -> strip_mutable_or_constrained_ty t + | _ -> t +;; + +let rec simplified_ty (t:Ast.ty) : Ast.ty = + match strip_mutable_or_constrained_ty t with + Ast.TY_box t -> simplified_ty t + | t -> t +;; -let project_type_to_slot +let rec project_type (base_ty:Ast.ty) (comp:Ast.lval_component) - : Ast.slot = + : Ast.ty = match (base_ty, comp) with (Ast.TY_rec elts, Ast.COMP_named (Ast.COMP_ident id)) -> begin match atab_search elts id with - Some slot -> slot + Some ty -> ty | None -> err None "unknown record-member '%s'" id end @@ -1054,30 +1100,35 @@ let project_type_to_slot then elts.(i) else err None "out-of-range tuple index %d" i - | (Ast.TY_vec slot, Ast.COMP_atom _) -> - slot + | (Ast.TY_vec ty, Ast.COMP_atom _) -> ty + | (Ast.TY_str, Ast.COMP_atom _) -> (Ast.TY_mach TY_u8) + | (Ast.TY_obj (_, fns), Ast.COMP_named (Ast.COMP_ident id)) -> + (Ast.TY_fn (Hashtbl.find fns id)) - | (Ast.TY_str, Ast.COMP_atom _) -> - interior_slot (Ast.TY_mach TY_u8) + | (Ast.TY_box t, Ast.COMP_deref) -> t - | (Ast.TY_obj (_, fns), Ast.COMP_named (Ast.COMP_ident id)) -> - interior_slot (Ast.TY_fn (Hashtbl.find fns id)) + (* Box, mutable and constrained are transparent to the + * other lval-ext forms: x.y and x.(y). + *) + | (Ast.TY_box t, _) + | (Ast.TY_mutable t, _) + | (Ast.TY_constrained (t, _), _) -> project_type t comp | (_,_) -> bug () - "unhandled form of lval-ext in Semant." - "project_slot: %a indexed by %a" - Ast.sprintf_ty base_ty Ast.sprintf_lval_component comp -;; - - -(* NB: this will fail if lval is not a slot. *) -let rec lval_slot (cx:ctxt) (lval:Ast.lval) : Ast.slot = - match lval with - Ast.LVAL_base nb -> lval_to_slot cx nb.id - | Ast.LVAL_ext (base, comp) -> - let base_ty = slot_ty (lval_slot cx base) in - project_type_to_slot base_ty comp + "project_ty: bad lval-ext: %s" + (match comp with + Ast.COMP_atom at -> + Printf.sprintf "%a.(%a)" + Ast.sprintf_ty base_ty + Ast.sprintf_atom at + | Ast.COMP_named nc -> + Printf.sprintf "%a.%a" + Ast.sprintf_ty base_ty + Ast.sprintf_name_component nc + | Ast.COMP_deref -> + Printf.sprintf "*(%a)" + Ast.sprintf_ty base_ty) ;; let exports_permit (view:Ast.mod_view) (ident:Ast.ident) : bool = @@ -1107,8 +1158,8 @@ let rec lval_item (cx:ctxt) (lval:Ast.lval) : Ast.mod_item = | Ast.COMP_named (Ast.COMP_app (i, args)) -> (i, args) | _ -> bug () - "unhandled lval-component '%a' in Semant.lval_item" - Ast.sprintf_lval_component comp + "unhandled lval-component in '%a' in lval_item" + Ast.sprintf_lval lval in match htab_search items i with | Some sub when exports_permit view i -> @@ -1150,6 +1201,38 @@ let lval_is_direct_mod (cx:ctxt) (lval:Ast.lval) : bool = | _ -> false ;; +(* + * FIXME: this function is a bad idea and exists only as a workaround + * for other logic that is even worse. Untangle. + *) +let rec project_lval_ty_from_slot (cx:ctxt) (lval:Ast.lval) : Ast.ty = + match lval with + Ast.LVAL_base nbi -> + let referent = lval_to_referent cx nbi.id in + if lval_is_slot cx lval + then slot_ty (get_slot cx referent) + else Hashtbl.find cx.ctxt_all_item_types nbi.id + | Ast.LVAL_ext (base, comp) -> + let base_ty = project_lval_ty_from_slot cx base in + project_type base_ty comp +;; + + +let lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty = + (* + FIXME: The correct definition of this function is just: + + Hashtbl.find cx.ctxt_all_lval_types (lval_base_id lval) + + However, since the typechecker is not presently handling + every stmt, we have a fallback mode to "pick out the slot + type and hope for the best". + *) + match htab_search cx.ctxt_all_lval_types (lval_base_id lval) with + Some t -> t + | None -> project_lval_ty_from_slot cx lval +;; + let lval_is_static (cx:ctxt) (lval:Ast.lval) : bool = defn_is_static (resolve_lval cx lval) ;; @@ -1164,7 +1247,7 @@ let lval_is_obj_vtbl (cx:ctxt) (lval:Ast.lval) : bool = match lval with Ast.LVAL_ext (base, _) -> begin - match slot_ty (lval_slot cx base) with + match (simplified_ty (project_lval_ty_from_slot cx base)) with Ast.TY_obj _ -> true | _ -> false end @@ -1172,11 +1255,6 @@ let lval_is_obj_vtbl (cx:ctxt) (lval:Ast.lval) : bool = else false ;; -let rec lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty = - let base_id = lval_base_id lval in - Hashtbl.find cx.ctxt_all_lval_types base_id -;; - let rec atom_type (cx:ctxt) (at:Ast.atom) : Ast.ty = match at with Ast.ATOM_literal {node=(Ast.LIT_int _); id=_} -> Ast.TY_int @@ -1236,7 +1314,7 @@ let ty_of_mod_item ((*inside*)_:bool) (item:Ast.mod_item) : Ast.ty = let tobj = Ast.TY_obj (ty_obj_of_obj ob) in let tsig = { Ast.sig_input_slots = arg_slots ob.Ast.obj_state; Ast.sig_input_constrs = ob.Ast.obj_constrs; - Ast.sig_output_slot = interior_slot tobj } + Ast.sig_output_slot = local_slot tobj } in (Ast.TY_fn (tsig, taux)) @@ -1246,7 +1324,7 @@ let ty_of_mod_item ((*inside*)_:bool) (item:Ast.mod_item) : Ast.ty = in let tsig = { Ast.sig_input_slots = tup_slots htup; Ast.sig_input_constrs = [| |]; - Ast.sig_output_slot = interior_slot (Ast.TY_tag ttag) } + Ast.sig_output_slot = local_slot (Ast.TY_tag ttag) } in (Ast.TY_fn (tsig, taux)) ;; @@ -1433,20 +1511,6 @@ let unreferenced_required_item_ignoring_visitor type resolved = ((scope list * node_id) option) ;; -let get_item (cx:ctxt) (node:node_id) : Ast.mod_item_decl = - match htab_search cx.ctxt_all_defns node with - Some (DEFN_item item) -> item - | Some _ -> bugi cx node "defn is not an item" - | None -> bugi cx node "missing defn" -;; - -let get_slot (cx:ctxt) (node:node_id) : Ast.slot = - match htab_search cx.ctxt_all_defns node with - Some (DEFN_slot slot) -> slot - | Some _ -> bugi cx node "defn is not a slot" - | None -> bugi cx node "missing defn" -;; - let get_mod_item (cx:ctxt) (node:node_id) @@ -1741,7 +1805,7 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty = let ptr = sp Il.OpaqueTy in let rc_ptr = sp (Il.StructTy [| word; Il.OpaqueTy |]) in let codeptr = sp Il.CodeTy in - let tup ttup = Il.StructTy (Array.map (slot_referent_type abi) ttup) in + let tup ttup = Il.StructTy (Array.map (referent_type abi) ttup) in let tag ttag = let union = Il.UnionTy @@ -1802,6 +1866,11 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty = | Ast.TY_native _ -> ptr + | Ast.TY_box t -> + sp (Il.StructTy [| word; referent_type abi t |]) + + | Ast.TY_mutable t -> referent_type abi t + | Ast.TY_param (i, _) -> Il.ParamTy i | Ast.TY_named _ -> bug () "named type in referent_type" @@ -1809,17 +1878,12 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty = and slot_referent_type (abi:Abi.abi) (sl:Ast.slot) : Il.referent_ty = let s t = Il.ScalarTy t in - let v b = Il.ValTy b in let p t = Il.AddrTy t in - let sv b = s (v b) in let sp t = s (p t) in - let word = sv abi.Abi.abi_word_bits in - let rty = referent_type abi (slot_ty sl) in match sl.Ast.slot_mode with - Ast.MODE_exterior _ -> sp (Il.StructTy [| word; rty |]) - | Ast.MODE_interior _ -> rty + | Ast.MODE_local _ -> rty | Ast.MODE_alias _ -> sp rty ;; @@ -1886,7 +1950,7 @@ let call_args_referent_type Il.ScalarTy (Il.AddrTy Il.OpaqueTy) |] in - match callee_ty with + match simplified_ty callee_ty with Ast.TY_fn (tsig, taux) -> call_args_referent_type_full cx.ctxt_abi @@ -1896,7 +1960,9 @@ let call_args_referent_type (if taux.Ast.fn_is_iter then (iterator_arg_rtys()) else [||]) indirect_arg_rtys - | _ -> bug cx "Semant.call_args_referent_type on non-callable type" + | _ -> bug cx + "Semant.call_args_referent_type on non-callable type %a" + Ast.sprintf_ty callee_ty ;; let indirect_call_args_referent_type @@ -1935,19 +2001,22 @@ let slot_sz (abi:Abi.abi) (s:Ast.slot) : int64 = ;; let word_slot (abi:Abi.abi) : Ast.slot = - interior_slot (Ast.TY_mach abi.Abi.abi_word_ty) + local_slot (Ast.TY_mach abi.Abi.abi_word_ty) ;; let alias_slot (ty:Ast.ty) : Ast.slot = { Ast.slot_mode = Ast.MODE_alias; - Ast.slot_mutable = false; Ast.slot_ty = Some ty } ;; let mutable_alias_slot (ty:Ast.ty) : Ast.slot = - { Ast.slot_mode = Ast.MODE_alias; - Ast.slot_mutable = true; - Ast.slot_ty = Some ty } + let ty = + match ty with + Ast.TY_mutable _ -> ty + | _ -> Ast.TY_mutable ty + in + { Ast.slot_mode = Ast.MODE_alias; + Ast.slot_ty = Some ty } ;; let mk_ty_fn_or_iter @@ -1977,7 +2046,7 @@ let mk_simple_ty_fn (arg_slots:Ast.slot array) : Ast.ty = (* In some cases we don't care what the output slot is. *) - let out_slot = interior_slot Ast.TY_nil in + let out_slot = local_slot Ast.TY_nil in mk_ty_fn out_slot arg_slots ;; @@ -1985,7 +2054,7 @@ let mk_simple_ty_iter (arg_slots:Ast.slot array) : Ast.ty = (* In some cases we don't care what the output slot is. *) - let out_slot = interior_slot Ast.TY_nil in + let out_slot = local_slot Ast.TY_nil in mk_ty_fn_or_iter out_slot arg_slots true ;; @@ -2002,12 +2071,10 @@ let item_str (cx:ctxt) (id:node_id) : string = let ty_str (ty:Ast.ty) : string = let base = associative_binary_op_ty_fold "" (fun a b -> a ^ b) in - let fold_slot (mode,mut,ty) = - (if mut then "m" else "") - ^ (match mode with - Ast.MODE_exterior -> "e" - | Ast.MODE_alias -> "a" - | Ast.MODE_interior -> "") + let fold_slot (mode,ty) = + (match mode with + Ast.MODE_alias -> "a" + | Ast.MODE_local -> "") ^ ty in let num n = (string_of_int n) ^ "$" in @@ -2080,6 +2147,8 @@ let ty_str (ty:Ast.ty) : string = ty_fold_native = (fun _ -> "N"); ty_fold_param = (fun _ -> "P"); ty_fold_type = (fun _ -> "Y"); + ty_fold_mutable = (fun t -> "M" ^ t); + ty_fold_box = (fun t -> "B" ^ t); (* FIXME (issue #78): encode obj types. *) (* FIXME (issue #78): encode opaque and param numbers. *) diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index 8ecc743e..abeff66e 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -55,13 +55,14 @@ let trans_visitor let (abi:Abi.abi) = cx.ctxt_abi in let (word_sz:int64) = word_sz abi in let (word_slot:Ast.slot) = word_slot abi in + let (word_ty:Ast.ty) = Ast.TY_mach abi.Abi.abi_word_ty in let oper_str = Il.string_of_operand abi.Abi.abi_str_of_hardreg in let cell_str = Il.string_of_cell abi.Abi.abi_str_of_hardreg in let (word_bits:Il.bits) = abi.Abi.abi_word_bits in - let (word_ty:Il.scalar_ty) = Il.ValTy word_bits in - let (word_rty:Il.referent_ty) = Il.ScalarTy word_ty in + let (word_sty:Il.scalar_ty) = Il.ValTy word_bits in + let (word_rty:Il.referent_ty) = Il.ScalarTy word_sty in let (word_ty_mach:ty_mach) = match word_bits with Il.Bits8 -> TY_u8 @@ -88,7 +89,7 @@ let trans_visitor let imm_true = imm_of_ty 1L TY_u8 in let imm_false = imm_of_ty 0L TY_u8 in let nil_ptr = Il.Mem ((Il.Abs (Asm.IMM 0L)), Il.NilTy) in - let wordptr_ty = Il.AddrTy (Il.ScalarTy word_ty) in + let wordptr_ty = Il.AddrTy (Il.ScalarTy word_sty) in let crate_rel fix = Asm.SUB (Asm.M_POS fix, Asm.M_POS cx.ctxt_crate_fixup) @@ -431,8 +432,8 @@ let trans_visitor in - let make_tydesc_slots n = - Array.init n (fun _ -> interior_slot Ast.TY_type) + let make_tydesc_tys n = + Array.init n (fun _ -> Ast.TY_type) in let cell_vreg_num (vr:(int option) ref) : int = @@ -445,7 +446,7 @@ let trans_visitor in let slot_id_referent_type (slot_id:node_id) : Il.referent_ty = - slot_referent_type abi (referent_to_slot cx slot_id) + slot_referent_type abi (get_slot cx slot_id) in let caller_args_cell (args_rty:Il.referent_ty) : Il.cell = @@ -521,7 +522,7 @@ let trans_visitor begin let obj = get_obj_for_current_frame() in let tydesc = get_element_ptr obj 1 in - let ty_params_ty = Ast.TY_tup (make_tydesc_slots n_ty_params) in + let ty_params_ty = Ast.TY_tup (make_tydesc_tys n_ty_params) in let ty_params_rty = referent_type abi ty_params_ty in let ty_params = get_element_ptr (deref tydesc) Abi.tydesc_field_first_param @@ -595,28 +596,28 @@ let trans_visitor | SIZE_rt_neg a -> let op_a = sub_sz a in - let tmp = next_vreg_cell word_ty in + let tmp = next_vreg_cell word_sty in emit (Il.unary Il.NEG tmp op_a); Il.Cell tmp | SIZE_rt_add (a, b) -> let op_a = sub_sz a in let op_b = sub_sz b in - let tmp = next_vreg_cell word_ty in + let tmp = next_vreg_cell word_sty in add tmp op_a op_b; Il.Cell tmp | SIZE_rt_mul (a, b) -> let op_a = sub_sz a in let op_b = sub_sz b in - let tmp = next_vreg_cell word_ty in + let tmp = next_vreg_cell word_sty in emit (Il.binary Il.UMUL tmp op_a op_b); Il.Cell tmp | SIZE_rt_max (a, b) -> let op_a = sub_sz a in let op_b = sub_sz b in - let tmp = next_vreg_cell word_ty in + let tmp = next_vreg_cell word_sty in mov tmp op_a; emit (Il.cmp op_a op_b); let jmp = mark () in @@ -643,8 +644,8 @@ let trans_visitor let op_align = sub_sz align in annotate "fetch offset"; let op_off = sub_sz off in - let mask = next_vreg_cell word_ty in - let off = next_vreg_cell word_ty in + let mask = next_vreg_cell word_sty in + let off = next_vreg_cell word_sty in mov mask op_align; sub_from mask one; mov off op_off; @@ -678,8 +679,8 @@ let trans_visitor | None -> let runtime_size = calculate_sz ty_params size in let v = next_vreg () in - let c = (Il.Reg (v, word_ty)) in - mov c (Il.Cell (Il.Reg (reg, word_ty))); + let c = (Il.Reg (v, word_sty)) in + mov c (Il.Cell (Il.Reg (reg, word_sty))); add_to c runtime_size; based v @@ -690,17 +691,17 @@ let trans_visitor based_sz (get_ty_params_of_current_frame()) abi.Abi.abi_sp_reg size in - let slot_sz_in_current_frame (slot:Ast.slot) : Il.operand = - let rty = slot_referent_type abi slot in + let ty_sz_in_current_frame (ty:Ast.ty) : Il.operand = + let rty = referent_type abi ty in let sz = Il.referent_ty_size word_bits rty in calculate_sz_in_current_frame sz in - let slot_sz_with_ty_params + let ty_sz_with_ty_params (ty_params:Il.cell) - (slot:Ast.slot) + (ty:Ast.ty) : Il.operand = - let rty = slot_referent_type abi slot in + let rty = referent_type abi ty in let sz = Il.referent_ty_size word_bits rty in calculate_sz ty_params sz in @@ -722,8 +723,8 @@ let trans_visitor Il.Mem (Il.mem_off_imm mem fixed_off, elt_rty) | sz -> let sz = calculate_sz ty_params sz in - let v = next_vreg word_ty in - let vc = Il.Reg (v, word_ty) in + let v = next_vreg word_sty in + let vc = Il.Reg (v, word_sty) in lea vc mem; add_to vc sz; Il.Mem (based v, elt_rty) @@ -739,12 +740,6 @@ let trans_visitor get_element_ptr_dyn (get_ty_params_of_current_frame()) mem_cell i in - let get_explicit_args_for_current_frame _ = - get_element_ptr_dyn_in_current_frame (get_args_for_current_frame ()) - Abi.calltup_elt_args - in - - let deref_off_sz (ty_params:Il.cell) (ptr:Il.cell) @@ -887,18 +882,29 @@ let trans_visitor in let rec trans_slot_lval_ext + (initializing:bool) (base_ty:Ast.ty) (cell:Il.cell) (comp:Ast.lval_component) - : (Il.cell * Ast.slot) = + : (Il.cell * Ast.ty) = - let bounds_checked_access at slot = + let bounds_checked_access at ty = let atop = trans_atom at in - let unit_sz = slot_sz_in_current_frame slot in - let idx = next_vreg_cell word_ty in + let unit_sz = ty_sz_in_current_frame ty in + let idx = next_vreg_cell word_sty in emit (Il.binary Il.UMUL idx atop unit_sz); let elt_mem = trans_bounds_check (deref cell) (Il.Cell idx) in - (Il.Mem (elt_mem, slot_referent_type abi slot), slot) + (Il.Mem (elt_mem, referent_type abi ty), ty) + in + (* + * All lval components aside from explicit-deref just auto-deref + * through all boxes to find their indexable referent. + *) + let base_ty = strip_mutable_or_constrained_ty base_ty in + let (cell, base_ty) = + if comp = Ast.COMP_deref + then (cell, base_ty) + else deref_ty DEREF_all_boxes initializing cell base_ty in match (base_ty, comp) with @@ -911,19 +917,21 @@ let trans_visitor Ast.COMP_named (Ast.COMP_idx i)) -> (get_element_ptr_dyn_in_current_frame cell i, entries.(i)) - | (Ast.TY_vec slot, + | (Ast.TY_vec ty, Ast.COMP_atom at) -> - bounds_checked_access at slot + bounds_checked_access at ty | (Ast.TY_str, Ast.COMP_atom at) -> - bounds_checked_access at (interior_slot (Ast.TY_mach TY_u8)) + bounds_checked_access at (Ast.TY_mach TY_u8) | (Ast.TY_obj obj_ty, Ast.COMP_named (Ast.COMP_ident id)) -> let (cell, fn_ty) = get_vtbl_entry cell obj_ty id in - (cell, (interior_slot (Ast.TY_fn fn_ty))) + (cell, (Ast.TY_fn fn_ty)) + | (Ast.TY_box _, Ast.COMP_deref) -> + deref_ty DEREF_one_box initializing cell base_ty | _ -> bug () "unhandled form of lval_ext in trans_slot_lval_ext" @@ -938,7 +946,7 @@ let trans_visitor let (base:Il.cell) = next_vreg_cell Il.voidptr_t in let (elt_reg:Il.reg) = next_vreg () in let (elt:Il.cell) = Il.Reg (elt_reg, Il.voidptr_t) in - let (diff:Il.cell) = next_vreg_cell word_ty in + let (diff:Il.cell) = next_vreg_cell word_sty in annotate "bounds check"; lea base (fst (need_mem_cell data)); add elt (Il.Cell base) mul_idx; @@ -950,23 +958,35 @@ let trans_visitor and trans_lval_full (initializing:bool) (lv:Ast.lval) - : (Il.cell * Ast.slot) = + : (Il.cell * Ast.ty) = let rec trans_slot_lval_full (initializing:bool) lv = - let (cell, slot) = + let (cell, ty) = match lv with Ast.LVAL_ext (base, comp) -> - let (base_cell, base_slot) = + let (base_cell, base_ty) = trans_slot_lval_full initializing base in - let base_cell' = deref_slot initializing base_cell base_slot in - trans_slot_lval_ext (slot_ty base_slot) base_cell' comp - - | Ast.LVAL_base nb -> - let slot = lval_to_slot cx nb.id in - let referent = lval_to_referent cx nb.id in - let cell = cell_of_block_slot referent in - (cell, slot) + trans_slot_lval_ext initializing base_ty base_cell comp + + | Ast.LVAL_base nbi -> + let sloti = lval_base_to_slot cx lv in + let cell = cell_of_block_slot sloti.id in + let ty = slot_ty sloti.node in + let cell = deref_slot initializing cell sloti.node in + let dctrl = + (* If this fails, type didn't visit the lval, and we + * don't know whether to auto-deref its base. Crashing + * here is best. Compiler bug. + *) + match htab_search cx.ctxt_auto_deref_lval nbi.id with + None -> + bugi cx nbi.id + "Lval without auto-deref info; bad typecheck?" + | Some true -> DEREF_all_boxes + | Some false -> DEREF_none + in + deref_ty dctrl initializing cell ty in iflog begin @@ -976,7 +996,7 @@ let trans_visitor Ast.sprintf_lval lv (cell_str cell)) end; - (cell, slot) + (cell, ty) in if lval_is_slot cx lv @@ -994,13 +1014,13 @@ let trans_visitor and trans_lval_maybe_init (initializing:bool) (lv:Ast.lval) - : (Il.cell * Ast.slot) = + : (Il.cell * Ast.ty) = trans_lval_full initializing lv - and trans_lval_init (lv:Ast.lval) : (Il.cell * Ast.slot) = + and trans_lval_init (lv:Ast.lval) : (Il.cell * Ast.ty) = trans_lval_maybe_init true lv - and trans_lval (lv:Ast.lval) : (Il.cell * Ast.slot) = + and trans_lval (lv:Ast.lval) : (Il.cell * Ast.ty) = trans_lval_maybe_init false lv and trans_callee @@ -1228,11 +1248,10 @@ let trans_visitor fun _ -> annotate (Fmt.fmt_to_str Ast.fmt_atom atom) end; - match atom with Ast.ATOM_lval lv -> - let (cell, slot) = trans_lval lv in - Il.Cell (deref_slot false cell slot) + let (cell, ty) = trans_lval lv in + Il.Cell (fst (deref_ty DEREF_none false cell ty)) | Ast.ATOM_literal lit -> trans_lit lit.node @@ -1302,7 +1321,7 @@ let trans_visitor and check_interrupt_flag _ = let dom = next_vreg_cell wordptr_ty in - let flag = next_vreg_cell word_ty in + let flag = next_vreg_cell word_sty in mov dom (Il.Cell (tp_imm (word_n Abi.task_field_dom))); mov flag (Il.Cell (deref_imm dom (word_n Abi.dom_field_interrupt_flag))); @@ -1393,7 +1412,7 @@ let trans_visitor (bs:Ast.slot array) (* FIXME (issue #5): mutability flag *) : Il.referent_ty = - let rc = Il.ScalarTy word_ty in + let rc = Il.ScalarTy word_sty in let targ = referent_type abi (mk_simple_ty_fn [||]) in let bindings = Array.map (slot_referent_type abi) bs in Il.StructTy [| rc; targ; Il.StructTy bindings |] @@ -1557,7 +1576,7 @@ let trans_visitor and ty_params_covering (t:Ast.ty) : Ast.slot = let n_ty_params = n_used_type_params t in - let params = make_tydesc_slots n_ty_params in + let params = make_tydesc_tys n_ty_params in alias_slot (Ast.TY_tup params) and get_drop_glue @@ -1570,7 +1589,7 @@ let trans_visitor let cell = get_element_ptr args 1 in note_drop_step ty "in drop-glue, dropping"; trace_word cx.ctxt_sess.Session.sess_trace_drop cell; - drop_ty ty_params ty (deref cell) curr_iso; + drop_ty ty_params (deref cell) ty curr_iso; note_drop_step ty "drop-glue complete"; in let ty_params_ptr = ty_params_covering ty in @@ -1585,31 +1604,31 @@ let trans_visitor : fixup = let g = GLUE_free ty in let inner _ (args:Il.cell) = - (* - * Free-glue assumes it's called with a pointer to an - * exterior allocation with normal exterior layout. It's - * just a way to move drop+free out of leaf code. + (* Free-glue assumes it's called with a pointer to a box allocation with + * normal box layout. It's just a way to move drop+free out of leaf + * code. *) let ty_params = deref (get_element_ptr args 0) in let cell = get_element_ptr args 1 in let (body_mem, _) = need_mem_cell (get_element_ptr_dyn ty_params (deref cell) - Abi.exterior_rc_slot_field_body) + Abi.box_rc_slot_field_body) in + let body_ty = simplified_ty ty in let vr = next_vreg_cell Il.voidptr_t in lea vr body_mem; - note_drop_step ty "in free-glue, calling drop-glue on body"; + note_drop_step body_ty "in free-glue, calling drop-glue on body"; trace_word cx.ctxt_sess.Session.sess_trace_drop vr; trans_call_simple_static_glue - (get_drop_glue ty curr_iso) ty_params vr; + (get_drop_glue body_ty curr_iso) ty_params vr; note_drop_step ty "back in free-glue, calling free"; trans_free cell is_gc; trace_str cx.ctxt_sess.Session.sess_trace_drop "free-glue complete"; in let ty_params_ptr = ty_params_covering ty in - let fty = mk_simple_ty_fn [| ty_params_ptr; exterior_slot ty |] in + let fty = mk_simple_ty_fn [| ty_params_ptr; box_slot ty |] in get_typed_mem_glue g fty inner @@ -1621,7 +1640,9 @@ let trans_visitor let inner _ (args:Il.cell) = let ty_params = deref (get_element_ptr args 0) in let cell = get_element_ptr args 1 in - sever_ty ty_params ty (deref cell) curr_iso + note_gc_step ty "in sever-glue, severing"; + sever_ty ty_params (deref cell) ty curr_iso; + note_gc_step ty "in sever-glue complete"; in let ty_params_ptr = ty_params_covering ty in let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in @@ -1636,7 +1657,9 @@ let trans_visitor let inner _ (args:Il.cell) = let ty_params = deref (get_element_ptr args 0) in let cell = get_element_ptr args 1 in - mark_ty ty_params ty (deref cell) curr_iso + note_gc_step ty "in mark-glue, marking"; + mark_ty ty_params (deref cell) ty curr_iso; + note_gc_step ty "mark-glue complete"; in let ty_params_ptr = ty_params_covering ty in let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in @@ -1653,12 +1676,12 @@ let trans_visitor let ty_params = deref (get_element_ptr args 0) in let src = deref (get_element_ptr args 1) in let clone_task = get_element_ptr args 2 in - clone_ty ty_params clone_task ty dst src curr_iso + clone_ty ty_params clone_task dst src ty curr_iso in let ty_params_ptr = ty_params_covering ty in let fty = mk_ty_fn - (interior_slot ty) (* dst *) + (local_slot ty) (* dst *) [| ty_params_ptr; alias_slot ty; (* src *) @@ -1677,12 +1700,12 @@ let trans_visitor let dst = deref out_ptr in let ty_params = deref (get_element_ptr args 0) in let src = deref (get_element_ptr args 1) in - copy_ty ty_params ty dst src curr_iso + trans_copy_ty ty_params false dst ty src ty curr_iso in let ty_params_ptr = ty_params_covering ty in let fty = mk_ty_fn - (interior_slot ty) + (local_slot ty) [| ty_params_ptr; alias_slot ty |] in get_typed_mem_glue g fty inner @@ -1888,12 +1911,12 @@ let trans_visitor in match expr with Ast.EXPR_binary (binop, a, b) -> - assert (is_prim_type (atom_type cx a)); - assert (is_prim_type (atom_type cx b)); + assert (is_prim_type (simplified_ty (atom_type cx a))); + assert (is_prim_type (simplified_ty (atom_type cx b))); trans_binary binop (trans_atom a) (trans_atom b) | Ast.EXPR_unary (unop, a) -> - assert (is_prim_type (atom_type cx a)); + assert (is_prim_type (simplified_ty (atom_type cx a))); let src = trans_atom a in let bits = Il.operand_bits word_bits src in let dst = Il.Reg (Il.next_vreg (emitter()), Il.ValTy bits) in @@ -1904,6 +1927,7 @@ let trans_visitor | Ast.UNOP_cast t -> let t = Hashtbl.find cx.ctxt_all_cast_types t.id in let at = atom_type cx a in + let (t, at) = (simplified_ty t, simplified_ty at) in if (type_is_2s_complement at) && (type_is_2s_complement t) then @@ -2043,7 +2067,7 @@ let trans_visitor List.iter patch fwd_jmps and trans_check_expr (id:node_id) (e:Ast.expr) : unit = - match expr_type cx e with + match simplified_ty (expr_type cx e) with Ast.TY_bool -> let fwd_jmps = trans_cond false e in trans_cond_fail (Fmt.fmt_to_str Ast.fmt_expr e) fwd_jmps @@ -2096,8 +2120,8 @@ let trans_visitor end and trans_init_port (dst:Ast.lval) : unit = - let (dstcell, dst_slot) = trans_lval_init dst in - let unit_ty = match slot_ty dst_slot with + let (dstcell, dst_ty) = trans_lval_init dst in + let unit_ty = match dst_ty with Ast.TY_port t -> t | _ -> bug () "init dst of port-init has non-port type" in @@ -2120,7 +2144,7 @@ let trans_visitor trans_void_upcall "upcall_kill" [| Il.Cell task |] (* - * A vec is implicitly exterior: every slot vec[T] is 1 word and + * A vec is implicitly boxed: every slot vec[T] is 1 word and * points to a refcounted structure. That structure has 3 words with * defined meaning at the beginning; data follows the header. * @@ -2134,19 +2158,18 @@ let trans_visitor *) and trans_init_vec (dst:Ast.lval) (atoms:Ast.atom array) : unit = - let (dst_cell, dst_slot) = trans_lval_init dst in - let dst_ty = slot_ty dst_slot in + let (dst_cell, dst_ty) = trans_lval_init dst in let gc_ctrl = - if (slot_mem_ctrl dst_slot) = MEM_gc - then Il.Cell (get_tydesc None (slot_ty dst_slot)) + if (ty_mem_ctrl dst_ty) = MEM_gc + then Il.Cell (get_tydesc None dst_ty) else zero in - let unit_slot = match dst_ty with - Ast.TY_vec s -> s + let unit_ty = match dst_ty with + Ast.TY_vec t -> t | _ -> bug () "init dst of vec-init has non-vec type" in - let fill = next_vreg_cell word_ty in - let unit_sz = slot_sz_in_current_frame unit_slot in + let fill = next_vreg_cell word_sty in + let unit_sz = ty_sz_in_current_frame unit_ty in umul fill unit_sz (imm (Int64.of_int (Array.length atoms))); trans_upcall "upcall_new_vec" dst_cell [| Il.Cell fill; gc_ctrl |]; let vec = deref dst_cell in @@ -2155,18 +2178,35 @@ let trans_visitor (get_element_ptr_dyn_in_current_frame vec Abi.vec_elt_data)) in - let unit_rty = slot_referent_type abi unit_slot in + let unit_rty = referent_type abi unit_ty in let body_rty = Il.StructTy (Array.map (fun _ -> unit_rty) atoms) in let body = Il.Mem (body_mem, body_rty) in Array.iteri begin fun i atom -> let cell = get_element_ptr_dyn_in_current_frame body i in - trans_init_slot_from_atom CLONE_none cell unit_slot atom + trans_init_ty_from_atom cell unit_ty atom end atoms; mov (get_element_ptr vec Abi.vec_elt_fill) (Il.Cell fill); + + and trans_init_box (dst:Ast.lval) (src:Ast.atom) : unit = + let src_op = trans_atom src in + let src_cell = Il.Mem (force_to_mem src_op) in + let src_ty = simplified_ty (atom_type cx src) in + let dst_sloti = lval_base_to_slot cx dst in + let dst_cell = cell_of_block_slot dst_sloti.id in + let dst_cell = deref_slot true dst_cell dst_sloti.node in + let dst_ty = slot_ty dst_sloti.node in + let (dst_cell, dst_ty) = + deref_ty DEREF_one_box true dst_cell dst_ty + in + let _ = assert (dst_ty = src_ty) in + trans_copy_ty (get_ty_params_of_current_frame()) true + dst_cell dst_ty src_cell src_ty None + + and get_dynamic_tydesc (idopt:node_id option) (t:Ast.ty) : Il.cell = let td = next_vreg_cell Il.voidptr_t in let root_desc = @@ -2213,44 +2253,40 @@ let trans_visitor (ty_align abi ty)) (tydesc_rty abi)) - and exterior_ctrl_cell (cell:Il.cell) (off:int) : Il.cell = - let (mem, _) = need_mem_cell (deref_imm cell (word_n off)) in - word_at mem - - and exterior_rc_cell (cell:Il.cell) : Il.cell = - exterior_ctrl_cell cell Abi.exterior_rc_slot_field_refcnt + and box_rc_cell (cell:Il.cell) : Il.cell = + get_element_ptr (deref cell) Abi.box_rc_slot_field_refcnt - and exterior_allocation_size - (slot:Ast.slot) + and box_allocation_size + (ty:Ast.ty) : Il.operand = let header_sz = - match slot_mem_ctrl slot with + match ty_mem_ctrl ty with MEM_gc | MEM_rc_opaque - | MEM_rc_struct -> word_n Abi.exterior_rc_header_size - | MEM_interior -> bug () "exterior_allocation_size of MEM_interior" + | MEM_rc_struct -> word_n Abi.box_rc_header_size + | MEM_interior -> bug () "box_allocation_size of MEM_interior" in - let t = slot_ty slot in + let ty = simplified_ty ty in let refty_sz = - Il.referent_ty_size abi.Abi.abi_word_bits (referent_type abi t) + Il.referent_ty_size abi.Abi.abi_word_bits (referent_type abi ty) in match refty_sz with - SIZE_fixed _ -> imm (Int64.add (ty_sz abi t) header_sz) + SIZE_fixed _ -> imm (Int64.add (ty_sz abi ty) header_sz) | _ -> let ty_params = get_ty_params_of_current_frame() in let refty_sz = calculate_sz ty_params refty_sz in - let v = next_vreg word_ty in - let vc = Il.Reg (v, word_ty) in + let v = next_vreg word_sty in + let vc = Il.Reg (v, word_sty) in mov vc refty_sz; add_to vc (imm header_sz); Il.Cell vc; - and iter_tag_slots + and iter_tag_parts (ty_params:Il.cell) (dst_cell:Il.cell) (src_cell:Il.cell) (ttag:Ast.ty_tag) - (f:Il.cell -> Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit) + (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit) (curr_iso:Ast.ty_iso option) : unit = let tag_keys = sorted_htab_keys ttag in @@ -2258,8 +2294,8 @@ let trans_visitor let dst_tag = get_element_ptr dst_cell 0 in let src_union = get_element_ptr_dyn ty_params src_cell 1 in let dst_union = get_element_ptr_dyn ty_params dst_cell 1 in - let tmp = next_vreg_cell word_ty in - f dst_tag src_tag word_slot curr_iso; + let tmp = next_vreg_cell word_sty in + f dst_tag src_tag word_ty curr_iso; mov tmp (Il.Cell src_tag); Array.iteri begin @@ -2271,7 +2307,7 @@ let trans_visitor trans_compare Il.JNE (Il.Cell tmp) (imm (Int64.of_int i)) in let ttup = Hashtbl.find ttag key in - iter_tup_slots + iter_tup_parts (get_element_ptr_dyn ty_params) (get_variant_ptr dst_union i) (get_variant_ptr src_union i) @@ -2284,29 +2320,29 @@ let trans_visitor tiso.Ast.iso_group.(tiso.Ast.iso_index) - and seq_unit_slot (seq:Ast.ty) : Ast.slot = + and seq_unit_ty (seq:Ast.ty) : Ast.ty = match seq with - Ast.TY_vec s -> s - | Ast.TY_str -> (interior_slot (Ast.TY_mach TY_u8)) - | _ -> bug () "seq_unit_slot of non-vec, non-str type" + Ast.TY_vec t -> t + | Ast.TY_str -> Ast.TY_mach TY_u8 + | _ -> bug () "seq_unit_ty of non-vec, non-str type" - and iter_seq_slots + and iter_seq_parts (ty_params:Il.cell) (dst_cell:Il.cell) (src_cell:Il.cell) - (unit_slot:Ast.slot) - (f:Il.cell -> Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit) + (unit_ty:Ast.ty) + (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit) (curr_iso:Ast.ty_iso option) : unit = - let unit_sz = slot_sz_with_ty_params ty_params unit_slot in + let unit_sz = ty_sz_with_ty_params ty_params unit_ty in (* - * Unlike most of the iter_ty_slots helpers; this one allocates a + * Unlike most of the iter_ty_parts helpers; this one allocates a * vreg and so has to be aware of when it's iterating over 2 * sequences of cells or just 1. *) - check_exterior_rty src_cell; - check_exterior_rty dst_cell; + check_box_rty src_cell; + check_box_rty dst_cell; if dst_cell = src_cell then begin @@ -2323,9 +2359,9 @@ let trans_visitor let back_jmp_target = mark () in let fwd_jmps = trans_compare Il.JAE (Il.Cell ptr) (Il.Cell lim) in let unit_cell = - deref (ptr_cast ptr (slot_referent_type abi unit_slot)) + deref (ptr_cast ptr (referent_type abi unit_ty)) in - f unit_cell unit_cell unit_slot curr_iso; + f unit_cell unit_cell unit_ty curr_iso; add_to ptr unit_sz; check_interrupt_flag (); emit (Il.jmp Il.JMP (Il.CodeLabel back_jmp_target)); @@ -2337,12 +2373,12 @@ let trans_visitor end - and iter_ty_slots_full + and iter_ty_parts_full (ty_params:Il.cell) - (ty:Ast.ty) (dst_cell:Il.cell) (src_cell:Il.cell) - (f:Il.cell -> Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit) + (ty:Ast.ty) + (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit) (curr_iso:Ast.ty_iso option) : unit = (* @@ -2352,84 +2388,74 @@ let trans_visitor *) match ty with Ast.TY_rec entries -> - iter_rec_slots + iter_rec_parts (get_element_ptr_dyn ty_params) dst_cell src_cell entries f curr_iso - | Ast.TY_tup slots -> - iter_tup_slots + | Ast.TY_tup tys -> + iter_tup_parts (get_element_ptr_dyn ty_params) dst_cell src_cell - slots f curr_iso + tys f curr_iso | Ast.TY_tag tag -> - iter_tag_slots ty_params dst_cell src_cell tag f curr_iso + iter_tag_parts ty_params dst_cell src_cell tag f curr_iso | Ast.TY_iso tiso -> let ttag = get_iso_tag tiso in - iter_tag_slots ty_params dst_cell src_cell ttag f (Some tiso) + iter_tag_parts ty_params dst_cell src_cell ttag f (Some tiso) | Ast.TY_fn _ | Ast.TY_obj _ -> bug () "Attempting to iterate over fn/pred/obj slots" | Ast.TY_vec _ | Ast.TY_str -> - let unit_slot = seq_unit_slot ty in - iter_seq_slots ty_params dst_cell src_cell unit_slot f curr_iso + let unit_ty = seq_unit_ty ty in + iter_seq_parts ty_params dst_cell src_cell unit_ty f curr_iso | _ -> () (* - * This just calls iter_ty_slots_full with your cell as both src and - * dst, with an adaptor function that discards the dst slots of the + * This just calls iter_ty_parts_full with your cell as both src and + * dst, with an adaptor function that discards the dst parts of the * parallel traversal and and calls your provided function on the - * passed-in src slots. + * passed-in src parts. *) - and iter_ty_slots + and iter_ty_parts (ty_params:Il.cell) - (ty:Ast.ty) (cell:Il.cell) - (f:Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit) + (ty:Ast.ty) + (f:Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit) (curr_iso:Ast.ty_iso option) : unit = - iter_ty_slots_full ty_params ty cell cell - (fun _ src_cell slot curr_iso -> f src_cell slot curr_iso) + iter_ty_parts_full ty_params cell cell ty + (fun _ src_cell ty curr_iso -> f src_cell ty curr_iso) curr_iso and drop_ty (ty_params:Il.cell) - (ty:Ast.ty) (cell:Il.cell) + (ty:Ast.ty) (curr_iso:Ast.ty_iso option) : unit = - match ty with - Ast.TY_param (i, _) -> - iflog (fun _ -> annotate - (Printf.sprintf "drop_ty: parametric drop %#d" i)); - aliasing false cell - begin - fun cell -> - trans_call_simple_dynamic_glue - i Abi.tydesc_field_drop_glue ty_params cell - end - | Ast.TY_fn _ -> - begin + let ty = maybe_iso curr_iso ty in + let curr_iso = maybe_enter_iso ty curr_iso in + let mctrl = ty_mem_ctrl ty in + + match ty with + + Ast.TY_fn _ -> let binding = get_element_ptr cell Abi.binding_field_binding in let null_jmp = null_check binding in (* Drop non-null bindings. *) - (* FIXME (issue #58): this is completely wrong, - * need a second thunk that generates code to make - * use of a runtime type descriptor extracted from - * a binding tuple. For now this only works by - * accident. + (* FIXME (issue #58): this is completely wrong, Closures need to + * carry tydescs like objs. For now this only works by accident, + * and will leak closures with box substructure. *) - drop_slot ty_params binding - (exterior_slot Ast.TY_int) curr_iso; + drop_ty ty_params binding (Ast.TY_box Ast.TY_int) curr_iso; patch null_jmp - end - | Ast.TY_obj _ -> - begin + | Ast.TY_obj _ -> let binding = get_element_ptr cell Abi.binding_field_binding in let null_jmp = null_check binding in let obj = deref binding in @@ -2445,139 +2471,143 @@ let trans_visitor in let null_dtor_jmp = null_check dtor in (* Call any dtor, if present. *) - trans_call_dynamic_glue tydesc - Abi.tydesc_field_obj_drop_glue None [| binding |]; - patch null_dtor_jmp; - (* Drop the body. *) - trans_call_dynamic_glue tydesc - Abi.tydesc_field_drop_glue None [| ty_params; alias body |]; - (* FIXME: this will fail if the user has lied about the - * state-ness of their obj. We need to store state-ness in the - * captured tydesc, and use that. *) - trans_free binding (type_has_state ty); - mov binding zero; - patch rc_jmp; - patch null_jmp - end + trans_call_dynamic_glue tydesc + Abi.tydesc_field_obj_drop_glue None [| binding |]; + patch null_dtor_jmp; + (* Drop the body. *) + trans_call_dynamic_glue tydesc + Abi.tydesc_field_drop_glue None [| ty_params; alias body |]; + (* FIXME: this will fail if the user has lied about the + * state-ness of their obj. We need to store state-ness in the + * captured tydesc, and use that. *) + trans_free binding (type_has_state ty); + mov binding zero; + patch rc_jmp; + patch null_jmp + | Ast.TY_param (i, _) -> + iflog (fun _ -> annotate + (Printf.sprintf "drop_ty: parametric drop %#d" i)); + aliasing false cell + begin + fun cell -> + trans_call_simple_dynamic_glue + i Abi.tydesc_field_drop_glue ty_params cell + end + | _ -> - iter_ty_slots ty_params ty cell (drop_slot ty_params) curr_iso + match mctrl with + MEM_gc + | MEM_rc_opaque + | MEM_rc_struct -> + + note_drop_step ty "in box-drop path of drop_ty"; + + let _ = check_box_rty cell in + let null_jmp = null_check cell in + let rc = box_rc_cell cell in + let j = drop_refcount_and_cmp rc in + + (* FIXME (issue #25): check to see that the box has + * further box members; if it doesn't we can elide the + * call to the glue function. *) + + if mctrl = MEM_rc_opaque + then + free_ty false ty_params ty cell curr_iso + else + trans_call_simple_static_glue + (get_free_glue ty (mctrl = MEM_gc) curr_iso) + ty_params cell; + + (* Null the slot out to prevent double-free if the frame + * unwinds. + *) + mov cell zero; + patch j; + patch null_jmp + + | MEM_interior when type_is_structured ty -> + note_drop_step ty "in structured-interior path of drop_ty"; + iter_ty_parts ty_params cell ty + (drop_ty ty_params) curr_iso + + | MEM_interior -> + note_drop_step ty "in simple-interior path of drop_ty"; + (* Interior allocation of all-interior value not caught above: + * nothing to do. + *) + () and sever_ty (ty_params:Il.cell) - (ty:Ast.ty) (cell:Il.cell) - (curr_iso:Ast.ty_iso option) - : unit = - match ty with - | Ast.TY_fn _ - | Ast.TY_obj _ -> () - | _ -> - iter_ty_slots ty_params ty cell (sever_slot ty_params) curr_iso - - and mark_ty - (ty_params:Il.cell) (ty:Ast.ty) - (cell:Il.cell) (curr_iso:Ast.ty_iso option) : unit = - match ty with - | Ast.TY_fn _ - | Ast.TY_obj _ -> () - | _ -> - iter_ty_slots ty_params ty cell (mark_slot ty_params) curr_iso + let _ = note_gc_step ty "severing" in + let sever_box c = + let _ = check_box_rty c in + let null_jmp = null_check c in + let rc = box_rc_cell c in + let _ = note_gc_step ty "severing GC cell" in + emit (Il.binary Il.SUB rc (Il.Cell rc) one); + mov c zero; + patch null_jmp + in + + match strip_mutable_or_constrained_ty ty with + Ast.TY_fn _ + | Ast.TY_obj _ -> + if type_has_state ty + then + let binding = get_element_ptr cell Abi.binding_field_binding in + sever_box binding; + + | _ -> + match ty_mem_ctrl ty with + MEM_gc -> + sever_box cell + + | MEM_interior when type_is_structured ty -> + iter_ty_parts ty_params cell ty + (sever_ty ty_params) curr_iso + + | _ -> () + (* No need to follow links / call glue; severing is + shallow. *) and clone_ty (ty_params:Il.cell) (clone_task:Il.cell) - (ty:Ast.ty) (dst:Il.cell) (src:Il.cell) - (curr_iso:Ast.ty_iso option) - : unit = - match ty with - Ast.TY_chan _ -> - trans_upcall "upcall_clone_chan" dst - [| (Il.Cell clone_task); (Il.Cell src) |] - | Ast.TY_task - | Ast.TY_port _ - | _ when type_has_state ty - -> bug () "cloning mutable type" - | _ when i64_le (ty_sz abi ty) word_sz - -> mov dst (Il.Cell src) - | Ast.TY_fn _ - | Ast.TY_obj _ -> () - | _ -> - iter_ty_slots_full ty_params ty dst src - (clone_slot ty_params clone_task) curr_iso - - and copy_ty - (ty_params:Il.cell) (ty:Ast.ty) - (dst:Il.cell) - (src:Il.cell) (curr_iso:Ast.ty_iso option) : unit = - iflog (fun _ -> - annotate ("copy_ty: referent data of type " ^ - (Fmt.fmt_to_str Ast.fmt_ty ty))); - match ty with - Ast.TY_nil - | Ast.TY_bool - | Ast.TY_mach _ - | Ast.TY_int - | Ast.TY_uint - | Ast.TY_native _ - | Ast.TY_type - | Ast.TY_char -> - iflog - (fun _ -> annotate - (Printf.sprintf "copy_ty: simple mov (%Ld byte scalar)" - (ty_sz abi ty))); - mov dst (Il.Cell src) - - | Ast.TY_param (i, _) -> - iflog - (fun _ -> annotate - (Printf.sprintf "copy_ty: parametric copy %#d" i)); - aliasing false src - begin - fun src -> - let td = get_ty_param ty_params i in - let ty_params_ptr = get_tydesc_params ty_params td in - trans_call_dynamic_glue - td Abi.tydesc_field_copy_glue - (Some dst) [| ty_params_ptr; src; |] - end - - | Ast.TY_fn _ - | Ast.TY_obj _ -> - begin - let src_item = get_element_ptr src Abi.binding_field_item in - let dst_item = get_element_ptr dst Abi.binding_field_item in - let src_binding = get_element_ptr src Abi.binding_field_binding in - let dst_binding = get_element_ptr dst Abi.binding_field_binding in - mov dst_item (Il.Cell src_item); - let null_jmp = null_check src_binding in - (* Copy if we have a src binding. *) - (* FIXME (issue #58): this is completely wrong, call - * through to the binding's self-copy fptr. For now - * this only works by accident. - *) - trans_copy_slot ty_params true - dst_binding (exterior_slot Ast.TY_int) - src_binding (exterior_slot Ast.TY_int) - curr_iso; - patch null_jmp - end - - | _ -> - iter_ty_slots_full ty_params ty dst src - (fun dst src slot curr_iso -> - trans_copy_slot ty_params true - dst slot src slot curr_iso) - curr_iso + let ty = strip_mutable_or_constrained_ty ty in + match ty with + Ast.TY_chan _ -> + trans_upcall "upcall_clone_chan" dst + [| (Il.Cell clone_task); (Il.Cell src) |] + | Ast.TY_task + | Ast.TY_port _ + | _ when type_has_state ty + -> bug () "cloning state type" + | _ when i64_le (ty_sz abi ty) word_sz + -> mov dst (Il.Cell src) + | Ast.TY_fn _ + | Ast.TY_obj _ -> () + | Ast.TY_box ty -> + let glue_fix = get_clone_glue ty curr_iso in + trans_call_static_glue + (code_fixup_to_ptr_operand glue_fix) + (Some dst) + [| alias ty_params; src; clone_task |] + | _ -> + iter_ty_parts_full ty_params dst src ty + (clone_ty ty_params clone_task) curr_iso and free_ty (is_gc:bool) @@ -2591,8 +2621,8 @@ let trans_visitor | Ast.TY_chan _ -> trans_del_chan cell | Ast.TY_task -> trans_kill_task cell | Ast.TY_vec s -> - iter_seq_slots ty_params cell cell s - (fun _ src slot iso -> drop_slot ty_params src slot iso) curr_iso; + iter_seq_parts ty_params cell cell s + (fun _ src ty iso -> drop_ty ty_params src ty iso) curr_iso; trans_free cell is_gc | _ -> trans_free cell is_gc @@ -2601,10 +2631,11 @@ let trans_visitor (curr_iso:Ast.ty_iso option) (t:Ast.ty) : Ast.ty = - match (curr_iso, t) with - (Some iso, Ast.TY_idx n) -> - Ast.TY_iso { iso with Ast.iso_index = n } - | (None, Ast.TY_idx _) -> + match (curr_iso, strip_mutable_or_constrained_ty t) with + (_, Ast.TY_idx _) -> bug () "traversing raw TY_idx (non-box )edge" + | (Some iso, Ast.TY_box (Ast.TY_idx n)) -> + Ast.TY_box (Ast.TY_iso { iso with Ast.iso_index = n }) + | (None, Ast.TY_box (Ast.TY_idx _)) -> bug () "TY_idx outside TY_iso" | _ -> t @@ -2612,78 +2643,50 @@ let trans_visitor (t:Ast.ty) (curr_iso:Ast.ty_iso option) : Ast.ty_iso option = - match t with - Ast.TY_iso tiso -> Some tiso + match strip_mutable_or_constrained_ty t with + Ast.TY_box (Ast.TY_iso tiso) -> Some tiso | _ -> curr_iso - and sever_slot + and mark_slot (ty_params:Il.cell) (cell:Il.cell) (slot:Ast.slot) (curr_iso:Ast.ty_iso option) : unit = - let _ = note_gc_step slot "severing" in - let ty = slot_ty slot in - match slot_mem_ctrl slot with - MEM_gc -> - - let _ = check_exterior_rty cell in - let null_jmp = null_check cell in - let rc = exterior_rc_cell cell in - let _ = note_gc_step slot "severing GC slot" in - emit (Il.binary Il.SUB rc (Il.Cell rc) one); - mov cell zero; - patch null_jmp + (* Marking goes straight through aliases. Reachable means reachable. *) + mark_ty ty_params (deref_slot false cell slot) (slot_ty slot) curr_iso - | MEM_interior when type_is_structured ty -> - let (mem, _) = need_mem_cell cell in - let tmp = next_vreg_cell Il.voidptr_t in - let ty = maybe_iso curr_iso ty in - let curr_iso = maybe_enter_iso ty curr_iso in - lea tmp mem; - trans_call_simple_static_glue - (get_sever_glue ty curr_iso) - ty_params tmp - - | MEM_interior -> - (* Interior allocation of all-interior value: sever directly. *) - let ty = maybe_iso curr_iso ty in - sever_ty ty_params ty cell curr_iso - - | _ -> () - - and mark_slot + and mark_ty (ty_params:Il.cell) (cell:Il.cell) - (slot:Ast.slot) + (ty:Ast.ty) (curr_iso:Ast.ty_iso option) : unit = - let ty = slot_ty slot in - match slot_mem_ctrl slot with - MEM_gc -> - let tmp = next_vreg_cell Il.voidptr_t in + match ty_mem_ctrl ty with + MEM_gc -> + let tmp = next_vreg_cell Il.voidptr_t in trans_upcall "upcall_mark" tmp [| Il.Cell cell |]; - let marked_jump = - trans_compare Il.JE (Il.Cell tmp) zero; - in - (* Iterate over exterior slots marking outgoing links. *) - let (body_mem, _) = - need_mem_cell - (get_element_ptr (deref cell) - Abi.exterior_gc_slot_field_body) - in - let ty = maybe_iso curr_iso ty in - let curr_iso = maybe_enter_iso ty curr_iso in - lea tmp body_mem; - trans_call_simple_static_glue - (get_mark_glue ty curr_iso) - ty_params tmp; - List.iter patch marked_jump; + let marked_jump = + trans_compare Il.JE (Il.Cell tmp) zero; + in + (* Iterate over box parts marking outgoing links. *) + let (body_mem, _) = + need_mem_cell + (get_element_ptr (deref cell) + Abi.box_gc_slot_field_body) + in + let ty = maybe_iso curr_iso ty in + let curr_iso = maybe_enter_iso ty curr_iso in + lea tmp body_mem; + trans_call_simple_static_glue + (get_mark_glue ty curr_iso) + ty_params tmp; + List.iter patch marked_jump; | MEM_interior when type_is_structured ty -> (iflog (fun _ -> - annotate ("mark interior slot " ^ - (Fmt.fmt_to_str Ast.fmt_slot slot)))); + annotate ("mark interior memory " ^ + (Fmt.fmt_to_str Ast.fmt_ty ty)))); let (mem, _) = need_mem_cell cell in let tmp = next_vreg_cell Il.voidptr_t in let ty = maybe_iso curr_iso ty in @@ -2695,39 +2698,15 @@ let trans_visitor | _ -> () - and check_exterior_rty cell = + and check_box_rty cell = match cell with Il.Reg (_, Il.AddrTy (Il.StructTy fields)) | Il.Mem (_, Il.ScalarTy (Il.AddrTy (Il.StructTy fields))) when (((Array.length fields) > 0) && (fields.(0) = word_rty)) -> () | _ -> bug () - "expected plausibly-exterior cell, got %s" + "expected plausibly-box cell, got %s" (Il.string_of_referent_ty (Il.cell_referent_ty cell)) - and clone_slot - (ty_params:Il.cell) - (clone_task:Il.cell) - (dst:Il.cell) - (src:Il.cell) - (dst_slot:Ast.slot) - (curr_iso:Ast.ty_iso option) - : unit = - let ty = slot_ty dst_slot in - match dst_slot.Ast.slot_mode with - Ast.MODE_exterior _ -> - let ty = maybe_iso curr_iso ty in - let curr_iso = maybe_enter_iso ty curr_iso in - let dst = deref_slot true dst dst_slot in - let glue_fix = get_clone_glue (slot_ty dst_slot) curr_iso in - trans_call_static_glue - (code_fixup_to_ptr_operand glue_fix) - (Some dst) - [| alias ty_params; src; clone_task |] - - | Ast.MODE_alias _ -> bug () "cloning into alias slot" - | Ast.MODE_interior _ -> - clone_ty ty_params clone_task ty dst src curr_iso - and drop_slot_in_current_frame (cell:Il.cell) (slot:Ast.slot) @@ -2755,104 +2734,101 @@ let trans_visitor (slot:Ast.slot) (curr_iso:Ast.ty_iso option) : unit = - let ty = slot_ty slot in - let ty = maybe_iso curr_iso ty in - let curr_iso = maybe_enter_iso ty curr_iso in - let slot = {slot with Ast.slot_ty = Some ty} in - let mctrl = slot_mem_ctrl slot in - match mctrl with - MEM_rc_opaque - | MEM_gc - | MEM_rc_struct -> - let _ = check_exterior_rty cell in - let null_jmp = null_check cell in - let rc = exterior_rc_cell cell in - let j = drop_refcount_and_cmp rc in - - (* FIXME (issue #25): check to see that the exterior has - * further exterior members; if it doesn't we can elide the - * call to the glue function. *) - - if mctrl = MEM_rc_opaque - then - free_ty false ty_params ty cell curr_iso - else - trans_call_simple_static_glue - (get_free_glue ty (mctrl = MEM_gc) curr_iso) - ty_params cell; - - (* Null the slot out to prevent double-free if the frame - * unwinds. - *) - mov cell zero; - patch j; - patch null_jmp - - | MEM_interior when type_is_structured ty -> - (iflog (fun _ -> - annotate ("drop interior slot " ^ - (Fmt.fmt_to_str Ast.fmt_slot slot)))); - let (mem, _) = need_mem_cell cell in - let vr = next_vreg_cell Il.voidptr_t in - lea vr mem; - trans_call_simple_static_glue - (get_drop_glue ty curr_iso) - ty_params vr - - | MEM_interior -> - (* Interior allocation of all-interior value: free directly. *) - let ty = maybe_iso curr_iso ty in - drop_ty ty_params ty cell curr_iso + match slot.Ast.slot_mode with + Ast.MODE_alias -> () + (* Aliases are always free to drop. *) + | Ast.MODE_local -> + drop_ty ty_params cell (slot_ty slot) curr_iso and note_drop_step ty step = if cx.ctxt_sess.Session.sess_trace_drop || cx.ctxt_sess.Session.sess_log_trans then - let slotstr = Fmt.fmt_to_str Ast.fmt_ty ty in - let str = step ^ " " ^ slotstr in + let mctrl_str = + match ty_mem_ctrl ty with + MEM_gc -> "MEM_gc" + | MEM_rc_struct -> "MEM_rc_struct" + | MEM_rc_opaque -> "MEM_rc_opaque" + | MEM_interior -> "MEM_interior" + in + let tystr = Fmt.fmt_to_str Ast.fmt_ty ty in + let str = step ^ " " ^ mctrl_str ^ " " ^ tystr in begin annotate str; trace_str cx.ctxt_sess.Session.sess_trace_drop str end - and note_gc_step slot step = + and note_gc_step ty step = if cx.ctxt_sess.Session.sess_trace_gc || cx.ctxt_sess.Session.sess_log_trans then let mctrl_str = - match slot_mem_ctrl slot with + match ty_mem_ctrl ty with MEM_gc -> "MEM_gc" | MEM_rc_struct -> "MEM_rc_struct" | MEM_rc_opaque -> "MEM_rc_opaque" | MEM_interior -> "MEM_interior" in - let slotstr = Fmt.fmt_to_str Ast.fmt_slot slot in - let str = step ^ " " ^ mctrl_str ^ " " ^ slotstr in + let tystr = Fmt.fmt_to_str Ast.fmt_ty ty in + let str = step ^ " " ^ mctrl_str ^ " " ^ tystr in begin annotate str; trace_str cx.ctxt_sess.Session.sess_trace_gc str end (* Returns the offset of the slot-body in the initialized allocation. *) - and init_exterior_slot (cell:Il.cell) (slot:Ast.slot) : unit = - let mctrl = slot_mem_ctrl slot in + and init_box (cell:Il.cell) (ty:Ast.ty) : unit = + let mctrl = ty_mem_ctrl ty in match mctrl with MEM_gc | MEM_rc_opaque | MEM_rc_struct -> let ctrl = if mctrl = MEM_gc - then Il.Cell (get_tydesc None (slot_ty slot)) + then Il.Cell (get_tydesc None ty) else zero in - iflog (fun _ -> annotate "init exterior: malloc"); - let sz = exterior_allocation_size slot in + iflog (fun _ -> annotate "init box: malloc"); + let sz = box_allocation_size ty in trans_malloc cell sz ctrl; - iflog (fun _ -> annotate "init exterior: load refcount"); - let rc = exterior_rc_cell cell in + iflog (fun _ -> annotate "init box: load refcount"); + let rc = box_rc_cell cell in mov rc one - | MEM_interior -> bug () "init_exterior_slot of MEM_interior" + | MEM_interior -> bug () "init_box of MEM_interior" + + and deref_ty + (dctrl:deref_ctrl) + (initializing:bool) + (cell:Il.cell) + (ty:Ast.ty) + : (Il.cell * Ast.ty) = + match (ty, dctrl) with + + | (Ast.TY_mutable ty, _) + | (Ast.TY_constrained (ty, _), _) -> + deref_ty dctrl initializing cell ty + + | (Ast.TY_box ty', DEREF_one_box) + | (Ast.TY_box ty', DEREF_all_boxes) -> + check_box_rty cell; + if initializing + then init_box cell ty; + let cell = + get_element_ptr_dyn_in_current_frame + (deref cell) + (Abi.box_rc_slot_field_body) + in + let inner_dctrl = + if dctrl = DEREF_one_box + then DEREF_none + else DEREF_all_boxes + in + (* Possibly deref recursively. *) + deref_ty inner_dctrl initializing cell ty' + + | _ -> (cell, ty) + and deref_slot (initializing:bool) @@ -2860,17 +2836,9 @@ let trans_visitor (slot:Ast.slot) : Il.cell = match slot.Ast.slot_mode with - Ast.MODE_interior _ -> + Ast.MODE_local -> cell - | Ast.MODE_exterior _ -> - check_exterior_rty cell; - if initializing - then init_exterior_slot cell slot; - get_element_ptr_dyn_in_current_frame - (deref cell) - Abi.exterior_rc_slot_field_body - | Ast.MODE_alias _ -> if initializing then cell @@ -2881,57 +2849,61 @@ let trans_visitor (initializing:bool) (dst:Il.cell) (src:Il.cell) - (slots:Ast.ty_tup) + (tys:Ast.ty_tup) : unit = Array.iteri begin - fun i slot -> + fun i ty -> let sub_dst_cell = get_element_ptr_dyn ty_params dst i in let sub_src_cell = get_element_ptr_dyn ty_params src i in - trans_copy_slot + trans_copy_ty ty_params initializing - sub_dst_cell slot sub_src_cell slot None + sub_dst_cell ty sub_src_cell ty None end - slots + tys - and trans_copy_slot + and trans_copy_ty (ty_params:Il.cell) (initializing:bool) - (dst:Il.cell) (dst_slot:Ast.slot) - (src:Il.cell) (src_slot:Ast.slot) + (dst:Il.cell) (dst_ty:Ast.ty) + (src:Il.cell) (src_ty:Ast.ty) (curr_iso:Ast.ty_iso option) : unit = let anno (weight:string) : unit = iflog begin fun _ -> + log cx "trans_copy_ty"; + log cx " dst ty %a, src ty %a" + Ast.sprintf_ty dst_ty Ast.sprintf_ty src_ty; + log cx " dst cell %s, src cell %s" + (cell_str dst) (cell_str src); annotate (Printf.sprintf "%sweight copy: %a <- %a" weight - Ast.sprintf_slot dst_slot - Ast.sprintf_slot src_slot) + Ast.sprintf_ty dst_ty + Ast.sprintf_ty src_ty) end; in - assert (slot_ty src_slot = slot_ty dst_slot); - match (slot_mem_ctrl src_slot, - slot_mem_ctrl dst_slot) with + assert (simplified_ty src_ty = simplified_ty dst_ty); + match (ty_mem_ctrl src_ty, ty_mem_ctrl dst_ty) with | (MEM_rc_opaque, MEM_rc_opaque) | (MEM_gc, MEM_gc) | (MEM_rc_struct, MEM_rc_struct) -> (* Lightweight copy: twiddle refcounts, move pointer. *) anno "refcounted light"; - add_to (exterior_rc_cell src) one; + add_to (box_rc_cell src) one; if not initializing then - drop_slot ty_params dst dst_slot None; + drop_ty ty_params dst dst_ty None; mov dst (Il.Cell src) | _ -> (* Heavyweight copy: duplicate 1 level of the referent. *) anno "heavy"; - trans_copy_slot_heavy ty_params initializing - dst dst_slot src src_slot curr_iso + trans_copy_ty_heavy ty_params initializing + dst dst_ty src src_ty curr_iso (* NB: heavyweight copying here does not mean "producing a deep * clone of the entire data tree rooted at the src operand". It means @@ -2960,39 +2932,116 @@ let trans_visitor * *) - and trans_copy_slot_heavy + and trans_copy_ty_heavy (ty_params:Il.cell) (initializing:bool) - (dst:Il.cell) (dst_slot:Ast.slot) - (src:Il.cell) (src_slot:Ast.slot) + (dst:Il.cell) (dst_ty:Ast.ty) + (src:Il.cell) (src_ty:Ast.ty) (curr_iso:Ast.ty_iso option) : unit = - assert (slot_ty src_slot = slot_ty dst_slot); - iflog (fun _ -> - annotate ("heavy copy: slot preparation")); + let src_ty = strip_mutable_or_constrained_ty src_ty in + let dst_ty = strip_mutable_or_constrained_ty dst_ty in + let dst_ty = maybe_iso curr_iso dst_ty in + let src_ty = maybe_iso curr_iso src_ty in + + iflog + begin + fun _ -> + log cx "trans_copy_ty_heavy"; + log cx " dst ty %a, src ty %a" + Ast.sprintf_ty dst_ty Ast.sprintf_ty src_ty; + log cx " dst cell %s, src cell %s" + (cell_str dst) (cell_str src); + end; + + assert (src_ty = dst_ty); + iflog (fun _ -> + annotate ("heavy copy: slot preparation")); + + let curr_iso = maybe_enter_iso dst_ty curr_iso in + let (dst, ty) = deref_ty DEREF_none initializing dst dst_ty in + let (src, _) = deref_ty DEREF_none false src src_ty in + assert (ty = dst_ty); + match ty with + Ast.TY_nil + | Ast.TY_bool + | Ast.TY_mach _ + | Ast.TY_int + | Ast.TY_uint + | Ast.TY_native _ + | Ast.TY_type + | Ast.TY_char -> + iflog + (fun _ -> annotate + (Printf.sprintf "copy_ty: simple mov (%Ld byte scalar)" + (ty_sz abi ty))); + mov dst (Il.Cell src) + + | Ast.TY_param (i, _) -> + iflog + (fun _ -> annotate + (Printf.sprintf "copy_ty: parametric copy %#d" i)); + aliasing false src + begin + fun src -> + let td = get_ty_param ty_params i in + let ty_params_ptr = get_tydesc_params ty_params td in + trans_call_dynamic_glue + td Abi.tydesc_field_copy_glue + (Some dst) [| ty_params_ptr; src; |] + end + + | Ast.TY_fn _ + | Ast.TY_obj _ -> + begin + let src_item = get_element_ptr src Abi.binding_field_item in + let dst_item = get_element_ptr dst Abi.binding_field_item in + let src_binding = + get_element_ptr src Abi.binding_field_binding + in + let dst_binding = + get_element_ptr dst Abi.binding_field_binding + in + mov dst_item (Il.Cell src_item); + let null_jmp = null_check src_binding in + (* Copy if we have a src binding. *) + (* FIXME (issue #58): this is completely wrong, call + * through to the binding's self-copy fptr. For now + * this only works by accident. + *) + trans_copy_ty ty_params false + dst_binding (Ast.TY_box Ast.TY_int) + src_binding (Ast.TY_box Ast.TY_int) + curr_iso; + patch null_jmp + end + + | _ -> + iter_ty_parts_full ty_params dst src ty + (fun dst src ty curr_iso -> + trans_copy_ty ty_params true + dst ty src ty curr_iso) + curr_iso - let ty = slot_ty src_slot in - let ty = maybe_iso curr_iso ty in - let curr_iso = maybe_enter_iso ty curr_iso in - let dst_slot = { dst_slot with Ast.slot_ty = Some ty } in - let src_slot = { src_slot with Ast.slot_ty = Some ty } in - let dst = deref_slot initializing dst dst_slot in - let src = deref_slot false src src_slot in - copy_ty ty_params ty dst src curr_iso and trans_copy (initializing:bool) (dst:Ast.lval) (src:Ast.expr) : unit = - let (dst_cell, dst_slot) = trans_lval_maybe_init initializing dst in - match (slot_ty dst_slot, src) with - (Ast.TY_vec _, + let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in + let rec can_append t = + match t with + Ast.TY_vec _ + | Ast.TY_str -> true + | Ast.TY_box t when can_append t -> true + | _ -> false + in + match (dst_ty, src) with + (t, Ast.EXPR_binary (Ast.BINOP_add, Ast.ATOM_lval a, Ast.ATOM_lval b)) - | (Ast.TY_str, - Ast.EXPR_binary (Ast.BINOP_add, - Ast.ATOM_lval a, Ast.ATOM_lval b)) -> + when can_append t -> (* * Translate str or vec * @@ -3003,14 +3052,14 @@ let trans_visitor * s = a; * s += b; *) - let (a_cell, a_slot) = trans_lval a in - let (b_cell, b_slot) = trans_lval b in - trans_copy_slot + let (a_cell, a_ty) = trans_lval a in + let (b_cell, b_ty) = trans_lval b in + trans_copy_ty (get_ty_params_of_current_frame()) - initializing dst_cell dst_slot - a_cell a_slot None; - trans_vec_append dst_cell dst_slot - (Il.Cell b_cell) (slot_ty b_slot) + initializing dst_cell dst_ty + a_cell a_ty None; + trans_vec_append dst_cell dst_ty + (Il.Cell b_cell) b_ty | (Ast.TY_obj caller_obj_ty, @@ -3026,7 +3075,6 @@ let trans_visitor | _ -> bug () "obj cast from non-obj type" in let src_cell = need_cell (trans_atom a) in - let src_slot = interior_slot src_ty in (* FIXME (issue #84): this is wrong. It treats the underlying * obj-state as the same as the callee and simply substitutes @@ -3036,16 +3084,16 @@ let trans_visitor * refcounted obj to hold the callee's vtbl+state pair, copy * that in as the state here. *) let _ = - trans_copy_slot (get_ty_params_of_current_frame()) + trans_copy_ty (get_ty_params_of_current_frame()) initializing - dst_cell dst_slot - src_cell src_slot + dst_cell dst_ty + src_cell src_ty in let caller_vtbl_oper = get_forwarding_vtbl caller_obj_ty callee_obj_ty in - let caller_obj = - deref_slot initializing dst_cell dst_slot + let (caller_obj, _) = + deref_ty DEREF_none initializing dst_cell dst_ty in let caller_vtbl = get_element_ptr caller_obj Abi.binding_field_item @@ -3061,19 +3109,21 @@ let trans_visitor * so copy is just MOV into the lval. *) let src_operand = trans_expr src in - mov (deref_slot false dst_cell dst_slot) src_operand + mov + (fst (deref_ty DEREF_none false dst_cell dst_ty)) + src_operand | (_, Ast.EXPR_atom (Ast.ATOM_lval src_lval)) -> if lval_is_direct_fn cx src_lval then trans_copy_direct_fn dst_cell src_lval else (* Possibly-large structure copying *) - let (src_cell, src_slot) = trans_lval src_lval in - trans_copy_slot + let (src_cell, src_ty) = trans_lval src_lval in + trans_copy_ty (get_ty_params_of_current_frame()) initializing - dst_cell dst_slot - src_cell src_slot + dst_cell dst_ty + src_cell src_ty None and trans_copy_direct_fn @@ -3089,120 +3139,136 @@ let trans_visitor let dst_pair_binding_cell = get_element_ptr dst_cell Abi.binding_field_binding in - mov dst_pair_item_cell (crate_rel_imm fix); mov dst_pair_binding_cell zero and trans_init_structural_from_atoms (dst:Il.cell) - (dst_slots:Ast.slot array) + (dst_tys:Ast.ty array) (atoms:Ast.atom array) : unit = Array.iteri begin fun i atom -> - trans_init_slot_from_atom - CLONE_none + trans_init_ty_from_atom (get_element_ptr_dyn_in_current_frame dst i) - dst_slots.(i) - atom + dst_tys.(i) atom end atoms and trans_init_rec_update (dst:Il.cell) - (dst_slots:Ast.slot array) + (dst_tys:Ast.ty array) (trec:Ast.ty_rec) - (atab:(Ast.ident * Ast.mode * bool * Ast.atom) array) + (atab:(Ast.ident * Ast.atom) array) (base:Ast.lval) : unit = Array.iteri begin fun i (fml_ident, _) -> - let fml_entry _ (act_ident, _, _, atom) = + let fml_entry _ (act_ident, atom) = if act_ident = fml_ident then Some atom else None in - let slot = dst_slots.(i) in + let dst_ty = dst_tys.(i) in match arr_search atab fml_entry with Some atom -> - trans_init_slot_from_atom - CLONE_none + trans_init_ty_from_atom (get_element_ptr_dyn_in_current_frame dst i) - slot - atom + dst_ty atom | None -> - let (src, _) = trans_lval base in - trans_copy_slot + let (src, src_ty) = trans_lval base in + trans_copy_ty (get_ty_params_of_current_frame()) true - (get_element_ptr_dyn_in_current_frame dst i) slot - (get_element_ptr_dyn_in_current_frame src i) slot + (get_element_ptr_dyn_in_current_frame dst i) dst_ty + (get_element_ptr_dyn_in_current_frame src i) src_ty None end trec - and trans_init_slot_from_atom - (clone:clone_ctrl) - (dst:Il.cell) (dst_slot:Ast.slot) - (atom:Ast.atom) + and trans_init_ty_from_atom + (dst:Il.cell) (ty:Ast.ty) (atom:Ast.atom) : unit = - let is_alias_cell = - match dst_slot.Ast.slot_mode with - Ast.MODE_alias _ -> true - | _ -> false - in - match atom with - | Ast.ATOM_literal _ -> - let src = trans_atom atom in - if is_alias_cell - then - match clone with - CLONE_none -> - (* Aliasing a literal is a bit weird since nobody - * else will ever see it, but it seems harmless. - *) - mov dst (Il.Cell (alias (Il.Mem (force_to_mem src)))) - | _ -> - bug () "attempting to clone alias cell" - else - mov (deref_slot true dst dst_slot) src - | Ast.ATOM_lval src_lval -> - let (src, src_slot) = trans_lval src_lval in - trans_init_slot_from_cell clone dst dst_slot src src_slot + let src = Il.Mem (force_to_mem (trans_atom atom)) in + trans_copy_ty (get_ty_params_of_current_frame()) + true dst ty src ty None and trans_init_slot_from_cell + (ty_params:Il.cell) (clone:clone_ctrl) (dst:Il.cell) (dst_slot:Ast.slot) - (src:Il.cell) (src_slot:Ast.slot) + (src:Il.cell) (src_ty:Ast.ty) : unit = - assert (slot_ty src_slot = slot_ty dst_slot); - let is_alias_cell = - match dst_slot.Ast.slot_mode with - Ast.MODE_alias _ -> true - | _ -> false + let dst_ty = slot_ty dst_slot in + let _ = + iflog (fun _ -> + log cx "trans_init_slot_from_cell"; + log cx " dst slot %a, src ty %a" + Ast.sprintf_slot dst_slot Ast.sprintf_ty src_ty; + log cx " dst cell %s, src cell %s" + (cell_str dst) (cell_str src)) in - match clone with - CLONE_chan clone_task -> + match (dst_slot.Ast.slot_mode, clone) with + (Ast.MODE_alias, CLONE_none) -> + mov dst (Il.Cell (alias (Il.Mem (need_mem_cell src)))) + + | (Ast.MODE_local, CLONE_none) -> + trans_copy_ty + ty_params true + dst dst_ty src src_ty None + + | (Ast.MODE_alias, _) -> + bug () "attempting to clone into alias slot" + + | (_, CLONE_chan clone_task) -> let clone = - if (type_contains_chan (slot_ty src_slot)) + if (type_contains_chan src_ty) then CLONE_all clone_task else CLONE_none in - trans_init_slot_from_cell clone dst dst_slot src src_slot - | CLONE_none -> - if is_alias_cell - then mov dst (Il.Cell (alias src)) - else - trans_copy_slot - (get_ty_params_of_current_frame()) - true dst dst_slot src src_slot None - | CLONE_all clone_task -> - if is_alias_cell - then bug () "attempting to clone alias cell" - else - clone_slot + (* Feed back with massaged args. *) + trans_init_slot_from_cell ty_params + clone dst dst_slot src src_ty + + | (_, CLONE_all clone_task) -> + clone_ty ty_params clone_task dst src src_ty None + + + and trans_init_slot_from_atom + (clone:clone_ctrl) + (dst:Il.cell) (dst_slot:Ast.slot) + (src_atom:Ast.atom) + : unit = + let _ = + iflog (fun _ -> + log cx "trans_init_slot_from_atom"; + log cx " dst slot %a, src ty %a" + Ast.sprintf_slot dst_slot + Ast.sprintf_ty (atom_type cx src_atom); + log cx " dst cell %s" + (cell_str dst)) + in + match (dst_slot.Ast.slot_mode, clone, src_atom) with + (Ast.MODE_alias, CLONE_none, + Ast.ATOM_literal _) -> + (* Aliasing a literal is a bit weird since nobody + * else will ever see it, but it seems harmless. + *) + let src = trans_atom src_atom in + mov dst (Il.Cell (alias (Il.Mem (force_to_mem src)))) + + | (Ast.MODE_alias, CLONE_chan _, _) + | (Ast.MODE_alias, CLONE_all _, _) -> + bug () "attempting to clone into alias slot" + | _ -> + let src = Il.Mem (force_to_mem (trans_atom src_atom)) in + begin + log cx " forced-to-mem src cell %s" (cell_str src); + trans_init_slot_from_cell (get_ty_params_of_current_frame()) - clone_task dst src dst_slot None + clone dst dst_slot src (atom_type cx src_atom) + end + and trans_be_fn (cx:ctxt) @@ -3376,9 +3442,10 @@ let trans_visitor (* Emit arg1 of any call: the task pointer. *) iflog (fun _ -> annotate "fn-call arg 1: task pointer"); trans_init_slot_from_cell + (get_ty_params_of_current_frame()) CLONE_none arg_cell word_slot - abi.Abi.abi_tp_cell word_slot + abi.Abi.abi_tp_cell word_ty and trans_argN (clone:clone_ctrl) @@ -3386,6 +3453,8 @@ let trans_visitor (arg_slot:Ast.slot) (arg:Ast.atom) : unit = + log cx "trans_argN: arg slot %a, arg atom %a" + Ast.sprintf_slot arg_slot Ast.sprintf_atom arg; trans_init_slot_from_atom clone arg_cell arg_slot arg and code_of_cell (cell:Il.cell) : Il.code = @@ -3405,7 +3474,7 @@ let trans_visitor (oper_str operand) and ty_arg_slots (ty:Ast.ty) : Ast.slot array = - match ty with + match simplified_ty ty with Ast.TY_fn (tsig, _) -> tsig.Ast.sig_input_slots | _ -> bug () "Trans.ty_arg_slots on non-callable type: %a" Ast.sprintf_ty ty @@ -3509,9 +3578,11 @@ let trans_visitor annotate (Printf.sprintf "fn-call ty param %d of %d" i n_ty_params)); - trans_init_slot_from_cell CLONE_none + trans_init_slot_from_cell + (get_ty_params_of_current_frame()) + CLONE_none (get_element_ptr callee_ty_params i) word_slot - (get_tydesc None ty_param) word_slot + (get_tydesc None ty_param) word_ty end call.call_callee_ty_params; @@ -3609,7 +3680,7 @@ let trans_visitor (Printf.sprintf "extract bound arg %d as actual arg %d" !bound_i arg_i)); - get_element_ptr closure_args_cell (!bound_i); + get_element_ptr closure_args_cell (!bound_i) end else begin @@ -3623,9 +3694,10 @@ let trans_visitor iflog (fun _ -> annotate (Printf.sprintf "copy into actual-arg %d" arg_i)); - trans_copy_slot - self_ty_params_cell - true dst_cell slot src_cell slot None; + trans_init_slot_from_cell + self_ty_params_cell CLONE_none + dst_cell slot + (deref_slot false src_cell slot) (slot_ty slot); incr (if is_bound then bound_i else unbound_i); done; assert ((!bound_i + !unbound_i) == n_args) @@ -3765,7 +3837,7 @@ let trans_visitor let (pat, block) = arm.node in (* Translates the pattern and returns the addresses of the branch * instructions, which are taken if the match fails. *) - let rec trans_pat pat src_cell src_slot = + let rec trans_pat pat src_cell src_ty = match pat with Ast.PAT_lit lit -> trans_compare Il.JNE (trans_lit lit) (Il.Cell src_cell) @@ -3773,7 +3845,7 @@ let trans_visitor | Ast.PAT_tag (lval, pats) -> let tag_name = tag_ctor_name_to_tag_name (lval_to_name lval) in let ty_tag = - match slot_ty src_slot with + match src_ty with Ast.TY_tag tag_ty -> tag_ty | Ast.TY_iso ti -> (ti.Ast.iso_group).(ti.Ast.iso_index) | _ -> bug cx "expected tag type" @@ -3782,9 +3854,6 @@ let trans_visitor let tag_number = arr_idx tag_keys tag_name in let ty_tup = Hashtbl.find ty_tag tag_name in - (* NB: follow any exterior pointer as we go. *) - let src_cell = deref_slot false src_cell src_slot in - let tag_cell:Il.cell = get_element_ptr src_cell 0 in let union_cell = get_element_ptr_dyn_in_current_frame src_cell 1 @@ -3801,8 +3870,8 @@ let trans_visitor let elem_cell = get_element_ptr_dyn_in_current_frame tup_cell i in - let elem_slot = ty_tup.(i) in - trans_pat elem_pat elem_cell elem_slot + let elem_ty = ty_tup.(i) in + trans_pat elem_pat elem_cell elem_ty in let elem_jumps = Array.mapi trans_elem_pat pats in @@ -3811,11 +3880,10 @@ let trans_visitor | Ast.PAT_slot (dst, _) -> let dst_slot = get_slot cx dst.id in let dst_cell = cell_of_block_slot dst.id in - trans_copy_slot - (get_ty_params_of_current_frame()) true - dst_cell dst_slot - src_cell src_slot - None; + trans_init_slot_from_cell + (get_ty_params_of_current_frame()) + CLONE_none dst_cell dst_slot + src_cell src_ty; [] (* irrefutable *) | Ast.PAT_wild -> [] (* irrefutable *) @@ -3909,16 +3977,16 @@ let trans_visitor let (dst_slot, _) = fo.Ast.for_slot in let dst_cell = cell_of_block_slot dst_slot.id in let (head_stmts, seq) = fo.Ast.for_seq in - let (seq_cell, seq_slot) = trans_lval_full false seq in - let unit_slot = seq_unit_slot (slot_ty seq_slot) in + let (seq_cell, seq_ty) = trans_lval seq in + let unit_ty = seq_unit_ty seq_ty in Array.iter trans_stmt head_stmts; - iter_seq_slots ty_params seq_cell seq_cell unit_slot + iter_seq_parts ty_params seq_cell seq_cell unit_ty begin - fun _ src_cell unit_slot curr_iso -> - trans_copy_slot - ty_params true + fun _ src_cell unit_ty _ -> + trans_init_slot_from_cell + ty_params CLONE_none dst_cell dst_slot.node - src_cell unit_slot curr_iso; + src_cell unit_ty; trans_block fo.Ast.for_body; end None @@ -3978,26 +4046,17 @@ let trans_visitor mov vr zero; trans_call_glue (code_of_operand block_fptr) None [| vr; fp |] - and trans_vec_append dst_cell dst_slot src_oper src_ty = - let (dst_elt_slot, trim_trailing_null) = - match slot_ty dst_slot with - Ast.TY_str -> (interior_slot (Ast.TY_mach TY_u8), true) - | Ast.TY_vec e -> (e, false) - | _ -> bug () "unexpected dst type in trans_vec_append" - in - match src_ty with + and trans_vec_append dst_cell dst_ty src_oper src_ty = + let elt_ty = seq_unit_ty dst_ty in + let trim_trailing_null = dst_ty = Ast.TY_str in + assert (simplified_ty src_ty = simplified_ty dst_ty); + match simplified_ty src_ty with Ast.TY_str | Ast.TY_vec _ -> let is_gc = if type_has_state src_ty then 1L else 0L in let src_cell = need_cell src_oper in let src_vec = deref src_cell in let src_fill = get_element_ptr src_vec Abi.vec_elt_fill in - let src_elt_slot = - match src_ty with - Ast.TY_str -> interior_slot (Ast.TY_mach TY_u8) - | Ast.TY_vec e -> e - | _ -> bug () "unexpected src type in trans_vec_append" - in let dst_vec = deref dst_cell in let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in if trim_trailing_null @@ -4018,12 +4077,11 @@ let trans_visitor let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in (* Copy loop: *) - let pty s = Il.AddrTy (slot_referent_type abi s) in - let dptr = next_vreg_cell (pty dst_elt_slot) in - let sptr = next_vreg_cell (pty src_elt_slot) in - let dlim = next_vreg_cell (pty dst_elt_slot) in - let dst_elt_sz = slot_sz_in_current_frame dst_elt_slot in - let src_elt_sz = slot_sz_in_current_frame src_elt_slot in + let eltp_rty = Il.AddrTy (referent_type abi elt_ty) in + let dptr = next_vreg_cell eltp_rty in + let sptr = next_vreg_cell eltp_rty in + let dlim = next_vreg_cell eltp_rty in + let elt_sz = ty_sz_in_current_frame elt_ty in let dst_data = get_element_ptr_dyn_in_current_frame dst_vec Abi.vec_elt_data @@ -4041,20 +4099,20 @@ let trans_visitor emit (Il.jmp Il.JMP Il.CodeNone); let back_jmp_targ = mark () in (* copy slot *) - trans_copy_slot + trans_copy_ty (get_ty_params_of_current_frame()) true - (deref dptr) dst_elt_slot - (deref sptr) src_elt_slot + (deref dptr) elt_ty + (deref sptr) elt_ty None; - add_to dptr dst_elt_sz; - add_to sptr src_elt_sz; + add_to dptr elt_sz; + add_to sptr elt_sz; patch fwd_jmp; check_interrupt_flag (); let back_jmp = trans_compare Il.JB (Il.Cell dptr) (Il.Cell dlim) in List.iter (fun j -> patch_existing j back_jmp_targ) back_jmp; - let v = next_vreg_cell word_ty in + let v = next_vreg_cell word_sty in mov v (Il.Cell src_fill); add_to dst_fill (Il.Cell v); | t -> @@ -4064,14 +4122,14 @@ let trans_visitor and trans_copy_binop dst binop a_src = - let (dst_cell, dst_slot) = trans_lval_maybe_init false dst in + let (dst_cell, dst_ty) = trans_lval_maybe_init false dst in let src_oper = trans_atom a_src in - match slot_ty dst_slot with + match dst_ty with Ast.TY_str | Ast.TY_vec _ when binop = Ast.BINOP_add -> - trans_vec_append dst_cell dst_slot src_oper (atom_type cx a_src) + trans_vec_append dst_cell dst_ty src_oper (atom_type cx a_src) | _ -> - let dst_cell = deref_slot false dst_cell dst_slot in + let (dst_cell, _) = deref_ty DEREF_none false dst_cell dst_ty in let op = trans_binop binop in emit (Il.binary op dst_cell (Il.Cell dst_cell) src_oper); @@ -4087,7 +4145,7 @@ let trans_visitor Some params -> params | None -> [| |] in - match ty with + match simplified_ty ty with Ast.TY_fn _ -> let (dst_cell, _) = trans_lval_maybe_init init dst in let fn_ptr = @@ -4099,7 +4157,7 @@ let trans_visitor and trans_log id a = - match atom_type cx a with + match simplified_ty (atom_type cx a) with (* NB: If you extend this, be sure to update the * typechecking code in type.ml as well. *) Ast.TY_str -> trans_log_str a @@ -4159,46 +4217,43 @@ let trans_visitor end | Ast.STMT_init_rec (dst, atab, base) -> - let (slot_cell, slot) = trans_lval_init dst in - let (trec, dst_slots) = - match slot_ty slot with + let (slot_cell, ty) = trans_lval_init dst in + let (trec, dst_tys) = + match ty with Ast.TY_rec trec -> (trec, Array.map snd trec) | _ -> bugi cx stmt.id "non-rec destination type in stmt_init_rec" in - let dst_cell = deref_slot true slot_cell slot in + let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in begin match base with None -> - let atoms = - Array.map (fun (_, _, _, atom) -> atom) atab - in + let atoms = Array.map snd atab in trans_init_structural_from_atoms - dst_cell dst_slots atoms + dst_cell dst_tys atoms | Some base_lval -> trans_init_rec_update - dst_cell dst_slots trec atab base_lval + dst_cell dst_tys trec atab base_lval end - | Ast.STMT_init_tup (dst, mode_atoms) -> - let (slot_cell, slot) = trans_lval_init dst in - let dst_slots = - match slot_ty slot with + | Ast.STMT_init_tup (dst, atoms) -> + let (slot_cell, ty) = trans_lval_init dst in + let dst_tys = + match ty with Ast.TY_tup ttup -> ttup | _ -> bugi cx stmt.id "non-tup destination type in stmt_init_tup" in - let atoms = Array.map (fun (_, _, atom) -> atom) mode_atoms in - let dst_cell = deref_slot true slot_cell slot in - trans_init_structural_from_atoms dst_cell dst_slots atoms + let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in + trans_init_structural_from_atoms dst_cell dst_tys atoms | Ast.STMT_init_str (dst, s) -> trans_init_str dst s - | Ast.STMT_init_vec (dst, _, atoms) -> + | Ast.STMT_init_vec (dst, atoms) -> trans_init_vec dst atoms | Ast.STMT_init_port dst -> @@ -4216,6 +4271,9 @@ let trans_visitor trans_init_chan dst p end + | Ast.STMT_init_box (dst, src) -> + trans_init_box dst src + | Ast.STMT_block block -> trans_block block @@ -4424,7 +4482,7 @@ let trans_visitor let trans_obj_ctor (obj_id:node_id) - (state:Ast.header_slots) + (header:Ast.header_slots) : unit = trans_frame_entry obj_id; @@ -4439,21 +4497,14 @@ let trans_visitor all_args_cell Abi.calltup_elt_ty_params in - let obj_args_tup = Array.map (fun (sloti,_) -> sloti.node) state in - let obj_args_slot = interior_slot (Ast.TY_tup obj_args_tup) in - let state_ty = - Ast.TY_tup [| interior_slot Ast.TY_type; - obj_args_slot |] - in - let state_rty = slot_referent_type abi (interior_slot state_ty) in - let state_ptr_slot = exterior_slot state_ty in - let state_ptr_rty = slot_referent_type abi state_ptr_slot in - let state_malloc_sz = - calculate_sz_in_current_frame - (SIZE_rt_add - ((SIZE_fixed (word_n Abi.exterior_rc_header_size)), - (Il.referent_ty_size word_bits state_rty))) + let obj_args_tup = + Array.map (fun (sloti,_) -> (slot_ty sloti.node)) header in + let obj_args_ty = Ast.TY_tup obj_args_tup in + let state_ty = Ast.TY_tup [| Ast.TY_type; obj_args_ty |] in + let state_ptr_ty = Ast.TY_box state_ty in + let state_ptr_rty = referent_type abi state_ptr_ty in + let state_malloc_sz = box_allocation_size state_ptr_ty in let ctor_ty = Hashtbl.find cx.ctxt_all_item_types obj_id in let obj_ty = @@ -4508,10 +4559,17 @@ let trans_visitor * because the arg slot ids are actually given layout * positions inside the object state, and are at different * offsets within that state than within the current - * frame. So we manually drop the argument tuple here, - * without mentioning the arg slot ids. + * frame. So we manually drop the argument slots here, + * without mentioning the slot ids. *) - drop_slot frame_ty_params frame_args obj_args_slot None; + Array.iteri + (fun i (sloti, _) -> + let cell = + get_element_ptr_dyn_in_current_frame + frame_args i + in + drop_slot frame_ty_params cell sloti.node None) + header; trans_frame_exit obj_id false; in @@ -4682,27 +4740,32 @@ let trans_visitor | Ast.TY_iso tiso -> get_iso_tag tiso | _ -> bugi cx tagid "unexpected fn type for tag constructor" in - let slots = - Array.map (fun sloti -> referent_to_slot cx sloti.id) header_tup - in let tag_keys = sorted_htab_keys ttag in let i = arr_idx tag_keys (Ast.NAME_base (Ast.BASE_ident n)) in let _ = log cx "tag variant: %s -> tag value #%d" n i in let (dst_cell, dst_slot) = get_current_output_cell_and_slot() in let dst_cell = deref_slot true dst_cell dst_slot in - let src = get_explicit_args_for_current_frame () in let tag_cell = get_element_ptr dst_cell 0 in let union_cell = get_element_ptr_dyn_in_current_frame dst_cell 1 in let tag_body_cell = get_variant_ptr union_cell i in let tag_body_rty = snd (need_mem_cell tag_body_cell) in + let ty_params = get_ty_params_of_current_frame() in (* A clever compiler will inline this. We are not clever. *) iflog (fun _ -> annotate (Printf.sprintf "write tag #%d" i)); mov tag_cell (imm (Int64.of_int i)); iflog (fun _ -> annotate ("copy tag-content tuple: tag_body_rty=" ^ (Il.string_of_referent_ty tag_body_rty))); - trans_copy_tup - (get_ty_params_of_current_frame()) - true tag_body_cell src slots; + Array.iteri + begin + fun i sloti -> + let slot = sloti.node in + let ty = slot_ty slot in + trans_copy_ty ty_params true + (get_element_ptr_dyn_in_current_frame tag_body_cell i) ty + (deref_slot false (cell_of_block_slot sloti.id) slot) ty + None; + end + header_tup; trace_str cx.ctxt_sess.Session.sess_trace_tag ("finished tag constructor " ^ n); trans_frame_exit tagid true; @@ -4721,8 +4784,8 @@ let trans_visitor else ignore (Stack.pop curr_file) in - let visit_local_mod_item_pre n _ i = - iflog (fun _ -> log cx "translating local item #%d = %s" + let visit_defined_mod_item_pre n _ i = + iflog (fun _ -> log cx "translating defined item #%d = %s" (int_of_node i.id) (path_name())); match i.node.Ast.decl_item with Ast.MOD_ITEM_fn f -> trans_fn i.id f.Ast.fn_body @@ -4767,7 +4830,7 @@ let trans_visitor inner.Walk.visit_obj_drop_pre obj b in - let visit_local_obj_fn_pre _ _ fn = + let visit_defined_obj_fn_pre _ _ fn = trans_fn fn.id fn.node.Ast.fn_body in @@ -4782,7 +4845,7 @@ let trans_visitor then visit_required_obj_fn_pre obj ident fn else - visit_local_obj_fn_pre obj ident fn; + visit_defined_obj_fn_pre obj ident fn; end; inner.Walk.visit_obj_fn_pre obj ident fn in @@ -4794,7 +4857,7 @@ let trans_visitor then visit_required_mod_item_pre n p i else - visit_local_mod_item_pre n p i + visit_defined_mod_item_pre n p i end; inner.Walk.visit_mod_item_pre n p i in diff --git a/src/boot/me/transutil.ml b/src/boot/me/transutil.ml index cb867fef..0ec49c8e 100644 --- a/src/boot/me/transutil.ml +++ b/src/boot/me/transutil.ml @@ -7,7 +7,7 @@ open Semant;; * "simple" precise, mark-sweep, single-generation, per-task (thereby * preemptable and relatively quick) GC scheme on mutable memory. * - * - For the sake of this note, call any exterior of 'state' effect a gc_val. + * - For the sake of this note, call any box of 'state' effect a gc_val. * * - gc_vals come from the same malloc as all other values but undergo * different storage management. @@ -19,7 +19,7 @@ open Semant;; * * - A pointer to a gc_val, however, points to the third of these three * words. So a certain quantity of code can treat gc_vals the same way it - * would treat refcounted exterior vals. + * would treat refcounted box vals. * * - The first word at the head of a gc_val is used as a refcount, as in * non-gc allocations. @@ -57,6 +57,12 @@ open Semant;; *) +type deref_ctrl = + DEREF_one_box + | DEREF_all_boxes + | DEREF_none +;; + type mem_ctrl = MEM_rc_opaque | MEM_rc_struct @@ -112,29 +118,35 @@ let word_ty_signed_mach (abi:Abi.abi) : ty_mach = ;; -let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl = - let ty = slot_ty slot in - match ty with - Ast.TY_port _ - | Ast.TY_chan _ - | Ast.TY_task - | Ast.TY_str -> MEM_rc_opaque - | Ast.TY_vec _ -> - if type_has_state ty - then MEM_gc +let rec ty_mem_ctrl (ty:Ast.ty) : mem_ctrl = + match ty with + Ast.TY_port _ + | Ast.TY_chan _ + | Ast.TY_task + | Ast.TY_str -> MEM_rc_opaque + | Ast.TY_vec _ -> + if type_has_state ty + then MEM_gc + else MEM_rc_opaque + | Ast.TY_box t -> + if type_has_state t + then MEM_gc + else + if type_is_structured t + then MEM_rc_struct else MEM_rc_opaque - | _ -> - match slot.Ast.slot_mode with - Ast.MODE_exterior _ when type_is_structured ty -> - if type_has_state ty - then MEM_gc - else MEM_rc_struct - | Ast.MODE_exterior _ -> - if type_has_state ty - then MEM_gc - else MEM_rc_opaque - | _ -> - MEM_interior + | Ast.TY_mutable t + | Ast.TY_constrained (t, _) -> + ty_mem_ctrl t + | _ -> + MEM_interior +;; + +let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl = + match slot.Ast.slot_mode with + Ast.MODE_alias -> MEM_interior + | Ast.MODE_local -> + ty_mem_ctrl (slot_ty slot) ;; @@ -147,7 +159,7 @@ let iter_block_slots Hashtbl.iter begin fun key slot_id -> - let slot = referent_to_slot cx slot_id in + let slot = get_slot cx slot_id in fn key slot_id slot end block_slots @@ -174,7 +186,7 @@ let iter_arg_slots begin fun slot_id -> let key = Hashtbl.find cx.ctxt_slot_keys slot_id in - let slot = referent_to_slot cx slot_id in + let slot = get_slot cx slot_id in fn key slot_id slot end ls @@ -200,33 +212,33 @@ let next_power_of_two (x:int64) : int64 = Int64.add 1L (!xr) ;; -let iter_tup_slots +let iter_tup_parts (get_element_ptr:'a -> int -> 'a) (dst_ptr:'a) (src_ptr:'a) (slots:Ast.ty_tup) - (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit) + (f:'a -> 'a -> Ast.ty -> (Ast.ty_iso option) -> unit) (curr_iso:Ast.ty_iso option) : unit = Array.iteri begin - fun i slot -> + fun i ty -> f (get_element_ptr dst_ptr i) (get_element_ptr src_ptr i) - slot curr_iso + ty curr_iso end slots ;; -let iter_rec_slots +let iter_rec_parts (get_element_ptr:'a -> int -> 'a) (dst_ptr:'a) (src_ptr:'a) (entries:Ast.ty_rec) - (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit) + (f:'a -> 'a -> Ast.ty -> (Ast.ty_iso option) -> unit) (curr_iso:Ast.ty_iso option) : unit = - iter_tup_slots get_element_ptr dst_ptr src_ptr + iter_tup_parts get_element_ptr dst_ptr src_ptr (Array.map snd entries) f curr_iso ;; diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index 346c6e39..b364ff56 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -5,17 +5,18 @@ type tyspec = TYSPEC_equiv of tyvar | TYSPEC_all | TYSPEC_resolved of (Ast.ty_param array) * Ast.ty - | TYSPEC_callable of (tyvar * tyvar array) (* out, ins *) - | TYSPEC_collection of tyvar (* vec or str *) - | TYSPEC_comparable (* comparable with = and != *) - | TYSPEC_plusable (* nums, vecs, and strings *) + | TYSPEC_box of tyvar (* @ of some t *) + | TYSPEC_mutable of tyvar (* something mutable *) + | TYSPEC_callable of (tyvar * tyvar array) (* out, ins *) + | TYSPEC_collection of tyvar (* vec or str *) + | TYSPEC_comparable (* comparable with = and != *) + | TYSPEC_plusable (* nums, vecs, and strings *) | TYSPEC_dictionary of dict - | TYSPEC_integral (* int-like *) - | TYSPEC_loggable - | TYSPEC_numeric (* int-like or float-like *) - | TYSPEC_ordered (* comparable with < etc. *) + | TYSPEC_integral (* int-like *) + | TYSPEC_numeric (* int-like or float-like *) + | TYSPEC_ordered (* comparable with < etc. *) | TYSPEC_record of dict - | TYSPEC_tuple of tyvar array (* heterogeneous tuple *) + | TYSPEC_tuple of tyvar array (* heterogeneous tuple *) | TYSPEC_vector of tyvar | TYSPEC_app of (tyvar * Ast.ty array) @@ -33,6 +34,7 @@ type binopsig = | BINOPSIG_plus_plus_plus (* plusable a * plusable a -> plusable a *) ;; + let rec tyspec_to_str (ts:tyspec) : string = let fmt = Format.fprintf in @@ -85,7 +87,6 @@ let rec tyspec_to_str (ts:tyspec) : string = | TYSPEC_comparable -> fmt ff "<comparable>" | TYSPEC_plusable -> fmt ff "<plusable>" | TYSPEC_integral -> fmt ff "<integral>" - | TYSPEC_loggable -> fmt ff "<loggable>" | TYSPEC_numeric -> fmt ff "<numeric>" | TYSPEC_ordered -> fmt ff "<ordered>" | TYSPEC_resolved (params, ty) -> @@ -104,6 +105,18 @@ let rec tyspec_to_str (ts:tyspec) : string = | TYSPEC_equiv tv -> fmt_tyspec ff (!tv) + | TYSPEC_box tv -> + fmt_obr ff; + fmt ff "box "; + fmt_tyspec ff (!tv); + fmt_cbr ff; + + | TYSPEC_mutable tv -> + fmt_obr ff; + fmt ff "mut "; + fmt_tyspec ff (!tv); + fmt_cbr ff + | TYSPEC_callable (out, ins) -> fmt_obb ff; fmt ff "callable fn("; @@ -119,9 +132,11 @@ let rec tyspec_to_str (ts:tyspec) : string = fmt_cbb ff; | TYSPEC_tuple tvs -> - fmt ff "("; + fmt_obr ff; + fmt ff "tuple ("; fmt_tvs ff tvs; fmt ff ")"; + fmt_cbr ff; | TYSPEC_vector tv -> fmt_obb ff; @@ -160,7 +175,41 @@ let rec resolve_tyvar (tv:tyvar) : tyvar = | _ -> tv ;; +type unify_ctxt = + { mut_ok: bool; + box_ok: bool } +;; + +let arg_pass_ctx = + { box_ok = false; + mut_ok = true } +;; + +let rval_ctx = + { box_ok = true; + mut_ok = true } +;; + +let lval_ctx = + { box_ok = false; + mut_ok = true } +;; + +let init_ctx = + { box_ok = true; + mut_ok = true } +;; + +let strict_ctx = + { box_ok = false; + mut_ok = false } +;; + + let process_crate (cx:ctxt) (crate:Ast.crate) : unit = + + let depth = ref 0 in + let log cx = Session.log "type" cx.ctxt_sess.Session.sess_log_type cx.ctxt_sess.Session.sess_log_out @@ -197,15 +246,17 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let visitor (cx:ctxt) (inner:Walk.visitor) : Walk.visitor = let rec unify_slot + (ucx:unify_ctxt) (slot:Ast.slot) (id_opt:node_id option) (tv:tyvar) : unit = match id_opt with - Some id -> unify_tyvars (Hashtbl.find bindings id) tv + Some id -> + unify_tyvars ucx (Hashtbl.find bindings id) tv | None -> match slot.Ast.slot_ty with None -> bug () "untyped unidentified slot" - | Some ty -> unify_ty ty tv + | Some ty -> unify_ty ucx ty tv and check_sane_tyvar tv = match !tv with @@ -213,24 +264,36 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = bug () "named-type in type checker" | _ -> () - and unify_tyvars (av:tyvar) (bv:tyvar) : unit = - iflog cx (fun _ -> - log cx "unifying types:"; - log cx "input tyvar A: %s" (tyspec_to_str !av); - log cx "input tyvar B: %s" (tyspec_to_str !bv)); - check_sane_tyvar av; - check_sane_tyvar bv; - - unify_tyvars' av bv; - - iflog cx (fun _ -> - log cx "unified types:"; - log cx "output tyvar A: %s" (tyspec_to_str !av); - log cx "output tyvar B: %s" (tyspec_to_str !bv)); - check_sane_tyvar av; - check_sane_tyvar bv; - - and unify_tyvars' (av:tyvar) (bv:tyvar) : unit = + and unify_tyvars (ucx:unify_ctxt) (av:tyvar) (bv:tyvar) : unit = + let indent = String.make (4 * (!depth)) ' ' in + iflog cx + (fun _ -> + log cx "%s> unifying types:" indent; + if ucx.box_ok || ucx.mut_ok + then + log cx "%s> (w/ %s%s%s)" + indent + (if ucx.box_ok then "ext-ok" else "") + (if ucx.box_ok && ucx.mut_ok then " " else "") + (if ucx.mut_ok then "mut-ok" else ""); + log cx "%s> input tyvar A: %s" indent (tyspec_to_str !av); + log cx "%s> input tyvar B: %s" indent (tyspec_to_str !bv)); + check_sane_tyvar av; + check_sane_tyvar bv; + + incr depth; + unify_tyvars' ucx av bv; + decr depth; + + iflog cx + (fun _ -> + log cx "%s< unified types:" indent; + log cx "%s< output tyvar A: %s" indent (tyspec_to_str !av); + log cx "%s< output tyvar B: %s" indent (tyspec_to_str !bv)); + check_sane_tyvar av; + check_sane_tyvar bv; + + and unify_tyvars' (ucx:unify_ctxt) (av:tyvar) (bv:tyvar) : unit = let (a, b) = ((resolve_tyvar av), (resolve_tyvar bv)) in let fail () = err None "mismatched types: %s vs. %s" (tyspec_to_str !av) @@ -241,7 +304,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let c = Hashtbl.create ((Hashtbl.length a) + (Hashtbl.length b)) in let merge ident tv_a = if Hashtbl.mem c ident - then unify_tyvars (Hashtbl.find c ident) tv_a + then unify_tyvars ucx (Hashtbl.find c ident) tv_a else Hashtbl.add c ident tv_a in Hashtbl.iter (Hashtbl.add c) b; @@ -253,17 +316,14 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = (dct:dict) (fields:Ast.ty_rec) : unit = - let rec find_slot (query:Ast.ident) i : Ast.slot = - if i = Array.length fields - then fail () - else match fields.(i) with - (ident, slot) -> - if ident = query then slot - else find_slot query (i + 1) + let find_ty (query:Ast.ident) : Ast.ty = + match atab_search fields query with + None -> fail() + | Some t -> t in let check_entry ident tv = - unify_slot (find_slot ident 0) None tv + unify_ty ucx (find_ty ident) tv in Hashtbl.iter check_entry dct in @@ -274,11 +334,27 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let check_entry (query:Ast.ident) tv : unit = match htab_search fns query with None -> fail () - | Some fn -> unify_ty (Ast.TY_fn fn) tv + | Some fn -> unify_ty ucx (Ast.TY_fn fn) tv in Hashtbl.iter check_entry dct in + let rec unify_resolved_types + (ty_a:Ast.ty) + (ty_b:Ast.ty) + : Ast.ty = + match ty_a, ty_b with + a, b when a = b -> a + | Ast.TY_box a, b | b, Ast.TY_box a when ucx.box_ok -> + Ast.TY_box (unify_resolved_types a b) + | Ast.TY_mutable a, b | b, Ast.TY_mutable a when ucx.mut_ok -> + Ast.TY_mutable (unify_resolved_types a b) + | Ast.TY_constrained (a, constrs), b + | b, Ast.TY_constrained (a, constrs) -> + Ast.TY_constrained ((unify_resolved_types a b), constrs) + | _ -> fail() + in + let rec is_comparable_or_ordered (comparable:bool) (ty:Ast.ty) : bool = match ty with Ast.TY_mach _ | Ast.TY_int | Ast.TY_uint @@ -292,43 +368,43 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | Ast.TY_named _ -> bug () "unexpected named type" | Ast.TY_constrained (ty, _) -> is_comparable_or_ordered comparable ty + | Ast.TY_mutable ty -> + is_comparable_or_ordered comparable ty + | Ast.TY_box ty -> + ucx.box_ok && is_comparable_or_ordered comparable ty in - let floating (ty:Ast.ty) : bool = + let rec floating (ty:Ast.ty) : bool = match ty with Ast.TY_mach TY_f32 | Ast.TY_mach TY_f64 -> true + | Ast.TY_mutable ty when ucx.mut_ok -> floating ty + | Ast.TY_box ty when ucx.box_ok -> floating ty | _ -> false in - let integral (ty:Ast.ty) : bool = + let rec integral (ty:Ast.ty) : bool = match ty with Ast.TY_int | Ast.TY_uint | Ast.TY_mach TY_u8 | Ast.TY_mach TY_u16 | Ast.TY_mach TY_u32 | Ast.TY_mach TY_u64 | Ast.TY_mach TY_i8 | Ast.TY_mach TY_i16 | Ast.TY_mach TY_i32 | Ast.TY_mach TY_i64 -> true + | Ast.TY_mutable ty when ucx.mut_ok -> integral ty + | Ast.TY_box ty when ucx.box_ok -> integral ty | _ -> false in let numeric (ty:Ast.ty) : bool = (integral ty) || (floating ty) in - let plusable (ty:Ast.ty) : bool = + let rec plusable (ty:Ast.ty) : bool = match ty with Ast.TY_str -> true | Ast.TY_vec _ -> true + | Ast.TY_mutable ty when ucx.mut_ok -> plusable ty + | Ast.TY_box ty when ucx.box_ok -> plusable ty | _ -> numeric ty in - let loggable (ty:Ast.ty) : bool = - match ty with - Ast.TY_str | Ast.TY_bool | Ast.TY_int | Ast.TY_uint - | Ast.TY_char - | Ast.TY_mach TY_u8 | Ast.TY_mach TY_u16 | Ast.TY_mach TY_u32 - | Ast.TY_mach TY_i8 | Ast.TY_mach TY_i16 | Ast.TY_mach TY_i32 - -> true - | _ -> false - in - let result = match (!a, !b) with (TYSPEC_equiv _, _) | (_, TYSPEC_equiv _) -> @@ -336,44 +412,110 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_all, other) | (other, TYSPEC_all) -> other + (* box *) + + | (TYSPEC_box a', TYSPEC_box b') -> + unify_tyvars ucx a' b'; !a + + | (TYSPEC_box tv, + TYSPEC_resolved (params, Ast.TY_box ty)) + | (TYSPEC_resolved (params, Ast.TY_box ty), + TYSPEC_box tv) -> + unify_ty_parametric ucx ty params tv; !a + + | (_, TYSPEC_resolved (params, Ast.TY_box ty)) + when ucx.box_ok -> + unify_ty_parametric ucx ty params a; !b + + | (TYSPEC_resolved (params, Ast.TY_box ty), _) + when ucx.box_ok -> + unify_ty_parametric ucx ty params b; !a + + | (TYSPEC_box a', _) when ucx.box_ok + -> unify_tyvars ucx a' b; !a + | (_, TYSPEC_box b') when ucx.box_ok + -> unify_tyvars ucx a b'; !b + + | (_, TYSPEC_box _) + | (TYSPEC_box _, _) -> fail() + + (* mutable *) + + | (TYSPEC_mutable a', TYSPEC_mutable b') -> + unify_tyvars ucx a' b'; !a + + | (TYSPEC_mutable tv, + TYSPEC_resolved (params, Ast.TY_mutable ty)) + | (TYSPEC_resolved (params, Ast.TY_mutable ty), + TYSPEC_mutable tv) -> + unify_ty_parametric ucx ty params tv; !a + + | (_, TYSPEC_resolved (params, Ast.TY_mutable ty)) + when ucx.mut_ok -> + unify_ty_parametric ucx ty params a; !b + + | (TYSPEC_resolved (params, Ast.TY_mutable ty), _) + when ucx.mut_ok -> + unify_ty_parametric ucx ty params b; !a + + | (TYSPEC_mutable a', _) when ucx.mut_ok + -> unify_tyvars ucx a' b; !a + | (_, TYSPEC_mutable b') when ucx.mut_ok + -> unify_tyvars ucx a b'; !b + + | (_, TYSPEC_mutable _) + | (TYSPEC_mutable _, _) -> fail() + (* resolved *) | (TYSPEC_resolved (params_a, ty_a), TYSPEC_resolved (params_b, ty_b)) -> - if params_a <> params_b || ty_a <> ty_b - then fail() - else TYSPEC_resolved (params_a, ty_a) + if params_a <> params_b then fail() + else TYSPEC_resolved + (params_a, (unify_resolved_types ty_a ty_b)) | (TYSPEC_resolved (params, ty), TYSPEC_callable (out_tv, in_tvs)) | (TYSPEC_callable (out_tv, in_tvs), TYSPEC_resolved (params, ty)) -> let unify_in_slot i in_slot = - unify_slot in_slot None in_tvs.(i) + unify_slot arg_pass_ctx in_slot None in_tvs.(i) in - begin + let rec unify ty = match ty with Ast.TY_fn ({ Ast.sig_input_slots = in_slots; Ast.sig_output_slot = out_slot }, _) -> if Array.length in_slots != Array.length in_tvs - then fail (); - unify_slot out_slot None out_tv; - Array.iteri unify_in_slot in_slots + then + fail () + else + unify_slot arg_pass_ctx out_slot None out_tv; + Array.iteri unify_in_slot in_slots; + ty + | Ast.TY_box ty when ucx.box_ok + -> Ast.TY_box (unify ty) + | Ast.TY_mutable ty when ucx.mut_ok + -> Ast.TY_mutable (unify ty) | _ -> fail () - end; - TYSPEC_resolved (params, ty) + in + TYSPEC_resolved (params, unify ty) | (TYSPEC_resolved (params, ty), TYSPEC_collection tv) | (TYSPEC_collection tv, TYSPEC_resolved (params, ty)) -> - begin + let rec unify ty = match ty with - Ast.TY_vec slot -> unify_slot slot None tv - | Ast.TY_str -> unify_ty (Ast.TY_mach TY_u8) tv + Ast.TY_vec ty' -> unify_ty ucx ty' tv; ty + | Ast.TY_str -> + unify_ty ucx (Ast.TY_mach TY_u8) tv; ty + | Ast.TY_box ty + when ucx.box_ok -> Ast.TY_box (unify ty) + | Ast.TY_mutable ty + when ucx.mut_ok -> Ast.TY_mutable (unify ty) | _ -> fail () - end; - TYSPEC_resolved (params, ty) + in + TYSPEC_resolved (params, unify ty) | (TYSPEC_resolved (params, ty), TYSPEC_comparable) | (TYSPEC_comparable, TYSPEC_resolved (params, ty)) -> @@ -387,15 +529,21 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_resolved (params, ty), TYSPEC_dictionary dct) | (TYSPEC_dictionary dct, TYSPEC_resolved (params, ty)) -> - begin + let rec unify ty = match ty with Ast.TY_rec fields -> - unify_dict_with_record_fields dct fields + unify_dict_with_record_fields dct fields; + ty | Ast.TY_obj (_, fns) -> - unify_dict_with_obj_fns dct fns + unify_dict_with_obj_fns dct fns; + ty + | Ast.TY_box ty + when ucx.box_ok -> Ast.TY_box (unify ty) + | Ast.TY_mutable ty + when ucx.mut_ok -> Ast.TY_mutable (unify ty) | _ -> fail () - end; - TYSPEC_resolved (params, ty) + in + TYSPEC_resolved (params, unify ty) | (TYSPEC_resolved (params, ty), TYSPEC_integral) | (TYSPEC_integral, TYSPEC_resolved (params, ty)) -> @@ -403,12 +551,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = then fail () else TYSPEC_resolved (params, ty) - | (TYSPEC_resolved (params, ty), TYSPEC_loggable) - | (TYSPEC_loggable, TYSPEC_resolved (params, ty)) -> - if not (loggable ty) - then fail () - else TYSPEC_resolved (params, ty) - | (TYSPEC_resolved (params, ty), TYSPEC_numeric) | (TYSPEC_numeric, TYSPEC_resolved (params, ty)) -> if not (numeric ty) then fail () @@ -422,52 +564,66 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_resolved (params, ty), TYSPEC_app (tv, args)) | (TYSPEC_app (tv, args), TYSPEC_resolved (params, ty)) -> let ty = rebuild_ty_under_params ty params args false in - unify_ty ty tv; + unify_ty ucx ty tv; TYSPEC_resolved ([| |], ty) | (TYSPEC_resolved (params, ty), TYSPEC_record dct) | (TYSPEC_record dct, TYSPEC_resolved (params, ty)) -> - begin + let rec unify ty = match ty with Ast.TY_rec fields -> - unify_dict_with_record_fields dct fields + unify_dict_with_record_fields dct fields; + ty + | Ast.TY_box ty + when ucx.box_ok -> Ast.TY_box (unify ty) + | Ast.TY_mutable ty + when ucx.mut_ok -> Ast.TY_mutable (unify ty) | _ -> fail () - end; - TYSPEC_resolved (params, ty) + in + TYSPEC_resolved (params, unify ty) | (TYSPEC_resolved (params, ty), TYSPEC_tuple tvs) | (TYSPEC_tuple tvs, TYSPEC_resolved (params, ty)) -> - begin + let rec unify ty = match ty with - Ast.TY_tup (elem_slots:Ast.slot array) -> - if (Array.length elem_slots) < (Array.length tvs) + Ast.TY_tup (elem_tys:Ast.ty array) -> + if (Array.length elem_tys) < (Array.length tvs) then fail () else let check_elem i tv = - unify_slot (elem_slots.(i)) None tv + unify_ty ucx (elem_tys.(i)) tv in - Array.iteri check_elem tvs + Array.iteri check_elem tvs; + ty + | Ast.TY_box ty + when ucx.box_ok -> Ast.TY_box (unify ty) + | Ast.TY_mutable ty + when ucx.box_ok -> Ast.TY_mutable (unify ty) | _ -> fail () - end; - TYSPEC_resolved (params, ty) + in + TYSPEC_resolved (params, unify ty) | (TYSPEC_resolved (params, ty), TYSPEC_vector tv) | (TYSPEC_vector tv, TYSPEC_resolved (params, ty)) -> - begin + let rec unify ty = match ty with - Ast.TY_vec slot -> - unify_slot slot None tv; - TYSPEC_resolved (params, ty) + Ast.TY_vec ty' -> unify_ty ucx ty' tv; ty + | Ast.TY_box ty when ucx.box_ok -> + Ast.TY_box (unify ty) + | Ast.TY_mutable ty when ucx.mut_ok -> + Ast.TY_mutable (unify ty) | _ -> fail () - end + in + TYSPEC_resolved (params, unify ty) (* callable *) | (TYSPEC_callable (a_out_tv, a_in_tvs), TYSPEC_callable (b_out_tv, b_in_tvs)) -> - unify_tyvars a_out_tv b_out_tv; + unify_tyvars arg_pass_ctx a_out_tv b_out_tv; let check_in_tv i a_in_tv = - unify_tyvars a_in_tv b_in_tvs.(i) + unify_tyvars arg_pass_ctx + a_in_tv b_in_tvs.(i) in Array.iteri check_in_tv a_in_tvs; TYSPEC_callable (a_out_tv, a_in_tvs) @@ -477,7 +633,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_callable _, TYSPEC_plusable) | (TYSPEC_callable _, TYSPEC_dictionary _) | (TYSPEC_callable _, TYSPEC_integral) - | (TYSPEC_callable _, TYSPEC_loggable) | (TYSPEC_callable _, TYSPEC_numeric) | (TYSPEC_callable _, TYSPEC_ordered) | (TYSPEC_callable _, TYSPEC_app _) @@ -489,7 +644,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_plusable, TYSPEC_callable _) | (TYSPEC_dictionary _, TYSPEC_callable _) | (TYSPEC_integral, TYSPEC_callable _) - | (TYSPEC_loggable, TYSPEC_callable _) | (TYSPEC_numeric, TYSPEC_callable _) | (TYSPEC_ordered, TYSPEC_callable _) | (TYSPEC_app _, TYSPEC_callable _) @@ -500,7 +654,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = (* collection *) | (TYSPEC_collection av, TYSPEC_collection bv) -> - unify_tyvars av bv; + unify_tyvars ucx av bv; TYSPEC_collection av | (TYSPEC_collection av, TYSPEC_comparable) @@ -512,7 +666,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_collection _, TYSPEC_dictionary _) | (TYSPEC_collection _, TYSPEC_integral) - | (TYSPEC_collection _, TYSPEC_loggable) | (TYSPEC_collection _, TYSPEC_numeric) | (TYSPEC_collection _, TYSPEC_ordered) | (TYSPEC_collection _, TYSPEC_app _) @@ -520,7 +673,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_collection _, TYSPEC_tuple _) | (TYSPEC_dictionary _, TYSPEC_collection _) | (TYSPEC_integral, TYSPEC_collection _) - | (TYSPEC_loggable, TYSPEC_collection _) | (TYSPEC_numeric, TYSPEC_collection _) | (TYSPEC_ordered, TYSPEC_collection _) | (TYSPEC_app _, TYSPEC_collection _) @@ -529,7 +681,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_collection av, TYSPEC_vector bv) | (TYSPEC_vector bv, TYSPEC_collection av) -> - unify_tyvars av bv; + unify_tyvars ucx av bv; TYSPEC_vector av (* comparable *) @@ -546,9 +698,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_comparable, TYSPEC_integral) | (TYSPEC_integral, TYSPEC_comparable) -> TYSPEC_integral - | (TYSPEC_comparable, TYSPEC_loggable) - | (TYSPEC_loggable, TYSPEC_comparable) -> TYSPEC_loggable - | (TYSPEC_comparable, TYSPEC_numeric) | (TYSPEC_numeric, TYSPEC_comparable) -> TYSPEC_numeric @@ -577,9 +726,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_plusable, TYSPEC_integral) | (TYSPEC_integral, TYSPEC_plusable) -> TYSPEC_integral - | (TYSPEC_plusable, TYSPEC_loggable) - | (TYSPEC_loggable, TYSPEC_plusable) -> TYSPEC_plusable - | (TYSPEC_plusable, TYSPEC_numeric) | (TYSPEC_numeric, TYSPEC_plusable) -> TYSPEC_numeric @@ -604,12 +750,10 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = TYSPEC_dictionary (merge_dicts da db) | (TYSPEC_dictionary _, TYSPEC_integral) - | (TYSPEC_dictionary _, TYSPEC_loggable) | (TYSPEC_dictionary _, TYSPEC_numeric) | (TYSPEC_dictionary _, TYSPEC_ordered) | (TYSPEC_dictionary _, TYSPEC_app _) | (TYSPEC_integral, TYSPEC_dictionary _) - | (TYSPEC_loggable, TYSPEC_dictionary _) | (TYSPEC_numeric, TYSPEC_dictionary _) | (TYSPEC_ordered, TYSPEC_dictionary _) | (TYSPEC_app _, TYSPEC_dictionary _) -> fail () @@ -626,10 +770,8 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = (* integral *) | (TYSPEC_integral, TYSPEC_integral) - | (TYSPEC_integral, TYSPEC_loggable) | (TYSPEC_integral, TYSPEC_numeric) | (TYSPEC_integral, TYSPEC_ordered) - | (TYSPEC_loggable, TYSPEC_integral) | (TYSPEC_numeric, TYSPEC_integral) | (TYSPEC_ordered, TYSPEC_integral) -> TYSPEC_integral @@ -642,25 +784,6 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | (TYSPEC_tuple _, TYSPEC_integral) | (TYSPEC_vector _, TYSPEC_integral) -> fail () - (* loggable *) - - | (TYSPEC_loggable, TYSPEC_loggable) -> TYSPEC_loggable - - | (TYSPEC_loggable, TYSPEC_numeric) - | (TYSPEC_numeric, TYSPEC_loggable) -> TYSPEC_numeric - - | (TYSPEC_loggable, TYSPEC_ordered) - | (TYSPEC_ordered, TYSPEC_loggable) -> TYSPEC_ordered - - | (TYSPEC_loggable, TYSPEC_app _) - | (TYSPEC_loggable, TYSPEC_record _) - | (TYSPEC_loggable, TYSPEC_tuple _) - | (TYSPEC_loggable, TYSPEC_vector _) - | (TYSPEC_app _, TYSPEC_loggable) - | (TYSPEC_record _, TYSPEC_loggable) - | (TYSPEC_tuple _, TYSPEC_loggable) - | (TYSPEC_vector _, TYSPEC_loggable) -> fail () - (* numeric *) | (TYSPEC_numeric, TYSPEC_numeric) -> TYSPEC_numeric @@ -698,7 +821,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = then fail() else begin - unify_tyvars tv_a tv_b; + unify_tyvars ucx tv_a tv_b; TYSPEC_app (tv_a, args_a) end @@ -731,7 +854,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = else if i >= len_b then tvs_a.(i) else begin - unify_tyvars tvs_a.(i) tvs_b.(i); + unify_tyvars strict_ctx tvs_a.(i) tvs_b.(i); tvs_a.(i) end in @@ -743,7 +866,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = (* vector *) | (TYSPEC_vector av, TYSPEC_vector bv) -> - unify_tyvars av bv; + unify_tyvars strict_ctx av bv; TYSPEC_vector av in let c = ref result in @@ -751,18 +874,19 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = b := TYSPEC_equiv c and unify_ty_parametric + (ucx:unify_ctxt) (ty:Ast.ty) (tps:Ast.ty_param array) (tv:tyvar) : unit = - unify_tyvars (ref (TYSPEC_resolved (tps, ty))) tv + unify_tyvars ucx (ref (TYSPEC_resolved (tps, ty))) tv - and unify_ty (ty:Ast.ty) (tv:tyvar) : unit = - unify_ty_parametric ty [||] tv + and unify_ty (ucx:unify_ctxt) (ty:Ast.ty) (tv:tyvar) : unit = + unify_ty_parametric ucx ty [||] tv in - let rec unify_lit (lit:Ast.lit) (tv:tyvar) : unit = + let rec unify_lit (ucx:unify_ctxt) (lit:Ast.lit) (tv:tyvar) : unit = let ty = match lit with Ast.LIT_nil -> Ast.TY_nil @@ -772,16 +896,16 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | Ast.LIT_uint (_, _) -> Ast.TY_uint | Ast.LIT_char _ -> Ast.TY_char in - unify_ty ty tv + unify_ty ucx ty tv - and unify_atom (atom:Ast.atom) (tv:tyvar) : unit = + and unify_atom (ucx:unify_ctxt) (atom:Ast.atom) (tv:tyvar) : unit = match atom with Ast.ATOM_literal { node = literal; id = _ } -> - unify_lit literal tv + unify_lit ucx literal tv | Ast.ATOM_lval lval -> - unify_lval lval tv + unify_lval ucx lval tv - and unify_expr (expr:Ast.expr) (tv:tyvar) : unit = + and unify_expr (ucx:unify_ctxt) (expr:Ast.expr) (tv:tyvar) : unit = match expr with Ast.EXPR_binary (binop, lhs, rhs) -> let binop_sig = match binop with @@ -812,64 +936,64 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = begin match binop_sig with BINOPSIG_bool_bool_bool -> - unify_atom lhs + unify_atom rval_ctx lhs (ref (TYSPEC_resolved ([||], Ast.TY_bool))); - unify_atom rhs + unify_atom rval_ctx rhs (ref (TYSPEC_resolved ([||], Ast.TY_bool))); - unify_ty Ast.TY_bool tv + unify_ty rval_ctx Ast.TY_bool tv | BINOPSIG_comp_comp_bool -> let tv_a = ref TYSPEC_comparable in - unify_atom lhs tv_a; - unify_atom rhs tv_a; - unify_ty Ast.TY_bool tv + unify_atom rval_ctx lhs tv_a; + unify_atom rval_ctx rhs tv_a; + unify_ty rval_ctx Ast.TY_bool tv | BINOPSIG_ord_ord_bool -> let tv_a = ref TYSPEC_ordered in - unify_atom lhs tv_a; - unify_atom rhs tv_a; - unify_ty Ast.TY_bool tv + unify_atom rval_ctx lhs tv_a; + unify_atom rval_ctx rhs tv_a; + unify_ty rval_ctx Ast.TY_bool tv | BINOPSIG_integ_integ_integ -> let tv_a = ref TYSPEC_integral in - unify_atom lhs tv_a; - unify_atom rhs tv_a; - unify_tyvars tv tv_a + unify_atom rval_ctx lhs tv_a; + unify_atom rval_ctx rhs tv_a; + unify_tyvars rval_ctx tv tv_a | BINOPSIG_num_num_num -> let tv_a = ref TYSPEC_numeric in - unify_atom lhs tv_a; - unify_atom rhs tv_a; - unify_tyvars tv tv_a + unify_atom rval_ctx lhs tv_a; + unify_atom rval_ctx rhs tv_a; + unify_tyvars rval_ctx tv tv_a | BINOPSIG_plus_plus_plus -> let tv_a = ref TYSPEC_plusable in - unify_atom lhs tv_a; - unify_atom rhs tv_a; - unify_tyvars tv tv_a + unify_atom rval_ctx lhs tv_a; + unify_atom rval_ctx rhs tv_a; + unify_tyvars rval_ctx tv tv_a end | Ast.EXPR_unary (unop, atom) -> begin match unop with Ast.UNOP_not -> - unify_atom atom + unify_atom rval_ctx atom (ref (TYSPEC_resolved ([||], Ast.TY_bool))); - unify_ty Ast.TY_bool tv + unify_ty rval_ctx Ast.TY_bool tv | Ast.UNOP_bitnot -> let tv_a = ref TYSPEC_integral in - unify_atom atom tv_a; - unify_tyvars tv tv_a + unify_atom rval_ctx atom tv_a; + unify_tyvars rval_ctx tv tv_a | Ast.UNOP_neg -> let tv_a = ref TYSPEC_numeric in - unify_atom atom tv_a; - unify_tyvars tv tv_a + unify_atom rval_ctx atom tv_a; + unify_tyvars rval_ctx tv tv_a | Ast.UNOP_cast t -> (* FIXME (issue #84): check cast-validity in * post-typecheck pass. Only some casts make sense. *) let tv_a = ref TYSPEC_all in let t = Hashtbl.find cx.ctxt_all_cast_types t.id in - unify_atom atom tv_a; - unify_ty t tv + unify_atom rval_ctx atom tv_a; + unify_ty rval_ctx t tv end - | Ast.EXPR_atom atom -> unify_atom atom tv + | Ast.EXPR_atom atom -> unify_atom ucx atom tv - and unify_lval' (lval:Ast.lval) (tv:tyvar) : unit = + and unify_lval' (ucx:unify_ctxt) (lval:Ast.lval) (tv:tyvar) : unit = let note_args args = iflog cx (fun _ -> log cx "noting lval '%a' type arguments: %a" Ast.sprintf_lval lval Ast.sprintf_app_args args); @@ -891,7 +1015,21 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = log cx "lval-base slot tyspec for %a = %s" Ast.sprintf_lval lval (tyspec_to_str (!tv)); end; - unify_slot slot (Some referent) tv + begin + match htab_search + cx.ctxt_auto_deref_lval nbi.id + with + None -> + htab_put cx.ctxt_auto_deref_lval + nbi.id ucx.box_ok + | Some b -> + (* A given source-occurrence of a name-base + * should never change its auto-deref + * nature. + *) + assert (b = ucx.box_ok); + end; + unify_slot ucx slot (Some referent) tv | _ -> let spec = (!(Hashtbl.find bindings referent)) in @@ -913,7 +1051,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = ref (TYSPEC_app (tv, args)) | _ -> err None "bad lval / tyspec combination" in - unify_tyvars (ref spec) tv + unify_tyvars ucx (ref spec) tv end | Ast.LVAL_ext (base, comp) -> let base_ts = match comp with @@ -934,19 +1072,22 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = TYSPEC_tuple (Array.init (i + 1) init) | Ast.COMP_atom atom -> - unify_atom atom + unify_atom rval_ctx atom (ref (TYSPEC_resolved ([||], Ast.TY_int))); TYSPEC_collection tv + + | Ast.COMP_deref -> + TYSPEC_box tv in let base_tv = ref base_ts in - unify_lval' base base_tv; + unify_lval' { ucx with box_ok = true } base base_tv; match !(resolve_tyvar base_tv) with TYSPEC_resolved (_, ty) -> - unify_ty (slot_ty (project_type_to_slot ty comp)) tv + unify_ty ucx (project_type ty comp) tv | _ -> () - and unify_lval (lval:Ast.lval) (tv:tyvar) : unit = + and unify_lval (ucx:unify_ctxt) (lval:Ast.lval) (tv:tyvar) : unit = let id = lval_base_id lval in (* Fetch lval with type components resolved. *) let lval = Hashtbl.find cx.ctxt_all_lvals id in @@ -954,13 +1095,13 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = "fetched resolved version of lval #%d = %a" (int_of_node id) Ast.sprintf_lval lval); Hashtbl.add lval_tyvars id tv; - unify_lval' lval tv + unify_lval' ucx lval tv in let gen_atom_tvs atoms = let gen_atom_tv atom = let tv = ref TYSPEC_all in - unify_atom atom tv; + unify_atom strict_ctx atom tv; tv in Array.map gen_atom_tv atoms @@ -970,97 +1111,114 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let check_callable out_tv callee args = let in_tvs = gen_atom_tvs args in let callee_tv = ref (TYSPEC_callable (out_tv, in_tvs)) in - unify_lval callee callee_tv; + unify_lval rval_ctx callee callee_tv; in + + let set_auto_deref lv b = + Hashtbl.replace cx.ctxt_auto_deref_lval (lval_base_id lv) b; + in + + let ty t = ref (TYSPEC_resolved ([||], t)) in + let any _ = ref TYSPEC_all in + match stmt.node with - Ast.STMT_spawn (out, _, callee, args) -> - let out_tv = ref (TYSPEC_resolved ([||], Ast.TY_nil)) in - unify_lval out (ref (TYSPEC_resolved ([||], Ast.TY_task))); + Ast.STMT_spawn (dst, _, callee, args) -> + let out_tv = ty Ast.TY_nil in + unify_lval lval_ctx dst (ty Ast.TY_task); check_callable out_tv callee args - | Ast.STMT_init_rec (lval, fields, Some base) -> + | Ast.STMT_init_rec (dst, fields, Some base) -> let dct = Hashtbl.create 10 in let tvrec = ref (TYSPEC_record dct) in - let add_field (ident, _, _, atom) = - let tv = ref TYSPEC_all in - unify_atom atom tv; + let add_field (ident, atom) = + let tv = any() in + unify_atom arg_pass_ctx atom tv; Hashtbl.add dct ident tv in Array.iter add_field fields; - let tvbase = ref TYSPEC_all in - unify_lval base tvbase; - unify_tyvars tvrec tvbase; - unify_lval lval tvrec + let tvbase = any() in + unify_lval rval_ctx base tvbase; + unify_tyvars rval_ctx tvrec tvbase; + unify_lval init_ctx dst tvrec - | Ast.STMT_init_rec (lval, fields, None) -> + | Ast.STMT_init_rec (dst, fields, None) -> let dct = Hashtbl.create 10 in - let add_field (ident, _, _, atom) = - let tv = ref TYSPEC_all in - unify_atom atom tv; + let add_field (ident, atom) = + let tv = any() in + unify_atom arg_pass_ctx atom tv; Hashtbl.add dct ident tv in Array.iter add_field fields; - unify_lval lval (ref (TYSPEC_record dct)) + unify_lval init_ctx dst (ref (TYSPEC_record dct)) - | Ast.STMT_init_tup (lval, members) -> - let member_to_tv (_, _, atom) = - let tv = ref TYSPEC_all in - unify_atom atom tv; + | Ast.STMT_init_tup (dst, members) -> + let member_to_tv atom = + let tv = any() in + unify_atom arg_pass_ctx atom tv; tv in let member_tvs = Array.map member_to_tv members in - unify_lval lval (ref (TYSPEC_tuple member_tvs)) + unify_lval init_ctx dst (ref (TYSPEC_tuple member_tvs)) - | Ast.STMT_init_vec (lval, _, atoms) -> - let tv = ref TYSPEC_all in - let unify_with_tv atom = unify_atom atom tv in + | Ast.STMT_init_vec (dst, atoms) -> + let tv = any() in + let unify_with_tv atom = unify_atom arg_pass_ctx atom tv in Array.iter unify_with_tv atoms; - unify_lval lval (ref (TYSPEC_vector tv)) - - | Ast.STMT_init_str (lval, _) -> - unify_lval lval (ref (TYSPEC_resolved ([||], Ast.TY_str))) - - | Ast.STMT_copy (lval, expr) -> - let tv = ref TYSPEC_all in - unify_expr expr tv; - unify_lval lval tv - - | Ast.STMT_copy_binop (lval, binop, at) -> - let tv = ref TYSPEC_all in - unify_expr (Ast.EXPR_binary (binop, Ast.ATOM_lval lval, at)) tv; - unify_lval lval tv; + unify_lval init_ctx dst (ref (TYSPEC_vector tv)) + + | Ast.STMT_init_str (dst, _) -> + unify_lval init_ctx dst (ty Ast.TY_str) + + | Ast.STMT_copy (dst, expr) -> + let tv = any() in + unify_expr arg_pass_ctx expr tv; + unify_lval lval_ctx dst tv + + | Ast.STMT_copy_binop (dst, binop, at) -> + let tv = any() in + unify_expr arg_pass_ctx + (Ast.EXPR_binary (binop, Ast.ATOM_lval dst, at)) tv; + (* Force-override the 'auto-deref' judgment that was cached + * in cx.ctxt_auto_deref_lval by preceding unify_expr call. + *) + set_auto_deref dst false; + unify_lval lval_ctx dst tv; | Ast.STMT_call (out, callee, args) -> - let out_tv = ref TYSPEC_all in - unify_lval out out_tv; + let out_tv = any() in + unify_lval arg_pass_ctx out out_tv; check_callable out_tv callee args - | Ast.STMT_log atom -> unify_atom atom (ref TYSPEC_loggable) + | Ast.STMT_log atom -> + begin + match atom with + Ast.ATOM_lval lv -> set_auto_deref lv true + | _ -> () + end | Ast.STMT_check_expr expr -> - unify_expr expr (ref (TYSPEC_resolved ([||], Ast.TY_bool))) + unify_expr rval_ctx expr (ty Ast.TY_bool) | Ast.STMT_check (_, check_calls) -> - let out_tv = ref (TYSPEC_resolved ([||], Ast.TY_bool)) in + let out_tv = ty Ast.TY_bool in Array.iter (fun (callee, args) -> check_callable out_tv callee args) check_calls - | Ast.STMT_while { Ast.while_lval = (_, expr); Ast.while_body = _ } -> - unify_expr expr (ref (TYSPEC_resolved ([||], Ast.TY_bool))) + | Ast.STMT_while { Ast.while_lval = (_, expr) } + | Ast.STMT_do_while { Ast.while_lval = (_, expr) } -> + unify_expr rval_ctx expr (ty Ast.TY_bool) | Ast.STMT_if { Ast.if_test = if_test } -> - unify_expr if_test (ref (TYSPEC_resolved ([||], Ast.TY_bool))); - - | Ast.STMT_decl _ -> () + unify_expr rval_ctx if_test (ty Ast.TY_bool); | Ast.STMT_ret atom_opt | Ast.STMT_put atom_opt -> begin match atom_opt with - None -> unify_ty Ast.TY_nil (retval_tv()) - | Some atom -> unify_atom atom (retval_tv()) + None -> unify_ty arg_pass_ctx Ast.TY_nil (retval_tv()) + | Some atom -> unify_atom arg_pass_ctx atom (retval_tv()) end | Ast.STMT_be (callee, args) -> @@ -1070,15 +1228,15 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = (* FIXME (issue #81): handle binding type parameters * eventually. *) - let out_tv = ref TYSPEC_all in + let out_tv = any() in let residue = ref [] in let gen_atom_opt_tvs atoms = let gen_atom_tv atom_opt = - let tv = ref TYSPEC_all in + let tv = any() in begin match atom_opt with None -> residue := tv :: (!residue); - | Some atom -> unify_atom atom tv + | Some atom -> unify_atom arg_pass_ctx atom tv end; tv in @@ -1089,14 +1247,14 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let arg_residue_tvs = Array.of_list (List.rev (!residue)) in let callee_tv = ref (TYSPEC_callable (out_tv, in_tvs)) in let bound_tv = ref (TYSPEC_callable (out_tv, arg_residue_tvs)) in - unify_lval callee callee_tv; - unify_lval bound bound_tv + unify_lval rval_ctx callee callee_tv; + unify_lval lval_ctx bound bound_tv | Ast.STMT_for_each fe -> - let out_tv = ref TYSPEC_all in + let out_tv = any() in let (si, _) = fe.Ast.for_each_slot in let (callee, args) = fe.Ast.for_each_call in - unify_slot si.node (Some si.id) out_tv; + unify_slot lval_ctx si.node (Some si.id) out_tv; check_callable out_tv callee args | Ast.STMT_for fo -> @@ -1104,23 +1262,71 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let seq_tv = ref (TYSPEC_collection mem_tv) in let (si, _) = fo.Ast.for_slot in let (_, seq) = fo.Ast.for_seq in - unify_lval seq seq_tv; - unify_slot si.node (Some si.id) mem_tv + unify_lval rval_ctx seq seq_tv; + unify_slot lval_ctx si.node (Some si.id) mem_tv | Ast.STMT_alt_tag { Ast.alt_tag_lval = lval; Ast.alt_tag_arms = arms } -> - let lval_tv = ref TYSPEC_all in - unify_lval lval lval_tv; + let lval_tv = any() in + unify_lval arg_pass_ctx lval lval_tv; Array.iter (fun _ -> push_pat_tv lval_tv) arms - (* FIXME (issue #52): plenty more to handle here. *) - | _ -> - log cx "warning: not typechecking stmt %s\n" - (Ast.sprintf_stmt () stmt) + | Ast.STMT_join lval -> + unify_lval rval_ctx lval (ty Ast.TY_task); + + | Ast.STMT_init_box (dst, v) -> + let in_tv = any() in + let tv = ref (TYSPEC_mutable (ref (TYSPEC_box in_tv))) in + unify_lval strict_ctx dst tv; + unify_atom rval_ctx v in_tv; + + (* FIXME (issue #52): Finish these. *) + (* Fake-typecheck a few comm-related statements for now, just enough + * to supply the auto-deref contexts; we will need new tyspecs for + * port and channel constraints. + *) + + | Ast.STMT_recv (dst, port) -> + set_auto_deref dst rval_ctx.box_ok; + set_auto_deref port rval_ctx.box_ok; + + | Ast.STMT_send (chan, v) -> + set_auto_deref chan rval_ctx.box_ok; + set_auto_deref v rval_ctx.box_ok; + + | Ast.STMT_init_chan (dst, port_opt) -> + begin + match port_opt with + None -> () + | Some port -> set_auto_deref port rval_ctx.box_ok + end; + set_auto_deref dst init_ctx.box_ok + + | Ast.STMT_init_port dst -> + set_auto_deref dst init_ctx.box_ok + + + (* Nothing to typecheck on these. *) + | Ast.STMT_block _ + | Ast.STMT_decl _ + | Ast.STMT_yield + | Ast.STMT_fail -> () + + (* Unimplemented. *) + | Ast.STMT_check_if _ + | Ast.STMT_prove _ + | Ast.STMT_note _ + | Ast.STMT_alt_port _ + | Ast.STMT_alt_type _ + | Ast.STMT_put_each _ + | Ast.STMT_slice _ -> err None "Unimplemented typecheck for stmt" in let visit_stmt_pre (stmt:Ast.stmt) : unit = try + log cx ""; + log cx "typechecking stmt: %a" Ast.sprintf_stmt stmt; + log cx ""; visit_stmt_pre_full stmt; (* * Reset any item-parameters that were resolved to types @@ -1129,6 +1335,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = Hashtbl.iter (fun _ params -> Array.iter (fun tv -> tv := TYSPEC_all) params) item_params; + log cx "finished typechecking stmt: %a" Ast.sprintf_stmt stmt; with Semant_err (None, msg) -> raise (Semant_err ((Some stmt.id), msg)) @@ -1137,7 +1344,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let enter_fn fn retspec = let out = fn.Ast.fn_output_slot in push_retval_tv (ref retspec); - unify_slot out.node (Some out.id) (retval_tv()) + unify_slot arg_pass_ctx out.node (Some out.id) (retval_tv()) in let visit_obj_fn_pre obj ident fn = @@ -1181,8 +1388,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = Ast.TY_fn (tsig, _) -> begin let vec_str = - interior_slot (Ast.TY_vec - (interior_slot Ast.TY_str)) + local_slot (Ast.TY_vec Ast.TY_str) in match tsig.Ast.sig_input_slots with [| |] -> () @@ -1205,12 +1411,12 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let visit_pat_pre (pat:Ast.pat) : unit = let expected = pat_tv() in match pat with - Ast.PAT_lit lit -> unify_lit lit expected + Ast.PAT_lit lit -> unify_lit strict_ctx lit expected | Ast.PAT_tag (lval, _) -> let expect ty = let tv = ref TYSPEC_all in - unify_ty ty tv; + unify_ty strict_ctx ty tv; push_pat_tv tv; in @@ -1222,7 +1428,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = * exactly to that function type, rebuilt under any latent type * parameters applied in the lval. *) let lval_tv = ref TYSPEC_all in - unify_lval lval lval_tv; + unify_lval strict_ctx lval lval_tv; let tag_ctor_ty = match !(resolve_tyvar lval_tv) with TYSPEC_resolved (_, ty) -> ty @@ -1234,19 +1440,13 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let tag_ty_tup = tag_or_iso_ty_tup_by_name tag_ty lval_nm in let tag_tv = ref TYSPEC_all in - unify_ty tag_ty tag_tv; - unify_tyvars expected tag_tv; - List.iter - begin - fun slot -> - match slot.Ast.slot_ty with - Some ty -> expect ty - | None -> bug () "no slot type in tag slot tuple" - end + unify_ty strict_ctx tag_ty tag_tv; + unify_tyvars strict_ctx expected tag_tv; + List.iter expect (List.rev (Array.to_list tag_ty_tup)); | Ast.PAT_slot (sloti, _) -> - unify_slot sloti.node (Some sloti.id) expected + unify_slot lval_ctx sloti.node (Some sloti.id) expected | Ast.PAT_wild -> () in @@ -1274,7 +1474,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = match defn with DEFN_slot { Ast.slot_mode = _; Ast.slot_ty = None } -> Queue.add id auto_queue; - Hashtbl.add bindings id (ref TYSPEC_all) + Hashtbl.add bindings id (ref (TYSPEC_mutable (ref TYSPEC_all))) | DEFN_slot { Ast.slot_mode = _; Ast.slot_ty = Some ty } -> let _ = iflog cx (fun _ -> log cx "initial slot #%d type: %a" (int_of_node id) Ast.sprintf_ty ty) @@ -1336,25 +1536,40 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let defn = Hashtbl.find cx.ctxt_all_defns id in match defn with DEFN_slot slot_defn -> - Hashtbl.replace cx.ctxt_all_defns id - (DEFN_slot { slot_defn with Ast.slot_ty = Some ty }) + begin + match slot_defn.Ast.slot_ty with + Some _ -> () + | None -> + log cx "setting auto slot #%d = %a to type %a" + (int_of_node id) + Ast.sprintf_slot_key + (Hashtbl.find cx.ctxt_slot_keys id) + Ast.sprintf_ty ty; + Hashtbl.replace cx.ctxt_all_defns id + (DEFN_slot { slot_defn with + Ast.slot_ty = Some ty }) + end | _ -> bug () "check_auto_tyvar: no slot defn" in - let get_resolved_ty tv id = + let rec get_resolved_ty tv id = let ts = !(resolve_tyvar tv) in match ts with TYSPEC_resolved ([||], ty) -> ty - | TYSPEC_vector (tv) -> - begin - match !(resolve_tyvar tv) with - TYSPEC_resolved ([||], ty) -> - (Ast.TY_vec (interior_slot ty)) - | _ -> - err (Some id) - "unresolved vector-element type in %s (%d)" - (tyspec_to_str ts) (int_of_node id) - end + | TYSPEC_box tv -> + Ast.TY_box (get_resolved_ty tv id) + + | TYSPEC_mutable tv -> + Ast.TY_mutable (get_resolved_ty tv id) + + | TYSPEC_vector tv -> + Ast.TY_vec (get_resolved_ty tv id) + + | TYSPEC_tuple tvs -> + Ast.TY_tup + (Array.map + (fun tv -> get_resolved_ty tv id) tvs) + | _ -> err (Some id) "unresolved type %s (%d)" (tyspec_to_str ts) @@ -1369,6 +1584,13 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let record_lval_ty id tv = let ty = get_resolved_ty tv id in + let _ = + iflog cx + (fun _ -> + log cx "recording resolved lval #%d type %a" + (int_of_node id) + Ast.sprintf_ty ty) + in Hashtbl.add cx.ctxt_all_lval_types id ty in diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml index d42aaf6d..2c0c4b15 100644 --- a/src/boot/me/typestate.ml +++ b/src/boot/me/typestate.ml @@ -68,9 +68,10 @@ let determine_constr_key if referent_is_slot cx aid then if type_has_state - (slot_ty (referent_to_slot cx aid)) + (strip_mutable_or_constrained_ty + (slot_ty (get_slot cx aid))) then err (Some aid) - "predicate applied to slot of mutable type" + "predicate applied to slot of state type" else aid else (* Items are always constant, they're ok. @@ -419,7 +420,7 @@ let condition_assigning_visitor raise_precondition s.id precond; raise_postcondition s.id postcond - | Ast.STMT_init_vec (dst, _, atoms) -> + | Ast.STMT_init_vec (dst, atoms) -> let precond = slot_inits (atoms_slots cx atoms) in let postcond = slot_inits (lval_slots cx dst) in raise_precondition s.id precond; @@ -439,6 +440,12 @@ let condition_assigning_visitor raise_precondition s.id precond; raise_postcondition s.id postcond + | Ast.STMT_init_box (dst, src) -> + let precond = slot_inits (atom_slots cx src) in + let postcond = slot_inits (lval_slots cx dst) in + raise_precondition s.id precond; + raise_postcondition s.id postcond + | Ast.STMT_copy (dst, src) -> let precond = slot_inits (expr_slots cx src) in let postcond = slot_inits (lval_slots cx dst) in @@ -980,16 +987,23 @@ let lifecycle_visitor if initializing then begin - Hashtbl.add cx.ctxt_copy_stmt_is_init s.id (); + iflog cx + begin + fun _ -> + log cx "noting lval %a init at stmt %a" + Ast.sprintf_lval lv_dst Ast.sprintf_stmt s + end; + Hashtbl.replace cx.ctxt_copy_stmt_is_init s.id (); init_lval lv_dst end; | Ast.STMT_init_rec (lv_dst, _, _) | Ast.STMT_init_tup (lv_dst, _) - | Ast.STMT_init_vec (lv_dst, _, _) + | Ast.STMT_init_vec (lv_dst, _) | Ast.STMT_init_str (lv_dst, _) | Ast.STMT_init_port lv_dst - | Ast.STMT_init_chan (lv_dst, _) -> + | Ast.STMT_init_chan (lv_dst, _) + | Ast.STMT_init_box (lv_dst, _) -> init_lval lv_dst | Ast.STMT_for f -> diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml index 203acfce..0b60c832 100644 --- a/src/boot/me/walk.ml +++ b/src/boot/me/walk.ml @@ -235,7 +235,7 @@ and walk_mod_item : unit = let children _ = match item.node.Ast.decl_item with - Ast.MOD_ITEM_type ty -> walk_ty v ty + Ast.MOD_ITEM_type (_, ty) -> walk_ty v ty | Ast.MOD_ITEM_fn f -> walk_fn v f item.id | Ast.MOD_ITEM_tag (htup, ttag, _) -> walk_header_tup v htup; @@ -262,7 +262,7 @@ and walk_mod_item item -and walk_ty_tup v ttup = Array.iter (walk_slot v) ttup +and walk_ty_tup v ttup = Array.iter (walk_ty v) ttup and walk_ty_tag v ttag = Hashtbl.iter (fun _ t -> walk_ty_tup v t) ttag @@ -273,8 +273,8 @@ and walk_ty let children _ = match ty with Ast.TY_tup ttup -> walk_ty_tup v ttup - | Ast.TY_vec s -> walk_slot v s - | Ast.TY_rec trec -> Array.iter (fun (_, s) -> walk_slot v s) trec + | Ast.TY_vec s -> walk_ty v s + | Ast.TY_rec trec -> Array.iter (fun (_, s) -> walk_ty v s) trec | Ast.TY_tag ttag -> walk_ty_tag v ttag | Ast.TY_iso tiso -> Array.iter (walk_ty_tag v) tiso.Ast.iso_group | Ast.TY_fn tfn -> walk_ty_fn v tfn @@ -301,6 +301,8 @@ and walk_ty | Ast.TY_nil -> () | Ast.TY_task -> () | Ast.TY_any -> () + | Ast.TY_box m -> walk_ty v m + | Ast.TY_mutable m -> walk_ty v m in walk_bracketed v.visit_ty_pre @@ -448,16 +450,16 @@ and walk_stmt | Ast.STMT_init_rec (lv, atab, base) -> walk_lval v lv; - Array.iter (fun (_, _, _, a) -> walk_atom v a) atab; + Array.iter (fun (_, a) -> walk_atom v a) atab; walk_option (walk_lval v) base; - | Ast.STMT_init_vec (lv, _, atoms) -> + | Ast.STMT_init_vec (lv, atoms) -> walk_lval v lv; Array.iter (walk_atom v) atoms | Ast.STMT_init_tup (lv, mut_atoms) -> walk_lval v lv; - Array.iter (fun (_, _, a) -> walk_atom v a) mut_atoms + Array.iter (walk_atom v) mut_atoms | Ast.STMT_init_str (lv, _) -> walk_lval v lv @@ -469,6 +471,10 @@ and walk_stmt walk_option (walk_lval v) port; walk_lval v chan; + | Ast.STMT_init_box (dst, src) -> + walk_lval v dst; + walk_atom v src + | Ast.STMT_for f -> walk_stmt_for f diff --git a/src/lib/util.rs b/src/lib/util.rs index bf57bb52..e0e52c8f 100644 --- a/src/lib/util.rs +++ b/src/lib/util.rs @@ -1,8 +1,4 @@ type option[T] = tag(none(), some(T)); -type box[T] = tup(@T); -type boxo[T] = option[box[T]]; -type boxm[T] = tup(mutable @T); -type boxmo[T] = option[boxm[T]]; type map[T, U] = fn(&T) -> U; @@ -17,28 +13,6 @@ fn option_map[T, U](map[T, U] f, &option[T] opt) -> option[U] { } } -fn unbox[T](&box[T] b) -> T { - ret b._0; -} - - -fn unboxm[T](&boxm[T] b) -> T { - ret b._0; -} - -fn unboxo[T](boxo[T] b) -> option[T] { - // Pending issue #90, no need to alias the function item in order to pass - // it as an arg. - let map[box[T], T] f = unbox[T]; - be option_map[box[T], T](f, b); -} - -fn unboxmo[T](boxmo[T] b) -> option[T] { - // Issue #90, as above - let map[boxm[T], T] f = unboxm[T]; - be option_map[boxm[T], T](f, b); -} - fn id[T](T x) -> T { ret x; } diff --git a/src/rt/rust_crate_reader.cpp b/src/rt/rust_crate_reader.cpp index 3c36729f..b9b4497c 100644 --- a/src/rt/rust_crate_reader.cpp +++ b/src/rt/rust_crate_reader.cpp @@ -255,12 +255,19 @@ rust_crate_reader::die::die(die_reader *rdr, uintptr_t off) if (!ab_idx) { ab = NULL; dom->log(rust_log::DWARF, "DIE <0x%" PRIxPTR "> (null)", off); + dom->get_log().outdent(); } else { ab = rdr->abbrevs.get_abbrev(ab_idx); - dom->log(rust_log::DWARF, "DIE <0x%" PRIxPTR "> abbrev 0x%" - PRIxPTR, off, ab_idx); - dom->log(rust_log::DWARF, " tag 0x%x, has children: %d", - ab->tag, ab->has_children); + if (!ab) { + dom->log(rust_log::DWARF, " bad abbrev number: 0x%" + PRIxPTR, ab_idx); + rdr->fail(); + } else { + dom->log(rust_log::DWARF, "DIE <0x%" PRIxPTR "> abbrev 0x%" + PRIxPTR, off, ab_idx); + dom->log(rust_log::DWARF, " tag 0x%x, has children: %d", + ab->tag, ab->has_children); + } } } @@ -334,6 +341,12 @@ rust_crate_reader::die::step_attr(attr &a) const return rdr->is_ok() || rdr->at_end(); break; + case DW_FORM_block4: + rdr->get(u32); + rdr->adv(u32); + return rdr->is_ok() || rdr->at_end(); + break; + default: rdr->mem.dom->log(rust_log::DWARF, " unknown dwarf form: 0x%" PRIxPTR, a.form); @@ -451,19 +464,21 @@ rust_crate_reader::die::next() const { rdr_sess use(rdr); if (start_attrs()) { - attr a; - while (step_attr(a)) { - I(dom, !(a.is_numeric() && a.is_string())); - if (a.is_numeric()) - dom->log(rust_log::DWARF, " attr num: 0x%" - PRIxPTR, a.get_num(dom)); - else if (a.is_string()) - dom->log(rust_log::DWARF, " attr str: %s", - a.get_str(dom)); - else - dom->log(rust_log::DWARF, " attr ??:"); - } + attr a; + while (step_attr(a)) { + I(dom, !(a.is_numeric() && a.is_string())); + if (a.is_numeric()) + dom->log(rust_log::DWARF, " attr num: 0x%" + PRIxPTR, a.get_num(dom)); + else if (a.is_string()) + dom->log(rust_log::DWARF, " attr str: %s", + a.get_str(dom)); + else + dom->log(rust_log::DWARF, " attr ??:"); + } } + if (has_children()) + dom->get_log().indent(); } return die(rdr, rdr->tell_off()); } diff --git a/src/rt/rust_task.cpp b/src/rt/rust_task.cpp index bf92ba90..5e230a58 100644 --- a/src/rt/rust_task.cpp +++ b/src/rt/rust_task.cpp @@ -413,6 +413,7 @@ rust_task::link_gc(gc_alloc *gcm) { I(dom, gcm->next == NULL); gcm->prev = NULL; gcm->next = gc_alloc_chain; + gc_alloc_chain = gcm; } void diff --git a/src/rt/rust_upcall.cpp b/src/rt/rust_upcall.cpp index ffe77532..b9cd68fc 100644 --- a/src/rt/rust_upcall.cpp +++ b/src/rt/rust_upcall.cpp @@ -328,11 +328,16 @@ upcall_malloc(rust_task *task, size_t nbytes, type_desc *td) { LOG_UPCALL_ENTRY(task); + task->dom->log(rust_log::UPCALL|rust_log::MEM, + "upcall malloc(%" PRIdPTR ", 0x%" PRIxPTR ")" + " with gc-chain head = 0x%" PRIxPTR, + nbytes, td, task->gc_alloc_chain); void *p = task->malloc(nbytes, td); task->dom->log(rust_log::UPCALL|rust_log::MEM, - "upcall malloc(%u) = 0x%" PRIxPTR + "upcall malloc(%" PRIdPTR ", 0x%" PRIxPTR + ") = 0x%" PRIxPTR " with gc-chain head = 0x%" PRIxPTR, - nbytes, (uintptr_t)p, task->gc_alloc_chain); + nbytes, td, (uintptr_t)p, task->gc_alloc_chain); return (uintptr_t) p; } diff --git a/src/test/run-pass/acyclic-unwind.rs b/src/test/run-pass/acyclic-unwind.rs index b549cffe..192a01f3 100644 --- a/src/test/run-pass/acyclic-unwind.rs +++ b/src/test/run-pass/acyclic-unwind.rs @@ -4,10 +4,10 @@ io fn f(chan[int] c) { type t = tup(int,int,int); - // Allocate an exterior. + // Allocate a box. let @t x = tup(1,2,3); - // Signal parent that we've allocated an exterior. + // Signal parent that we've allocated a box. c <| 1; while (true) { diff --git a/src/test/run-pass/box-unbox.rs b/src/test/run-pass/box-unbox.rs index 821ac74c..9c00f55c 100644 --- a/src/test/run-pass/box-unbox.rs +++ b/src/test/run-pass/box-unbox.rs @@ -1,10 +1,10 @@ type box[T] = tup(@T); -fn unbox[T](box[T] b) -> T { ret b._0; } +fn unbox[T](box[T] b) -> T { ret *b._0; } fn main() { let int foo = 17; - let box[int] bfoo = tup(foo); + let box[int] bfoo = tup(@foo); log "see what's in our box"; check (unbox[int](bfoo) == foo); } diff --git a/src/test/run-pass/deref.rs b/src/test/run-pass/deref.rs new file mode 100644 index 00000000..36a28ba5 --- /dev/null +++ b/src/test/run-pass/deref.rs @@ -0,0 +1,4 @@ +fn main() { + let @int x = @10; + let int y = *x; +}
\ No newline at end of file diff --git a/src/test/run-pass/exterior.rs b/src/test/run-pass/exterior.rs index bb0b91eb..0e93e25a 100644 --- a/src/test/run-pass/exterior.rs +++ b/src/test/run-pass/exterior.rs @@ -10,7 +10,7 @@ fn f(@point p) { fn main() { let point a = rec(x=10, y=11, z=mutable 12); - let @point b = a; + let @point b = @a; check (b.z == 12); f(b); check (a.z == 12); diff --git a/src/test/run-pass/generic-tag.rs b/src/test/run-pass/generic-tag.rs index 9a98ead5..0e1c6a65 100644 --- a/src/test/run-pass/generic-tag.rs +++ b/src/test/run-pass/generic-tag.rs @@ -1,6 +1,6 @@ type option[T] = tag(some(@T), none()); fn main() { - let option[int] a = some[int](10); + let option[int] a = some[int](@10); a = none[int](); }
\ No newline at end of file diff --git a/src/test/run-pass/lazy-and-or.rs b/src/test/run-pass/lazy-and-or.rs index 81f09843..fe0ffe6b 100644 --- a/src/test/run-pass/lazy-and-or.rs +++ b/src/test/run-pass/lazy-and-or.rs @@ -1,4 +1,4 @@ -fn incr(mutable &int x) -> bool { +fn incr(& mutable int x) -> bool { x += 1; check (false); ret false; diff --git a/src/test/run-pass/list.rs b/src/test/run-pass/list.rs index 38601f8f..c615b67c 100644 --- a/src/test/run-pass/list.rs +++ b/src/test/run-pass/list.rs @@ -3,5 +3,5 @@ type list = tag(cons(int,@list), nil()); fn main() { - cons(10, cons(11, cons(12, nil()))); + cons(10, @cons(11, @cons(12, @nil()))); } diff --git a/src/test/run-pass/mlist.rs b/src/test/run-pass/mlist.rs index ba71aa58..c9bdb283 100644 --- a/src/test/run-pass/mlist.rs +++ b/src/test/run-pass/mlist.rs @@ -3,5 +3,5 @@ type mlist = tag(cons(int,mutable @mlist), nil()); fn main() { - cons(10, cons(11, cons(12, nil()))); + cons(10, @cons(11, @cons(12, @nil()))); } diff --git a/src/test/run-pass/obj-drop.rs b/src/test/run-pass/obj-drop.rs index 6d4ca3d4..107e6693 100644 --- a/src/test/run-pass/obj-drop.rs +++ b/src/test/run-pass/obj-drop.rs @@ -1,6 +1,6 @@ fn main() { obj handle(@int i) { } - // This just tests whether the obj leaks its exterior state members. - auto ob = handle(0xf00f00); + // This just tests whether the obj leaks its box state members. + auto ob = handle(@0xf00f00); }
\ No newline at end of file diff --git a/src/test/run-pass/output-slot-variants.rs b/src/test/run-pass/output-slot-variants.rs index 3dd5ae2e..5142a9b1 100644 --- a/src/test/run-pass/output-slot-variants.rs +++ b/src/test/run-pass/output-slot-variants.rs @@ -3,7 +3,7 @@ fn ret_int_i() -> int { } fn ret_ext_i() -> @int { - ret 10; + ret @10; } fn ret_int_tup() -> tup(int,int) { @@ -11,7 +11,7 @@ fn ret_int_tup() -> tup(int,int) { } fn ret_ext_tup() -> @tup(int,int) { - ret tup(10, 10); + ret @tup(10, 10); } fn ret_ext_mem() -> tup(@int, @int) { @@ -19,7 +19,7 @@ fn ret_ext_mem() -> tup(@int, @int) { } fn ret_ext_ext_mem() -> @tup(@int, @int) { - ret tup(@10, @10); + ret @tup(@10, @10); } fn main() { diff --git a/src/test/run-pass/vec-drop.rs b/src/test/run-pass/vec-drop.rs index 267c7a78..fff9a1ee 100644 --- a/src/test/run-pass/vec-drop.rs +++ b/src/test/run-pass/vec-drop.rs @@ -1,4 +1,4 @@ fn main() { // This just tests whether the vec leaks its members. - let vec[@tup(int,int)] pvec = vec(tup(1,2),tup(3,4),tup(5,6)); + let vec[@tup(int,int)] pvec = vec(@tup(1,2),@tup(3,4),@tup(5,6)); } diff --git a/src/test/run-pass/writealias.rs b/src/test/run-pass/writealias.rs index 96b2a9d7..061b1b57 100644 --- a/src/test/run-pass/writealias.rs +++ b/src/test/run-pass/writealias.rs @@ -2,7 +2,7 @@ type point = rec(int x, int y, mutable int z); -fn f(mutable &point p) { +fn f(& mutable point p) { p.z = 13; } |