From 74a835634fc9ee5457f3cc7109af069dad9f2d2f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 11 Oct 2017 18:57:44 -0400
Subject: - Migrated new-luxc to latest version of stdlib. - Some refactoring.
---
new-luxc/source/luxc/analyser.lux | 17 +--
new-luxc/source/luxc/analyser/case.lux | 108 +++++++-------
new-luxc/source/luxc/analyser/common.lux | 20 +--
new-luxc/source/luxc/analyser/function.lux | 45 +++---
new-luxc/source/luxc/analyser/inference.lux | 21 +--
new-luxc/source/luxc/analyser/primitive.lux | 8 +-
new-luxc/source/luxc/analyser/procedure.lux | 20 +--
new-luxc/source/luxc/analyser/procedure/common.lux | 86 ++++++------
.../source/luxc/analyser/procedure/host.jvm.lux | 57 ++++----
new-luxc/source/luxc/analyser/reference.lux | 8 +-
new-luxc/source/luxc/analyser/structure.lux | 103 +++++++-------
new-luxc/source/luxc/analyser/type.lux | 8 +-
new-luxc/source/luxc/base.lux | 6 +-
new-luxc/source/luxc/generator/common.jvm.lux | 2 +-
new-luxc/source/luxc/generator/eval.jvm.lux | 2 +-
new-luxc/source/luxc/generator/function.jvm.lux | 155 ++++++++++-----------
new-luxc/source/luxc/generator/host/jvm.lux | 36 ++---
new-luxc/source/luxc/generator/host/jvm/def.lux | 22 +--
new-luxc/source/luxc/generator/host/jvm/inst.lux | 5 +-
new-luxc/source/luxc/generator/procedure.jvm.lux | 12 +-
.../source/luxc/generator/procedure/common.jvm.lux | 64 ++++-----
new-luxc/source/luxc/generator/runtime.jvm.lux | 2 +-
new-luxc/source/luxc/module.lux | 16 +--
new-luxc/source/luxc/parser.lux | 7 +-
new-luxc/source/luxc/scope.lux | 38 ++---
new-luxc/source/luxc/synthesizer.lux | 47 ++++---
new-luxc/source/luxc/synthesizer/loop.lux | 7 +-
new-luxc/source/luxc/synthesizer/variable.lux | 4 +-
28 files changed, 462 insertions(+), 464 deletions(-)
(limited to 'new-luxc/source')
diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
index f17ec8496..ba6003440 100644
--- a/new-luxc/source/luxc/analyser.lux
+++ b/new-luxc/source/luxc/analyser.lux
@@ -2,13 +2,10 @@
lux
(lux (control monad)
(data ["R" result]
- [text "T/" Eq<Text>]
- text/format
- [number]
- [product])
- [macro #+ Monad<Lux>]
+ text/format)
+ [macro]
[type]
- (type ["TC" check]))
+ (type ["tc" check]))
(luxc ["&" base]
(lang ["la" analysis])
["&;" module])
@@ -25,10 +22,10 @@
(-> (List Code) (Lux (List [Code Code])))
(case raw
(^ (list))
- (:: Monad<Lux> wrap (list))
+ (:: macro;Monad<Lux> wrap (list))
(^ (list& patternH bodyH inputT))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[outputT (to-branches inputT)]
(wrap (list& [patternH bodyH] outputT)))
@@ -88,7 +85,7 @@
(^ (#;Form (list& [_ (#;Symbol ["" "_lux_case"])]
input
branches)))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[paired (to-branches branches)]
(&&case;analyse-case analyse input paired))
@@ -105,7 +102,7 @@
[#;Tag &&structure;analyse-tagged-sum])
(^ (#;Form (list& func args)))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[[funcT =func] (&&common;with-unknown-type
(analyse func))]
(case =func
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index 9a205d934..4b327fb6d 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -2,18 +2,18 @@
lux
(lux (control [monad #+ do]
eq)
- (data [bool "B/" Eq<Bool>]
+ (data [bool]
[number]
+ [product]
+ ["R" result]
+ [maybe]
[text]
text/format
- [product]
- ["R" result "R/" Monad<Result>]
- (coll [list "L/" Fold<List> Monoid<List> Monad<List>]
- ["D" dict]))
- [macro #+ Monad<Lux>]
+ (coll [list "list/" Fold<List> Monoid<List> Functor<List>]))
+ [macro]
(macro [code])
[type]
- (type ["TC" check]))
+ (type ["tc" check]))
(../.. ["&" base]
(lang ["la" analysis])
["&;" scope])
@@ -37,13 +37,13 @@
(-> Type (Lux Type))
(case type
(#;Var id)
- (do Monad<Lux>
- [? (&;within-type-env
- (TC;bound? id))]
+ (do macro;Monad<Lux>
+ [? (&;with-type-env
+ (tc;bound? id))]
(if ?
(do @
- [type' (&;within-type-env
- (TC;read-var id))]
+ [type' (&;with-type-env
+ (tc;read id))]
(simplify-case-type type'))
(&;fail (format "Cannot simplify type for pattern-matching: " (%type type)))))
@@ -51,13 +51,13 @@
(simplify-case-type unnamedT)
(^or (#;UnivQ _) (#;ExQ _))
- (do Monad<Lux>
- [[ex-id exT] (&;within-type-env
- TC;existential)]
- (simplify-case-type (assume (type;apply (list exT) type))))
+ (do macro;Monad<Lux>
+ [[ex-id exT] (&;with-type-env
+ tc;existential)]
+ (simplify-case-type (maybe;assume (type;apply (list exT) type))))
_
- (:: Monad<Lux> wrap type)))
+ (:: macro;Monad<Lux> wrap type)))
## This function handles several concerns at once, but it must be that
## way because those concerns are interleaved when doing
@@ -80,7 +80,7 @@
(case pattern
[cursor (#;Symbol ["" name])]
(&;with-cursor cursor
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[outputA (&scope;with-local [name inputT]
next)
idx &scope;next-local]
@@ -93,9 +93,9 @@
(^template [<type> <code-tag> <pattern-tag>]
[cursor (<code-tag> test)]
(&;with-cursor cursor
- (do Monad<Lux>
- [_ (&;within-type-env
- (TC;check inputT <type>))
+ (do macro;Monad<Lux>
+ [_ (&;with-type-env
+ (tc;check inputT <type>))
outputA next]
(wrap [(<pattern-tag> test) outputA]))))
([Bool #;Bool #la;BoolP]
@@ -107,9 +107,9 @@
(^ [cursor (#;Tuple (list))])
(&;with-cursor cursor
- (do Monad<Lux>
- [_ (&;within-type-env
- (TC;check inputT Unit))
+ (do macro;Monad<Lux>
+ [_ (&;with-type-env
+ (tc;check inputT Unit))
outputA next]
(wrap [(#la;TupleP (list)) outputA])))
@@ -118,39 +118,39 @@
[cursor (#;Tuple sub-patterns)]
(&;with-cursor cursor
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[inputT' (simplify-case-type inputT)]
(case inputT'
(#;Product _)
(let [sub-types (type;flatten-tuple inputT)
- num-sub-types (default (list;size sub-types)
- num-tags)
+ num-sub-types (maybe;default (list;size sub-types)
+ num-tags)
num-sub-patterns (list;size sub-patterns)
matches (cond (n.< num-sub-types num-sub-patterns)
(let [[prefix suffix] (list;split (n.dec num-sub-patterns) sub-types)]
- (list;zip2 (L/append prefix (list (type;tuple suffix))) sub-patterns))
+ (list;zip2 (list/compose prefix (list (type;tuple suffix))) sub-patterns))
(n.> num-sub-types num-sub-patterns)
(let [[prefix suffix] (list;split (n.dec num-sub-types) sub-patterns)]
- (list;zip2 sub-types (L/append prefix (list (code;tuple suffix)))))
+ (list;zip2 sub-types (list/compose prefix (list (code;tuple suffix)))))
## (n.= num-sub-types num-sub-patterns)
(list;zip2 sub-types sub-patterns)
)]
(do @
- [[memberP+ thenA] (L/fold (: (All [a]
- (-> [Type Code] (Lux [(List la;Pattern) a])
- (Lux [(List la;Pattern) a])))
- (function [[memberT memberC] then]
- (do @
- [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a])))
- analyse-pattern)
- #;None memberT memberC then)]
- (wrap [(list& memberP memberP+) thenA]))))
- (do @
- [nextA next]
- (wrap [(list) nextA]))
- matches)]
+ [[memberP+ thenA] (list/fold (: (All [a]
+ (-> [Type Code] (Lux [(List la;Pattern) a])
+ (Lux [(List la;Pattern) a])))
+ (function [[memberT memberC] then]
+ (do @
+ [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a])))
+ analyse-pattern)
+ #;None memberT memberC then)]
+ (wrap [(list& memberP memberP+) thenA]))))
+ (do @
+ [nextA next]
+ (wrap [(list) nextA]))
+ matches)]
(wrap [(#la;TupleP memberP+) thenA])))
_
@@ -158,11 +158,11 @@
)))
[cursor (#;Record record)]
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[record (&structure;normalize record)
[members recordT] (&structure;order record)
- _ (&;within-type-env
- (TC;check inputT recordT))]
+ _ (&;with-type-env
+ (tc;check inputT recordT))]
(analyse-pattern (#;Some (list;size members)) inputT [cursor (#;Tuple members)] next))
[cursor (#;Tag tag)]
@@ -171,26 +171,26 @@
(^ [cursor (#;Form (list& [_ (#;Nat idx)] values))])
(&;with-cursor cursor
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[inputT' (simplify-case-type inputT)]
(case inputT'
(#;Sum _)
(let [flat-sum (type;flatten-variant inputT)
size-sum (list;size flat-sum)
- num-cases (default size-sum num-tags)]
+ num-cases (maybe;default size-sum num-tags)]
(case (list;nth idx flat-sum)
(^multi (#;Some case-type)
(n.< num-cases idx))
(if (and (n.> num-cases size-sum)
(n.= (n.dec num-cases) idx))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[[testP nextA] (analyse-pattern #;None
(type;variant (list;drop (n.dec num-cases) flat-sum))
(` [(~@ values)])
next)]
(wrap [(#la;VariantP idx num-cases testP)
nextA]))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)]
(wrap [(#la;VariantP idx num-cases testP)
nextA])))
@@ -203,11 +203,11 @@
(^ [cursor (#;Form (list& [_ (#;Tag tag)] values))])
(&;with-cursor cursor
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[tag (macro;normalize tag)
[idx group variantT] (macro;resolve-tag tag)
- _ (&;within-type-env
- (TC;check inputT variantT))]
+ _ (&;with-type-env
+ (tc;check inputT variantT))]
(analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next)))
_
@@ -221,7 +221,7 @@
(&;fail "Cannot have empty branches in pattern-matching expression.")
(#;Cons [patternH bodyH] branchesT)
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[[inputT inputA] (&common;with-unknown-type
(analyse input))
outputH (analyse-pattern #;None inputT patternH (analyse bodyH))
@@ -232,7 +232,7 @@
_ (case (monad;fold R;Monad<Result>
&&coverage;merge
(|> outputH product;left &&coverage;determine)
- (L/map (|>. product;left &&coverage;determine) outputT))
+ (list/map (|>. product;left &&coverage;determine) outputT))
(#R;Success coverage)
(if (&&coverage;exhaustive? coverage)
(wrap [])
diff --git a/new-luxc/source/luxc/analyser/common.lux b/new-luxc/source/luxc/analyser/common.lux
index c1246d81c..b9142713c 100644
--- a/new-luxc/source/luxc/analyser/common.lux
+++ b/new-luxc/source/luxc/analyser/common.lux
@@ -6,29 +6,31 @@
[product])
[macro #+ Monad<Lux>]
[type]
- (type ["TC" check]))
+ (type ["tc" check]))
(luxc ["&" base]
(lang analysis)))
(def: #export (with-unknown-type action)
(All [a] (-> (Lux Analysis) (Lux [Type Analysis])))
(do Monad<Lux>
- [[var-id var-type] (&;within-type-env
- TC;create-var)
+ [[var-id var-type] (&;with-type-env
+ tc;create)
analysis (&;with-expected-type var-type
action)
- analysis-type (&;within-type-env
- (TC;clean var-id var-type))
- _ (&;within-type-env
- (TC;delete-var var-id))]
+ analysis-type (&;with-type-env
+ (tc;clean var-id var-type))
+ _ (&;with-type-env
+ (tc;delete var-id))]
(wrap [analysis-type analysis])))
(def: #export (with-var body)
(All [a] (-> (-> [Nat Type] (Lux a)) (Lux a)))
(do Monad<Lux>
- [[id var] (&;within-type-env TC;create-var)
+ [[id var] (&;with-type-env
+ tc;create)
output (body [id var])
- _ (&;within-type-env (TC;delete-var id))]
+ _ (&;with-type-env
+ (tc;delete id))]
(wrap output)))
(def: #export (variant-out-of-bounds-error type size tag)
diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux
index 31bc367f4..f9fde0eab 100644
--- a/new-luxc/source/luxc/analyser/function.lux
+++ b/new-luxc/source/luxc/analyser/function.lux
@@ -1,12 +1,13 @@
(;module:
lux
(lux (control monad)
- (data [text]
+ (data [maybe]
+ [text]
text/format
- (coll [list "L/" Fold<List> Monoid<List> Monad<List>]))
+ (coll [list "list/" Fold<List> Monoid<List> Monad<List>]))
[macro #+ Monad<Lux>]
[type]
- (type ["TC" check]))
+ (type ["tc" check]))
(luxc ["&" base]
(lang ["la" analysis #+ Analysis])
["&;" scope]
@@ -35,23 +36,23 @@
(#;UnivQ _)
(do @
- [[var-id var] (&;within-type-env
- TC;existential)]
- (recur (assume (type;apply (list var) expected))))
+ [[var-id var] (&;with-type-env
+ tc;existential)]
+ (recur (maybe;assume (type;apply (list var) expected))))
(#;ExQ _)
(&common;with-var
(function [[var-id var]]
- (recur (assume (type;apply (list var) expected)))))
+ (recur (maybe;assume (type;apply (list var) expected)))))
(#;Var id)
(do @
- [? (&;within-type-env
- (TC;bound? id))]
+ [? (&;with-type-env
+ (tc;bound? id))]
(if ?
(do @
- [expected' (&;within-type-env
- (TC;read-var id))]
+ [expected' (&;with-type-env
+ (tc;read id))]
(recur expected'))
## Inference
(&common;with-var
@@ -61,16 +62,16 @@
(do @
[#let [funT (#;Function inputT outputT)]
funA (recur funT)
- funT' (&;within-type-env
- (TC;clean output-id funT))
- concrete-input? (&;within-type-env
- (TC;bound? input-id))
+ funT' (&;with-type-env
+ (tc;clean output-id funT))
+ concrete-input? (&;with-type-env
+ (tc;bound? input-id))
funT'' (if concrete-input?
- (&;within-type-env
- (TC;clean input-id funT'))
+ (&;with-type-env
+ (tc;clean input-id funT'))
(wrap (type;univ-q +1 (&inference;replace-var input-id +1 funT'))))
- _ (&;within-type-env
- (TC;check expected funT''))]
+ _ (&;with-type-env
+ (tc;check expected funT''))]
(wrap funA))
))))))
@@ -92,10 +93,10 @@
(-> &;Analyser Type Analysis (List Code) (Lux Analysis))
(&;with-stacked-errors
(function [_] (format "Cannot apply function " (%type funcT)
- " to args: " (|> args (L/map %code) (text;join-with " "))))
+ " to args: " (|> args (list/map %code) (text;join-with " "))))
(do Monad<Lux>
[expected macro;expected-type
[applyT argsA] (&inference;apply-function analyse funcT args)
- _ (&;within-type-env
- (TC;check expected applyT))]
+ _ (&;with-type-env
+ (tc;check expected applyT))]
(wrap (la;apply argsA funcA)))))
diff --git a/new-luxc/source/luxc/analyser/inference.lux b/new-luxc/source/luxc/analyser/inference.lux
index 8390a890c..9b2411249 100644
--- a/new-luxc/source/luxc/analyser/inference.lux
+++ b/new-luxc/source/luxc/analyser/inference.lux
@@ -1,11 +1,12 @@
(;module:
lux
(lux (control monad)
- (data text/format
+ (data [maybe]
+ text/format
(coll [list "L/" Functor<List>]))
[macro #+ Monad<Lux>]
[type]
- (type ["TC" check]))
+ (type ["tc" check]))
(luxc ["&" base]
(lang ["la" analysis #+ Analysis])
(analyser ["&;" common])))
@@ -74,23 +75,23 @@
(&common;with-var
(function [[var-id varT]]
(do Monad<Lux>
- [[outputT argsA] (apply-function analyse (assume (type;apply (list varT) funcT)) args)]
+ [[outputT argsA] (apply-function analyse (maybe;assume (type;apply (list varT) funcT)) args)]
(do @
- [? (&;within-type-env
- (TC;bound? var-id))
+ [? (&;with-type-env
+ (tc;bound? var-id))
## Quantify over the type if genericity/parametricity
## is discovered.
outputT' (if ?
- (&;within-type-env
- (TC;clean var-id outputT))
+ (&;with-type-env
+ (tc;clean var-id outputT))
(wrap (type;univ-q +1 (replace-var var-id +1 outputT))))]
(wrap [outputT' argsA])))))
(#;ExQ _)
(do Monad<Lux>
- [[ex-id exT] (&;within-type-env
- TC;existential)]
- (apply-function analyse (assume (type;apply (list exT) funcT)) args))
+ [[ex-id exT] (&;with-type-env
+ tc;existential)]
+ (apply-function analyse (maybe;assume (type;apply (list exT) funcT)) args))
## Arguments are inferred back-to-front because, by convention,
## Lux functions take the most important arguments *last*, which
diff --git a/new-luxc/source/luxc/analyser/primitive.lux b/new-luxc/source/luxc/analyser/primitive.lux
index 69e4f2b07..127e5896c 100644
--- a/new-luxc/source/luxc/analyser/primitive.lux
+++ b/new-luxc/source/luxc/analyser/primitive.lux
@@ -12,8 +12,8 @@
(-> <type> (Lux Analysis))
(do Monad<Lux>
[expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected <type>))]
+ _ (&;with-type-env
+ (TC;check expected <type>))]
(wrap (<tag> value))))]
[analyse-bool Bool #la;Bool]
@@ -28,6 +28,6 @@
(Lux Analysis)
(do Monad<Lux>
[expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected Unit))]
+ _ (&;with-type-env
+ (TC;check expected Unit))]
(wrap #la;Unit)))
diff --git a/new-luxc/source/luxc/analyser/procedure.lux b/new-luxc/source/luxc/analyser/procedure.lux
index 064a28e9b..23fbae198 100644
--- a/new-luxc/source/luxc/analyser/procedure.lux
+++ b/new-luxc/source/luxc/analyser/procedure.lux
@@ -1,23 +1,23 @@
(;module:
lux
(lux (control [monad #+ do])
- (data [text]
+ (data [maybe]
+ [text]
text/format
- (coll ["d" dict])
- [maybe]))
+ (coll [dict])))
(luxc ["&" base]
- (lang ["la" analysis #+ Analysis]))
+ (lang ["la" analysis]))
(. ["./;" common]
["./;" host]))
(def: procedures
./common;Bundle
(|> ./common;procedures
- (d;merge ./host;procedures)))
+ (dict;merge ./host;procedures)))
(def: #export (analyse-procedure analyse proc-name proc-args)
- (-> &;Analyser Text (List Code) (Lux Analysis))
- (default (&;fail (format "Unknown procedure: " (%t proc-name)))
- (do maybe;Monad<Maybe>
- [proc (d;get proc-name procedures)]
- (wrap (proc analyse proc-args)))))
+ (-> &;Analyser Text (List Code) (Lux la;Analysis))
+ (<| (maybe;default (&;fail (format "Unknown procedure: " (%t proc-name))))
+ (do maybe;Monad<Maybe>
+ [proc (dict;get proc-name procedures)]
+ (wrap (proc analyse proc-args)))))
diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux
index ffb87a2ca..a0f739f3b 100644
--- a/new-luxc/source/luxc/analyser/procedure/common.lux
+++ b/new-luxc/source/luxc/analyser/procedure/common.lux
@@ -6,32 +6,32 @@
text/format
(coll [list "list/" Functor<List>]
[array #+ Array]
- ["d" dict]))
+ [dict #+ Dict]))
[macro #+ Monad<Lux>]
- (type ["TC" check])
+ (type ["tc" check])
[io])
(luxc ["&" base]
- (lang ["la" analysis #+ Analysis])
+ (lang ["la" analysis])
(analyser ["&;" common])))
## [Utils]
(type: #export Proc
- (-> &;Analyser (List Code) (Lux Analysis)))
+ (-> &;Analyser (List Code) (Lux la;Analysis)))
(type: #export Bundle
- (d;Dict Text Proc))
+ (Dict Text Proc))
(def: #export (install name unnamed)
(-> Text (-> Text Proc)
(-> Bundle Bundle))
- (d;put name (unnamed name)))
+ (dict;put name (unnamed name)))
(def: #export (prefix prefix bundle)
(-> Text Bundle Bundle)
(|> bundle
- d;entries
+ dict;entries
(list/map (function [[key val]] [(format prefix " " key) val]))
- (d;from-list text;Hash<Text>)))
+ (dict;from-list text;Hash<Text>)))
(def: #export (wrong-arity proc expected actual)
(-> Text Nat Nat Text)
@@ -52,8 +52,8 @@
(analyse argC)))
(list;zip2 input-types args))
expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected output-type))]
+ _ (&;with-type-env
+ (tc;check expected output-type))]
(wrap (#la;Procedure proc argsA)))
(&;fail (wrong-arity proc num-expected num-actual)))))))
@@ -95,11 +95,11 @@
(do Monad<Lux>
[opA (&;with-expected-type (type (io;IO varT))
(analyse opC))
- outputT (&;within-type-env
- (TC;clean var-id (type (Either Text varT))))
+ outputT (&;with-type-env
+ (tc;clean var-id (type (Either Text varT))))
expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected outputT))]
+ _ (&;with-type-env
+ (tc;check expected outputT))]
(wrap (#la;Procedure proc (list opA))))
_
@@ -107,14 +107,14 @@
(def: lux-procs
Bundle
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "is" lux-is)
(install "try" lux-try)))
(def: io-procs
Bundle
(<| (prefix "io")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "log" (unary Text Unit))
(install "error" (unary Text Bottom))
(install "exit" (unary Nat Bottom))
@@ -123,7 +123,7 @@
(def: bit-procs
Bundle
(<| (prefix "bit")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "count" (unary Nat Nat))
(install "and" (binary Nat Nat Nat))
(install "or" (binary Nat Nat Nat))
@@ -136,7 +136,7 @@
(def: nat-procs
Bundle
(<| (prefix "nat")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "+" (binary Nat Nat Nat))
(install "-" (binary Nat Nat Nat))
(install "*" (binary Nat Nat Nat))
@@ -152,7 +152,7 @@
(def: int-procs
Bundle
(<| (prefix "int")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "+" (binary Int Int Int))
(install "-" (binary Int Int Int))
(install "*" (binary Int Int Int))
@@ -168,7 +168,7 @@
(def: deg-procs
Bundle
(<| (prefix "deg")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "+" (binary Deg Deg Deg))
(install "-" (binary Deg Deg Deg))
(install "*" (binary Deg Deg Deg))
@@ -185,7 +185,7 @@
(def: frac-procs
Bundle
(<| (prefix "frac")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "+" (binary Frac Frac Frac))
(install "-" (binary Frac Frac Frac))
(install "*" (binary Frac Frac Frac))
@@ -207,7 +207,7 @@
(def: text-procs
Bundle
(<| (prefix "text")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "=" (binary Text Text Bool))
(install "<" (binary Text Text Bool))
(install "prepend" (binary Text Text Text))
@@ -246,7 +246,7 @@
(def: array-procs
Bundle
(<| (prefix "array")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "new" (unary Nat Array))
(install "get" array-get)
(install "put" array-put)
@@ -257,7 +257,7 @@
(def: math-procs
Bundle
(<| (prefix "math")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "cos" (unary Frac Frac))
(install "sin" (unary Frac Frac))
(install "tan" (unary Frac Frac))
@@ -288,11 +288,11 @@
(do Monad<Lux>
[initA (&;with-expected-type varT
(analyse initC))
- outputT (&;within-type-env
- (TC;clean var-id (type (A;Atom varT))))
+ outputT (&;with-type-env
+ (tc;clean var-id (type (A;Atom varT))))
expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected outputT))]
+ _ (&;with-type-env
+ (tc;check expected outputT))]
(wrap (#la;Procedure proc (list initA))))
_
@@ -317,7 +317,7 @@
(def: atom-procs
Bundle
(<| (prefix "atom")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "new" atom-new)
(install "read" atom-read)
(install "compare-and-swap" atom-compare-and-swap)
@@ -326,7 +326,7 @@
(def: process-procs
Bundle
(<| (prefix "process")
- (|> (d;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "concurrency-level" (nullary Nat))
(install "future" (unary (type (io;IO Top)) Unit))
(install "schedule" (binary Nat (type (io;IO Top)) Unit))
@@ -335,16 +335,16 @@
(def: #export procedures
Bundle
(<| (prefix "lux")
- (|> (d;new text;Hash<Text>)
- (d;merge lux-procs)
- (d;merge bit-procs)
- (d;merge nat-procs)
- (d;merge int-procs)
- (d;merge deg-procs)
- (d;merge frac-procs)
- (d;merge text-procs)
- (d;merge array-procs)
- (d;merge math-procs)
- (d;merge atom-procs)
- (d;merge process-procs)
- (d;merge io-procs))))
+ (|> (dict;new text;Hash<Text>)
+ (dict;merge lux-procs)
+ (dict;merge bit-procs)
+ (dict;merge nat-procs)
+ (dict;merge int-procs)
+ (dict;merge deg-procs)
+ (dict;merge frac-procs)
+ (dict;merge text-procs)
+ (dict;merge array-procs)
+ (dict;merge math-procs)
+ (dict;merge atom-procs)
+ (dict;merge process-procs)
+ (dict;merge io-procs))))
diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
index a8af2748a..1dba7a5f8 100644
--- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
@@ -5,6 +5,7 @@
["ex" exception #+ exception:])
(concurrency ["A" atom])
(data ["R" result]
+ [maybe]
[product]
[text "text/" Eq<Text>]
(text format
@@ -18,7 +19,7 @@
[host])
(luxc ["&" base]
["&;" host]
- (lang ["la" analysis #+ Analysis])
+ (lang ["la" analysis])
(analyser ["&;" common]))
["@" ../common]
)
@@ -245,7 +246,7 @@
(case elemT
(#;Host name #;Nil)
(let [boxed-name (|> (dict;get name boxes)
- (default name))]
+ (maybe;default name))]
(wrap [(#;Host boxed-name #;Nil)
boxed-name]))
@@ -267,8 +268,8 @@
(do macro;Monad<Lux>
[arrayA (&;with-expected-type (type (Array varT))
(analyse arrayC))
- elemT (&;within-type-env
- (tc;read-var var-id))
+ elemT (&;with-type-env
+ (tc;read var-id))
[elemT elem-class] (box-array-element-type elemT)
idxA (&;with-expected-type Nat
(analyse idxC))
@@ -288,8 +289,8 @@
(do macro;Monad<Lux>
[arrayA (&;with-expected-type (type (Array varT))
(analyse arrayC))
- elemT (&;within-type-env
- (tc;read-var var-id))
+ elemT (&;with-type-env
+ (tc;read var-id))
[valueT elem-class] (box-array-element-type elemT)
idxA (&;with-expected-type Nat
(analyse idxC))
@@ -334,8 +335,8 @@
(do macro;Monad<Lux>
[objectA (&;with-expected-type varT
(analyse objectC))
- objectT (&;within-type-env
- (tc;read-var var-id))
+ objectT (&;with-type-env
+ (tc;read var-id))
_ (check-object objectT)
_ (&;infer Bool)]
(wrap (#la;Procedure proc (list objectA))))
@@ -353,8 +354,8 @@
(do macro;Monad<Lux>
[monitorA (&;with-expected-type varT
(analyse monitorC))
- monitorT (&;within-type-env
- (tc;read-var var-id))
+ monitorT (&;with-type-env
+ (tc;read var-id))
_ (check-object monitorT)
exprA (analyse exprC)]
(wrap (#la;Procedure proc (list monitorA exprA))))
@@ -432,8 +433,8 @@
(do macro;Monad<Lux>
[exceptionA (&;with-expected-type varT
(analyse exceptionC))
- exceptionT (&;within-type-env
- (tc;read-var var-id))
+ exceptionT (&;with-type-env
+ (tc;read var-id))
exception-class (check-object exceptionT)
? (sub-class? "java.lang.Throwable" exception-class)
_ (: (Lux Unit)
@@ -478,8 +479,8 @@
(do macro;Monad<Lux>
[objectA (&;with-expected-type varT
(analyse objectC))
- objectT (&;within-type-env
- (tc;read-var var-id))
+ objectT (&;with-type-env
+ (tc;read var-id))
object-class (check-object objectT)
? (sub-class? class object-class)]
(if ?
@@ -599,13 +600,13 @@
[to-name (check-jvm to)
from-name (check-jvm from)]
(cond (dict;contains? to-name boxes)
- (let [box (assume (dict;get to-name boxes))]
+ (let [box (maybe;assume (dict;get to-name boxes))]
(if (text/= box from-name)
(wrap [box (#;Host to-name (list))])
(&;throw Cannot-Cast-To-Primitive (format from-name " => " to-name))))
(dict;contains? from-name boxes)
- (let [box (assume (dict;get from-name boxes))]
+ (let [box (maybe;assume (dict;get from-name boxes))]
(do @
[[_ castT] (cast to (#;Host box (list)))]
(wrap [from-name castT])))
@@ -709,8 +710,8 @@
target-class))
sourceA (&;with-expected-type varT
(analyse sourceC))
- sourceT (&;within-type-env
- (tc;read-var var-id))
+ sourceT (&;with-type-env
+ (tc;read var-id))
[unboxed castT] (cast targetT sourceT)
_ (&;assert (format "Object cannot be a primitive: " unboxed)
(text;empty? unboxed))]
@@ -722,8 +723,8 @@
(do macro;Monad<Lux>
[sourceA (&;with-expected-type varT
(analyse sourceC))
- sourceT (&;within-type-env
- (tc;read-var var-id))
+ sourceT (&;with-type-env
+ (tc;read var-id))
[unboxed castT] (cast targetT sourceT)]
(wrap [castT unboxed sourceA]))))
@@ -738,8 +739,8 @@
[[fieldT final?] (static-field class field)
expectedT macro;expected-type
[unboxed castT] (cast expectedT fieldT)
- _ (&;within-type-env
- (tc;check expectedT castT))]
+ _ (&;with-type-env
+ (tc;check expectedT castT))]
(wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed)))))
_
@@ -760,8 +761,8 @@
_ (&;assert (Final-Field (format class "#" field))
(not final?))
[valueT unboxed valueA] (analyse-input analyse fieldT valueC)
- _ (&;within-type-env
- (tc;check fieldT valueT))
+ _ (&;with-type-env
+ (tc;check fieldT valueT))
_ (&;infer Unit)]
(wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA))))
@@ -783,8 +784,8 @@
[fieldT final?] (virtual-field class field objectT)
expectedT macro;expected-type
[unboxed castT] (cast expectedT fieldT)
- _ (&;within-type-env
- (tc;check expectedT castT))]
+ _ (&;with-type-env
+ (tc;check expectedT castT))]
(wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) objectA))))
_
@@ -806,8 +807,8 @@
_ (&;assert (Final-Field (format class "#" field))
(not final?))
[valueT unboxed valueA] (analyse-input analyse fieldT valueC)
- _ (&;within-type-env
- (tc;check fieldT valueT))
+ _ (&;with-type-env
+ (tc;check fieldT valueT))
_ (&;infer Unit)]
(wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA objectA))))
diff --git a/new-luxc/source/luxc/analyser/reference.lux b/new-luxc/source/luxc/analyser/reference.lux
index d664ac9d0..9b051bb79 100644
--- a/new-luxc/source/luxc/analyser/reference.lux
+++ b/new-luxc/source/luxc/analyser/reference.lux
@@ -13,8 +13,8 @@
(do Monad<Lux>
[actual (macro;find-def-type def-name)
expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected actual))]
+ _ (&;with-type-env
+ (TC;check expected actual))]
(wrap (#la;Definition def-name))))
(def: (analyse-variable var-name)
@@ -25,8 +25,8 @@
(#;Some [actual ref])
(do @
[expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected actual))]
+ _ (&;with-type-env
+ (TC;check expected actual))]
(wrap (#;Some (#la;Variable ref))))
#;None
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
index 9a42db0fa..a6424b466 100644
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -2,21 +2,20 @@
lux
(lux (control [monad #+ do]
pipe)
- [io #- run]
[function]
(concurrency ["A" atom])
- (data [text "T/" Eq<Text>]
- text/format
- [ident]
- (coll [list "L/" Fold<List> Monoid<List> Monad<List>]
- ["D" dict]
- ["S" set])
+ (data [ident]
[number]
- [product])
- [macro #+ Monad<Lux>]
+ [product]
+ [maybe]
+ (coll [list "list/" Functor<List>]
+ [dict #+ Dict])
+ [text]
+ text/format)
+ [macro]
(macro [code])
[type]
- (type ["TC" check]))
+ (type ["tc" check]))
(luxc ["&" base]
(lang ["la" analysis])
["&;" module]
@@ -37,7 +36,7 @@
(def: #export (analyse-sum analyse tag valueC)
(-> &;Analyser Nat Code (Lux la;Analysis))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[expected macro;expected-type]
(&;with-stacked-errors
(function [_] (not-variant expected))
@@ -62,12 +61,12 @@
(#;Var id)
(do @
- [bound? (&;within-type-env
- (TC;bound? id))]
+ [bound? (&;with-type-env
+ (tc;bound? id))]
(if bound?
(do @
- [expected' (&;within-type-env
- (TC;read-var id))]
+ [expected' (&;with-type-env
+ (tc;read id))]
(&;with-expected-type expected'
(analyse-sum analyse tag valueC)))
## Cannot do inference when the tag is numeric.
@@ -77,15 +76,15 @@
(#;UnivQ _)
(do @
- [[var-id var] (&;within-type-env
- TC;existential)]
- (&;with-expected-type (assume (type;apply (list var) expected))
+ [[var-id var] (&;with-type-env
+ tc;existential)]
+ (&;with-expected-type (maybe;assume (type;apply (list var) expected))
(analyse-sum analyse tag valueC)))
(#;ExQ _)
(&common;with-var
(function [[var-id var]]
- (&;with-expected-type (assume (type;apply (list var) expected))
+ (&;with-expected-type (maybe;assume (type;apply (list var) expected))
(analyse-sum analyse tag valueC))))
(#;Apply inputT funT)
@@ -102,7 +101,7 @@
(def: (analyse-typed-product analyse members)
(-> &;Analyser (List Code) (Lux la;Analysis))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[expected macro;expected-type]
(loop [expected expected
members members]
@@ -150,7 +149,7 @@
(def: #export (analyse-product analyse membersC)
(-> &;Analyser (List Code) (Lux la;Analysis))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[expected macro;expected-type]
(&;with-stacked-errors
(function [_] (format "Invalid type for tuple: " (%type expected)))
@@ -164,34 +163,34 @@
(#;Var id)
(do @
- [bound? (&;within-type-env
- (TC;bound? id))]
+ [bound? (&;with-type-env
+ (tc;bound? id))]
(if bound?
(do @
- [expected' (&;within-type-env
- (TC;read-var id))]
+ [expected' (&;with-type-env
+ (tc;read id))]
(&;with-expected-type expected'
(analyse-product analyse membersC)))
## Must do inference...
(do @
[membersTA (monad;map @ (|>. analyse &common;with-unknown-type)
membersC)
- _ (&;within-type-env
- (TC;check expected
- (type;tuple (L/map product;left membersTA))))]
- (wrap (la;product (L/map product;right membersTA))))))
+ _ (&;with-type-env
+ (tc;check expected
+ (type;tuple (list/map product;left membersTA))))]
+ (wrap (la;product (list/map product;right membersTA))))))
(#;UnivQ _)
(do @
- [[var-id var] (&;within-type-env
- TC;existential)]
- (&;with-expected-type (assume (type;apply (list var) expected))
+ [[var-id var] (&;with-type-env
+ tc;existential)]
+ (&;with-expected-type (maybe;assume (type;apply (list var) expected))
(analyse-product analyse membersC)))
(#;ExQ _)
(&common;with-var
(function [[var-id var]]
- (&;with-expected-type (assume (type;apply (list var) expected))
+ (&;with-expected-type (maybe;assume (type;apply (list var) expected))
(analyse-product analyse membersC))))
(#;Apply inputT funT)
@@ -209,17 +208,17 @@
(def: #export (analyse-tagged-sum analyse tag value)
(-> &;Analyser Ident Code (Lux la;Analysis))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[tag (macro;normalize tag)
[idx group variantT] (macro;resolve-tag tag)
#let [case-size (list;size group)]
inferenceT (&inference;variant-inference-type idx case-size variantT)
[inferredT valueA+] (&inference;apply-function analyse inferenceT (list value))
expectedT macro;expected-type
- _ (&;within-type-env
- (TC;check expectedT inferredT))
+ _ (&;with-type-env
+ (tc;check expectedT inferredT))
temp &scope;next-local]
- (wrap (la;sum idx case-size temp (|> valueA+ list;head assume)))))
+ (wrap (la;sum idx case-size temp (|> valueA+ list;head maybe;assume)))))
## There cannot be any ambiguity or improper syntax when analysing
## records, so they must be normalized for further analysis.
@@ -227,11 +226,11 @@
## canonical form (with their corresponding module identified).
(def: #export (normalize record)
(-> (List [Code Code]) (Lux (List [Ident Code])))
- (monad;map Monad<Lux>
+ (monad;map macro;Monad<Lux>
(function [[key val]]
(case key
[_ (#;Tag key)]
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[key (macro;normalize key)]
(wrap [key val]))
@@ -247,10 +246,10 @@
(case record
## empty-record = empty-tuple = unit = []
#;Nil
- (:: Monad<Lux> wrap [(list) Unit])
+ (:: macro;Monad<Lux> wrap [(list) Unit])
(#;Cons [head-k head-v] _)
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[head-k (macro;normalize head-k)
[_ tag-set recordT] (macro;resolve-tag head-k)
#let [size-record (list;size record)
@@ -262,36 +261,36 @@
" 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 (D;from-list ident;Hash<Ident> (list;zip2 tag-set tuple-range))]
+ 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 (D;get key tag->idx)
+ (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 (D;contains? idx idx->val)
+ (if (dict;contains? idx idx->val)
(&;fail (format "Cannot repeat tag inside record: " (%code (code;tag key))))
- (wrap (D;put idx val idx->val))))))
- (: (D;Dict Nat Code)
- (D;new number;Hash<Nat>))
+ (wrap (dict;put idx val idx->val))))))
+ (: (Dict Nat Code)
+ (dict;new number;Hash<Nat>))
record)
- #let [ordered-tuple (L/map (function [idx] (assume (D;get idx idx->val)))
- tuple-range)]]
+ #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]) (Lux la;Analysis))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[members (normalize members)
[members recordT] (order members)
expectedT macro;expected-type
inferenceT (&inference;record-inference-type recordT)
[inferredT membersA] (&inference;apply-function analyse inferenceT members)
- _ (&;within-type-env
- (TC;check expectedT inferredT))]
+ _ (&;with-type-env
+ (tc;check expectedT inferredT))]
(wrap (la;product membersA))))
diff --git a/new-luxc/source/luxc/analyser/type.lux b/new-luxc/source/luxc/analyser/type.lux
index 1eb278d2a..b69790a59 100644
--- a/new-luxc/source/luxc/analyser/type.lux
+++ b/new-luxc/source/luxc/analyser/type.lux
@@ -15,8 +15,8 @@
[actual (eval Type type)
#let [actual (:! Type actual)]
expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected actual))]
+ _ (&;with-type-env
+ (TC;check expected actual))]
(&;with-expected-type actual
(analyse value))))
@@ -25,7 +25,7 @@
(do Monad<Lux>
[actual (eval Type type)
expected macro;expected-type
- _ (&;within-type-env
- (TC;check expected (:! Type actual)))]
+ _ (&;with-type-env
+ (TC;check expected (:! Type actual)))]
(&;with-expected-type Top
(analyse value))))
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index c0108da7e..fe57cc1dd 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -57,7 +57,7 @@
(#R;Error error)
(#R;Error error))))
-(def: #export (within-type-env action)
+(def: #export (with-type-env action)
(All [a] (-> (tc;Check a) (Lux a)))
(function [compiler]
(case (action (get@ #;type-context compiler))
@@ -72,8 +72,8 @@
(-> Type (Lux Unit))
(do macro;Monad<Lux>
[expectedT macro;expected-type]
- (within-type-env
- (tc;check expectedT actualT))))
+ (with-type-env
+ (tc;check expectedT actualT))))
(def: #export (pl-get key table)
(All [a] (-> Text (List [Text a]) (Maybe a)))
diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux
index 1f04f5798..054d11098 100644
--- a/new-luxc/source/luxc/generator/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/common.jvm.lux
@@ -21,7 +21,7 @@
(host;import java.lang.ClassLoader
(loadClass [String] (Class Object)))
-(type: #export Bytecode host;Byte-Array)
+(type: #export Bytecode (host;type (Array byte)))
(type: #export Class-Store (A;Atom (d;Dict Text Bytecode)))
diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux
index 96f7a4917..4f02dcffb 100644
--- a/new-luxc/source/luxc/generator/eval.jvm.lux
+++ b/new-luxc/source/luxc/generator/eval.jvm.lux
@@ -54,7 +54,7 @@
(visitEnd [] void)
(visitField [int String String String Object] FieldVisitor)
(visitMethod [int String String String (Array String)] MethodVisitor)
- (toByteArray [] Byte-Array))
+ (toByteArray [] (Array byte)))
(def: eval-field Text "_value")
(def: $Object $;Type ($t;class "java.lang.Object" (list)))
diff --git a/new-luxc/source/luxc/generator/function.jvm.lux b/new-luxc/source/luxc/generator/function.jvm.lux
index 135daf47e..e3582e183 100644
--- a/new-luxc/source/luxc/generator/function.jvm.lux
+++ b/new-luxc/source/luxc/generator/function.jvm.lux
@@ -2,7 +2,7 @@
lux
(lux (control [monad #+ do])
(data text/format
- (coll [list "L/" Functor<List> Monoid<List>]))
+ (coll [list "list/" Functor<List> Monoid<List>]))
[macro])
(luxc ["&" base]
(lang ["la" analysis]
@@ -68,7 +68,7 @@
(def: (inputsI start amount)
(-> $;Register Nat $;Inst)
(|> (list;n.range start (n.+ start (n.dec amount)))
- (L/map $i;ALOAD)
+ (list/map $i;ALOAD)
$i;fuse))
(def: (applysI start amount)
@@ -96,26 +96,26 @@
(def: (with-captured env)
(-> (List ls;Variable) $;Def)
(|> (list;enumerate env)
- (L/map (function [[env-idx env-source]]
- ($d;field #$;Private $;finalF (captured env-idx) $Object)))
+ (list/map (function [[env-idx env-source]]
+ ($d;field #$;Private $;finalF (captured env-idx) $Object)))
$d;fuse))
(def: (with-partial arity)
(-> ls;Arity $;Def)
(if (poly-arg? arity)
(|> (list;n.range +0 (n.- +2 arity))
- (L/map (function [idx]
- ($d;field #$;Private $;finalF (partial idx) $Object)))
+ (list/map (function [idx]
+ ($d;field #$;Private $;finalF (partial idx) $Object)))
$d;fuse)
id))
(def: (instance class arity env)
(-> Text ls;Arity (List ls;Variable) $;Inst)
(let [captureI (|> env
- (L/map (function [source]
- (if (function;captured? source)
- ($i;GETFIELD class (captured (function;captured-idx source)) $Object)
- ($i;ALOAD (int-to-nat source)))))
+ (list/map (function [source]
+ (if (function;captured? source)
+ ($i;GETFIELD class (captured (function;captured-idx source)) $Object)
+ ($i;ALOAD (int-to-nat source)))))
$i;fuse)
argsI (if (poly-arg? arity)
(|> (nullsI (n.dec arity))
@@ -136,9 +136,9 @@
captureI (|> (case env-size
+0 (list)
_ (list;n.range +0 (n.dec env-size)))
- (L/map (function [source]
- (|>. ($i;ALOAD +0)
- ($i;GETFIELD class (captured source) $Object))))
+ (list/map (function [source]
+ (|>. ($i;ALOAD +0)
+ ($i;GETFIELD class (captured source) $Object))))
$i;fuse)
argsI (|> (nullsI (n.dec arity))
(list ($i;int 0))
@@ -179,18 +179,18 @@
store-capturedI (|> (case env-size
+0 (list)
_ (list;n.range +0 (n.dec env-size)))
- (L/map (function [register]
- (|>. ($i;ALOAD +0)
- ($i;ALOAD (n.inc register))
- ($i;PUTFIELD class (captured register) $Object))))
+ (list/map (function [register]
+ (|>. ($i;ALOAD +0)
+ ($i;ALOAD (n.inc register))
+ ($i;PUTFIELD class (captured register) $Object))))
$i;fuse)
store-partialI (if (poly-arg? arity)
(|> (list;n.range +0 (n.- +2 arity))
- (L/map (function [idx]
- (let [register (offset-partial idx)]
- (|>. ($i;ALOAD +0)
- ($i;ALOAD (n.inc register))
- ($i;PUTFIELD class (partial idx) $Object)))))
+ (list/map (function [idx]
+ (let [register (offset-partial idx)]
+ (|>. ($i;ALOAD +0)
+ ($i;ALOAD (n.inc register))
+ ($i;PUTFIELD class (partial idx) $Object)))))
$i;fuse)
id)]
($d;method #$;Public $;noneM "<init>" (init-method env arity)
@@ -200,69 +200,62 @@
store-partialI
$i;RETURN))))
-(def: (when test f)
- (All [a] (-> Bool (-> a a) (-> a a)))
- (function [value]
- (if test
- (f value)
- value)))
-
(def: (with-apply class env function-arity @begin bodyI apply-arity)
(-> Text (List ls;Variable) ls;Arity $;Label $;Inst ls;Arity
$;Def)
(let [num-partials (n.dec function-arity)
@default ($;new-label [])
- @labels (L/map $;new-label (list;repeat num-partials []))
+ @labels (list/map $;new-label (list;repeat num-partials []))
arity-over-extent (|> (nat-to-int function-arity) (i.- (nat-to-int apply-arity)))
- casesI (|> (L/append @labels (list @default))
+ casesI (|> (list/compose @labels (list @default))
(list;zip2 (list;n.range +0 num-partials))
- (L/map (function [[stage @label]]
- (let [load-partialsI (if (n.> +0 stage)
- (|> (list;n.range +0 (n.dec stage))
- (L/map (|>. partial (load-fieldI class)))
- $i;fuse)
- id)]
- (cond (i.= arity-over-extent (nat-to-int stage))
- (|>. ($i;label @label)
- ($i;ALOAD +0)
- (when (n.> +0 stage)
- ($i;INVOKEVIRTUAL class "reset" (reset-method class) false))
- load-partialsI
- (inputsI +1 apply-arity)
- ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
- $i;ARETURN)
+ (list/map (function [[stage @label]]
+ (let [load-partialsI (if (n.> +0 stage)
+ (|> (list;n.range +0 (n.dec stage))
+ (list/map (|>. partial (load-fieldI class)))
+ $i;fuse)
+ id)]
+ (cond (i.= arity-over-extent (nat-to-int stage))
+ (|>. ($i;label @label)
+ ($i;ALOAD +0)
+ (when (n.> +0 stage)
+ ($i;INVOKEVIRTUAL class "reset" (reset-method class) false))
+ load-partialsI
+ (inputsI +1 apply-arity)
+ ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
+ $i;ARETURN)
- (i.> arity-over-extent (nat-to-int stage))
- (let [args-to-completion (|> function-arity (n.- stage))
- args-left (|> apply-arity (n.- args-to-completion))]
- (|>. ($i;label @label)
- ($i;ALOAD +0)
- ($i;INVOKEVIRTUAL class "reset" (reset-method class) false)
- load-partialsI
- (inputsI +1 args-to-completion)
- ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
- (applysI (n.inc args-to-completion) args-left)
- $i;ARETURN))
+ (i.> arity-over-extent (nat-to-int stage))
+ (let [args-to-completion (|> function-arity (n.- stage))
+ args-left (|> apply-arity (n.- args-to-completion))]
+ (|>. ($i;label @label)
+ ($i;ALOAD +0)
+ ($i;INVOKEVIRTUAL class "reset" (reset-method class) false)
+ load-partialsI
+ (inputsI +1 args-to-completion)
+ ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
+ (applysI (n.inc args-to-completion) args-left)
+ $i;ARETURN))
- ## (i.< arity-over-extent (nat-to-int stage))
- (let [env-size (list;size env)
- load-capturedI (|> (case env-size
- +0 (list)
- _ (list;n.range +0 (n.dec env-size)))
- (L/map (|>. captured (load-fieldI class)))
- $i;fuse)]
- (|>. ($i;label @label)
- ($i;NEW class)
- $i;DUP
- load-capturedI
- get-amount-of-partialsI
- (inc-intI apply-arity)
- load-partialsI
- (inputsI +1 apply-arity)
- (nullsI (|> num-partials (n.- apply-arity) (n.- stage)))
- ($i;INVOKESPECIAL class "<init>" (init-method env function-arity) false)
- $i;ARETURN))
- ))))
+ ## (i.< arity-over-extent (nat-to-int stage))
+ (let [env-size (list;size env)
+ load-capturedI (|> (case env-size
+ +0 (list)
+ _ (list;n.range +0 (n.dec env-size)))
+ (list/map (|>. captured (load-fieldI class)))
+ $i;fuse)]
+ (|>. ($i;label @label)
+ ($i;NEW class)
+ $i;DUP
+ load-capturedI
+ get-amount-of-partialsI
+ (inc-intI apply-arity)
+ load-partialsI
+ (inputsI +1 apply-arity)
+ (nullsI (|> num-partials (n.- apply-arity) (n.- stage)))
+ ($i;INVOKESPECIAL class "<init>" (init-method env function-arity) false)
+ $i;ARETURN))
+ ))))
$i;fuse)]
($d;method #$;Public $;noneM &runtime;apply-method (&runtime;apply-signature apply-arity)
(|>. get-amount-of-partialsI
@@ -286,7 +279,7 @@
(if (poly-arg? arity)
(|> (n.min arity &runtime;num-apply-variants)
(list;n.range +1)
- (L/map (with-apply class env arity @begin bodyI))
+ (list/map (with-apply class env arity @begin bodyI))
(list& (with-implementation arity @begin bodyI))
$d;fuse)
($d;method #$;Public $;strictM &runtime;apply-method (&runtime;apply-signature +1)
@@ -332,10 +325,10 @@
[functionI (generate functionS)
argsI (monad;map @ generate argsS)
#let [applyI (|> (segment &runtime;num-apply-variants argsI)
- (L/map (function [chunkI+]
- (|>. ($i;CHECKCAST &runtime;function-class)
- ($i;fuse chunkI+)
- ($i;INVOKEVIRTUAL &runtime;function-class &runtime;apply-method (&runtime;apply-signature (list;size chunkI+)) false))))
+ (list/map (function [chunkI+]
+ (|>. ($i;CHECKCAST &runtime;function-class)
+ ($i;fuse chunkI+)
+ ($i;INVOKEVIRTUAL &runtime;function-class &runtime;apply-method (&runtime;apply-signature (list;size chunkI+)) false))))
$i;fuse)]]
(wrap (|>. functionI
applyI))))
diff --git a/new-luxc/source/luxc/generator/host/jvm.lux b/new-luxc/source/luxc/generator/host/jvm.lux
index 149fbf123..4fb3fa77d 100644
--- a/new-luxc/source/luxc/generator/host/jvm.lux
+++ b/new-luxc/source/luxc/generator/host/jvm.lux
@@ -2,7 +2,7 @@
[lux #- Type Def]
(lux (control monad
["p" parser])
- (data (coll [list "L/" Functor<List>]))
+ (data (coll [list "list/" Functor<List>]))
[macro]
(macro [code]
["s" syntax #+ syntax:])
@@ -86,32 +86,32 @@
[options (s;tuple (p;many s;local-symbol))])
(let [g!type (code;local-symbol type)
g!none (code;local-symbol none)
- g!tags+ (L/map code;local-tag options)
+ g!tags+ (list/map code;local-tag options)
g!_left (code;local-symbol "_left")
g!_right (code;local-symbol "_right")
- g!options+ (L/map (function [option]
- (` (def: (~' #export) (~ (code;local-symbol option))
- (~ g!type)
- (|> (~ g!none)
- (set@ (~ (code;local-tag option)) true)))))
- options)]
+ g!options+ (list/map (function [option]
+ (` (def: (~' #export) (~ (code;local-symbol option))
+ (~ g!type)
+ (|> (~ g!none)
+ (set@ (~ (code;local-tag option)) true)))))
+ options)]
(wrap (list& (` (type: (~' #export) (~ g!type)
- (~ (code;record (L/map (function [tag]
- [tag (` ;Bool)])
- g!tags+)))))
+ (~ (code;record (list/map (function [tag]
+ [tag (` ;Bool)])
+ g!tags+)))))
(` (def: (~' #export) (~ g!none)
(~ g!type)
- (~ (code;record (L/map (function [tag]
- [tag (` false)])
- g!tags+)))))
+ (~ (code;record (list/map (function [tag]
+ [tag (` false)])
+ g!tags+)))))
(` (def: (~' #export) ((~ (code;local-symbol ++)) (~ g!_left) (~ g!_right))
(-> (~ g!type) (~ g!type) (~ g!type))
- (~ (code;record (L/map (function [tag]
- [tag (` (and (get@ (~ tag) (~ g!_left))
- (get@ (~ tag) (~ g!_right))))])
- g!tags+)))))
+ (~ (code;record (list/map (function [tag]
+ [tag (` (and (get@ (~ tag) (~ g!_left))
+ (get@ (~ tag) (~ g!_right))))])
+ g!tags+)))))
g!options+))))
diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux
index 18cd4f945..7dd78ceb3 100644
--- a/new-luxc/source/luxc/generator/host/jvm/def.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/def.lux
@@ -4,7 +4,7 @@
text/format
[product]
(coll ["a" array]
- [list "L/" Functor<List>]))
+ [list "list/" Functor<List>]))
[host #+ do-to])
["$" ..]
(.. ["$t" type]))
@@ -56,13 +56,13 @@
(visitEnd [] void)
(visitField [int String String String Object] FieldVisitor)
(visitMethod [int String String String (Array String)] MethodVisitor)
- (toByteArray [] Byte-Array))
+ (toByteArray [] (Array byte)))
## [Defs]
(def: (string-array values)
(-> (List Text) (a;Array Text))
(let [output (host;array String (list;size values))]
- (exec (L/map (function [[idx value]]
+ (exec (list/map (function [[idx value]]
(host;array-write idx value output))
(list;enumerate values))
output)))
@@ -70,7 +70,7 @@
(def: exceptions-array
(-> $;Method (a;Array Text))
(|>. (get@ #$;exceptions)
- (L/map (|>. #$;Generic $t;descriptor))
+ (list/map (|>. #$;Generic $t;descriptor))
string-array))
(def: (version-flag version)
@@ -127,7 +127,7 @@
(format name
(param-signature super)
(|> interfaces
- (L/map param-signature)
+ (list/map param-signature)
(text;join-with ""))))
(def: (parameters-signature parameters super interfaces)
@@ -137,13 +137,13 @@
""
(format "<"
(|> parameters
- (L/map formal-param)
+ (list/map formal-param)
(text;join-with ""))
">"))]
(format formal-params
(|> super class-to-type $t;signature)
(|> interfaces
- (L/map (|>. class-to-type $t;signature))
+ (list/map (|>. class-to-type $t;signature))
(text;join-with "")))))
(def: class-computes
@@ -156,7 +156,7 @@
[(def: #export (<name> version visibility config name parameters super interfaces
definitions)
(-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def
- host;Byte-Array)
+ (host;type (Array byte)))
(let [writer (|> (do-to (ClassWriter.new class-computes)
(ClassWriter.visit [(version-flag version)
($_ i.+
@@ -168,7 +168,7 @@
(parameters-signature parameters super interfaces)
(|> super product;left $t;binary-name)
(|> interfaces
- (L/map (|>. product;left $t;binary-name))
+ (list/map (|>. product;left $t;binary-name))
string-array)]))
definitions)
_ (ClassWriter.visitEnd [] writer)]
@@ -183,7 +183,7 @@
(def: #export (interface version visibility config name parameters interfaces
definitions)
(-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def
- host;Byte-Array)
+ (host;type (Array byte)))
(let [writer (|> (do-to (ClassWriter.new class-computes)
(ClassWriter.visit [(version-flag version)
($_ i.+
@@ -195,7 +195,7 @@
(parameters-signature parameters $Object interfaces)
(|> $Object product;left $t;binary-name)
(|> interfaces
- (L/map (|>. product;left $t;binary-name))
+ (list/map (|>. product;left $t;binary-name))
string-array)]))
definitions)
_ (ClassWriter.visitEnd [] writer)]
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index 02027294a..aa9a852dd 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -2,8 +2,9 @@
[lux #- char]
(lux (control monad
["p" parser])
- (data text/format
+ (data [maybe]
["R" result]
+ text/format
(coll [list "L/" Functor<List>]))
[host #+ do-to]
[macro]
@@ -262,7 +263,7 @@
_ (loop [idx +0]
(if (n.< num-labels idx)
(exec (host;array-write idx
- (assume (list;nth idx labels))
+ (maybe;assume (list;nth idx labels))
labels-array)
(recur (n.inc idx)))
[]))]
diff --git a/new-luxc/source/luxc/generator/procedure.jvm.lux b/new-luxc/source/luxc/generator/procedure.jvm.lux
index 77828c952..524513eb5 100644
--- a/new-luxc/source/luxc/generator/procedure.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure.jvm.lux
@@ -2,8 +2,8 @@
(;module:
lux
(lux (control [monad #+ do])
- (data text/format
- [maybe]
+ (data [maybe]
+ text/format
(coll ["d" dict])))
(luxc ["&" base]
(lang ["ls" synthesis])
@@ -13,7 +13,7 @@
(def: #export (generate-procedure generate name args)
(-> (-> ls;Synthesis (Lux $;Inst)) Text (List ls;Synthesis)
(Lux $;Inst))
- (default (&;fail (format "Unknown procedure: " (%t name)))
- (do maybe;Monad<Maybe>
- [proc (d;get name &&common;procedures)]
- (wrap (proc generate args)))))
+ (<| (maybe;default (&;fail (format "Unknown procedure: " (%t name))))
+ (do maybe;Monad<Maybe>
+ [proc (d;get name &&common;procedures)]
+ (wrap (proc generate args)))))
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index 9f8afdbb2..ffbe69708 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -3,9 +3,9 @@
(lux (control [monad #+ do])
(data [text]
text/format
- (coll [list "L/" Functor<List> Monoid<List>]
- ["D" dict]))
- [macro #+ Monad<Lux> with-gensyms]
+ (coll [list "list/" Functor<List>]
+ [dict #+ Dict]))
+ [macro #+ with-gensyms]
(macro [code]
["s" syntax #+ syntax:])
[host])
@@ -41,7 +41,7 @@
(-> Generator (List ls;Synthesis) (Lux $;Inst)))
(type: Bundle
- (D;Dict Text Proc))
+ (Dict Text Proc))
(syntax: (Vector [size s;nat] elemT)
(wrap (list (` [(~@ (list;repeat size elemT))]))))
@@ -61,7 +61,7 @@
(def: (install name unnamed)
(-> Text (-> Text Proc)
(-> Bundle Bundle))
- (D;put name (unnamed name)))
+ (dict;put name (unnamed name)))
(def: (wrong-amount-error proc expected actual)
(-> Text Nat Nat Text)
@@ -82,8 +82,8 @@
(^ (list (~@ g!input+)))
(do macro;Monad<Lux>
[(~@ (|> g!input+
- (L/map (function [g!input]
- (list g!input (` ((~ g!generate) (~ g!input))))))
+ (list/map (function [g!input]
+ (list g!input (` ((~ g!generate) (~ g!input))))))
list;concat))]
((~' wrap) ((~ g!proc) [(~@ g!input+)])))
@@ -527,13 +527,13 @@
## [Bundles]
(def: lux-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "lux is" (binary lux//is))
(install "lux try" (unary lux//try))))
(def: bit-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "bit count" (unary bit//count))
(install "bit and" (binary bit//and))
(install "bit or" (binary bit//or))
@@ -545,7 +545,7 @@
(def: nat-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "nat +" (binary nat//add))
(install "nat -" (binary nat//sub))
(install "nat *" (binary nat//mul))
@@ -560,7 +560,7 @@
(def: int-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "int +" (binary int//add))
(install "int -" (binary int//sub))
(install "int *" (binary int//mul))
@@ -575,7 +575,7 @@
(def: deg-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "deg +" (binary deg//add))
(install "deg -" (binary deg//sub))
(install "deg *" (binary deg//mul))
@@ -591,7 +591,7 @@
(def: frac-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "frac +" (binary frac//add))
(install "frac -" (binary frac//sub))
(install "frac *" (binary frac//mul))
@@ -612,7 +612,7 @@
(def: text-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "text =" (binary text//eq))
(install "text <" (binary text//lt))
(install "text append" (binary text//append))
@@ -626,7 +626,7 @@
(def: array-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "array new" (unary array//new))
(install "array get" (binary array//get))
(install "array put" (trinary array//put))
@@ -636,7 +636,7 @@
(def: math-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "math cos" (unary math//cos))
(install "math sin" (unary math//sin))
(install "math tan" (unary math//tan))
@@ -659,7 +659,7 @@
(def: io-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "io log" (unary io//log))
(install "io error" (unary io//error))
(install "io exit" (unary io//exit))
@@ -667,14 +667,14 @@
(def: atom-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "atom new" (unary atom//new))
(install "atom read" (unary atom//read))
(install "atom compare-and-swap" (trinary atom//compare-and-swap))))
(def: process-procs
Bundle
- (|> (D;new text;Hash<Text>)
+ (|> (dict;new text;Hash<Text>)
(install "process concurrency-level" (nullary process//concurrency-level))
(install "process future" (unary process//future))
(install "process schedule" (binary process//schedule))
@@ -682,17 +682,17 @@
(def: #export procedures
Bundle
- (|> (D;new text;Hash<Text>)
- (D;merge lux-procs)
- (D;merge bit-procs)
- (D;merge nat-procs)
- (D;merge int-procs)
- (D;merge deg-procs)
- (D;merge frac-procs)
- (D;merge text-procs)
- (D;merge array-procs)
- (D;merge math-procs)
- (D;merge io-procs)
- (D;merge atom-procs)
- (D;merge process-procs)
+ (|> (dict;new text;Hash<Text>)
+ (dict;merge lux-procs)
+ (dict;merge bit-procs)
+ (dict;merge nat-procs)
+ (dict;merge int-procs)
+ (dict;merge deg-procs)
+ (dict;merge frac-procs)
+ (dict;merge text-procs)
+ (dict;merge array-procs)
+ (dict;merge math-procs)
+ (dict;merge io-procs)
+ (dict;merge atom-procs)
+ (dict;merge process-procs)
))
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index 69f90cea0..c073e7da0 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -39,7 +39,7 @@
(new [int])
(visit [int int String String String (Array String)] void)
(visitEnd [] void)
- (toByteArray [] Byte-Array))
+ (toByteArray [] (Array byte)))
(def: #export runtime-class Text "LuxRuntime")
(def: #export function-class Text "LuxFunction")
diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux
index 66c53e479..240b60f97 100644
--- a/new-luxc/source/luxc/module.lux
+++ b/new-luxc/source/luxc/module.lux
@@ -11,14 +11,14 @@
(def: (new-module hash)
(-> Nat Module)
- {#;module-hash hash
- #;module-aliases (list)
- #;defs (list)
- #;imports (list)
- #;tags (list)
- #;types (list)
- #;module-anns (list)
- #;module-state #;Active})
+ {#;module-hash hash
+ #;module-aliases (list)
+ #;defs (list)
+ #;imports (list)
+ #;tags (list)
+ #;types (list)
+ #;module-annotations (' {})
+ #;module-state #;Active})
(def: #export (define (^@ full-name [module-name def-name])
definition)
diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux
index 2e8ad1fd5..7eb4dcb16 100644
--- a/new-luxc/source/luxc/parser.lux
+++ b/new-luxc/source/luxc/parser.lux
@@ -32,9 +32,10 @@
[text]
["R" result]
[number]
+ [product]
+ [maybe]
(text ["l" lexer]
format)
- [product]
(coll [list "L/" Functor<List> Fold<List>]
["V" vector]))))
@@ -252,7 +253,7 @@
(update@ #;column (n.+ chars-consumed)))
char]))))
_ (l;this "\"")
- #let [char (assume (text;nth +0 char))]]
+ #let [char (maybe;assume (text;nth +0 char))]]
(wrap [(|> where'
(update@ #;column n.inc))
[where (#;Nat char)]])))
@@ -372,7 +373,7 @@
## text's body.
(recur (|> offset
(text;split offset-column)
- (default (undefined))
+ (maybe;default (undefined))
product;right
(format text-read))
(|> where
diff --git a/new-luxc/source/luxc/scope.lux b/new-luxc/source/luxc/scope.lux
index e15e01130..1dc5b932d 100644
--- a/new-luxc/source/luxc/scope.lux
+++ b/new-luxc/source/luxc/scope.lux
@@ -1,12 +1,12 @@
(;module:
lux
(lux (control monad)
- (data [text "T/" Eq<Text>]
+ (data [text]
text/format
- [maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>]
+ [maybe "maybe/" Monad<Maybe>]
[product]
["R" result]
- (coll [list "L/" Fold<List> Monoid<List>]))
+ (coll [list "list/" Fold<List> Monoid<List>]))
[macro])
(luxc ["&" base]))
@@ -25,7 +25,7 @@
(|> scope
(get@ [<slot> #;mappings])
(&;pl-get name)
- (Maybe/map (function [[type value]]
+ (maybe/map (function [[type value]]
[type (<then> value)]))))]
[#;locals is-local? get-local #;Local]
@@ -57,20 +57,20 @@
(#;Right [compiler #;None])
(#;Cons top-outer _)
- (let [[ref-type init-ref] (default (undefined)
- (get-ref name top-outer))
- [ref inner'] (L/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
- (function [scope [ref inner]]
- [(#;Captured (get@ [#;captured #;counter] scope))
- (#;Cons (update@ #;captured
- (: (-> Captured Captured)
- (|>. (update@ #;counter n.inc)
- (update@ #;mappings (&;pl-put name [ref-type ref]))))
- scope)
- inner)]))
- [init-ref #;Nil]
- (list;reverse inner))
- scopes (L/append inner' outer)]
+ (let [[ref-type init-ref] (maybe;default (undefined)
+ (get-ref name top-outer))
+ [ref inner'] (list/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
+ (function [scope [ref inner]]
+ [(#;Captured (get@ [#;captured #;counter] scope))
+ (#;Cons (update@ #;captured
+ (: (-> Captured Captured)
+ (|>. (update@ #;counter n.inc)
+ (update@ #;mappings (&;pl-put name [ref-type ref]))))
+ scope)
+ inner)]))
+ [init-ref #;Nil]
+ (list;reverse inner))
+ scopes (list/compose inner' outer)]
(#;Right [(set@ #;scopes scopes compiler)
(#;Some [ref-type ref])]))
))))
@@ -141,7 +141,7 @@
(#R;Success [compiler' output])
(#R;Success [(update@ #;scopes
- (|>. list;tail (default (list)))
+ (|>. list;tail (maybe;default (list)))
compiler')
output])
))
diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
index 7bee8fe58..651da82a7 100644
--- a/new-luxc/source/luxc/synthesizer.lux
+++ b/new-luxc/source/luxc/synthesizer.lux
@@ -1,10 +1,11 @@
(;module:
lux
- (lux (data text/format
+ (lux (data [maybe]
[number]
[product]
- (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
- ["d" dict])))
+ text/format
+ (coll [list "list/" Functor<List> Fold<List> Monoid<List>]
+ [dict #+ Dict])))
(luxc ["&" base]
(lang ["la" analysis]
["ls" synthesis])
@@ -15,7 +16,7 @@
))
(def: init-env (List ls;Variable) (list))
-(def: init-resolver (d;Dict Int Int) (d;new number;Hash<Int>))
+(def: init-resolver (Dict Int Int) (dict;new number;Hash<Int>))
(def: (prepare-body inner-arity arity body)
(-> Nat Nat ls;Synthesis ls;Synthesis)
@@ -43,7 +44,7 @@
[#la;Definition #ls;Definition])
(#la;Product _)
- (#ls;Tuple (L/map (recur +0 resolver num-locals) (&&structure;unfold-tuple exprA)))
+ (#ls;Tuple (list/map (recur +0 resolver num-locals) (&&structure;unfold-tuple exprA)))
(#la;Sum choice)
(let [[tag last? value] (&&structure;unfold-variant choice)]
@@ -55,14 +56,14 @@
(if (&&function;nested? outer-arity)
(if (n.= +0 register)
(#ls;Call (|> (list;n.range +1 (n.dec outer-arity))
- (L/map (|>. &&function;to-local #ls;Variable)))
+ (list/map (|>. &&function;to-local #ls;Variable)))
(#ls;Variable 0))
(#ls;Variable (&&function;adjust-var outer-arity (&&function;to-local register))))
(#ls;Variable (&&function;to-local register)))
(#;Captured register)
(#ls;Variable (let [var (&&function;to-captured register)]
- (default var (d;get var resolver)))))
+ (maybe;default var (dict;get var resolver)))))
(#la;Case inputA branchesA)
(let [inputS (recur +0 resolver num-locals inputA)]
@@ -88,9 +89,9 @@
#ls;ExecP
(#ls;SeqP (&&case;path pattern)))))]
(#ls;Case inputS
- (L/fold &&case;weave
- (transform-branch lastP lastA)
- (L/map (product;uncurry transform-branch) prevsPA))))
+ (list/fold &&case;weave
+ (transform-branch lastP lastA)
+ (list/map (product;uncurry transform-branch) prevsPA))))
_
(undefined)
@@ -99,21 +100,21 @@
(#la;Function scope bodyA)
(let [inner-arity (n.inc outer-arity)
raw-env (&&function;environment scope)
- env (L/map (function [var] (default var (d;get var resolver))) raw-env)
+ env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
env-vars (let [env-size (list;size raw-env)]
(: (List ls;Variable)
(case env-size
+0 (list)
- _ (L/map &&function;to-captured (list;n.range +0 (n.dec env-size))))))
+ _ (list/map &&function;to-captured (list;n.range +0 (n.dec env-size))))))
resolver' (if (&&function;nested? inner-arity)
- (L/fold (function [[from to] resolver']
- (d;put from to resolver'))
- init-resolver
- (list;zip2 env-vars env))
- (L/fold (function [var resolver']
- (d;put var var resolver'))
- init-resolver
- env-vars))]
+ (list/fold (function [[from to] resolver']
+ (dict;put from to resolver'))
+ init-resolver
+ (list;zip2 env-vars env))
+ (list/fold (function [var resolver']
+ (dict;put var var resolver'))
+ init-resolver
+ env-vars))]
(case (recur inner-arity resolver' +0 bodyA)
(#ls;Function arity' env' bodyS')
(let [arity (n.inc arity')]
@@ -125,7 +126,7 @@
(#la;Apply _)
(let [[funcA argsA] (&&function;unfold-apply exprA)
funcS (recur +0 resolver num-locals funcA)
- argsS (L/map (recur +0 resolver num-locals) argsA)]
+ argsS (list/map (recur +0 resolver num-locals) argsA)]
(case funcS
(^multi (#ls;Function _arity _env _bodyS)
(and (n.= _arity (list;size argsS))
@@ -137,11 +138,11 @@
(&&loop;adjust _env register-offset _bodyS)))
(#ls;Call argsS' funcS')
- (#ls;Call (L/append argsS' argsS) funcS')
+ (#ls;Call (list/compose argsS' argsS) funcS')
_
(#ls;Call argsS funcS)))
(#la;Procedure name args)
- (#ls;Procedure name (L/map (recur +0 resolver num-locals) args))
+ (#ls;Procedure name (list/map (recur +0 resolver num-locals) args))
)))
diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux
index 9f4d09a49..ad4504f41 100644
--- a/new-luxc/source/luxc/synthesizer/loop.lux
+++ b/new-luxc/source/luxc/synthesizer/loop.lux
@@ -1,7 +1,8 @@
(;module:
lux
- (lux (data (coll [list "L/" Functor<List>])
- text/format))
+ (lux (data [maybe]
+ text/format
+ (coll [list "L/" Functor<List>])))
(luxc (lang ["ls" synthesis])
(synthesizer ["&&;" function])))
@@ -105,7 +106,7 @@
(let [resolve-captured (: (-> ls;Variable ls;Variable)
(function [var]
(let [idx (|> var (i.* -1) int-to-nat n.dec)]
- (|> env (list;nth idx) assume))))]
+ (|> env (list;nth idx) maybe;assume))))]
(loop [exprS exprS]
(case exprS
(#ls;Variant tag last? valueS)
diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux
index 3a48cb3f2..01ad101fa 100644
--- a/new-luxc/source/luxc/synthesizer/variable.lux
+++ b/new-luxc/source/luxc/synthesizer/variable.lux
@@ -16,7 +16,7 @@
(list (nat-to-int register))
(^or (#ls;SeqP pre post) (#ls;AltP pre post))
- (L/append (bound-vars pre) (bound-vars post))
+ (L/compose (bound-vars pre) (bound-vars post))
_
(list)))
@@ -31,7 +31,7 @@
(path-bodies post)
(#ls;AltP pre post)
- (L/append (path-bodies pre) (path-bodies post))
+ (L/compose (path-bodies pre) (path-bodies post))
_
(list)))
--
cgit v1.2.3