add require type
This commit is contained in:
parent
42ac41ae15
commit
471e1617e8
5 changed files with 169 additions and 21 deletions
|
|
@ -4,6 +4,7 @@
|
||||||
bootstrap inputs [
|
bootstrap inputs [
|
||||||
{
|
{
|
||||||
maybe = ./maybe.nix;
|
maybe = ./maybe.nix;
|
||||||
|
require = ./require.nix;
|
||||||
terminal = ./terminal.nix;
|
terminal = ./terminal.nix;
|
||||||
}
|
}
|
||||||
]
|
]
|
||||||
|
|
|
||||||
44
nt/precursor/bootstrap/naive/require.nix
Normal file
44
nt/precursor/bootstrap/naive/require.nix
Normal file
|
|
@ -0,0 +1,44 @@
|
||||||
|
{...}: let
|
||||||
|
inherit
|
||||||
|
(builtins)
|
||||||
|
attrNames
|
||||||
|
concatStringsSep
|
||||||
|
isAttrs
|
||||||
|
typeOf
|
||||||
|
;
|
||||||
|
in rec {
|
||||||
|
# Naive Require Type
|
||||||
|
Require = pred: let
|
||||||
|
got = typeOf pred;
|
||||||
|
in
|
||||||
|
assert (got == "lambda")
|
||||||
|
|| throw ''
|
||||||
|
Naive type "Require" requires a predicate context of
|
||||||
|
primitive type "lambda"! But got "${got}".
|
||||||
|
''; {
|
||||||
|
_pred = pred;
|
||||||
|
};
|
||||||
|
|
||||||
|
# Type Checking
|
||||||
|
isRequire = T: isAttrs T && attrNames T == ["_pred"];
|
||||||
|
enfIsRequire = T: msg: let
|
||||||
|
throw' = got: throw "${msg}: expected naive type Require but got ${got}";
|
||||||
|
attrs =
|
||||||
|
attrNames T
|
||||||
|
|> map (name: "\"${name}\"")
|
||||||
|
|> concatStringsSep ", ";
|
||||||
|
in
|
||||||
|
if isAttrs T
|
||||||
|
then isRequire T || throw' "attribute set with structure [${attrs}]"
|
||||||
|
else throw' "pred \"${toString T}\" of primitive type \"${typeOf T}\"";
|
||||||
|
|
||||||
|
applyRequire = T: x: let
|
||||||
|
result = T._pred x;
|
||||||
|
got = typeOf result;
|
||||||
|
in
|
||||||
|
assert (got == "bool")
|
||||||
|
|| throw ''
|
||||||
|
Naive type "Require" must return primitive type "bool"!
|
||||||
|
But got "${got}".
|
||||||
|
''; result;
|
||||||
|
}
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
{...}: let
|
{...}: let
|
||||||
inherit
|
inherit
|
||||||
(builtins)
|
(builtins)
|
||||||
all
|
|
||||||
elem
|
elem
|
||||||
elemAt
|
elemAt
|
||||||
foldl'
|
foldl'
|
||||||
|
|
@ -9,7 +8,10 @@
|
||||||
length
|
length
|
||||||
;
|
;
|
||||||
in rec {
|
in rec {
|
||||||
contains = sub: list: all (x: elem x list) sub;
|
# contains = x: list:
|
||||||
|
# list
|
||||||
|
# |> foldl' (state: el: state || el == x) false;
|
||||||
|
contains = elem;
|
||||||
|
|
||||||
sublist = start: count: list: let
|
sublist = start: count: list: let
|
||||||
len = length list;
|
len = length list;
|
||||||
|
|
@ -82,4 +84,13 @@ in rec {
|
||||||
if index == null
|
if index == null
|
||||||
then default
|
then default
|
||||||
else elemAt list index;
|
else elemAt list index;
|
||||||
|
|
||||||
|
unique = list:
|
||||||
|
list
|
||||||
|
|> foldl' (
|
||||||
|
acc: el:
|
||||||
|
if acc |> contains el
|
||||||
|
then acc
|
||||||
|
else acc ++ [el]
|
||||||
|
) [];
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,18 +1,24 @@
|
||||||
{this, ...}: let
|
{this, ...}: let
|
||||||
inherit
|
inherit
|
||||||
(builtins)
|
(builtins)
|
||||||
|
all
|
||||||
|
attrValues
|
||||||
|
concatLists
|
||||||
|
filter
|
||||||
isFunction
|
isFunction
|
||||||
length
|
length
|
||||||
mapAttrs
|
mergeAttrsList
|
||||||
partition
|
partition
|
||||||
|
typeOf
|
||||||
;
|
;
|
||||||
|
|
||||||
inherit
|
inherit
|
||||||
(this)
|
(this)
|
||||||
enfIsType
|
enfIsType
|
||||||
enfIsClassSig
|
enfIsClassSig
|
||||||
|
isClass
|
||||||
|
enfIsTypeSig
|
||||||
ntTrapdoorKey
|
ntTrapdoorKey
|
||||||
parseClassSig
|
|
||||||
typeSig
|
typeSig
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
@ -28,6 +34,7 @@
|
||||||
projectOnto
|
projectOnto
|
||||||
recdef
|
recdef
|
||||||
removeAttrsRec
|
removeAttrsRec
|
||||||
|
unique
|
||||||
;
|
;
|
||||||
|
|
||||||
inherit
|
inherit
|
||||||
|
|
@ -35,11 +42,19 @@
|
||||||
Terminal
|
Terminal
|
||||||
;
|
;
|
||||||
|
|
||||||
|
inherit
|
||||||
|
(this.naive.require)
|
||||||
|
isRequire
|
||||||
|
;
|
||||||
|
|
||||||
classDecl = {
|
classDecl = {
|
||||||
derive = Terminal [];
|
derive = Terminal [];
|
||||||
ops = Terminal {};
|
ops = Terminal {};
|
||||||
};
|
};
|
||||||
|
|
||||||
|
# XXX: i think this works?
|
||||||
|
typeDecl = classDecl;
|
||||||
|
|
||||||
unwrapBuilder = builder: Self:
|
unwrapBuilder = builder: Self:
|
||||||
if isFunction builder
|
if isFunction builder
|
||||||
then builder Self
|
then builder Self
|
||||||
|
|
@ -56,33 +71,87 @@
|
||||||
# ELSE IF IT IS SPECIFIED BY NAMESPACE
|
# ELSE IF IT IS SPECIFIED BY NAMESPACE
|
||||||
# THEN add it to a list of all invalid ops (errors)
|
# THEN add it to a list of all invalid ops (errors)
|
||||||
# ELSE add it to a list of ops belonging solely to self
|
# ELSE add it to a list of ops belonging solely to self
|
||||||
parseOps = ops: req: let
|
parseOps = decl: let
|
||||||
|
opsFormatted = assert (
|
||||||
|
decl.ops
|
||||||
|
|> attrValues
|
||||||
|
|> all isFunction
|
||||||
|
)
|
||||||
|
|| throw ''
|
||||||
|
Typeclass opts must be specified as an attrset of functions.
|
||||||
|
Either clarify the deriving class by partial name (ie `MyClass.myOp = ...`)
|
||||||
|
or by complete type signature (ie `$${typeSig MyClass}.myOp = ...`).
|
||||||
|
'';
|
||||||
|
decl.ops
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
# XXX: WARNING: TODO: this code is unfinished!!!!
|
||||||
|
|> partition (x: true); # i forgor, TODO: rember :(
|
||||||
|
|
||||||
|
# NOTE: reqDerived can/will contain duplicates
|
||||||
|
# NOTE: it's wasteful to filter uniques now, just wait
|
||||||
|
reqDerived =
|
||||||
|
decl.derive
|
||||||
|
|> map (x: x.req)
|
||||||
|
|> mergeAttrsList;
|
||||||
|
|
||||||
|
reqSelf =
|
||||||
|
decl.ops
|
||||||
|
|> filter isRequire;
|
||||||
|
|
||||||
reqPaths =
|
reqPaths =
|
||||||
req
|
(reqDerived ++ reqSelf)
|
||||||
|> mapAttrs (name: let
|
|> unique # XXX: now we filter uniques
|
||||||
segs = parseClassSig name;
|
|> 3;
|
||||||
in
|
|
||||||
value: segs ++ [value]);
|
# reqPaths =
|
||||||
|
# decl.req
|
||||||
|
# |> mapAttrs (name: let
|
||||||
|
# segs = parseClassSig name;
|
||||||
|
# in
|
||||||
|
# value: segs ++ [value]);
|
||||||
|
|
||||||
# XXX: TODO: having to specify the full namespace sucks :(
|
# XXX: TODO: having to specify the full namespace sucks :(
|
||||||
|
|
||||||
matches = partition (flip hasAttrAt ops) reqPaths;
|
matches = partition (flip hasAttrAt decl.ops) reqPaths;
|
||||||
|
|
||||||
pathsMissing = matches.wrong;
|
pathsMissing = matches.wrong;
|
||||||
opsSelf = removeAttrsRec matches.right ops;
|
opsSelf = removeAttrsRec matches.right decl.ops;
|
||||||
opsDerived = removeAttrsRec matches.wrong ops;
|
opsDerived = removeAttrsRec matches.wrong decl.ops;
|
||||||
in {
|
in {
|
||||||
inherit opsSelf opsDerived pathsMissing;
|
inherit opsSelf opsDerived pathsMissing;
|
||||||
success = length pathsMissing == 0;
|
success = length pathsMissing == 0;
|
||||||
};
|
};
|
||||||
|
|
||||||
mkClass = sig: decl:
|
mkClass = sig: decl:
|
||||||
assert enfIsClassSig sig "mkClass"; let
|
assert enfIsClassSig sig "mkClass";
|
||||||
|
assert decl.derive
|
||||||
|
|> all (x:
|
||||||
|
isClass x
|
||||||
|
|| throw ''
|
||||||
|
NixTypes can only derive from NixType classes!
|
||||||
|
However, ${sig} derives from invalid ${x} (type: ${typeOf x}).
|
||||||
|
''); let
|
||||||
|
# XXX: TODO: enforce that every derive is a class!
|
||||||
allDerivedClasses =
|
allDerivedClasses =
|
||||||
decl.derive
|
decl.derive
|
||||||
|> map (class: typeSig class ++ class.${ntTrapdoorKey}.derive);
|
|> map (class: [typeSig class] ++ class.${ntTrapdoorKey}.derive)
|
||||||
|
|> concatLists;
|
||||||
|
|
||||||
parseResult = parseOps decl.ops decl.req;
|
parseResult = parseOps decl;
|
||||||
inherit
|
inherit
|
||||||
(parseResult)
|
(parseResult)
|
||||||
opsSelf
|
opsSelf
|
||||||
|
|
@ -98,15 +167,38 @@
|
||||||
${ntTrapdoorKey} = {
|
${ntTrapdoorKey} = {
|
||||||
inherit sig;
|
inherit sig;
|
||||||
derive = allDerivedClasses;
|
derive = allDerivedClasses;
|
||||||
ops = {${sig} = opsSelf;} // opsDerived;
|
ops = opsDerived // {${sig} = opsSelf;};
|
||||||
req = null; # XXX: TODO make it more advanced
|
req = null;
|
||||||
};
|
};
|
||||||
};
|
};
|
||||||
};
|
};
|
||||||
|
|
||||||
|
mkType = sig: decl:
|
||||||
|
assert enfIsTypeSig sig "mkType"; let
|
||||||
|
allDerivedClasses =
|
||||||
|
decl.derive
|
||||||
|
|> map (class: typeSig class ++ class.${ntTrapdoorKey}.derive);
|
||||||
|
|
||||||
|
parseResult = parseOps decl;
|
||||||
|
inherit
|
||||||
|
(parseResult)
|
||||||
|
opsSelf
|
||||||
|
opsDerived
|
||||||
|
;
|
||||||
|
in
|
||||||
|
# XXX: WARNING: classes currently *shouldn't* be able to inherit ops (i think?)
|
||||||
|
assert parseResult.success || throw "TODO";
|
||||||
|
opsSelf.mk;
|
||||||
in {
|
in {
|
||||||
Class = sig: builder:
|
Class = sig: builder:
|
||||||
recdef (Self:
|
recdef (Self:
|
||||||
unwrapBuilder builder Self
|
unwrapBuilder builder Self
|
||||||
|> parseDecl classDecl
|
|> parseDecl classDecl
|
||||||
|> mkClass sig);
|
|> mkClass sig);
|
||||||
|
|
||||||
|
Type = sig: builder:
|
||||||
|
recdef (Self:
|
||||||
|
unwrapBuilder builder Self
|
||||||
|
|> parseDecl typeDecl
|
||||||
|
|> mkType sig);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -28,6 +28,7 @@
|
||||||
(this.naive.maybe)
|
(this.naive.maybe)
|
||||||
bindMaybe
|
bindMaybe
|
||||||
isSome
|
isSome
|
||||||
|
Some
|
||||||
;
|
;
|
||||||
in rec {
|
in rec {
|
||||||
parseSig = sig: let
|
parseSig = sig: let
|
||||||
|
|
@ -69,12 +70,11 @@ in rec {
|
||||||
typeSig = T:
|
typeSig = T:
|
||||||
assert enfIsNT T "nt.typeSig";
|
assert enfIsNT T "nt.typeSig";
|
||||||
openNT T
|
openNT T
|
||||||
|> bindMaybe (getAttr "sig")
|
|> bindMaybe (getAttr "sig");
|
||||||
|> isSome;
|
|
||||||
|
|
||||||
toTypeSig = x:
|
toTypeSig = x:
|
||||||
if isString x
|
if isString x
|
||||||
then x
|
then Some x
|
||||||
else typeSig x;
|
else typeSig x;
|
||||||
|
|
||||||
# NOTE: we're testing how similar `list` is to `toTypeSig type` (non-commutative)
|
# NOTE: we're testing how similar `list` is to `toTypeSig type` (non-commutative)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue