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 [
|
||||
{
|
||||
maybe = ./maybe.nix;
|
||||
require = ./require.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
|
||||
inherit
|
||||
(builtins)
|
||||
all
|
||||
elem
|
||||
elemAt
|
||||
foldl'
|
||||
|
|
@ -9,7 +8,10 @@
|
|||
length
|
||||
;
|
||||
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
|
||||
len = length list;
|
||||
|
|
@ -82,4 +84,13 @@ in rec {
|
|||
if index == null
|
||||
then default
|
||||
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
|
||||
inherit
|
||||
(builtins)
|
||||
all
|
||||
attrValues
|
||||
concatLists
|
||||
filter
|
||||
isFunction
|
||||
length
|
||||
mapAttrs
|
||||
mergeAttrsList
|
||||
partition
|
||||
typeOf
|
||||
;
|
||||
|
||||
inherit
|
||||
(this)
|
||||
enfIsType
|
||||
enfIsClassSig
|
||||
isClass
|
||||
enfIsTypeSig
|
||||
ntTrapdoorKey
|
||||
parseClassSig
|
||||
typeSig
|
||||
;
|
||||
|
||||
|
|
@ -28,6 +34,7 @@
|
|||
projectOnto
|
||||
recdef
|
||||
removeAttrsRec
|
||||
unique
|
||||
;
|
||||
|
||||
inherit
|
||||
|
|
@ -35,11 +42,19 @@
|
|||
Terminal
|
||||
;
|
||||
|
||||
inherit
|
||||
(this.naive.require)
|
||||
isRequire
|
||||
;
|
||||
|
||||
classDecl = {
|
||||
derive = Terminal [];
|
||||
ops = Terminal {};
|
||||
};
|
||||
|
||||
# XXX: i think this works?
|
||||
typeDecl = classDecl;
|
||||
|
||||
unwrapBuilder = builder: Self:
|
||||
if isFunction builder
|
||||
then builder Self
|
||||
|
|
@ -56,33 +71,87 @@
|
|||
# ELSE IF IT IS SPECIFIED BY NAMESPACE
|
||||
# THEN add it to a list of all invalid ops (errors)
|
||||
# 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 =
|
||||
req
|
||||
|> mapAttrs (name: let
|
||||
segs = parseClassSig name;
|
||||
in
|
||||
value: segs ++ [value]);
|
||||
(reqDerived ++ reqSelf)
|
||||
|> unique # XXX: now we filter uniques
|
||||
|> 3;
|
||||
|
||||
# reqPaths =
|
||||
# decl.req
|
||||
# |> mapAttrs (name: let
|
||||
# segs = parseClassSig name;
|
||||
# in
|
||||
# value: segs ++ [value]);
|
||||
|
||||
# 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;
|
||||
opsSelf = removeAttrsRec matches.right ops;
|
||||
opsDerived = removeAttrsRec matches.wrong ops;
|
||||
opsSelf = removeAttrsRec matches.right decl.ops;
|
||||
opsDerived = removeAttrsRec matches.wrong decl.ops;
|
||||
in {
|
||||
inherit opsSelf opsDerived pathsMissing;
|
||||
success = length pathsMissing == 0;
|
||||
};
|
||||
|
||||
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 =
|
||||
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
|
||||
(parseResult)
|
||||
opsSelf
|
||||
|
|
@ -98,15 +167,38 @@
|
|||
${ntTrapdoorKey} = {
|
||||
inherit sig;
|
||||
derive = allDerivedClasses;
|
||||
ops = {${sig} = opsSelf;} // opsDerived;
|
||||
req = null; # XXX: TODO make it more advanced
|
||||
ops = opsDerived // {${sig} = opsSelf;};
|
||||
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 {
|
||||
Class = sig: builder:
|
||||
recdef (Self:
|
||||
unwrapBuilder builder Self
|
||||
|> parseDecl classDecl
|
||||
|> mkClass sig);
|
||||
|
||||
Type = sig: builder:
|
||||
recdef (Self:
|
||||
unwrapBuilder builder Self
|
||||
|> parseDecl typeDecl
|
||||
|> mkType sig);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@
|
|||
(this.naive.maybe)
|
||||
bindMaybe
|
||||
isSome
|
||||
Some
|
||||
;
|
||||
in rec {
|
||||
parseSig = sig: let
|
||||
|
|
@ -69,12 +70,11 @@ in rec {
|
|||
typeSig = T:
|
||||
assert enfIsNT T "nt.typeSig";
|
||||
openNT T
|
||||
|> bindMaybe (getAttr "sig")
|
||||
|> isSome;
|
||||
|> bindMaybe (getAttr "sig");
|
||||
|
||||
toTypeSig = x:
|
||||
if isString x
|
||||
then x
|
||||
then Some x
|
||||
else typeSig x;
|
||||
|
||||
# NOTE: we're testing how similar `list` is to `toTypeSig type` (non-commutative)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue