diff options
author | Eduardo Julian | 2018-05-16 00:11:49 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-05-16 00:11:49 -0400 |
commit | 8ba6ac8952e3457b1a09e30ac5312168d48006d1 (patch) | |
tree | f4ed8a04f95bd95165add394541ef81eadbfd839 /new-luxc/source/luxc/lang/analysis | |
parent | 4242e4d3b18eb532ae18e8b38e85ad1ee1988e02 (diff) |
- Migrated structure analysis to stdlib.
- Added an easy way to report information in exceptions.
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis')
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/common.lux | 21 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/expression.lux | 126 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/inference.lux | 252 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/structure.lux | 365 |
4 files changed, 0 insertions, 764 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux deleted file mode 100644 index 072616cfa..000000000 --- a/new-luxc/source/luxc/lang/analysis/common.lux +++ /dev/null @@ -1,21 +0,0 @@ -(.module: - lux - (lux (control monad - ["ex" exception #+ exception:]) - (data text/format - [product]) - [macro] - (lang [type] - (type ["tc" check]))) - (luxc ["&" lang] - (lang analysis))) - -(exception: #export (Variant-Tag-Out-Of-Bounds {message Text}) - message) - -(def: #export (variant-out-of-bounds-error type size tag) - (All [a] (-> Type Nat Nat (Meta a))) - (&.throw Variant-Tag-Out-Of-Bounds - (format " Tag: " (%n tag) "\n" - "Variant Size: " (%n size) "\n" - "Variant Type: " (%type type)))) diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux deleted file mode 100644 index aaa64940b..000000000 --- a/new-luxc/source/luxc/lang/analysis/expression.lux +++ /dev/null @@ -1,126 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data ["e" error] - [product] - text/format) - [macro] - (lang [type] - (type ["tc" check])) - [host]) - (luxc ["&" lang] - (lang ["&." module] - [".L" host] - [".L" macro] - [".L" extension] - ["la" analysis] - (translation (jvm [".T" common])))) - (// [".A" common] - [".A" function] - [".A" primitive] - [".A" reference] - [".A" structure])) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Macro-Expression-Must-Have-Single-Expansion] - [Unrecognized-Syntax] - [Macro-Expansion-Failed] - ) - -(def: #export (analyser eval) - (-> &.Eval &.Analyser) - (: (-> Code (Meta la.Analysis)) - (function (analyse code) - (do macro.Monad<Meta> - [expectedT macro.expected-type] - (let [[cursor code'] code] - ## The cursor must be set in the compiler for the sake - ## of having useful error messages. - (&.with-cursor cursor - (case code' - (^template [<tag> <analyser>] - (<tag> value) - (<analyser> value)) - ([#.Bool primitiveA.analyse-bool] - [#.Nat primitiveA.analyse-nat] - [#.Int primitiveA.analyse-int] - [#.Deg primitiveA.analyse-deg] - [#.Frac primitiveA.analyse-frac] - [#.Text primitiveA.analyse-text]) - - (^ (#.Tuple (list))) - primitiveA.analyse-unit - - ## Singleton tuples are equivalent to the element they contain. - (^ (#.Tuple (list singleton))) - (analyse singleton) - - (^ (#.Tuple elems)) - (structureA.analyse-product analyse elems) - - (^ (#.Record pairs)) - (structureA.analyse-record analyse pairs) - - (#.Symbol reference) - (referenceA.analyse-reference reference) - - (^ (#.Form (list& [_ (#.Text proc-name)] proc-args))) - (do macro.Monad<Meta> - [procedure (extensionL.find-analysis proc-name)] - (procedure analyse eval proc-args)) - - (^template [<tag> <analyser>] - (^ (#.Form (list& [_ (<tag> tag)] - values))) - (case values - (#.Cons value #.Nil) - (<analyser> analyse tag value) - - _ - (<analyser> analyse tag (` [(~+ values)])))) - ([#.Nat structureA.analyse-sum] - [#.Tag structureA.analyse-tagged-sum]) - - (#.Tag tag) - (structureA.analyse-tagged-sum analyse tag (' [])) - - (^ (#.Form (list& func args))) - (do macro.Monad<Meta> - [[funcT funcA] (commonA.with-unknown-type - (analyse func))] - (case funcA - [_ (#.Symbol def-name)] - (do @ - [?macro (&.with-error-tracking - (macro.find-macro def-name))] - (case ?macro - (#.Some macro) - (do @ - [expansion (: (Meta (List Code)) - (function (_ compiler) - (case (macroL.expand macro args compiler) - (#e.Error error) - ((&.throw Macro-Expansion-Failed error) compiler) - - output - output)))] - (case expansion - (^ (list single)) - (analyse single) - - _ - (&.throw Macro-Expression-Must-Have-Single-Expansion (%code code)))) - - _ - (functionA.analyse-apply analyse funcT funcA args))) - - _ - (functionA.analyse-apply analyse funcT funcA args))) - - _ - (&.throw Unrecognized-Syntax (%code code)) - ))))))) diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux deleted file mode 100644 index 9bc668050..000000000 --- a/new-luxc/source/luxc/lang/analysis/inference.lux +++ /dev/null @@ -1,252 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - [text] - text/format - (coll [list "list/" Functor<List>])) - [macro "macro/" Monad<Meta>] - (lang [type] - (type ["tc" check]))) - (luxc ["&" lang] - (lang ["la" analysis #+ Analysis] - (analysis ["&." common])))) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Cannot-Infer] - [Cannot-Infer-Argument] - [Smaller-Variant-Than-Expected] - [Invalid-Type-Application] - [Not-A-Record-Type] - [Not-A-Variant-Type] - ) - -(def: (cannot-infer type args) - (-> Type (List Code) Text) - (format " Type: " (%type type) "\n" - "Arguments:" - (|> args - list.enumerate - (list/map (function (_ [idx argC]) - (format "\n " (%n idx) " " (%code argC)))) - (text.join-with "")))) - -(def: (replace-bound bound-idx replacementT type) - (-> Nat Type Type Type) - (case type - (#.Primitive name params) - (#.Primitive name (list/map (replace-bound bound-idx replacementT) params)) - - (^template [<tag>] - (<tag> left right) - (<tag> (replace-bound bound-idx replacementT left) - (replace-bound bound-idx replacementT right))) - ([#.Sum] - [#.Product] - [#.Function] - [#.Apply]) - - (#.Bound idx) - (if (n/= bound-idx idx) - replacementT - type) - - (^template [<tag>] - (<tag> env quantified) - (<tag> (list/map (replace-bound bound-idx replacementT) env) - (replace-bound (n/+ +2 bound-idx) replacementT quantified))) - ([#.UnivQ] - [#.ExQ]) - - _ - type)) - -(def: new-named-type - (Meta Type) - (do macro.Monad<Meta> - [[_module _line _column] macro.cursor - [ex-id exT] (&.with-type-env tc.existential)] - (wrap (#.Primitive (format "{New Type @ " (%t _module) - "," (%n _line) - "," (%n _column) - "} " (%n ex-id)) - (list))))) - -## Type-inference works by applying some (potentially quantified) type -## to a sequence of values. -## Function types are used for this, although inference is not always -## done for function application (alternative uses may be records and -## tagged variants). -## But, so long as the type being used for the inference can be treated -## as a function type, this method of inference should work. -(def: #export (general analyse inferT args) - (-> &.Analyser Type (List Code) (Meta [Type (List Analysis)])) - (case args - #.Nil - (do macro.Monad<Meta> - [_ (&.infer inferT)] - (wrap [inferT (list)])) - - (#.Cons argC args') - (case inferT - (#.Named name unnamedT) - (general analyse unnamedT args) - - (#.UnivQ _) - (do macro.Monad<Meta> - [[var-id varT] (&.with-type-env tc.var)] - (general analyse (maybe.assume (type.apply (list varT) inferT)) args)) - - (#.ExQ _) - (do macro.Monad<Meta> - [[var-id varT] (&.with-type-env tc.var) - output (general analyse - (maybe.assume (type.apply (list varT) inferT)) - args) - bound? (&.with-type-env - (tc.bound? var-id)) - _ (if bound? - (wrap []) - (do @ - [newT new-named-type] - (&.with-type-env - (tc.check varT newT))))] - (wrap output)) - - (#.Apply inputT transT) - (case (type.apply (list inputT) transT) - (#.Some outputT) - (general analyse outputT args) - - #.None - (&.throw Invalid-Type-Application (%type inferT))) - - ## Arguments are inferred back-to-front because, by convention, - ## Lux functions take the most important arguments *last*, which - ## means that the most information for doing proper inference is - ## located in the last arguments to a function call. - ## By inferring back-to-front, a lot of type-annotations can be - ## avoided in Lux code, since the inference algorithm can piece - ## things together more easily. - (#.Function inputT outputT) - (do macro.Monad<Meta> - [[outputT' args'A] (general analyse outputT args') - argA (&.with-stacked-errors - (function (_ _) - (ex.construct Cannot-Infer-Argument - (format "Inferred Type: " (%type inputT) "\n" - " Argument: " (%code argC)))) - (&.with-type inputT - (analyse argC)))] - (wrap [outputT' (list& argA args'A)])) - - (#.Var infer-id) - (do macro.Monad<Meta> - [?inferT' (&.with-type-env (tc.read infer-id))] - (case ?inferT' - (#.Some inferT') - (general analyse inferT' args) - - _ - (&.throw Cannot-Infer (cannot-infer inferT args)))) - - _ - (&.throw Cannot-Infer (cannot-infer inferT args))) - )) - -## Turns a record type into the kind of function type suitable for inference. -(def: #export (record inferT) - (-> Type (Meta Type)) - (case inferT - (#.Named name unnamedT) - (record unnamedT) - - (^template [<tag>] - (<tag> env bodyT) - (do macro.Monad<Meta> - [bodyT+ (record bodyT)] - (wrap (<tag> env bodyT+)))) - ([#.UnivQ] - [#.ExQ]) - - (#.Apply inputT funcT) - (case (type.apply (list inputT) funcT) - (#.Some outputT) - (record outputT) - - #.None - (&.throw Invalid-Type-Application (%type inferT))) - - (#.Product _) - (macro/wrap (type.function (type.flatten-tuple inferT) inferT)) - - _ - (&.throw Not-A-Record-Type (%type inferT)))) - -## Turns a variant type into the kind of function type suitable for inference. -(def: #export (variant tag expected-size inferT) - (-> Nat Nat Type (Meta Type)) - (loop [depth +0 - currentT inferT] - (case currentT - (#.Named name unnamedT) - (do macro.Monad<Meta> - [unnamedT+ (recur depth unnamedT)] - (wrap unnamedT+)) - - (^template [<tag>] - (<tag> env bodyT) - (do macro.Monad<Meta> - [bodyT+ (recur (n/inc depth) bodyT)] - (wrap (<tag> env bodyT+)))) - ([#.UnivQ] - [#.ExQ]) - - (#.Sum _) - (let [cases (type.flatten-variant currentT) - actual-size (list.size cases) - boundary (n/dec expected-size)] - (cond (or (n/= expected-size actual-size) - (and (n/> expected-size actual-size) - (n/< boundary tag))) - (case (list.nth tag cases) - (#.Some caseT) - (macro/wrap (if (n/= +0 depth) - (type.function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n/dec (n/* +2)) inferT)] - (type.function (list (replace! caseT)) - (replace! currentT))))) - - #.None - (&common.variant-out-of-bounds-error inferT expected-size tag)) - - (n/< expected-size actual-size) - (&.throw Smaller-Variant-Than-Expected - (format "Expected: " (%i (nat-to-int expected-size)) "\n" - " Actual: " (%i (nat-to-int actual-size)))) - - (n/= boundary tag) - (let [caseT (type.variant (list.drop boundary cases))] - (macro/wrap (if (n/= +0 depth) - (type.function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n/dec (n/* +2)) inferT)] - (type.function (list (replace! caseT)) - (replace! currentT)))))) - - ## else - (&common.variant-out-of-bounds-error inferT expected-size tag))) - - (#.Apply inputT funcT) - (case (type.apply (list inputT) funcT) - (#.Some outputT) - (variant tag expected-size outputT) - - #.None - (&.throw Invalid-Type-Application (%type inferT))) - - _ - (&.throw Not-A-Variant-Type (%type inferT))))) diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux deleted file mode 100644 index f9e7ad8fc..000000000 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ /dev/null @@ -1,365 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [ident] - [number] - [product] - [maybe] - (coll [list "list/" Functor<List>] - (dictionary ["dict" unordered #+ Dict])) - text/format) - [macro] - (macro [code]) - (lang [type] - (type ["tc" check]))) - (luxc ["&" lang] - (lang ["&." scope] - ["&." module] - ["la" analysis] - (analysis ["&." common] - [".A" primitive] - ["&." inference])))) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Invalid-Variant-Type] - [Invalid-Tuple-Type] - [Not-Quantified-Type] - - [Cannot-Analyse-Variant] - [Cannot-Analyse-Tuple] - - [Cannot-Infer-Numeric-Tag] - [Record-Keys-Must-Be-Tags] - [Cannot-Repeat-Tag] - [Tag-Does-Not-Belong-To-Record] - [Record-Size-Mismatch] - ) - -(def: #export (analyse-sum analyse tag valueC) - (-> &.Analyser Nat Code (Meta la.Analysis)) - (do macro.Monad<Meta> - [expectedT macro.expected-type] - (&.with-stacked-errors - (function (_ _) - (ex.construct Cannot-Analyse-Variant - (format " Type: " (%type expectedT) "\n" - " Tag: " (%n tag) "\n" - "Expression: " (%code valueC)))) - (case expectedT - (#.Sum _) - (let [flat (type.flatten-variant expectedT) - type-size (list.size flat)] - (case (list.nth tag flat) - (#.Some variant-type) - (do @ - [valueA (&.with-type variant-type - (analyse valueC)) - temp &scope.next-local] - (wrap (la.sum tag type-size temp valueA))) - - #.None - (&common.variant-out-of-bounds-error expectedT type-size tag))) - - (#.Named name unnamedT) - (&.with-type unnamedT - (analyse-sum analyse tag valueC)) - - (#.Var id) - (do @ - [?expectedT' (&.with-type-env - (tc.read id))] - (case ?expectedT' - (#.Some expectedT') - (&.with-type expectedT' - (analyse-sum analyse tag valueC)) - - _ - ## Cannot do inference when the tag is numeric. - ## This is because there is no way of knowing how many - ## cases the inferred sum type would have. - (&.throw Cannot-Infer-Numeric-Tag - (format " Type: " (%type expectedT) "\n" - " Tag: " (%n tag) "\n" - "Expression: " (%code valueC))) - )) - - (^template [<tag> <instancer>] - (<tag> _) - (do @ - [[instance-id instanceT] (&.with-type-env <instancer>)] - (&.with-type (maybe.assume (type.apply (list instanceT) expectedT)) - (analyse-sum analyse tag valueC)))) - ([#.UnivQ tc.existential] - [#.ExQ tc.var]) - - (#.Apply inputT funT) - (case funT - (#.Var funT-id) - (do @ - [?funT' (&.with-type-env (tc.read funT-id))] - (case ?funT' - (#.Some funT') - (&.with-type (#.Apply inputT funT') - (analyse-sum analyse tag valueC)) - - _ - (&.throw Invalid-Variant-Type (format " Type: " (%type expectedT) "\n" - " Tag: " (%n tag) "\n" - "Expression: " (%code valueC))))) - - _ - (case (type.apply (list inputT) funT) - #.None - (&.throw Not-Quantified-Type (%type funT)) - - (#.Some outputT) - (&.with-type outputT - (analyse-sum analyse tag valueC)))) - - _ - (&.throw Invalid-Variant-Type (format " Type: " (%type expectedT) "\n" - " Tag: " (%n tag) "\n" - "Expression: " (%code valueC))))))) - -(def: (analyse-typed-product analyse membersC+) - (-> &.Analyser (List Code) (Meta la.Analysis)) - (do macro.Monad<Meta> - [expectedT macro.expected-type] - (loop [expectedT expectedT - membersC+ membersC+] - (case [expectedT membersC+] - ## If the tuple runs out, whatever expression is the last gets - ## matched to the remaining type. - [tailT (#.Cons tailC #.Nil)] - (&.with-type tailT - (analyse tailC)) - - ## If the type and the code are still ongoing, match each - ## sub-expression to its corresponding type. - [(#.Product leftT rightT) (#.Cons leftC rightC)] - (do @ - [leftA (&.with-type leftT - (analyse leftC)) - rightA (recur rightT rightC)] - (wrap (` [(~ leftA) (~ rightA)]))) - - ## If, however, the type runs out but there is still enough - ## tail, the remaining elements get packaged into another - ## tuple, and analysed through the intermediation of a - ## temporary local variable. - ## The reason for this is that it is assumed that the type of - ## the tuple represents the expectations of the user. - ## If the type is for a 3-tuple, but a 5-tuple is provided, it - ## is assumed that the user intended the following layout: - ## [0, 1, [2, 3, 4]] - ## but that, for whatever reason, it was written in a flat - ## way. - ## The reason why an intermediate variable is used is that if - ## the code was just re-written with just tuple nesting, the - ## resulting analysis would have undone the explicity nesting, - ## since Product nodes rely on nesting inherently, thereby - ## blurring the line between what was wanted (the separation) - ## and what was analysed. - [tailT tailC] - (macro.with-gensyms [g!tail] - (&.with-type tailT - (analyse (` ("lux case" [(~+ tailC)] - (~ g!tail) - (~ g!tail)))))) - )))) - -(def: #export (analyse-product analyse membersC) - (-> &.Analyser (List Code) (Meta la.Analysis)) - (do macro.Monad<Meta> - [expectedT macro.expected-type] - (&.with-stacked-errors - (function (_ _) - (ex.construct Cannot-Analyse-Tuple - (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~+ membersC)]))))) - (case expectedT - (#.Product _) - (analyse-typed-product analyse membersC) - - (#.Named name unnamedT) - (&.with-type unnamedT - (analyse-product analyse membersC)) - - (#.Var id) - (do @ - [?expectedT' (&.with-type-env - (tc.read id))] - (case ?expectedT' - (#.Some expectedT') - (&.with-type expectedT' - (analyse-product analyse membersC)) - - _ - ## Must do inference... - (do @ - [membersTA (monad.map @ (|>> analyse &common.with-unknown-type) - membersC) - _ (&.with-type-env - (tc.check expectedT - (type.tuple (list/map product.left membersTA))))] - (wrap (la.product (list/map product.right membersTA)))))) - - (^template [<tag> <instancer>] - (<tag> _) - (do @ - [[instance-id instanceT] (&.with-type-env <instancer>)] - (&.with-type (maybe.assume (type.apply (list instanceT) expectedT)) - (analyse-product analyse membersC)))) - ([#.UnivQ tc.existential] - [#.ExQ tc.var]) - - (#.Apply inputT funT) - (case funT - (#.Var funT-id) - (do @ - [?funT' (&.with-type-env (tc.read funT-id))] - (case ?funT' - (#.Some funT') - (&.with-type (#.Apply inputT funT') - (analyse-product analyse membersC)) - - _ - (&.throw Invalid-Tuple-Type - (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~+ membersC)])))))) - - _ - (case (type.apply (list inputT) funT) - #.None - (&.throw Not-Quantified-Type (%type funT)) - - (#.Some outputT) - (&.with-type outputT - (analyse-product analyse membersC)))) - - _ - (&.throw Invalid-Tuple-Type - (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~+ membersC)])))) - )))) - -(def: #export (analyse-tagged-sum analyse tag valueC) - (-> &.Analyser Ident Code (Meta la.Analysis)) - (do macro.Monad<Meta> - [tag (macro.normalize tag) - [idx group variantT] (macro.resolve-tag tag) - expectedT macro.expected-type] - (case expectedT - (#.Var _) - (do @ - [#let [case-size (list.size group)] - inferenceT (&inference.variant idx case-size variantT) - [inferredT valueA+] (&inference.general analyse inferenceT (list valueC)) - temp &scope.next-local] - (wrap (la.sum idx case-size temp (|> valueA+ list.head maybe.assume)))) - - _ - (analyse-sum analyse idx valueC)))) - -## There cannot be any ambiguity or improper syntax when analysing -## records, so they must be normalized for further analysis. -## Normalization just means that all the tags get resolved to their -## canonical form (with their corresponding module identified). -(def: #export (normalize record) - (-> (List [Code Code]) (Meta (List [Ident Code]))) - (monad.map macro.Monad<Meta> - (function (_ [key val]) - (case key - [_ (#.Tag key)] - (do macro.Monad<Meta> - [key (macro.normalize key)] - (wrap [key val])) - - _ - (&.throw Record-Keys-Must-Be-Tags - (format " Key: " (%code key) "\n" - "Record: " (%code (code.record record)))))) - record)) - -## Lux already possesses the means to analyse tuples, so -## re-implementing the same functionality for records makes no sense. -## Records, thus, get transformed into tuples by ordering the elements. -(def: #export (order record) - (-> (List [Ident Code]) (Meta [(List Code) Type])) - (case record - ## empty-record = empty-tuple = unit = [] - #.Nil - (:: macro.Monad<Meta> wrap [(list) Top]) - - (#.Cons [head-k head-v] _) - (do macro.Monad<Meta> - [head-k (macro.normalize head-k) - [_ tag-set recordT] (macro.resolve-tag head-k) - #let [size-record (list.size record) - size-ts (list.size tag-set)] - _ (if (n/= size-ts size-record) - (wrap []) - (&.throw Record-Size-Mismatch - (format " Expected: " (|> size-ts nat-to-int %i) "\n" - " Actual: " (|> size-record nat-to-int %i) "\n" - " Type: " (%type recordT) "\n" - "Expression: " (%code (|> record - (list/map (function (_ [keyI valueC]) - [(code.tag keyI) valueC])) - code.record))))) - #let [tuple-range (list.n/range +0 (n/dec size-ts)) - tag->idx (dict.from-list ident.Hash<Ident> (list.zip2 tag-set tuple-range))] - idx->val (monad.fold @ - (function (_ [key val] idx->val) - (do @ - [key (macro.normalize key)] - (case (dict.get key tag->idx) - #.None - (&.throw Tag-Does-Not-Belong-To-Record - (format " Tag: " (%code (code.tag key)) "\n" - "Type: " (%type recordT))) - - (#.Some idx) - (if (dict.contains? idx idx->val) - (&.throw Cannot-Repeat-Tag - (format " Tag: " (%code (code.tag key)) "\n" - "Record: " (%code (code.record (list/map (function (_ [keyI valC]) - [(code.tag keyI) valC]) - record))))) - (wrap (dict.put idx val idx->val)))))) - (: (Dict Nat Code) - (dict.new number.Hash<Nat>)) - record) - #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val))) - tuple-range)]] - (wrap [ordered-tuple recordT])) - )) - -(def: #export (analyse-record analyse members) - (-> &.Analyser (List [Code Code]) (Meta la.Analysis)) - (do macro.Monad<Meta> - [members (normalize members) - [membersC recordT] (order members)] - (case membersC - (^ (list)) - primitiveA.analyse-unit - - (^ (list singletonC)) - (analyse singletonC) - - _ - (do @ - [expectedT macro.expected-type] - (case expectedT - (#.Var _) - (do @ - [inferenceT (&inference.record recordT) - [inferredT membersA] (&inference.general analyse inferenceT membersC)] - (wrap (la.product membersA))) - - _ - (analyse-product analyse membersC)))))) |