diff options
author | Eduardo Julian | 2017-05-15 22:19:14 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-05-15 22:19:14 -0400 |
commit | 824482b2e8b13e42a524a5e4945ea3e172395c9e (patch) | |
tree | 959bb7684461318b1026cd773ae29ac76d426054 /new-luxc/test | |
parent | 04c0a8d2fceae628099673e62527fc48e2afd7e7 (diff) |
WIP
- Simplified the Analysis type, by removing all meta-data.
- Added analysis of function calls.
- Added analysis of common Lux procedures.
- Lots of refactoring.
Diffstat (limited to 'new-luxc/test')
-rw-r--r-- | new-luxc/test/test/luxc/analyser/common.lux | 53 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/lux.lux | 173 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/primitive.lux | 61 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/reference.lux | 49 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/struct.lux | 39 | ||||
-rw-r--r-- | new-luxc/test/tests.lux | 4 |
6 files changed, 205 insertions, 174 deletions
diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux new file mode 100644 index 000000000..9e3db3513 --- /dev/null +++ b/new-luxc/test/test/luxc/analyser/common.lux @@ -0,0 +1,53 @@ +(;module: + lux + (lux ["R" math/random "R/" Monad<Random>] + (macro [code]))) + +(def: compiler-version Text "0.6.0") + +(def: init-compiler-info + Compiler-Info + {#;compiler-version compiler-version + #;compiler-mode #;Build}) + +(def: init-type-context + Type-Context + {#;ex-counter +0 + #;var-counter +0 + #;var-bindings (list)}) + +(def: #export init-compiler + Compiler + {#;info init-compiler-info + #;source [dummy-cursor ""] + #;cursor dummy-cursor + #;modules (list) + #;scopes (list) + #;type-context init-type-context + #;expected #;None + #;seed +0 + #;scope-type-vars (list) + #;host (:! Void [])}) + +(def: gen-unit + (R;Random Code) + (R/wrap (' []))) + +(def: #export gen-simple-primitive + (R;Random [Type Code]) + (with-expansions + [<generators> (do-template [<type> <code-wrapper> <value-gen>] + [(R;seq (R/wrap <type>) (R/map <code-wrapper> <value-gen>))] + + [Unit code;tuple (R;list +0 gen-unit)] + [Bool code;bool R;bool] + [Nat code;nat R;nat] + [Int code;int R;int] + [Deg code;deg R;deg] + [Real code;real R;real] + [Char code;char R;char] + [Text code;text (R;text +5)] + )] + ($_ R;either + <generators> + ))) diff --git a/new-luxc/test/test/luxc/analyser/lux.lux b/new-luxc/test/test/luxc/analyser/lux.lux deleted file mode 100644 index beb26513c..000000000 --- a/new-luxc/test/test/luxc/analyser/lux.lux +++ /dev/null @@ -1,173 +0,0 @@ -(;module: - lux - (lux [io] - (control monad - pipe) - (data [bool "B/" Eq<Bool>] - [char "C/" Eq<Char>] - [text "T/" Eq<Text>] - (text format - ["l" lexer]) - [number] - ["E" error] - [product] - (coll [list "L/" Functor<List> Fold<List>])) - ["R" math/random "R/" Monad<Random>] - [type "Type/" Eq<Type>] - [macro #+ Monad<Lux>] - (macro [code]) - test) - (luxc ["&" base] - ["&;" env] - ["&;" module] - (lang ["~" analysis]) - [analyser] - (analyser ["@" lux] - ["@;" common]))) - -(def: init-cursor Cursor ["" +0 +0]) - -(def: compiler-version Text "0.6.0") - -(def: init-compiler-info - Compiler-Info - {#;compiler-version compiler-version - #;compiler-mode #;Build}) - -(def: init-type-context - Type-Context - {#;ex-counter +0 - #;var-counter +0 - #;var-bindings (list)}) - -(def: init-compiler - Compiler - {#;info init-compiler-info - #;source [init-cursor ""] - #;cursor init-cursor - #;modules (list) - #;scopes (list) - #;type-context init-type-context - #;expected #;None - #;seed +0 - #;scope-type-vars (list) - #;host (:! Void [])}) - -(test: "Simple primitives" - [%bool% R;bool - %nat% R;nat - %int% R;int - %deg% R;deg - %real% R;real - %char% R;char - %text% (R;text +5)] - (with-expansions - [<primitives> (do-template [<desc> <type> <tag> <value> <analyser>] - [(assert (format "Can analyse " <desc> ".") - (|> (@common;with-unknown-type - (<analyser> init-cursor <value>)) - (macro;run init-compiler) - (case> (#E;Success [[_type _cursor] (<tag> value)]) - (and (Type/= <type> _type) - (is <value> value)) - - _ - false)) - )] - - ["unit" Unit #~;Unit [] (function [cursor value] (@;analyse-unit cursor))] - ["bool" Bool #~;Bool %bool% @;analyse-bool] - ["nat" Nat #~;Nat %nat% @;analyse-nat] - ["int" Int #~;Int %int% @;analyse-int] - ["deg" Deg #~;Deg %deg% @;analyse-deg] - ["real" Real #~;Real %real% @;analyse-real] - ["char" Char #~;Char %char% @;analyse-char] - ["text" Text #~;Text %text% @;analyse-text] - )] - ($_ seq - <primitives>))) - -(def: gen-unit - (R;Random Code) - (R/wrap (' []))) - -(def: gen-simple-primitive - (R;Random [Type Code]) - (with-expansions - [<generators> (do-template [<type> <code-wrapper> <value-gen>] - [(R;seq (R/wrap <type>) (R/map <code-wrapper> <value-gen>))] - - [Unit code;tuple (R;list +0 gen-unit)] - [Bool code;bool R;bool] - [Nat code;nat R;nat] - [Int code;int R;int] - [Deg code;deg R;deg] - [Real code;real R;real] - [Char code;char R;char] - [Text code;text (R;text +5)] - )] - ($_ R;either - <generators> - ))) - -(test: "Tuples" - [size (|> R;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - primitives (R;list size gen-simple-primitive)] - ($_ seq - (let [tuple-type (type;tuple (L/map product;left primitives))] - (assert "Can analyse tuple." - (|> (@common;with-unknown-type - (@;analyse-tuple (analyser;analyse (:!! [])) - init-cursor - (L/map product;right primitives))) - (macro;run init-compiler) - (case> (#E;Success [[_type _cursor] (#~;Tuple elems)]) - (and (Type/= tuple-type _type) - (n.= size (list;size elems)) - (L/fold (function [[pt at] so-far] - (and so-far (Type/= pt at))) - true - (list;zip2 (L/map product;left primitives) - (L/map ~;get-type elems)))) - - _ - false)) - )))) - -(test: "References" - [[ref-type _] gen-simple-primitive - module-name (R;text +5) - scope-name (R;text +5) - var-name (R;text +5)] - ($_ seq - (assert "Can analyse relative reference." - (|> (&env;with-scope scope-name - (&env;with-local [var-name ref-type] - (@common;with-unknown-type - (@;analyse-reference init-cursor ["" var-name])))) - (macro;run init-compiler) - (case> (#E;Success [[_type _cursor] (#~;Relative idx)]) - (Type/= ref-type _type) - - (#E;Error error) - false - - _ - false))) - (assert "Can analyse absolute reference." - (|> (do Monad<Lux> - [_ (&module;create +0 module-name) - _ (&module;define [module-name var-name] - [ref-type (list) (:! Void [])])] - (@common;with-unknown-type - (@;analyse-reference init-cursor [module-name var-name]))) - (macro;run init-compiler) - (case> (#E;Success [[_type _cursor] (#~;Absolute idx)]) - (Type/= ref-type _type) - - (#E;Error error) - false - - _ - false))) - )) diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux new file mode 100644 index 000000000..321a51fcb --- /dev/null +++ b/new-luxc/test/test/luxc/analyser/primitive.lux @@ -0,0 +1,61 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data [bool "B/" Eq<Bool>] + [char "C/" Eq<Char>] + [text "T/" Eq<Text>] + (text format + ["l" lexer]) + [number] + ["E" error] + [product] + (coll [list "L/" Functor<List> Fold<List>])) + ["R" math/random "R/" Monad<Random>] + [type "Type/" Eq<Type>] + [macro #+ Monad<Lux>] + (macro [code]) + test) + (luxc ["&" base] + ["&;" env] + ["&;" module] + (lang ["~" analysis]) + [analyser] + (analyser ["@" primitive] + ["@;" common])) + (.. common)) + +(test: "Simple primitives" + [%bool% R;bool + %nat% R;nat + %int% R;int + %deg% R;deg + %real% R;real + %char% R;char + %text% (R;text +5)] + (with-expansions + [<primitives> (do-template [<desc> <type> <tag> <value> <analyser>] + [(assert (format "Can analyse " <desc> ".") + (|> (@common;with-unknown-type + (<analyser> <value>)) + (macro;run init-compiler) + (case> (#E;Success [_type (<tag> value)]) + (and (Type/= <type> _type) + (is <value> value)) + + _ + false)) + )] + + ["unit" Unit #~;Unit [] (function [value] @;analyse-unit)] + ["bool" Bool #~;Bool %bool% @;analyse-bool] + ["nat" Nat #~;Nat %nat% @;analyse-nat] + ["int" Int #~;Int %int% @;analyse-int] + ["deg" Deg #~;Deg %deg% @;analyse-deg] + ["real" Real #~;Real %real% @;analyse-real] + ["char" Char #~;Char %char% @;analyse-char] + ["text" Text #~;Text %text% @;analyse-text] + )] + ($_ seq + <primitives>))) diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux new file mode 100644 index 000000000..4e83a7af8 --- /dev/null +++ b/new-luxc/test/test/luxc/analyser/reference.lux @@ -0,0 +1,49 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data ["E" error]) + ["R" math/random "R/" Monad<Random>] + [type "Type/" Eq<Type>] + [macro #+ Monad<Lux>] + test) + (luxc ["&;" env] + ["&;" module] + (lang ["~" analysis]) + [analyser] + (analyser ["@" reference] + ["@;" common])) + (.. common)) + +(test: "References" + [[ref-type _] gen-simple-primitive + module-name (R;text +5) + scope-name (R;text +5) + var-name (R;text +5)] + ($_ seq + (assert "Can analyse relative reference." + (|> (&env;with-scope scope-name + (&env;with-local [var-name ref-type] + (@common;with-unknown-type + (@;analyse-reference ["" var-name])))) + (macro;run init-compiler) + (case> (#E;Success [_type (#~;Relative idx)]) + (Type/= ref-type _type) + + _ + false))) + (assert "Can analyse absolute reference." + (|> (do Monad<Lux> + [_ (&module;create +0 module-name) + _ (&module;define [module-name var-name] + [ref-type (list) (:! Void [])])] + (@common;with-unknown-type + (@;analyse-reference [module-name var-name]))) + (macro;run init-compiler) + (case> (#E;Success [_type (#~;Absolute idx)]) + (Type/= ref-type _type) + + _ + false))) + )) diff --git a/new-luxc/test/test/luxc/analyser/struct.lux b/new-luxc/test/test/luxc/analyser/struct.lux new file mode 100644 index 000000000..a86f6da9c --- /dev/null +++ b/new-luxc/test/test/luxc/analyser/struct.lux @@ -0,0 +1,39 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data ["E" error] + [product] + (coll [list "L/" Functor<List>])) + ["R" math/random "R/" Monad<Random>] + [type "Type/" Eq<Type>] + [macro #+ Monad<Lux>] + test) + (luxc ["&" base] + (lang ["~" analysis]) + [analyser] + (analyser ["@" struct] + ["@;" common])) + (.. common)) + +(def: analyse + &;Analyser + (analyser;analyser (:!! []))) + +(test: "Tuples" + [size (|> R;nat (:: @ map (|>. (n.% +10) (n.max +2)))) + primitives (R;list size gen-simple-primitive)] + ($_ seq + (assert "Can analyse tuple." + (|> (@common;with-unknown-type + (@;analyse-tuple analyse (L/map product;right primitives))) + (macro;run init-compiler) + (case> (#E;Success [_type (#~;Tuple elems)]) + (and (Type/= (type;tuple (L/map product;left primitives)) + _type) + (n.= size (list;size elems))) + + _ + false)) + ))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index cbff78c2e..a330560fc 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -6,7 +6,9 @@ [cli #+ program:] [test]) (test (luxc ["_;" parser] - (analyser ["_;" lux])))) + (analyser ["_;" primitive] + ["_;" struct] + ["_;" reference])))) ## [Program] (program: args |