aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/analyser/structure.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/analyser/structure.lux')
-rw-r--r--new-luxc/source/luxc/analyser/structure.lux311
1 files changed, 0 insertions, 311 deletions
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
deleted file mode 100644
index d523065ea..000000000
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ /dev/null
@@ -1,311 +0,0 @@
-(;module:
- lux
- (lux (control [monad #+ do]
- ["ex" exception #+ exception:]
- pipe)
- [function]
- (concurrency ["A" atom])
- (data [ident]
- [number]
- [product]
- [maybe]
- (coll [list "list/" Functor<List>]
- [dict #+ Dict])
- [text]
- text/format)
- [meta]
- (meta [code]
- [type]
- (type ["tc" check])))
- (luxc ["&" base]
- (lang ["la" analysis])
- ["&;" module]
- ["&;" scope]
- (analyser ["&;" common]
- ["&;" inference])))
-
-(exception: #export Not-Variant-Type)
-(exception: #export Not-Tuple-Type)
-(exception: #export Cannot-Infer-Numeric-Tag)
-
-(type: Type-Error
- (-> Type Text))
-
-(def: (not-quantified type)
- Type-Error
- (format "Not a quantified type: " (%type type)))
-
-(def: #export (analyse-sum analyse tag valueC)
- (-> &;Analyser Nat Code (Meta la;Analysis))
- (do meta;Monad<Meta>
- [expectedT meta;expected-type]
- (&;with-stacked-errors
- (function [_] (Not-Variant-Type (format " Tag: " (%n tag) "\n"
- "Value: " (%code valueC) "\n"
- " Type: " (%type expectedT))))
- (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-expected-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-expected-type unnamedT
- (analyse-sum analyse tag valueC))
-
- (#;Var id)
- (do @
- [bound? (&;with-type-env
- (tc;bound? id))]
- (if bound?
- (do @
- [expectedT' (&;with-type-env
- (tc;read id))]
- (&;with-expected-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 " Tag: " (%n tag) "\n"
- "Value: " (%code valueC) "\n"
- " Type: " (%type expectedT)))))
-
- (#;UnivQ _)
- (do @
- [[var-id var] (&;with-type-env
- tc;existential)]
- (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
- (analyse-sum analyse tag valueC)))
-
- (#;ExQ _)
- (&common;with-var
- (function [[var-id var]]
- (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
- (analyse-sum analyse tag valueC))))
-
- (#;Apply inputT funT)
- (case (type;apply (list inputT) funT)
- #;None
- (&;fail (not-quantified funT))
-
- (#;Some outputT)
- (&;with-expected-type outputT
- (analyse-sum analyse tag valueC)))
-
- _
- (&;throw Not-Variant-Type (format " Tag: " (%n tag) "\n"
- "Value: " (%code valueC) "\n"
- " Type: " (%type expectedT)))))))
-
-(def: (analyse-typed-product analyse members)
- (-> &;Analyser (List Code) (Meta la;Analysis))
- (do meta;Monad<Meta>
- [expectedT meta;expected-type]
- (loop [expectedT expectedT
- members members]
- (case [expectedT members]
- ## 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-expected-type leftT
- (analyse leftC))
- rightA (recur rightT rightC)]
- (wrap (` [(~ leftA) (~ rightA)])))
-
- ## If the tuple runs out, whatever expression is the last gets
- ## matched to the remaining type.
- [tailT (#;Cons tailC #;Nil)]
- (&;with-expected-type tailT
- (analyse tailC))
-
- ## 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]
- (do @
- [g!tail (meta;gensym "tail")]
- (&;with-expected-type tailT
- (analyse (` ((~' _lux_case) [(~@ tailC)]
- (~ g!tail)
- (~ g!tail))))))
- ))))
-
-(def: #export (analyse-product analyse membersC)
- (-> &;Analyser (List Code) (Meta la;Analysis))
- (do meta;Monad<Meta>
- [expectedT meta;expected-type]
- (&;with-stacked-errors
- (function [_] (Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
- "Value: " (%code (` [(~@ membersC)])))))
- (case expectedT
- (#;Product _)
- (analyse-typed-product analyse membersC)
-
- (#;Named name unnamedT)
- (&;with-expected-type unnamedT
- (analyse-product analyse membersC))
-
- (#;Var id)
- (do @
- [bound? (&;with-type-env
- (tc;bound? id))]
- (if bound?
- (do @
- [expectedT' (&;with-type-env
- (tc;read id))]
- (&;with-expected-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))))))
-
- (#;UnivQ _)
- (do @
- [[var-id var] (&;with-type-env
- tc;existential)]
- (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
- (analyse-product analyse membersC)))
-
- (#;ExQ _)
- (&common;with-var
- (function [[var-id var]]
- (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
- (analyse-product analyse membersC))))
-
- (#;Apply inputT funT)
- (case (type;apply (list inputT) funT)
- #;None
- (&;fail (not-quantified funT))
-
- (#;Some outputT)
- (&;with-expected-type outputT
- (analyse-product analyse membersC)))
-
- _
- (&;throw Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
- "Value: " (%code (` [(~@ membersC)]))))
- ))))
-
-(def: #export (analyse-tagged-sum analyse tag valueC)
- (-> &;Analyser Ident Code (Meta la;Analysis))
- (do meta;Monad<Meta>
- [tag (meta;normalize tag)
- [idx group variantT] (meta;resolve-tag tag)
- expectedT meta;expected-type]
- (case expectedT
- (#;Var _)
- (do @
- [#let [case-size (list;size group)]
- inferenceT (&inference;variant idx case-size variantT)
- [inferredT valueA+] (&inference;apply-function analyse inferenceT (list valueC))
- _ (&;with-type-env
- (tc;check expectedT inferredT))
- 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 meta;Monad<Meta>
- (function [[key val]]
- (case key
- [_ (#;Tag key)]
- (do meta;Monad<Meta>
- [key (meta;normalize key)]
- (wrap [key val]))
-
- _
- (&;fail (format "Cannot use non-tag tokens in key positions in records: " (%code key)))))
- 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
- (:: meta;Monad<Meta> wrap [(list) Unit])
-
- (#;Cons [head-k head-v] _)
- (do meta;Monad<Meta>
- [head-k (meta;normalize head-k)
- [_ tag-set recordT] (meta;resolve-tag head-k)
- #let [size-record (list;size record)
- size-ts (list;size tag-set)]
- _ (if (n.= size-ts size-record)
- (wrap [])
- (&;fail (format "Record size does not match tag-set size." "\n"
- "Expected: " (|> size-ts nat-to-int %i) "\n"
- " Actual: " (|> size-record nat-to-int %i) "\n"
- "For type: " (%type recordT))))
- #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 (meta;normalize key)]
- (case (dict;get key tag->idx)
- #;None
- (&;fail (format "Tag " (%code (code;tag key))
- " does not belong to tag-set for type " (%type recordT)))
-
- (#;Some idx)
- (if (dict;contains? idx idx->val)
- (&;fail (format "Cannot repeat tag inside record: " (%code (code;tag key))))
- (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 meta;Monad<Meta>
- [members (normalize members)
- [members recordT] (order members)
- expectedT meta;expected-type
- inferenceT (&inference;record recordT)
- [inferredT membersA] (&inference;apply-function analyse inferenceT members)
- _ (&;with-type-env
- (tc;check expectedT inferredT))]
- (wrap (la;product membersA))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 13:29:56 +0000