Last active
December 20, 2021 07:20
-
-
Save MonoidMusician/edaf572a1dac7f44635f36e4b1b46ef6 to your computer and use it in GitHub Desktop.
Sketches for Dhall-standard-as-data in Python using a type system à la PureScript
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Syntax for a metalanguage for writing programming language standards/specifications with an eye towards codegen | |
# The data format is very simple: data is either a string or a tuple of data. | |
# The idea is that we'll impose some simple types on top of this: | |
# Obviously strings, and arrays, possibly associative lists, and then mixed ADTs/enums, which are either plain strings or arrays where the first item is the tag denoting the constructor. | |
# I don't have the types figured out yet. | |
# Variable names | |
variable-name = [_A-Za-z][-_A-Za-z0-9]* | |
# A variable can have periods, but they don't mean anything | |
variable = variable-name ("." variable-name)* | |
# String literal | |
# this needs escaping and stuff obviously | |
string-literal = '"' character '"' | "'" character "'" | |
character = [.] | |
# A pattern can match a variable name and/or a semi-literal | |
pattern = variable | semi-literal | variable "@" semi-literal | |
# A semi-literal is a string literal or a list of patterns (separated by space, since a pattern has well-defined extent) | |
semi-literal = string-literal | "[" patterns "]" | |
patterns = pattern+ | |
# A simple expression is an expression that has well-defined extent: we know when it ends, so a list of them can be separated by whitespace | |
simple-expression | |
= pattern | |
| variable | |
| "%" lambda-body "!" | |
| "(" expression ")" | |
simple-expressions = simple-expression+ | |
# An expression can be a simple expression or a lambda with no ending … idk | |
expression | |
= simple-expression | |
| "%" lambda-body | |
# A lambda consists of many cases separated by vertical bars, see below | |
lambda-body = "|"? case ("|" case)* "|"? | |
# A switch expression is just syntactic sugar for calling a lambda with arguments | |
switch = "?" calling lambda-body "!" | |
# Top-level functions are defined using slash-separated paths for each case, and the trailing slash is required so we know it is a definition | |
path = variable-name ("/" variable-name)* "/" | |
top-case = path case | |
# Match means specifying patterns and then the return expression | |
matching = patterns "=>" simple-expression | |
# A case consists of matching followed by conditions, which are the body of the function, the commands to execute to reach the result (which was already specified in matching) | |
case = matching (";" | ":"? conditions) | |
# A condition consists of calling a function with arguments and matching on the result | |
condition = simple-expression calling | |
conditions = condition* | |
# Each time we call a function we get to match on its result | |
calling = simple-expressions "=>" pattern | |
# Notes | |
# Typechecking lambdas is tricky, but it works out because we want main functions (which have type information) to be at head: if a lambda is being applied immediately that is a case expression, if it is being returned then also know its type again | |
# Oh wait, I guess polymorphism jinxes that: identity function will not work to determine the type of its argument and result | |
# If we only case-match on variables (partial evaluate to get there) then we have a simpler time with type inference: we can't guess the type of literals, but every variable should have a type | |
# We can have an untyped local macro thingy too, but it shouldn't be necessary | |
# We can elaborate to desugar typeclasses during typechecking | |
# Not sure how matching is going to work: ideally I want nested matches to use the specified equality | |
# Need to think about effects … hmm how do languages with first-class effects make functions functors? functions aren't traversable so it seems like they couldn't even support `map` in a language where all functions come with effects | |
# Main use for first-class effects: want to write a meta-function `ensure` that acts to force unification, it will take basically a raw pattern match and then be elaborated to unify with that constructor (it must be a single constructor) … `ensure :: (Expr -[Maybe, …]> o) -> (Expr -[…]> o)` | |
# are there languages with first-class patterns? what does that look like? I have a function that basically wants to take a pattern, thinking about how to make unification appear ergonomic |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
reference-equality :: m.a -> m.a -> m.a | |
reference-equality/ o o => o | |
syntactic-equality :: Expr -> Expr -> Expr | |
syntactic-equality/reference-equality/ l r => o | |
reference-equality l r => o | |
syntactic-equality/ l r => o | |
traverseRTogether % [x y] => z | |
syntactic-equality x y => z ! l r => ['Some' o] | |
judgmental-equality :: Expr -> Expr -> Expr | |
judgmental-equality/reference-equality/ l r => o | |
reference-equality l r => o | |
judgmental-equality/ l r => o | |
alpha-beta-normalize l => x | |
alpha-beta-normalize r => y | |
syntactic-equality x y => o | |
constant :: Text -> Expr -> Expr | |
constant/ v e => r | |
shift '-1' v '0' e => r | |
shift-nat :: Integer -> Natural -> Natural | |
le :: Natural -> Natural -> Bool | |
if-eq-suc :: Text -> Text -> Natural -> Natural | |
if-eq-suc/eq/ v v m => m1 | |
suc m => m1 | |
if-eq-suc/neq/ _ _ m => m | |
shift :: Integer -> Text -> Natural -> Expr -> Expr | |
shift/Variable/ d v m e@['Variable' v n] => ['Variable' v nd] | |
le m n => 'True' | |
ensure-shift-nat d n => nd | |
shift/Lambda/ d v m e@['Lambda' u A0 b0] => ['Lambda' u A1 b1] | |
if-eq-suc v u m => m1 | |
shift d v m A0 => A1 | |
shift d v m1 b0 => b1 | |
shift/Forall/ d v m e@['Forall' u A0 B0] => ['Forall' u A1 B1] | |
if-eq-suc v u m => m1 | |
shift d v m A0 => A1 | |
shift d v m1 B0 => B1 | |
shift/Let/ d v m e@['Let' u mA0 a0 b0] => ['Let' u mA1 a0 b1] | |
if-eq-suc v u m => m1 | |
traverse mA0 % A0 => A1 | |
shift d v m A0 => A1 ! => mA1 | |
shift d v m a0 => a1 | |
shift d v m1 b0 => b1 | |
shift/Application/ d v m ['Application' f0 a0] => ['Application' f1 a1] | |
shift d v m f0 => f1 | |
shift d v m a0 => a1 | |
shift/Type/ d v m 'Type' => 'Type' | |
shift/Variable/ _ _ _ v@['Variable' _ _] => v | |
shift/ d v m e1 => e2 | |
traverseR e1 % se1 => se2 | |
shift d v m se1 => se2 ! => e2 | |
substitute :: Text -> Natural -> Expr -> Expr -> Expr | |
substitute/Variable-match/ v m r ['Variable' v m] => r | |
substitute/Lambda/ v m r ['Lambda' u A0 b0] => ['Lambda' u A1 b1] | |
if-eq-suc v u m => m1 | |
substitute v m r A0 => A1 | |
shift '1' u '0' r => r1 | |
substitute v m1 r1 b0 => b1 | |
substitute/Forall/ v m r ['Forall' u A0 B0] => ['Forall' u A1 B1] | |
if-eq-suc v u m => m1 | |
substitute v m r A0 => A1 | |
shift '1' u '0' r => r1 | |
substitute v m r1 B0 => B1 | |
substitute/Let/ v m r ['Let' v mA0 a0 b0] => ['Lambda' v A1 b1] | |
if-eq-suc v u m => m1 | |
substitute v m r A0 => A1 | |
shift '1' v '0' r => r1 | |
substitute v m1 r1 b0 => b1 | |
substitute/ v m r e1 => e2 | |
traverseR e1 % se1 => se2 | |
substitute v m r se1 => se2 ! => e2 | |
shift-substitute-shift :: Text -> Expr -> Expr -> Expr | |
shift-substitute-shift/ v r0 e0 => e2 | |
shift '1' v '0' r0 => r1 | |
substitute v '0' r1 e0 => e1 | |
shift '-1' v '0' e1 => e2 | |
rename-immediate :: Text -> Text -> Expr -> Expr | |
rename-immediate/noop/ v v e => e | |
rename-immediate/ v u e0 => e1 | |
shift-substitute-shift v ['Variable' u '0'] e0 => e1 | |
alpha-normalize :: Expr -> Expr | |
alpha-normalize/Lambda/ ['Lambda' v A0 b0] => ['Lambda' '_' A1 b2] | |
alpha-normalize A0 => A1 | |
rename-immediate v '_' b0 => b1 | |
alpha-normalize b1 => b2 | |
alpha-normalize/Forall/ ['Forall' v A0 B0] => ['Forall' '_' A1 B2] | |
alpha-normalize A0 => A1 | |
rename-immediate v '_' B0 => B1 | |
alpha-normalize B1 => B2 | |
alpha-normalize/Let/ ['Let' v mA0 a0 b0] => ['Let' '_' mA1 a1 b2] | |
traverse mA0 % A0 => A1 | |
alpha-normalize A0 => A1 ! => mA1 | |
alpha-normalize a0 => a1 | |
rename-immediate v '_' b0 => b1 | |
alpha-normalize b1 => b2 | |
alpha-normalize/ e0 => e1 | |
traverseR e0 % se0 => se1 | |
alpha-normalize se0 => se1 ! => e1 | |
beta-normalize :: Expr -> Expr | |
beta-normalize/Bool/if_then_else_/ ['if_then_else_' ['BoolLit' b] l r] => o | |
builtin/if_then_else_ b l r => o | |
beta-normalize/Bool/if_then_else_/identity/ ['if_then_else_' b ['BoolLit' 'true'] ['BoolLit' 'false']] => b | |
beta-normalize/Bool/if_then_else_/constant/ ['if_then_else_' _ e e] => e | |
beta-normalize/Bool/||/L-absorb/ ['||' l@['BoolLit' 'True'] _] => l | |
beta-normalize/Bool/||/L-identity/ ['||' _@['BoolLit' 'False'] r] => r | |
beta-normalize/Bool/||/ ['||' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/|| l r => o | |
beta-normalize/Bool/||/R-absorb/ ['||' _ r@['BoolLit' 'True']] => r | |
beta-normalize/Bool/||/R-identity/ ['||' l _@['BoolLit' 'False']] => l | |
beta-normalize/Bool/||/idempotence/ ['||' e e] => e | |
beta-normalize/Bool/&&/L-absorb/ ['&&' l@['BoolLit' 'False'] _] => l | |
beta-normalize/Bool/&&/L-identity/ ['&&' _@['BoolLit' 'True'] r] => r | |
beta-normalize/Bool/&&/ ['&&' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/&& l r => o | |
beta-normalize/Bool/&&/R-absorb/ ['&&' _ r@['BoolLit' 'False']] => r | |
beta-normalize/Bool/&&/R-identity/ ['&&' l _@['BoolLit' 'True']] => l | |
beta-normalize/Bool/&&/idempotence/ ['&&' e e] => e | |
beta-normalize/Bool/==/L-identity/ ['==' _@['BoolLit' 'True'] r] => r | |
beta-normalize/Bool/==/ ['==' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/== l r => o | |
beta-normalize/Bool/==/R-identity/ ['==' l _@['BoolLit' 'True']] => l | |
beta-normalize/Bool/==/idempotence/ ['==' e e] => e | |
beta-normalize/Bool/!=/L-identity/ ['!=' _@['BoolLit' 'False'] r] => r | |
beta-normalize/Bool/!=/ ['!=' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/!= l r => o | |
beta-normalize/Bool/!=/R-identity/ ['!=' l _@['BoolLit' 'False']] => l | |
beta-normalize/Bool/!=/idempotence/ ['!=' e e] => e | |
beta-normalize/Natural/build/ ['Application' 'Natural/build' g] => b | |
identity ['Lambda' 'x' 'Natural' ['+' ['Variable' 'x' '0'] ['NaturalLit' '1']]] => succ | |
identity ['NaturalLit' '0'] => zero | |
beta-normalize ['Application' g 'Natural' succ zero] => b | |
beta-normalize/Natural/fold/ ['Application' 'Natural/fold' ['NaturalLit' n] B g b] => r | |
fold-natural n b % r0 => ['Application' g r0] ! => r | |
beta-normalize/Natural/*/L-absorb/ ['*' l@['NaturalLit' '0'] _] => l | |
beta-normalize/Natural/*/L-identity/ ['*' _@['NaturalLit' '1'] r] => r | |
beta-normalize/Natural/*/ ['*' ['NaturalLit' l] ['NaturalLit' r]] => ['NaturalLit' o] | |
builtin/* l r => o | |
beta-normalize/Natural/*/R-absorb/ ['*' r@['NaturalLit' '0'] _] => r | |
beta-normalize/Natural/*/R-identity/ ['*' l _@['NaturalLit' '1']] => l | |
beta-normalize/Natural/+/L-identity/ ['+' _@['NaturalLit' '0'] r] => r | |
beta-normalize/Natural/+/ ['+' ['NaturalLit' l] ['NaturalLit' r]] => ['NaturalLit' o] | |
builtin/+ l r => o | |
beta-normalize/Natural/+/R-identity/ ['+' l _@['NaturalLit' '0']] => l | |
beta-normalize/Natural/isZero/ ['Application' 'Natural/isZero' ['NaturalLit' n]] => ['BoolLit' o] | |
builtin/Natural/isZero n => o | |
beta-normalize/Natural/even/ ['Application' 'Natural/even' ['NaturalLit' n]] => ['BoolLit' o] | |
builtin/Natural/even n => o | |
beta-normalize/Natural/odd/ ['Application' 'Natural/odd' ['NaturalLit' n]] => ['BoolLit' o] | |
builtin/Natural/odd n => o | |
beta-normalize/Natural/toInteger/ ['Application' 'Natural/toInteger' ['NaturalLit' n]] => ['IntegerLit' o] | |
builtin/Natural/toInteger n => o | |
beta-normalize/Natural/show/ ['Application' 'Natural/show' ['NaturalLit' n]] => ['TextLit' o] | |
builtin/Natural/show n => o | |
beta-normalize/Natural/subtract/L-zero/ ['Application' 'Natural/subtract' ['NaturalLit' '0'] n] => n | |
beta-normalize/Natural/subtract/R-zero/ ['Application' 'Natural/subtract' _ l@['NaturalLit' '0']] => l | |
beta-normalize/Natural/subtract/equal/ ['Application' 'Natural/subtract' n n] => ['NaturalLit' '0'] | |
beta-normalize/Natural/subtract/ ['Application' 'Natural/subtract' ['NaturalLit' m] ['NaturalLit' n]] => ['NaturalLit' o] | |
builtin/Natural/subtract m n => o | |
beta-normalize/List/build/ ['Application' 'List/build' A0 g] => b | |
shift '1' 'a' '0' A0 => A1 | |
identity ['Lambda' 'a' A0 ['Lambda' 'as' ['Application' 'List' A1] ['#' ['ListLit' [['Variable' 'a' '0']] 'None'] ['Variable' 'as' '0']]]] => succ | |
identity ['ListLit' [] ['Some' ['Application' 'List' A0]]] => zero | |
beta-normalize ['Application' g ['Application' 'List' A0] succ zero] => b | |
beta-normalize/List/fold/ ['Application' 'List/fold' A0 ['ListLit' l _] B g b] => r | |
fold-list l b % a0 r0 => ['Application' g a0 r0] ! => r | |
beta-normalize/List/#/L-identity/ ['#' ['ListLit' [] _] r] => r | |
beta-normalize/List/#/R-identity/ ['#' l ['ListLit' [] _]] => l | |
beta-normalize/List/#/ ['#' ['ListLit' ls 'None'] ['ListLit' rs 'None']] => ['ListLit' lrs []] | |
builtin/List/# ls rs => lrs | |
beta-normalize/Record/Field/ ['Field' ['RecordLit' kvs] k] => v | |
find kvs k => v | |
beta-normalize/Record/Field/Project/ ['Field' ['Project' rec ks] k] => ['Field' rec k] | |
beta-normalize/Record/Field/Prefer/L-yes/ ['Field' ['Prefer' ['RecordLit' kvs] r] k] => v | |
find kvs k => v | |
beta-normalize/Record/Field/Prefer/L-no/ ['Field' ['Prefer' ['RecordLit' kvs] r] k] => ['Field' r k] | |
beta-normalize/Record/Field/Prefer/R-yes/ ['Field' ['Prefer' l ['RecordLit' kvs]] k] => v | |
find kvs k => v | |
beta-normalize/Record/Field/Prefer/R-no/ ['Field' ['Prefer' l ['RecordLit' kvs]] k] => ['Field' l k] | |
beta-normalize/Record/Field/Combine/L-yes/ ['Field' ['Combine' ['RecordLit' kvs] r] k] => ['Field' ['Combine' ['RecordLit' [[k v]]] r] k] | |
find kvs k => v | |
beta-normalize/Record/Field/Combine/L-no/ ['Field' ['Combine' ['RecordLit' kvs] r] k] => ['Field' r k] | |
beta-normalize/Record/Field/Combine/R-yes/ ['Field' ['Combine' l ['RecordLit' kvs]] k] => ['Field' ['Combine' l ['RecordLit' [[k v]]]] k] | |
find kvs k => v | |
beta-normalize/Record/Field/Combine/R-no/ ['Field' ['Combine' l ['RecordLit' kvs]] k] => ['Field' l k] | |
beta-normalize/Record/Project/empty/ ['Project' rec ['ByLabels' []]] => ['RecordLit' []] | |
beta-normalize/Record/Project/ ['Project' ['RecordLit' kvs0] ['ByLabels' ks]] => ['RecordLit' kvs1] | |
select kvs0 ks => kvs1 | |
beta-normalize/Record/Project/Project/ ['Project' ['Project' rec _] ['ByLabels' ks]] => ['Project' rec ['ByLabels' ks]] | |
beta-normalize/Record/Project/Prefer/ ['Project' ['Prefer' l ['RecordLit' kvs]] ['ByLabels' ks]] => ['Prefer' ['Project' l ['ByFields' lks]] ['Project' r ['ByFields' rks]]] | |
separate kvs ks lks => rks | |
beta-normalize/Record/Project/Record/ ['Project' rec ['ByType' ['RecordType' kvs]]] => ['Project' rec ['ByFields' ks]] | |
void kvs => ks | |
beta-normalize/Application/ ['Application' ['Lambda' v _ b] a] => r | |
shift-substitute-shift v a b => r | |
beta-normalize/Let/ ['Let' v _ a b] => r | |
shift-substitute-shift v a b => r | |
beta-normalize/Annotation/ ['Annotation' v _] => v | |
eta-normalize :: Expr -> Expr | |
eta-normalize/ ['Lambda' v t ['Application' f ['Variable' v '0']]] => o | |
constant v f => o | |
typecheck :: Context Expr -> Expr -> Expr | |
typecheck/Variable/ ctx ['Variable' x n] => T | |
find-ctx ctx x n => T | |
typecheck/Bool/ ctx 'Bool' => 'Type' | |
typecheck/BoolLit/ ctx ['BoolLit' _] => 'Bool' | |
typecheck/if_then_else_/ ctx ['if_then_else_' b l r] => T | |
typecheck ctx b => 'Bool' | |
typecheck ctx l => T | |
typecheck ctx r => T | |
typecheck/||/ ctx ['||' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/&&/ ctx ['&&' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/==/ ctx ['==' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/!=/ ctx ['!=' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/Natural/ ctx 'Natural' => 'Type' | |
typecheck/NaturalLit/ ctx ['NaturalLit' _] => 'Natural' | |
typecheck/+/ ctx ['+' l r] => 'Natural' | |
typecheck ctx l => 'Natural' | |
typecheck ctx r => 'Natural' | |
typecheck/*/ ctx ['*' l r] => 'Natural' | |
typecheck ctx l => 'Natural' | |
typecheck ctx r => 'Natural' | |
typecheck/Natural/build/ ctx 'Natural/build' => ['Forall' '_' ['Forall' 'natural' 'Type' ['Forall' 'succ' ['Forall' '_' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']] ['Forall' 'zero' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']]]] 'Natural'] | |
typecheck/Natural/fold/ ctx 'Natural/fold' => ['Forall' '_' 'Natural' ['Forall' 'natural' 'Type' ['Forall' 'succ' ['Forall' '_' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']] ['Forall' 'zero' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']]]]] | |
typecheck/Natural/isZero/ ctx 'Natural/isZero' => ['Forall' '_' 'Natural' 'Bool'] | |
typecheck/Natural/even/ ctx 'Natural/even' => ['Forall' '_' 'Natural' 'Bool'] | |
typecheck/Natural/odd/ ctx 'Natural/odd' => ['Forall' '_' 'Natural' 'Bool'] | |
typecheck/Natural/toInteger/ ctx 'Natural/toInteger' => ['Forall' '_' 'Natural' 'Integer'] | |
typecheck/Natural/show/ ctx 'Natural/show' => ['Forall' '_' 'Natural' 'Text'] | |
typecheck/Natural/subtract/ ctx 'Natural/subtract' => ['Forall' '_' 'Natural' ['Forall' '_' 'Natural' 'Natural']] | |
typecheck/Text/ ctx 'Text' => 'Type' | |
typecheck/TextLiteral/ ctx ['TextLiteral' txt] => 'Text' | |
traverse_ % t => [] | |
typecheck ctx t => 'Text' ! txt => [] | |
typecheck/Text/show/ ctx 'Text/show' => ['Forall' '_' 'Text' 'Text'] | |
typecheck/Text/replace/ ctx 'Text/replace' => ['Forall' 'needle' 'Text' ['Forall' 'replacement' 'Text' ['Forall' 'haystack' 'Text' 'Text']]] | |
typecheck/Text/++/ ctx ['++' l r] => 'Text' | |
typecheck ctx l => 'Text' | |
typecheck ctx r => 'Text' | |
typecheck/Date/ ctx 'Date' => 'Type' | |
typecheck/Time/ ctx 'Time' => 'Type' | |
typecheck/TimeZone/ ctx 'TimeZone' => 'Type' | |
typecheck/Date/ ctx ['DateLiteral' _] => 'Date' | |
typecheck/Time/ ctx ['TimeLiteral' _] => 'Time' | |
typecheck/TimeZone/ ctx ['TimeZoneLiteral' _] => 'TimeZone' | |
typecheck/List/ ctx 'List' => ['Forall' '_' 'Type' 'Type'] | |
typecheck/List/#/ ctx ['#' l r] => ['Application' 'List' T] | |
typecheck ctx l => ['Application' 'List' T] | |
typecheck ctx r => ['Application' 'List' T] | |
typecheck/RecordLit/ ctx ['RecordLit' kvs] => kts | |
ensureNodupes kvs => [] | |
traverse typecheck kvs => kts | |
typecheck/Field/ ctx ['Field' expr field] => fieldType | |
typecheck expr => ty | |
? ty => fieldType | |
| ['Record' kts] => fieldType | |
find kts field => fieldType | |
| ['Const' c] => fieldType | |
? expr => fieldType | |
| ['Union' kts] => fieldType | |
find kts field => mt | |
? mt => fieldType | |
| ['Some' ty] => ['Pi' field ty result] | |
shift field '1' expr => result | |
| 'None' => expr | |
! | |
! | |
! | |
typecheck/Integer/ ctx 'Integer' => 'Type' | |
typecheck/IntegerLit/ ctx ['IntegerLit' _] => 'Integer' | |
typecheck/Integer/show/ ctx 'Integer/show' => ['Forall' '_' 'Integer' 'Text'] | |
typecheck/Integer/toDouble/ ctx 'Integer/toDouble' => ['Forall' '_' 'Integer' 'Double'] | |
typecheck/Integer/negate/ ctx 'Integer/negate' => ['Forall' '_' 'Integer' 'Integer'] | |
typecheck/Integer/clamp/ ctx 'Integer/clamp' => ['Forall' '_' 'Integer' 'Natural'] | |
typecheck/Double/ ctx 'Double' => 'Type' | |
typecheck/DoubleLit/ ctx ['DoubleLit' _] => 'Double' | |
typecheck/Double/show/ ctx 'Double/show' => ['Forall' '_' 'Double' 'Text'] | |
typecheck/Forall/ ctx ['Forall' x A B] => ['Const' c] | |
typecheck ctx A => ['Const' i] | |
add-ctx x A ctx => ctx1 | |
typecheck ctx1 B => ['Const' o] | |
imax i o => c | |
typecheck/Lambda/ ctx ['Lambda' x A b] => ['Forall' x A B] | |
typecheck ctx A => ['Const' _] | |
add-ctx x A ctx => ctx1 | |
typecheck ctx1 b => B | |
typecheck/Application/ ctx ['Application' f a] => ['Application' ['Lambda' x A B] a] | |
typecheck ctx f => ['Forall' x A B] | |
typecheck ctx a => A | |
typecheck/Let/ ctx ['Let' x mA a b] => B | |
typecheck ctx a => A | |
traverse_ % A => [] ! mA => [] | |
shift-substitute-shift x a b => b1 | |
typecheck ctx b1 => B | |
typecheck/Annot/ ctx ['Annot' a A] => A | |
typecheck ctx a => A | |
typecheck/Assert/ ctx ['Assert' T] => ['Equivalent' x x] | |
typecheck ctx T => 'Type' | |
beta-normalize T => ['Equivalent' x x] | |
typecheck/Equivalent/ ctx ['Equivalent' x y] => 'Type' | |
typecheck ctx x => A | |
typecheck ctx y => A | |
typecheck ctx A => 'Type' | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
reference-equality :: m.a -> m.a -> m.a | |
reference-equality/ o.0 o.1 => o | |
eq o.0 o.1 => o.2 | |
identity o.2 => o | |
syntactic-equality :: Expr -> Expr -> Expr | |
syntactic-equality/reference-equality/ l r => o | |
reference-equality l r => o | |
syntactic-equality/ l r => o | |
traverseRTogether % [x y] => z | |
syntactic-equality x y => z ! l r => ['Some' o] | |
judgmental-equality :: Expr -> Expr -> Expr | |
judgmental-equality/reference-equality/ l r => o | |
reference-equality l r => o | |
judgmental-equality/ l r => o | |
alpha-beta-normalize l => x | |
alpha-beta-normalize r => y | |
syntactic-equality x y => o | |
constant :: Text -> Expr -> Expr | |
constant/ v e => r | |
shift '-1' v '0' e => r | |
shift-nat :: Integer -> Natural -> Natural | |
le :: Natural -> Natural -> Bool | |
if-eq-suc :: Text -> Text -> Natural -> Natural | |
if-eq-suc/eq/ v.0 v.1 m => m1 | |
eq v.0 v.1 => v.2 | |
identity v.2 => v | |
suc m => m1 | |
if-eq-suc/neq/ _ _ m => m | |
shift :: Integer -> Text -> Natural -> Expr -> Expr | |
shift/Variable/ d v.0 m e@['Variable' v.1 n] => ['Variable' v nd] | |
eq v.0 v.1 => v.2 | |
identity v.2 => v | |
le m n => 'True' | |
ensure-shift-nat d n => nd | |
shift/Lambda/ d v m e@['Lambda' u A0 b0] => ['Lambda' u A1 b1] | |
if-eq-suc v u m => m1 | |
shift d v m A0 => A1 | |
shift d v m1 b0 => b1 | |
shift/Forall/ d v m e@['Forall' u A0 B0] => ['Forall' u A1 B1] | |
if-eq-suc v u m => m1 | |
shift d v m A0 => A1 | |
shift d v m1 B0 => B1 | |
shift/Let/ d v m e@['Let' u mA0 a0 b0] => ['Let' u mA1 a0 b1] | |
if-eq-suc v u m => m1 | |
traverse mA0 % A0 => A1 | |
shift d v m A0 => A1 ! => mA1 | |
shift d v m a0 => a1 | |
shift d v m1 b0 => b1 | |
shift/Application/ d v m ['Application' f0 a0] => ['Application' f1 a1] | |
shift d v m f0 => f1 | |
shift d v m a0 => a1 | |
shift/Type/ d v m 'Type' => 'Type' | |
shift/Variable/ _ _ _ v@['Variable' _ _] => v | |
shift/ d v m e1 => e2 | |
traverseR e1 % se1 => se2 | |
shift d v m se1 => se2 ! => e2 | |
substitute :: Text -> Natural -> Expr -> Expr -> Expr | |
substitute/Variable-match/ v.0 m.0 r ['Variable' v.1 m.1] => r | |
eq v.0 v.1 => v.2 | |
eq m.0 m.1 => m.2 | |
identity v.2 => v | |
identity m.2 => m | |
substitute/Lambda/ v m r ['Lambda' u A0 b0] => ['Lambda' u A1 b1] | |
if-eq-suc v u m => m1 | |
substitute v m r A0 => A1 | |
shift '1' u '0' r => r1 | |
substitute v m1 r1 b0 => b1 | |
substitute/Forall/ v m r ['Forall' u A0 B0] => ['Forall' u A1 B1] | |
if-eq-suc v u m => m1 | |
substitute v m r A0 => A1 | |
shift '1' u '0' r => r1 | |
substitute v m r1 B0 => B1 | |
substitute/Let/ v.0 m r ['Let' v.1 mA0 a0 b0] => ['Lambda' v A1 b1] | |
eq v.0 v.1 => v.2 | |
identity v.2 => v | |
if-eq-suc v u m => m1 | |
substitute v m r A0 => A1 | |
shift '1' v '0' r => r1 | |
substitute v m1 r1 b0 => b1 | |
substitute/ v m r e1 => e2 | |
traverseR e1 % se1 => se2 | |
substitute v m r se1 => se2 ! => e2 | |
shift-substitute-shift :: Text -> Expr -> Expr -> Expr | |
shift-substitute-shift/ v r0 e0 => e2 | |
shift '1' v '0' r0 => r1 | |
substitute v '0' r1 e0 => e1 | |
shift '-1' v '0' e1 => e2 | |
rename-immediate :: Text -> Text -> Expr -> Expr | |
rename-immediate/noop/ v.0 v.1 e => e | |
eq v.0 v.1 => v.2 | |
identity v.2 => v | |
rename-immediate/ v u e0 => e1 | |
shift-substitute-shift v ['Variable' u '0'] e0 => e1 | |
alpha-normalize :: Expr -> Expr | |
alpha-normalize/Lambda/ ['Lambda' v A0 b0] => ['Lambda' '_' A1 b2] | |
alpha-normalize A0 => A1 | |
rename-immediate v '_' b0 => b1 | |
alpha-normalize b1 => b2 | |
alpha-normalize/Forall/ ['Forall' v A0 B0] => ['Forall' '_' A1 B2] | |
alpha-normalize A0 => A1 | |
rename-immediate v '_' B0 => B1 | |
alpha-normalize B1 => B2 | |
alpha-normalize/Let/ ['Let' v mA0 a0 b0] => ['Let' '_' mA1 a1 b2] | |
traverse mA0 % A0 => A1 | |
alpha-normalize A0 => A1 ! => mA1 | |
alpha-normalize a0 => a1 | |
rename-immediate v '_' b0 => b1 | |
alpha-normalize b1 => b2 | |
alpha-normalize/ e0 => e1 | |
traverseR e0 % se0 => se1 | |
alpha-normalize se0 => se1 ! => e1 | |
beta-normalize :: Expr -> Expr | |
beta-normalize/Bool/if_then_else_/ ['if_then_else_' ['BoolLit' b] l r] => o | |
builtin/if_then_else_ b l r => o | |
beta-normalize/Bool/if_then_else_/identity/ ['if_then_else_' b ['BoolLit' 'true'] ['BoolLit' 'false']] => b | |
beta-normalize/Bool/if_then_else_/constant/ ['if_then_else_' _ e.0 e.1] => e | |
judgmental-equality e.0 e.1 => e.2 | |
identity e.2 => e | |
beta-normalize/Bool/||/L-absorb/ ['||' l@['BoolLit' 'True'] _] => l | |
beta-normalize/Bool/||/L-identity/ ['||' _@['BoolLit' 'False'] r] => r | |
beta-normalize/Bool/||/ ['||' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/|| l r => o | |
beta-normalize/Bool/||/R-absorb/ ['||' _ r@['BoolLit' 'True']] => r | |
beta-normalize/Bool/||/R-identity/ ['||' l _@['BoolLit' 'False']] => l | |
beta-normalize/Bool/||/idempotence/ ['||' e.0 e.1] => e | |
judgmental-equality e.0 e.1 => e.2 | |
identity e.2 => e | |
beta-normalize/Bool/&&/L-absorb/ ['&&' l@['BoolLit' 'False'] _] => l | |
beta-normalize/Bool/&&/L-identity/ ['&&' _@['BoolLit' 'True'] r] => r | |
beta-normalize/Bool/&&/ ['&&' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/&& l r => o | |
beta-normalize/Bool/&&/R-absorb/ ['&&' _ r@['BoolLit' 'False']] => r | |
beta-normalize/Bool/&&/R-identity/ ['&&' l _@['BoolLit' 'True']] => l | |
beta-normalize/Bool/&&/idempotence/ ['&&' e.0 e.1] => e | |
judgmental-equality e.0 e.1 => e.2 | |
identity e.2 => e | |
beta-normalize/Bool/==/L-identity/ ['==' _@['BoolLit' 'True'] r] => r | |
beta-normalize/Bool/==/ ['==' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/== l r => o | |
beta-normalize/Bool/==/R-identity/ ['==' l _@['BoolLit' 'True']] => l | |
beta-normalize/Bool/==/idempotence/ ['==' e.0 e.1] => e | |
judgmental-equality e.0 e.1 => e.2 | |
identity e.2 => e | |
beta-normalize/Bool/!=/L-identity/ ['!=' _@['BoolLit' 'False'] r] => r | |
beta-normalize/Bool/!=/ ['!=' ['BoolLit' l] ['BoolLit' r]] => ['BoolLit' o] | |
builtin/!= l r => o | |
beta-normalize/Bool/!=/R-identity/ ['!=' l _@['BoolLit' 'False']] => l | |
beta-normalize/Bool/!=/idempotence/ ['!=' e.0 e.1] => e | |
judgmental-equality e.0 e.1 => e.2 | |
identity e.2 => e | |
beta-normalize/Natural/build/ ['Application' 'Natural/build' g] => b | |
identity ['Lambda' 'x' 'Natural' ['+' ['Variable' 'x' '0'] ['NaturalLit' '1']]] => succ | |
identity ['NaturalLit' '0'] => zero | |
beta-normalize ['Application' g 'Natural' succ zero] => b | |
beta-normalize/Natural/fold/ ['Application' 'Natural/fold' ['NaturalLit' n] B g b] => r | |
fold-natural n b % r0 => ['Application' g r0] ! => r | |
beta-normalize/Natural/*/L-absorb/ ['*' l@['NaturalLit' '0'] _] => l | |
beta-normalize/Natural/*/L-identity/ ['*' _@['NaturalLit' '1'] r] => r | |
beta-normalize/Natural/*/ ['*' ['NaturalLit' l] ['NaturalLit' r]] => ['NaturalLit' o] | |
builtin/* l r => o | |
beta-normalize/Natural/*/R-absorb/ ['*' r@['NaturalLit' '0'] _] => r | |
beta-normalize/Natural/*/R-identity/ ['*' l _@['NaturalLit' '1']] => l | |
beta-normalize/Natural/+/L-identity/ ['+' _@['NaturalLit' '0'] r] => r | |
beta-normalize/Natural/+/ ['+' ['NaturalLit' l] ['NaturalLit' r]] => ['NaturalLit' o] | |
builtin/+ l r => o | |
beta-normalize/Natural/+/R-identity/ ['+' l _@['NaturalLit' '0']] => l | |
beta-normalize/Natural/isZero/ ['Application' 'Natural/isZero' ['NaturalLit' n]] => ['BoolLit' o] | |
builtin/Natural/isZero n => o | |
beta-normalize/Natural/even/ ['Application' 'Natural/even' ['NaturalLit' n]] => ['BoolLit' o] | |
builtin/Natural/even n => o | |
beta-normalize/Natural/odd/ ['Application' 'Natural/odd' ['NaturalLit' n]] => ['BoolLit' o] | |
builtin/Natural/odd n => o | |
beta-normalize/Natural/toInteger/ ['Application' 'Natural/toInteger' ['NaturalLit' n]] => ['IntegerLit' o] | |
builtin/Natural/toInteger n => o | |
beta-normalize/Natural/show/ ['Application' 'Natural/show' ['NaturalLit' n]] => ['TextLit' o] | |
builtin/Natural/show n => o | |
beta-normalize/Natural/subtract/L-zero/ ['Application' 'Natural/subtract' ['NaturalLit' '0'] n] => n | |
beta-normalize/Natural/subtract/R-zero/ ['Application' 'Natural/subtract' _ l@['NaturalLit' '0']] => l | |
beta-normalize/Natural/subtract/equal/ ['Application' 'Natural/subtract' n.0 n.1] => ['NaturalLit' '0'] | |
judgmental-equality n.0 n.1 => n.2 | |
identity n.2 => n | |
beta-normalize/Natural/subtract/ ['Application' 'Natural/subtract' ['NaturalLit' m] ['NaturalLit' n]] => ['NaturalLit' o] | |
builtin/Natural/subtract m n => o | |
beta-normalize/List/build/ ['Application' 'List/build' A0 g] => b | |
shift '1' 'a' '0' A0 => A1 | |
identity ['Lambda' 'a' A0 ['Lambda' 'as' ['Application' 'List' A1] ['#' ['ListLit' [['Variable' 'a' '0']] 'None'] ['Variable' 'as' '0']]]] => succ | |
identity ['ListLit' [] ['Some' ['Application' 'List' A0]]] => zero | |
beta-normalize ['Application' g ['Application' 'List' A0] succ zero] => b | |
beta-normalize/List/fold/ ['Application' 'List/fold' A0 ['ListLit' l _] B g b] => r | |
fold-list l b % a0 r0 => ['Application' g a0 r0] ! => r | |
beta-normalize/List/#/L-identity/ ['#' ['ListLit' [] _] r] => r | |
beta-normalize/List/#/R-identity/ ['#' l ['ListLit' [] _]] => l | |
beta-normalize/List/#/ ['#' ['ListLit' ls 'None'] ['ListLit' rs 'None']] => ['ListLit' lrs []] | |
builtin/List/# ls rs => lrs | |
beta-normalize/Record/Field/ ['Field' ['RecordLit' kvs] k] => v | |
find kvs k => v | |
beta-normalize/Record/Field/Project/ ['Field' ['Project' rec ks] k] => ['Field' rec k] | |
beta-normalize/Record/Field/Prefer/L-yes/ ['Field' ['Prefer' ['RecordLit' kvs] r] k] => v | |
find kvs k => v | |
beta-normalize/Record/Field/Prefer/L-no/ ['Field' ['Prefer' ['RecordLit' kvs] r] k] => ['Field' r k] | |
beta-normalize/Record/Field/Prefer/R-yes/ ['Field' ['Prefer' l ['RecordLit' kvs]] k] => v | |
find kvs k => v | |
beta-normalize/Record/Field/Prefer/R-no/ ['Field' ['Prefer' l ['RecordLit' kvs]] k] => ['Field' l k] | |
beta-normalize/Record/Field/Combine/L-yes/ ['Field' ['Combine' ['RecordLit' kvs] r] k] => ['Field' ['Combine' ['RecordLit' [[k v]]] r] k] | |
find kvs k => v | |
beta-normalize/Record/Field/Combine/L-no/ ['Field' ['Combine' ['RecordLit' kvs] r] k] => ['Field' r k] | |
beta-normalize/Record/Field/Combine/R-yes/ ['Field' ['Combine' l ['RecordLit' kvs]] k] => ['Field' ['Combine' l ['RecordLit' [[k v]]]] k] | |
find kvs k => v | |
beta-normalize/Record/Field/Combine/R-no/ ['Field' ['Combine' l ['RecordLit' kvs]] k] => ['Field' l k] | |
beta-normalize/Record/Project/empty/ ['Project' rec ['ByLabels' []]] => ['RecordLit' []] | |
beta-normalize/Record/Project/ ['Project' ['RecordLit' kvs0] ['ByLabels' ks]] => ['RecordLit' kvs1] | |
select kvs0 ks => kvs1 | |
beta-normalize/Record/Project/Project/ ['Project' ['Project' rec _] ['ByLabels' ks]] => ['Project' rec ['ByLabels' ks]] | |
beta-normalize/Record/Project/Prefer/ ['Project' ['Prefer' l ['RecordLit' kvs]] ['ByLabels' ks]] => ['Prefer' ['Project' l ['ByFields' lks]] ['Project' r ['ByFields' rks]]] | |
separate kvs ks lks => rks | |
beta-normalize/Record/Project/Record/ ['Project' rec ['ByType' ['RecordType' kvs]]] => ['Project' rec ['ByFields' ks]] | |
void kvs => ks | |
beta-normalize/Application/ ['Application' ['Lambda' v _ b] a] => r | |
shift-substitute-shift v a b => r | |
beta-normalize/Let/ ['Let' v _ a b] => r | |
shift-substitute-shift v a b => r | |
beta-normalize/Annotation/ ['Annotation' v _] => v | |
eta-normalize :: Expr -> Expr | |
eta-normalize/ ['Lambda' v.0 t ['Application' f ['Variable' v.1 '0']]] => o | |
judgmental-equality v.0 v.1 => v.2 | |
identity v.2 => v | |
constant v f => o | |
typecheck :: Context Expr -> Expr -> Expr | |
typecheck/Variable/ ctx ['Variable' x n] => T | |
find-ctx ctx x n => T | |
typecheck/Bool/ ctx 'Bool' => 'Type' | |
typecheck/BoolLit/ ctx ['BoolLit' _] => 'Bool' | |
typecheck/if_then_else_/ ctx ['if_then_else_' b l r] => T | |
judgmental-equality T.0 T.1 => T.2 | |
identity T.2 => T | |
typecheck ctx b => 'Bool' | |
typecheck ctx l => T.0 | |
typecheck ctx r => T.1 | |
typecheck/||/ ctx ['||' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/&&/ ctx ['&&' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/==/ ctx ['==' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/!=/ ctx ['!=' l r] => 'Bool' | |
typecheck ctx l => 'Bool' | |
typecheck ctx r => 'Bool' | |
typecheck/Natural/ ctx 'Natural' => 'Type' | |
typecheck/NaturalLit/ ctx ['NaturalLit' _] => 'Natural' | |
typecheck/+/ ctx ['+' l r] => 'Natural' | |
typecheck ctx l => 'Natural' | |
typecheck ctx r => 'Natural' | |
typecheck/*/ ctx ['*' l r] => 'Natural' | |
typecheck ctx l => 'Natural' | |
typecheck ctx r => 'Natural' | |
typecheck/Natural/build/ ctx 'Natural/build' => ['Forall' '_' ['Forall' 'natural' 'Type' ['Forall' 'succ' ['Forall' '_' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']] ['Forall' 'zero' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']]]] 'Natural'] | |
typecheck/Natural/fold/ ctx 'Natural/fold' => ['Forall' '_' 'Natural' ['Forall' 'natural' 'Type' ['Forall' 'succ' ['Forall' '_' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']] ['Forall' 'zero' ['Variable' 'natural' '0'] ['Variable' 'natural' '0']]]]] | |
typecheck/Natural/isZero/ ctx 'Natural/isZero' => ['Forall' '_' 'Natural' 'Bool'] | |
typecheck/Natural/even/ ctx 'Natural/even' => ['Forall' '_' 'Natural' 'Bool'] | |
typecheck/Natural/odd/ ctx 'Natural/odd' => ['Forall' '_' 'Natural' 'Bool'] | |
typecheck/Natural/toInteger/ ctx 'Natural/toInteger' => ['Forall' '_' 'Natural' 'Integer'] | |
typecheck/Natural/show/ ctx 'Natural/show' => ['Forall' '_' 'Natural' 'Text'] | |
typecheck/Natural/subtract/ ctx 'Natural/subtract' => ['Forall' '_' 'Natural' ['Forall' '_' 'Natural' 'Natural']] | |
typecheck/Text/ ctx 'Text' => 'Type' | |
typecheck/TextLiteral/ ctx ['TextLiteral' txt] => 'Text' | |
traverse_ % t => [] | |
typecheck ctx t => 'Text' ! txt => [] | |
typecheck/Text/show/ ctx 'Text/show' => ['Forall' '_' 'Text' 'Text'] | |
typecheck/Text/replace/ ctx 'Text/replace' => ['Forall' 'needle' 'Text' ['Forall' 'replacement' 'Text' ['Forall' 'haystack' 'Text' 'Text']]] | |
typecheck/Text/++/ ctx ['++' l r] => 'Text' | |
typecheck ctx l => 'Text' | |
typecheck ctx r => 'Text' | |
typecheck/Date/ ctx 'Date' => 'Type' | |
typecheck/Time/ ctx 'Time' => 'Type' | |
typecheck/TimeZone/ ctx 'TimeZone' => 'Type' | |
typecheck/Date/ ctx ['DateLiteral' _] => 'Date' | |
typecheck/Time/ ctx ['TimeLiteral' _] => 'Time' | |
typecheck/TimeZone/ ctx ['TimeZoneLiteral' _] => 'TimeZone' | |
typecheck/List/ ctx 'List' => ['Forall' '_' 'Type' 'Type'] | |
typecheck/List/#/ ctx ['#' l r] => ['Application' 'List' T] | |
judgmental-equality T.0 T.1 => T.2 | |
identity T.2 => T | |
typecheck ctx l => ['Application' 'List' T.0] | |
typecheck ctx r => ['Application' 'List' T.1] | |
typecheck/RecordLit/ ctx ['RecordLit' kvs] => kts | |
ensureNodupes kvs => [] | |
traverse typecheck kvs => kts | |
typecheck/Field/ ctx ['Field' expr field] => fieldType | |
typecheck expr => ty | |
? ty => fieldType | |
| ['Record' kts] => fieldType | |
find kts field => fieldType | |
| ['Const' c] => fieldType | |
? expr => fieldType | |
| ['Union' kts] => fieldType | |
find kts field => mt | |
? mt => fieldType | |
| ['Some' ty] => ['Pi' field ty result] | |
shift field '1' expr => result | |
| 'None' => expr | |
! | |
! | |
! | |
typecheck/Integer/ ctx 'Integer' => 'Type' | |
typecheck/IntegerLit/ ctx ['IntegerLit' _] => 'Integer' | |
typecheck/Integer/show/ ctx 'Integer/show' => ['Forall' '_' 'Integer' 'Text'] | |
typecheck/Integer/toDouble/ ctx 'Integer/toDouble' => ['Forall' '_' 'Integer' 'Double'] | |
typecheck/Integer/negate/ ctx 'Integer/negate' => ['Forall' '_' 'Integer' 'Integer'] | |
typecheck/Integer/clamp/ ctx 'Integer/clamp' => ['Forall' '_' 'Integer' 'Natural'] | |
typecheck/Double/ ctx 'Double' => 'Type' | |
typecheck/DoubleLit/ ctx ['DoubleLit' _] => 'Double' | |
typecheck/Double/show/ ctx 'Double/show' => ['Forall' '_' 'Double' 'Text'] | |
typecheck/Forall/ ctx ['Forall' x A B] => ['Const' c] | |
typecheck ctx A => ['Const' i] | |
add-ctx x A ctx => ctx1 | |
typecheck ctx1 B => ['Const' o] | |
imax i o => c | |
typecheck/Lambda/ ctx ['Lambda' x A b] => ['Forall' x A B] | |
typecheck ctx A => ['Const' _] | |
add-ctx x A ctx => ctx1 | |
typecheck ctx1 b => B | |
typecheck/Application/ ctx ['Application' f a] => ['Application' ['Lambda' x A B] a] | |
judgmental-equality A.0 A.1 => A.2 | |
identity A.2 => A | |
typecheck ctx f => ['Forall' x A.0 B] | |
typecheck ctx a => A.1 | |
typecheck/Let/ ctx ['Let' x mA a b] => B | |
typecheck ctx a => A | |
traverse_ % A => [] ! mA => [] | |
shift-substitute-shift x a b => b1 | |
typecheck ctx b1 => B | |
typecheck/Annot/ ctx ['Annot' a A.0] => A | |
judgmental-equality A.0 A.1 => A.2 | |
identity A.2 => A | |
typecheck ctx a => A.1 | |
typecheck/Assert/ ctx ['Assert' T] => ['Equivalent' x x] | |
judgmental-equality x.0 x.1 => x.2 | |
identity x.2 => x | |
typecheck ctx T => 'Type' | |
beta-normalize T => ['Equivalent' x.0 x.1] | |
typecheck/Equivalent/ ctx ['Equivalent' x y] => 'Type' | |
judgmental-equality A.0 A.1 => A.2 | |
identity A.2 => A | |
typecheck ctx x => A.0 | |
typecheck ctx y => A.1 | |
typecheck ctx A => 'Type' | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env python3 | |
import inspect | |
# Defer f(*a)(*b) so the first application is only computed after the second | |
# is being applied. Memoized so it the first is only computed once. | |
def defer(f, *arg): | |
saved = False | |
value = None | |
def deferred(*arg2): | |
nonlocal saved, value | |
if not saved: | |
value = f(*arg) | |
saved = True | |
return value(*arg2) | |
return deferred | |
# Parse a basic syntax of parentheses and spaces into a tree of tuples | |
def parse(s): | |
z = iter(s) | |
def go(): | |
r = () | |
o = True | |
for c in z: | |
if c == " ": | |
o = True | |
elif c == "(": | |
if r == (): | |
r = go() | |
else: | |
r = (r, go()) | |
o = True | |
elif c == ")": | |
return r | |
elif o: | |
o = False | |
if r == (): | |
r = c | |
else: | |
r = (r, c) | |
else: | |
if isinstance(r, str): | |
r += c | |
else: | |
r = tuple([*r[:-1], r[-1]+c]) | |
return r | |
return go() | |
# Print a tree of tuples into space-delimited applications, | |
# adding parentheses as needed | |
def pretty(r): | |
if isinstance(r, str): | |
return r | |
if isinstance(r, Taker) or isinstance(r, Matcher): | |
return repr(r) | |
s = "" | |
s += pretty(r[0]) | |
s += " " | |
if isinstance(r[1], str): | |
s += r[1] | |
else: | |
s += "(" | |
s += pretty(r[1]) | |
s += ")" | |
return s | |
# Forall type, takes a lambda, like Void = Forall(lambda a: a) | |
class Forall: | |
def __init__(self, value, name=None): | |
if name is None: | |
name = list(inspect.signature(value).parameters.keys())[0] | |
self.name = name | |
self.value = value | |
self.tester = Tester(self.name) | |
self.tested = self.value(self.tester) | |
#print(f"kind {tester.kind!r}") | |
self.kind = () | |
def __repr__(self): | |
return f"Forall(lambda {self.name}: {repr(self.tested)})" | |
def __call__(self, param): | |
return self.value(param) | |
# Type in the meta language: | |
# - `name` is a string for primitive types, or a tuple-tree of names | |
# as applied to each other. | |
# - `kind` is a tuple of input kinds, which are themselves tuples of input kinds | |
# (the output is always Type). Thus a type has kind `()`, a functor has kind | |
# `((),)`, a bifunctor has kind `((),())`, etc. | |
# - `pred` is the predicate used to verify data; for types that take parameters | |
# it is first passed the predicate for the parameter, then later it gets | |
# the actual data to verify. | |
class MetaType: | |
registry = dict() | |
# __init__ registers all named types immediately | |
def __init__(self, name, pred, kind=()): | |
self.name = name | |
self.pred = pred | |
self.kind = kind | |
if isinstance(self.name, str): | |
if self.name in MetaType.registry: | |
raise KeyError(f"Duplicate type with name {self.name}") | |
MetaType.registry[self.name] = self | |
# Note: __repr__ does not use `parse` because it could include type | |
# variables which cannot be parsed, so we use `get` instead. | |
def __repr__(self): | |
# Shortcut to eliminate one layer of parentheses | |
if isinstance(self.name, tuple): | |
return f"MetaType.get{self.name!r}" | |
return f"MetaType.get({self.name!r})" | |
def __eq__(self, other): | |
return self.name == other.name | |
def __hash__(self): | |
return hash(self.name) | |
@classmethod | |
def parse(cls, name): | |
return cls.get(parse(name)) | |
@classmethod | |
def get(cls, *name): | |
if len(name) == 1: | |
name = name[0] | |
if isinstance(name, str): | |
return cls.registry[name] | |
if isinstance(name, MetaType): | |
return name | |
return MetaType.__call__(*(cls.get(n) for n in name)) | |
# __call__ either instantiates type parameters or checks data across the | |
# predicate. These are exclusive: it doesn't make sense to check data on | |
# a functor. | |
def __call__(self, *params): | |
if len(params) == 1 and not isinstance(params[0], MetaType): | |
return self.pred(params[0]) | |
if self.kind.__len__() < len(params): | |
raise TypeError(f"Cannot instantiate type with {len(params)} more parameters") | |
kind = self.kind | |
for i,p in enumerate(params): | |
if kind[i] != p.kind: | |
raise TypeError(f"Mismatched kind while applying parameter {i}") | |
self = MetaType((self.name, p.name), defer(self.pred, p), kind[i+1:]) | |
return self | |
# Create the wrapped data for this type. | |
def mk(self, data): | |
return MetaData(self, data) | |
# Deconstruct an application of this type, returning the parameters passed | |
# to it. Returns None if it is not an application of this type, or if | |
# the passed `arity` does not match the number of arguments. | |
def de(self, other, arity=None): | |
args = [] | |
head = other.name | |
while head != self.name: | |
if not isinstance(head, tuple): | |
return None | |
args.insert(0, *head[1:]) | |
head = head[0] | |
if arity is not None: | |
args = args[:arity] | |
if len(args) != arity: | |
return None | |
return tuple(MetaType.get(a) for a in args) | |
# Construct the predicate for an algebraic data type. | |
@staticmethod | |
def adt(spec): | |
def validate(data): | |
if not isinstance(data, tuple) or len(data) < 1: | |
return False | |
if data[0] not in spec: | |
return False | |
tag = spec[data[0]] | |
if len(data)-1 != len(tag): | |
return False | |
return all(tag[i](data[i+1]) for i in range(len(tag))) | |
return validate | |
# Construct the predicate that only matches the specified values. | |
@staticmethod | |
def enum(*values): | |
values = set(values) | |
def validate(data): | |
return data in values | |
return validate | |
# More abstract specification, subsumes but enum and adt. | |
@staticmethod | |
def abstractSpec(spec): | |
discr = dict() | |
for i,rule in enumerate(spec): | |
if isinstance(rule, str): | |
if rule in discr: | |
raise KeyError(f"Duplicate rule matching on {rule} at indices {discr[rule]}, {i}") | |
discr[rule] = i | |
elif isinstance(rule, tuple): | |
if len(rule) == 0: | |
if () in discr: | |
raise KeyError(f"Duplicate empty tuple at index {i}") | |
discr[()] = i | |
elif isinstance(rule[0], str): | |
if not all(isinstance(r, MetaType) for r in rule[1:]): | |
raise TypeError(f"Bad tuple item at index {i}") | |
k = (len(rule), rule[0]) | |
discr[k] = i | |
else: | |
raise TypeError(f"Bad tuple rule at index {i}") | |
else: | |
raise TypeError(f"Bad rule at index {i}") | |
def validate(data): | |
if isinstance(data, str): | |
return data in discr | |
if isinstance(data, tuple): | |
if len(data) == 0: | |
return () in discr | |
if not isinstance(data[0], str): | |
return False | |
k = (len(data), data[0]) | |
if k not in discr: | |
return False | |
rule = spec[discr[k]] | |
return all(r.pred(d) for r,d in zip(rule[1:], data[1:])) | |
return False | |
return validate | |
# Kinds | |
MetaType.Type = () | |
MetaType.Functor = (MetaType.Type,) | |
MetaType.Bifunctor = (MetaType.Type, MetaType.Type) | |
# Data tagged with a MetaType. | |
class MetaData: | |
def __init__(self, typ, data): | |
if isinstance(data, MetaData): | |
if data.typ != typ: | |
raise TypeError(f"Data had existing type {data.typ!r}, expected {typ!r}") | |
self.typ = data.typ | |
self.data = data.data | |
elif isinstance(typ, Forall): | |
if not callable(data): | |
raise TypeError(f"Forall expects function") | |
self.typ = typ | |
self.data = data | |
else: | |
if typ.kind != (): | |
raise TypeError(f"Cannot construct data for non-fully-applied types") | |
else: | |
if not typ.pred(data): | |
print(data) | |
raise TypeError(f"Data does not satisfy type predicate for {typ!r}") | |
self.typ = typ | |
self.data = data | |
def __repr__(self): | |
return f"MetaData({self.typ!r}, {self.data!r})" | |
def __call__(self, *args): | |
for arg in args: | |
if isinstance(self.typ, Forall): | |
if not isinstance(arg, MetaType): | |
raise TypeError(f"Expected type for forall") | |
self = MetaData(self.typ(arg), self.data(arg)) | |
else: | |
try: | |
(ti, to) = mtFunction.de(self.typ, 2) | |
except TypeError: | |
raise TypeError(f"Was not function type {self.typ!r}") | |
arg = MetaData(ti, arg) | |
self = MetaData(to, self.data(arg.data)) | |
return self | |
# Very basic TypeClass support | |
# Multi-parameter (no fundeps, no flexible contexts/instances) | |
class TypeClass: | |
registry = dict() | |
def __init__(self, name, kinds, methods): | |
self.name = name | |
self.kinds = kinds | |
self.methods = methods | |
self.instances = dict() | |
if self.name in TypeClass.registry: | |
raise KeyError(f"Duplicate typeclass with name {self.name}") | |
TypeClass.registry[self.name] = self | |
def __repr__(self): | |
return f"TypeClass.get({self.name!r})" | |
def __getitem__(self, typs): | |
return self.instances[typs] | |
@classmethod | |
def parse(cls, name): | |
return cls.get(parse(name)) | |
@classmethod | |
def get(cls, name): | |
return cls.registry[name] | |
# Instance of TypeClass for specified types | |
class ClassData: | |
def __init__(self, cls, typs, methods): | |
if tuple(t.kind for t in typs) != tuple(cls.kinds): | |
raise TypeError(f"Types do not match kinds from class") | |
if methods.keys() != cls.methods.keys(): | |
raise TypeError(f"Methods mismatch") | |
self.cls = cls | |
self.typs = typs | |
self.methods = {m: MetaData(cls.methods[m](*typs),methods[m]) for m in cls.methods} | |
if typs in cls.instances: | |
raise KeyError(f"Duplicate typeclass instance") | |
cls.instances[typs] = self | |
def __repr__(self): | |
return f"{self.cls!r}[{self.typs!r}]" | |
def __getitem__(self, m): | |
return self.methods[m] | |
# Hacks to do HOAS | |
class AlwaysTrue: | |
def __bool__(self): | |
return True | |
def __call__(self, *args): | |
return self | |
class Tester(MetaType): | |
def __init__(self, name, kind=None): | |
self.secret = name | |
self.name = self | |
self.kind = Taker() if kind is None else kind | |
self.pred = AlwaysTrue() | |
def __repr__(self): | |
return self.secret | |
def __call__(self, *params): | |
kind = TupleTaker(tuple(p.kind for p in params)) | |
print(f"Guessing {kind!r}") | |
if not (self.kind == kind): | |
pass | |
for i,p in enumerate(params): | |
self = MetaType((self.name, p.name), AlwaysTrue(), kind[i+1:]) | |
print(f"Guessed {kind!r}") | |
return self | |
class ManyTaker: | |
def __init__(self): | |
self.values = dict() | |
def __get__(self, i): | |
if i not in self.values: | |
self.values[i] = Taker() | |
return self.values[i] | |
class Taker: | |
def __init__(self): | |
self.hasValue = False | |
def __eq__(self, other): | |
if not self.hasValue: | |
#print(f"Taking {other!r} for {id(self):02X}") | |
self.value = other | |
self.hasValue = True | |
return True | |
return self.value == other | |
def __len__(self): | |
if not self.hasValue: | |
self.value = TupleTaker() | |
self.hasValue = True | |
return self.value.__len__() | |
def __getitem__(self, i): | |
if not self.hasValue: | |
self.value = TupleTaker() | |
self.hasValue = True | |
return self.value[i] | |
def __repr__(self): | |
if self.hasValue: | |
return repr(self.value) | |
else: | |
return f"Taker({id(self):02X})" | |
class TakeLen: | |
def __init__(self, len=0): | |
self.finalized = False | |
self.len = len | |
def __lt__(self, other): | |
if self.finalized: | |
return self.len < other | |
if self.len < other: | |
self.len = other | |
return False | |
class TakeLenView: | |
def __init__(self, parent, offset): | |
self.parent = parent | |
self.offset = offset | |
def __lt__(self, other): | |
return self.parent < other+self.offset | |
class TupleTaker: | |
def __init__(self, data=()): | |
self.len = TakeLen(len(data)) | |
self.data = list(data) | |
def __repr__(self): | |
if self.len.finalized: | |
return repr(self.data) | |
while len(self.data) < self.len.len: | |
self.data.append(Taker()) | |
return f"TupleTaker({self.data!r})" | |
def __len__(self): | |
return self.len | |
def __eq__(self, other): | |
if self.len.finalized: | |
return self.data == other | |
if other.len < self.len.len: | |
return False | |
self.len.len = other.len | |
self.len.finalized = True | |
self.data = tuple(other) | |
return True | |
def __getitem__(self, i): | |
if isinstance(i, slice): | |
if self.len.finalized: | |
return self.data[i] | |
if i.step is not None or i.stop is not None: | |
raise IndexError() | |
return TupleTakerView(self, i.start) | |
else: | |
if self.len < i: | |
raise IndexError() | |
while len(self.data) < self.len.len: | |
self.data.append(Taker()) | |
return self.data[i] | |
class TupleTakerView: | |
def __init__(self, parent, offset): | |
if parent.len < offset: | |
raise IndexError() | |
self.parent = parent | |
self.offset = offset | |
def __repr__(self): | |
return f"TupleTakerView({self.parent!r}, {self.offset!r})" | |
def __len__(self): | |
return TakeLenView(self.parent.len, self.offset) | |
def __eq__(self, other): | |
if self.parent.len < self.offset+len(other): | |
return False | |
self.parent.len.finalized = True | |
self.parent.data = tuple(self.parent.data[:self.offset]) + tuple(other) | |
return True | |
def __getitem__(self, i): | |
if isinstance(i, slice): | |
s = slice( | |
i.start + self.offset, | |
None if i.stop is None else i.stop + self.offset, | |
i.step, | |
) | |
return self.parent[s] | |
else: | |
return self.parent[i+self.offset] | |
# End hacks, begin examples | |
# Note: I used PureScript names for these types | |
mtFunction = MetaType("Function", lambda a: lambda b: callable, MetaType.Bifunctor) | |
mtString = MetaType("String", lambda x: isinstance(x, str), MetaType.Type) | |
mtArray = MetaType("Array", lambda a: lambda x: isinstance(x, tuple) and all(a(y) for y in x), MetaType.Functor) | |
mtStrMap = MetaType("StrMap", lambda a: lambda x: isinstance(x, tuple) and all(isinstance(k, str) and a(y) for k,y in x), MetaType.Functor) | |
mtOrdering = MetaType("Ordering", MetaType.enum("LT","GT","EQ")) | |
mtNatural = MetaType("Natural", lambda x: isinstance(x, str) and int(x) >= 0) | |
mtTuple = MetaType("Tuple", lambda a: lambda b: lambda x: isinstance(x, tuple) and len(x) == 2 and a(x[0]) and b(x[1]), MetaType.Bifunctor) | |
mtJoin = MetaType("Join", lambda f: lambda a: f(a)(a), (MetaType.Bifunctor, MetaType.Type)) | |
mtBoolean = MetaType("Boolean", MetaType.enum("true", "false")) | |
mtUnit = MetaType("Unit", MetaType.enum("")) | |
mtIdentity = MetaType("Identity", lambda a: a, MetaType.Functor) | |
mkIdentity = MetaData(Forall(lambda a: mtFunction(a, mtIdentity(a))), lambda a: lambda fa: MetaData(mtIdentity(a), fa)) | |
unIdentity = MetaData(Forall(lambda a: mtFunction(mtIdentity(a), a)), lambda a: lambda fa: MetaData(a, fa)) | |
mtPair = mtJoin(mtTuple) | |
def mu(f): | |
return f(mtMu(f)) | |
mtMu = MetaType("Mu", mu, (MetaType.Functor,)) | |
mtString.mk("hello") | |
mtArray(mtString).mk(("a","b")) | |
mtStrMap(mtString).mk((("k","v"),("k1","v1"))) | |
repr(Forall(lambda x: MetaType.get(('Function', x, x)))) | |
repr(Forall(lambda x: MetaType.get(('Function', (x, 'StrMap'), (x, 'Array'))))) | |
comparePrim = lambda x: lambda y: ["LT","EQ","GT"][1 + (x > y) - (x < y)] | |
tcOrd = TypeClass("Ord", (MetaType.Type,), { | |
"compare": lambda a: mtFunction(a, mtFunction(a, mtOrdering)) | |
}) | |
tcOrdString = ClassData(tcOrd, (mtString,), { "compare": comparePrim }) | |
tcOrdString["compare"]("a", "b") | |
tcFunctor = TypeClass("Functor", (MetaType.Functor,), { | |
"map": lambda f: Forall(lambda a: Forall(lambda b: mtFunction(mtFunction(a, b), mtFunction(f(a), f(b))))) | |
}) | |
tcFunctorArray = ClassData(tcFunctor, (mtArray,), {"map": lambda a: lambda b: lambda ab: lambda aa: tuple(ab(a) for a in aa)}) | |
tcFunctorIdentity = ClassData(tcFunctor, (mtIdentity,), {"map": lambda a: lambda b: lambda ab: lambda aa: ab(aa)}) | |
tcApplicative = TypeClass("Applicative", (MetaType.Functor,), { | |
"pure": lambda m: Forall(lambda a: MetaType.get(('Function', a, (m, a)))), | |
"apply": lambda m: Forall(lambda a: Forall(lambda b: MetaType.get(('Function', (m, ('Function', a, b)), ('Function', (m, a), (m, b)))))), | |
}) | |
tcApplicativeIdentity = ClassData(tcApplicative, (mtIdentity,), { | |
"pure": lambda a: lambda fa: fa, | |
"apply": lambda a: lambda b: lambda fab: lambda fa: mkIdentity(b, unIdentity(mtFunction(a, b), fab, unIdentity(a, fa))), | |
}) | |
tcApplicativeArray = ClassData(tcApplicative, (mtArray,), { | |
"pure": lambda a: lambda fa: (fa,), | |
"apply": lambda a: lambda b: lambda fab: lambda fa: tuple(ab(a) for ab in fab for a in fa), | |
}) | |
tcContainer = TypeClass("Container", (MetaType.Type,MetaType.Functor,), { | |
"mapWithIndex": lambda i, f: Forall(lambda a: Forall(lambda b: MetaType.get(('Function', ('Function', i, ('Function', a, b)), ('Function', (f, a), (f, b)))))), | |
}) | |
tcTraversable = TypeClass("Traversable", (MetaType.Functor,), { | |
"sequence": lambda f: Forall(lambda m: Forall(lambda a: MetaType.get(('Function', (f, (m, a)), (m, (f, a)))))), | |
}) | |
mapWithIndexPrim = lambda a: lambda b: lambda mapper: lambda aa: tuple(mapper(str(i))(aa[i]) for i in range(len(aa))) | |
tcContainerArray = ClassData(tcContainer, (mtNatural,mtArray), { | |
"mapWithIndex": mapWithIndexPrim | |
}) | |
tcContainerPair = ClassData(tcContainer, (mtBoolean,mtJoin(mtTuple)), { | |
"mapWithIndex": lambda a: lambda b: lambda mapper: lambda aa: (mapper("false")(aa[0]), mapper("true")(aa[1])) | |
}) | |
# sequence (Pair fa0 fa1) = (\a0 a1 -> Pair a0 a1) <$> fa0 <*> fa1 | |
tcTraversablePair = ClassData(tcTraversable, (mtPair,), { | |
"sequence": lambda m: lambda a: lambda aa: tcApplicative[(m,)]["apply"](a, mtPair(a), tcFunctor[(m,)]["map"](a, mtFunction(a, mtPair(a)), lambda a0: lambda a1: (a0, a1), aa[0]), aa[1]), | |
}) | |
def sequenceArrayPrim(m, a, aa): | |
apM = tcApplicative[(m,)] | |
fnM = tcFunctor[(m,)] | |
r = apM["pure"](mtArray(a), tuple()) | |
for mai in aa: | |
r = apM["apply"](a, mtArray(a), fnM["map"](mtArray(a), mtFunction(a, mtArray(a)), lambda ar: lambda ai: (*ar, ai), r), mai) | |
return r | |
tcTraversableArray = ClassData(tcTraversable, (mtArray,), { | |
"sequence": lambda m: lambda a: lambda aa: sequenceArrayPrim(m, a, aa), | |
}) | |
tcFunctorIdentity["map"](mtNatural, mtString, lambda s: s + s, "34") | |
tcContainerArray["mapWithIndex"](mtString, mtTuple(mtNatural, mtString), lambda i: lambda v: (i, v), ("a","b")) | |
tcContainerPair["mapWithIndex"](mtNatural, mtNatural, lambda d: lambda n: str(int(n) * 2 + (d == "true")), ("6", "10")) | |
tcTraversablePair["sequence"](mtIdentity, mtString, ("","")) | |
tcTraversablePair["sequence"](mtArray, mtString, (("a","c"),("b","d"))) | |
tcTraversableArray["sequence"](mtArray, mtString, (("a","1"),("b","2"),("c","3"))) | |
# Okay, now we're getting to the Dhall language sketches | |
# Suggested format for syntax types | |
# Define a functor for one layer of syntax | |
mtBoolExprF = MetaType("BoolExprF", lambda e: MetaType.abstractSpec( | |
( "Bool" | |
, ("if_then_else_", e, e, e) | |
, ("BoolLit", mtBoolean) | |
) | |
), MetaType.Functor) | |
# And make it recursive | |
mtBoolExpr = mtMu(mtBoolExprF) | |
mtBoolExpr.mk("Bool") | |
mtBoolExpr.mk(("BoolLit", "true")) | |
mtBoolExpr.mk(("if_then_else_", ("BoolLit", "true"), ("BoolLit", "false"), ("BoolLit", "true"))) | |
# Rule form: | |
# - S-exp style (prefix) for rules and data | |
# - Rules specify name/aliases, attributes, arity, and input/output types | |
# - Name of n-ary rule, n arguments, sideconditions, and finally the result | |
# - Each rule can be thought of as specifying an algorithm in an appropriate | |
# monadic context | |
# | |
# Matching forms: | |
# - String literals and S-exp constructor literals | |
# - `m.var` matcher matches and binds `var` | |
# - Repeated matchers and nested matches match up to specified equality | |
# (short for a side-condition of specified equality) | |
# - `m._` matches anything and binds nothing | |
# - `m.var("c", a, b)` matches a constructor literal as well as binding `var`, | |
# like at-patterns in Haskell/Purescript | |
# - `m.var["l"]` matches a string literal as well as binding `var` | |
# - `m(func, i1, i2, ..., im, o)` is a sidecondition | |
# - `m[i1, i2, ..., im, m(c1), m(c2), ..., m(cn), o][...]...` is a m-ary | |
# multicase lambda that matches m inputs and returns an output based on those | |
# matches, depending on the side-conditions c1, c2, ..., cn. Note: inherits | |
# matching semantics from parent rule. | |
# | |
# Meta-judgments? | |
# - "traverse" | |
# - "ensure": converts a pattern match failure to the given error | |
# | |
# Attributes: | |
# - "external": Has separate external implementation | |
# - "inline": Inline this rule wherever it occurs | |
# - "match:judgmental-equality": Use jugmental equality (syntactic is default) | |
# | |
# Desugaring: | |
# - Repeated matchers `m.v, m.v` get desugared to separate matchers | |
# `m.v1, m.v2` with sidecondition `m("equality", m.v1, m.v2, m.v)` | |
# (with the type of equality specified in the rule) | |
# - Nested matches `("constr", m.vs...)` get desugared to a matcher `m.v` | |
# with sidecondition `m("match", m.v, ("constr", m.vs...))` | |
# (with the type of match normalization specified in the rule) | |
# - Case analysis optimizations, totality checking? | |
# - Parallel applicative vs sequential monad optimization? | |
# - Optimization, e.g. optimized alpha-beta normalization generated from mix? | |
# - "ensure" with a single pattern match will be compiled to unification, | |
# a multipattern match is not possible, so first one will have to match on the | |
# specified cases, and then the fallback will be to "ensure" the combined | |
# constructor (e.g. `m(m[a, x][b, y][m._, m("ensure", m.v, a_or_b), z], m.v)`) | |
# | |
# Open problems: | |
# - Provenance ……… for efficiency, we don't want to represent it in the tree, | |
# but then we have to deal with passing it down? meh | |
""" | |
itraverseRTogether :: forall i m t f. | |
Recursive t f => | |
Corecursive t f => | |
TraversableWithIndex i f => | |
Merge f => | |
Applicative m => | |
(i -> Pair t -> m t) -> t -> t -> Maybe (m t) | |
itraverseRTogether f l r = | |
(map embed <<< traverseWithIndex f) <$> | |
(mergeWith Pair `on` project) l r | |
""" | |
# Class for my weird matching syntax as explained above | |
# | |
# Matches can be variables and values, where the values are string literals or | |
# tuples with nested matches. | |
# | |
# There are also lambda-cases, which take some inputs and case on them | |
# and return some output after computation. | |
# | |
# Statements are for computation, so you can reference either lambdas | |
# (for casing on a known result) or globally defined functions, with some | |
# arguments provided and then matching on the result. | |
# | |
# All matches are partial, all functions are partial. | |
class Matcher: | |
def OrLambda(v): | |
if isinstance(v, Matcher.Lambda): | |
return v | |
return Matcher(v) | |
class Statement: | |
def __init__(self, fn, inputs, output): | |
self.fn = fn | |
self.inputs = tuple(Matcher.OrLambda(i) for i in inputs) | |
self.output = Matcher(output) | |
def copy(self): | |
return Statement(self.fn, tuple(i.copy() for i in self.inputs), self.output.copy()) | |
def __repr__(self): | |
return "m"+repr(tuple([self.fn, *self.inputs, self.output])) | |
def unparse(self): | |
r = "" | |
calling = " " + " ".join(v.unparse() for v in self.inputs) + " => " + self.output.unparse() | |
if isinstance(self.fn, Matcher.Lambda): | |
r += "?" + calling + "\n" | |
for c in self.fn.cases: | |
r += "|" + c.unparse() | |
r += "!" | |
elif isinstance(self.fn, Builtin): | |
r += "builtin" + "/" + self.fn.key + calling | |
else: | |
r += self.fn + calling | |
return r | |
class Lambda: | |
class Case: | |
def __init__(self, inputs, stmts, output, name=None): | |
self.name = name | |
self.inputs = tuple(Matcher(i) for i in inputs) | |
self.stmts = stmts | |
self.output = Matcher.OrLambda(output) | |
def copy(self): | |
other = Lambda.Case(self.inputs, tuple(s.copy for s in self.stmts), self.output.copy()) | |
def __repr__(self): | |
return repr([*self.inputs, *self.stmts, self.output]) | |
def unparse(self): | |
r = "" | |
for i in self.inputs: | |
r += " " + i.unparse() | |
r += " => " + self.output.unparse() + "\n" | |
for s in self.stmts: | |
r += " " + s.unparse().replace("\n", "\n ") + "\n" | |
return r | |
def __init__(self, cases=()): | |
self.cases = cases | |
def copy(self): | |
return Lambda(tuple(c.copy() for c in self.cases)) | |
def __repr__(self): | |
if not len(self.cases): | |
return "m.Lambda()" | |
return "m" + "".join(repr(c) for c in self.cases) | |
def unparse(self): | |
r = "%" | |
for i,c in enumerate(self.cases): | |
r += (" |" if i else "") + c.unparse() | |
if i == 0: | |
r = r[:-1] + " " | |
return r + "!" | |
def __getitem__(self, args): | |
assert isinstance(args, tuple) | |
assert len(args) > 1 | |
name = None | |
if isinstance(args[0], slice): | |
if slice.step is not None: | |
raise TypeError(f"Triple colon not supported for lambda case") | |
name = args[0].start | |
args[0] = args[0].stop | |
inputs, statements = [], [] | |
for a in args[:-1]: | |
(inputs, statements)[isinstance(a, Matcher.Statement)].append(a) | |
output = args[-1] | |
case = Matcher.Lambda.Case(tuple(inputs), tuple(statements), output, name) | |
return Matcher.Lambda(tuple([*self.cases, case])) | |
def __init__(self, value=None, name=()): | |
while isinstance(value, Matcher): | |
name = value.name | |
value = value.value | |
self.name = name | |
if value is None: | |
self.value = value | |
else: | |
def validate(arg): | |
if isinstance(arg, tuple): | |
return tuple(validate(a) for a in arg) | |
else: | |
assert isinstance(arg, str) or isinstance(arg, Matcher) or arg is Ellipsis | |
return arg | |
try: | |
self.value = validate(value) | |
except AssertionError: | |
raise TypeError(f"Invalid Matcher value: {value!r}") | |
def copy(self): | |
return Matcher(self) | |
def __repr__(self): | |
if self.name == (): | |
if self.value is None: | |
return "m" | |
elif isinstance(self.value, tuple): | |
return "m"+repr(self.value) | |
elif isinstance(self.value, str): | |
return repr(self.value) | |
elif self.value is Ellipsis: | |
return "m[...]" | |
else: | |
return "m??" | |
else: | |
if self.name is None: | |
pre = "m._" | |
else: | |
pre = "m." + ".".join(self.name) | |
if self.value is None: | |
return pre | |
else: | |
if isinstance(self.value, str): | |
return f"{pre}[{self.value!r}]" | |
elif self.value is Ellipsis: | |
return f"{pre}[...]" | |
return f"{pre}{self.value!r}" | |
def unparse(self): | |
if self.name is None: | |
pre = "_" | |
else: | |
pre = ".".join(self.name) | |
if self.value is None: | |
return pre | |
elif pre: | |
pre += "@" | |
if isinstance(self.value, tuple): | |
return pre+"[" + " ".join(Matcher(v).unparse() for v in self.value) + "]" | |
elif isinstance(self.value, str): | |
return f"{pre}{self.value!r}" | |
elif self.value is Ellipsis: | |
return f"{pre}..." | |
return f"{pre}{self.value.unparse()}" | |
def __getattr__(self, name): | |
if self.value is not None: | |
raise TypeError(f"Put variable before value") | |
if self.name != (): | |
raise TypeError(f"Cannot bind two names at once") | |
if name == "_": return Matcher(None, None) | |
return Matcher(None, tuple([*self.name, name])) | |
def __call__(self, *args): | |
if self.name == (): | |
return Matcher.Statement(args[0], args[1:-1], args[-1]) | |
if self.value is not None: | |
raise TypeError(f"Multimatch is not supported") | |
return Matcher(args, self.name) | |
def __getitem__(self, i): | |
if self.name == (): | |
return Matcher.Lambda()[i] | |
if self.value is not None: | |
raise TypeError(f"Multimatch is not supported") | |
return Matcher(i, self.name) | |
class MatchError(Exception): | |
__module__ = Exception.__module__ | |
pass | |
@staticmethod | |
def record(name, value, vars): | |
if name in vars: | |
if value != vars[name]: | |
raise Matcher.MatchError(Matcher(value, name), vars[name]) | |
else: | |
vars[name] = value | |
def verify_pattern_pair(left, right): | |
def verify(m): | |
if isinstance(m, str): | |
return | |
if isinstance(m, tuple): | |
ell = False | |
for mm in m: | |
if isinstance(mm, Matcher) and mm.value is Ellipsis: | |
if ell: | |
raise ValueError(f"Can only match against one ellipsis at once") | |
ell = True | |
if mm.name is None or mm.name == (): | |
raise ValueError(f"Ellipsis must be named in pattern pair") | |
else: | |
verify(mm) | |
return | |
if isinstance(m, Matcher): | |
if m.name is not None and m.name != (): | |
vars.add(m.name) | |
if m.value is not None: | |
verify(m.value) | |
return | |
raise ValueError(f"Unknown data in pattern: {m!r}") | |
vars = set() | |
verify(left) | |
lvars = set(vars) | |
vars = set() | |
verify(right) | |
rvars = set(vars) | |
if lvars != rvars: | |
raise ValueError(f"Pattern pair must use same variables") | |
def match(m, v, vars=None): | |
if vars is None: vars = dict() | |
if isinstance(m, str): | |
if m != v: | |
raise Matcher.MatchError(m, v) | |
return vars | |
if isinstance(m, tuple): | |
if not isinstance(v, tuple): | |
raise Matcher.MatchError(m, v) | |
i = None | |
for j,mm in enumerate(m): | |
if isinstance(mm, Matcher) and mm.value is Ellipsis: | |
if i is None: | |
i = j | |
else: | |
raise ValueError(f"Can only match against one ellipsis at once") | |
if i is not None: | |
e = m[i] | |
if len(m)-1 > len(v): | |
raise Matcher.MatchError(m, v) | |
j = (i+1)-len(m)+len(v) | |
Matcher.match(m[:i], v[:i], vars) | |
if e.name is not None and e.name != (): | |
Matcher.record(e.name, v[i:j], vars) | |
Matcher.match(m[i+1:], v[j:], vars) | |
else: | |
if len(m) != len(v): | |
raise Matcher.MatchError(m, v) | |
for i in range(len(m)): | |
Matcher.match(m[i], v[i], vars) | |
return vars | |
if isinstance(m, Matcher): | |
if m.value is not None: | |
Matcher.match(m.value, v, vars) | |
if m.name is not None and m.name != (): | |
Matcher.record(m.name, v, vars) | |
return vars | |
raise ValueError(f"Invalid value in Matcher: {m!r}") | |
def instantiate(m, vars=None): | |
if vars is None: | |
vars = dict() | |
if isinstance(m, str): | |
return m | |
if isinstance(m, tuple): | |
i = None | |
for j,mm in enumerate(m): | |
if isinstance(mm, Matcher) and mm.value is Ellipsis: | |
if i is None: | |
i = j | |
else: | |
raise ValueError(f"Can only match against one ellipsis at once") | |
if i is not None: | |
e = m[i] | |
j = (i+1)-len(m) | |
r0 = Matcher.instantiate(m[:i], vars) | |
if e.name is not None and e.name != (): | |
r1 = vars[e.name] | |
else: | |
raise ValueError(f"Unnamed ellipsis cannot be instantiated") | |
r2 = Matcher.instantiate(m[j:], vars) | |
return r0 + r1 + r2 | |
else: | |
return tuple(Matcher.instantiate(mm, vars) for mm in m) | |
if isinstance(m, Matcher): | |
if m.value is not None: | |
v = Matcher.instantiate(m.value, vars) | |
if m.name is not None and m.name != (): | |
Matcher.record(m.name, v, vars) | |
return v | |
else: | |
if m.name is not None and m.name != (): | |
return vars[m.name] | |
else: | |
raise ValueError(f"Cannot instantiate matcher without value and without name") | |
# Class for reifying it into actual data and processing it | |
class Description: | |
Types = "# Types" | |
Patterns = "# Patterns" | |
Rules = "# Rules" | |
Laws = "# Laws" | |
modes = set([Types, Patterns, Rules]) | |
# Parse the data from a list of rules into a slightly more structured | |
# representation | |
def __init__(self, *data): | |
# by name | |
type_aliases = dict() | |
self.types = dict() | |
# by type | |
ptrn_aliases = dict() | |
self.ptrns = dict() | |
# by name | |
func_aliases = dict() | |
self.funcs = dict() | |
mode = None | |
for (linenum, line) in enumerate(data): | |
try: | |
if line in Description.modes: | |
mode = line | |
continue | |
if mode == Description.Types: | |
if isinstance(line, str): | |
continue | |
assert isinstance(line, tuple) and len(line) | |
if line[0] == "alias": | |
assert len(line) == 3 | |
alias = line[1] | |
alibi = line[2] | |
if alias in type_aliases: | |
raise KeyError(f"Duplicate type alias") | |
type_aliases[alias] = alibi | |
continue | |
if mode == Description.Patterns: | |
if isinstance(line, str): | |
continue | |
assert isinstance(line, tuple) | |
assert len(line) == 3 | |
ty = line[0] | |
left = line[1] | |
right = line[2] | |
Matcher.verify_pattern_pair(left, right) | |
if ty not in self.ptrns: | |
self.ptrns[ty] = [] | |
self.ptrns[ty].append((Matcher(left), Matcher(right))) | |
continue | |
if mode == Description.Rules: | |
if isinstance(line, str): | |
continue | |
assert isinstance(line, tuple) | |
if isinstance(line[0], tuple): | |
name = line[0][0] | |
assert isinstance(name, str) | |
aliases = line[0][1:] | |
section = None | |
else: | |
assert isinstance(line[0], str) | |
parts = line[0].split("/") | |
name = parts[0] | |
section = tuple(parts[1:]) | |
aliases = None | |
if name not in self.funcs: | |
if section: | |
raise TypeError(f"Missing definition of {name}") | |
for alias in aliases or []: | |
assert isinstance(alias, str) | |
func_aliases[alias] = name | |
attrs = line[1] | |
assert isinstance(attrs, tuple) | |
signature = line[2:] | |
self.funcs[name] = Description.Function(attrs, signature) | |
else: | |
if aliases: | |
raise TypeError(f"Duplicate definition or malformed syntax") | |
self.funcs[name].add_case(*line[1:], name=section) | |
pass | |
continue | |
except Exception as e: | |
if len(e.args) == 1: | |
raise type(e)(e.args[0] + f" at line {linenum+1}: {line}") | |
raise Exception(e, f"at line {linenum+1}: {line}") | |
raise TypeError(f"Missing mode (start with Description.Types or Description.Rules)") | |
def copy(self): | |
other = Description() | |
other.types = {k:v.copy() for k,v in self.types.items()} | |
other.ptrns = {k:v.copy() for k,v in self.ptrns.items()} | |
other.funcs = {k:v.copy() for k,v in self.funcs.items()} | |
return other | |
class Function: | |
def __init__(self, attrs, signature): | |
self.attrs = attrs | |
self.inputs = signature[:-1] | |
self.output = signature[-1] | |
self.spec = Matcher.Lambda() | |
def copy(self): | |
other = Function(self.attrs, self.inputs + (self.output,)) | |
other.spec = self.spec.copy() | |
return other | |
def add_case(self, *args, **kwargs): | |
self.spec = self.spec[args] | |
case = self.spec.cases[-1] | |
case.name = kwargs['name'] | |
if len(case.inputs) != len(self.inputs): | |
raise TypeError(f"Wrong number of inputs, {len(case.inputs)} vs {len(self.inputs)}") | |
def unparse(self, name): | |
r = name + " :: " + " -> ".join(pretty(v) for v in [*self.inputs, self.output]) + "\n" | |
for case in self.spec.cases: | |
r += name + "/" + ("/".join(case.name) + "/" if len(case.name) and case.name != ("",) else "") | |
r += case.unparse() | |
return r | |
def unparse(self): | |
r = "" | |
for name in self.funcs: | |
r += self.funcs[name].unparse(name) | |
r += "\n" | |
return r | |
def inline(self): | |
pass | |
def add_method(cls): | |
def decorator(func): | |
setattr(cls, func.__name__, func) | |
return None | |
return decorator | |
# Compilation methods | |
# - helpers: | |
def nextFree(used, name): | |
try: | |
i = int(name[-1]) | |
name = name[:-1] | |
except: | |
i = 0 | |
while (ret := tuple((*name, str(i)))) in used: | |
i += 1 | |
used.add(ret) | |
return ret | |
# - linearization: | |
# - v1 =[v]= v2 -- just need to rename input occurrences and add | |
# side-conditions, output stays the same | |
# - first calculate which variables need to change | |
# - then for each, keep track of { [original_name]: latest_name } | |
# - first occurrence: instantiate original_name and latest_name with new name | |
# - next occurrences: rename, join this name with lastest name to another new | |
# name in statement, update map | |
# - at end, tie latest_name back to original_name via identity function | |
@add_method(Description) | |
def linearize(self): | |
for f in self.funcs: | |
self.funcs[f].linearize() | |
@add_method(Description.Function) | |
def linearize(self): | |
matcher = "eq" | |
tag = "match:" | |
for attr in self.attrs: | |
if attr[:len(tag)] == tag: | |
matcher = attr[len(tag):] | |
self.spec.linearize(matcher, dict()) | |
@add_method(Matcher.Lambda) | |
def linearize(self, matcher, vars): | |
for c in self.cases: | |
c.linearize(matcher, vars) | |
@add_method(Matcher.Lambda.Case) | |
def linearize(self, matcher, vars): | |
M = m | |
# This visits all the matchers used in inputs positions. | |
# It only recurses into lambdas if stacker is not None, though. | |
# (In particular, for gathering used variables, cases operate | |
# independently, with their results merged together.) | |
def visitinputs(visitor, m, stacker=None): | |
if isinstance(m, tuple): | |
for v in m: | |
visitinputs(visitor, v) | |
# If we are visiting a Matcher: | |
if type(m) == Matcher: | |
# Visit it if it has a name | |
if m.name is not None and m.name != (): | |
visitor(m) | |
# And visit its children: | |
visitinputs(visitor, m.value) | |
# If we are visiting a Lambda, descend only if we have a stacker: | |
if type(m) == Matcher.Lambda and stacker is not None: | |
# Push the stack | |
stacker[0]() | |
for v in m.cases: | |
# Prep the stack | |
stacker[1]() | |
visitinputs(visitor, v) | |
# Get the result off the stack | |
stacker[2]() | |
# Pop the stack | |
stacker[3]() | |
# If we are visiting a Case: | |
if type(m) == Matcher.Lambda.Case: | |
# Visit the inputs: | |
for v in m.inputs: | |
visitinputs(visitor, v, stacker) | |
# Visit the outputs of each statement: | |
for s in m.stmts: | |
visitinputs(visitor, s.output, stacker) | |
# And descend into the output, if it is a Lambda: | |
if isinstance(m.output, Matcher.Lambda): | |
visitinputs(visitor, m.output, stacker) | |
# We prep the used variables from the keys of vars | |
used = set(vars) | |
# And start by assuming 0 duplicates: | |
dups = set() | |
# Stack for recursion in Lambdas: | |
stack = [] | |
def push_stack(): | |
# running total (used,dups) then reset state (used,dups) | |
stack.append((used, dups, used, dups)) | |
def stack_start(): | |
# reset state from latter half of last item on stack | |
used = set(stack[-1][2]) | |
dups = set(stack[-1][3]) | |
def stack_end(): | |
# accumulate the running total back into the stack | |
stack[-1][0].update(used) | |
stack[-1][1].update(dups) | |
def pop_stack(): | |
# pop the result off of the stack | |
(used, dups) = stack.pop()[:2] | |
def collect(m): | |
if m.name in used: | |
dups.add(m.name) | |
else: | |
used.add(m.name) | |
visitinputs(collect, self, (push_stack, stack_start, stack_end, pop_stack)) | |
#print((used, dups)) | |
if len(dups) and matcher is None: | |
offenses = tuple(Matcher(name=d) for d in dups) | |
if len(offenses) == 1: offenses = offenses[0] | |
raise ValueError(f"No matching semantics specified for duplicate variables {offenses!r}") | |
preused = set(used) | |
# Okay, now we maintain a map of original_name to latest_name | |
# as we start renaming variables: | |
vars = dict(vars) | |
# And a list of sideconditions: | |
pre = [] | |
def renamer(m): | |
# If we see a name we've seen before: | |
if m.name in vars: | |
# Remember the latest name | |
lst = vars[m.name] | |
# Generate two new names | |
# (note: automatically added to used) | |
new = nextFree(used, lst) | |
dst = nextFree(used, new) | |
# Update the latest name | |
vars[m.name] = dst | |
# Rename to bind the new name instead | |
m.name = new | |
# And add side condition (lst =[dst]= new) | |
pre.append(M(matcher, Matcher(name=lst), Matcher(name=new), Matcher(name=dst))) | |
# If it is a new name: | |
elif m.name in dups: | |
# Simply rename freshly and record the new name: | |
vars[m.name] = nextFree(used, m.name) | |
m.name = vars[m.name] | |
# Now run it! over all the inputs of self and outputs of statements of self | |
visitinputs(renamer, self) | |
# Descend into the tail: | |
if isinstance(self.output, Matcher.Lambda): | |
# We need to keep track of the variables we generated, | |
# so we pass it down as part of vars | |
for k in used.difference(preused): | |
if k not in vars: | |
vars[k] = None | |
self.output.linearize(matcher, vars) | |
# Or, if there is no tail, do bookkeeping: | |
else: | |
# We could really just rename all variables in output, but it seems nice | |
# to use the intended name in the output, so we add assignments from the | |
# new name to the intended name: | |
post = [] | |
for (old,new) in vars.items(): | |
if new is not None: | |
post.append(M("identity", Matcher(name=new), Matcher(name=old))) | |
self.stmts = tuple(post) + self.stmts | |
# Add the preconditions to the list of statements | |
self.stmts = tuple(pre) + self.stmts | |
del linearize | |
m = Matcher() | |
def test(h): | |
return | |
print(h) | |
h.linearize("eq", dict()) | |
print(h) | |
print("---") | |
test(m[m.v, m.v][m.v, m.v]) | |
test(m[m.v, m.v, m.v]) | |
test(m[m.v, m[m.v, m.v]]) | |
test(m[m.v, m["", m.v][m.v, m.v]]) | |
class getter: | |
def __init__(self, wrapper=None): | |
if wrapper is None: | |
wrapper = lambda x: x | |
self.wrapper = wrapper | |
def __getitem__(self, x): | |
return self.wrapper(x) | |
class Builtin: | |
def __init__(self, key): | |
self.key = key | |
builtins = getter(Builtin) | |
Builtins =\ | |
( "Natural/build" | |
, "Natural/fold" | |
, "Natural/isZero" | |
, "Natural/even" | |
, "Natural/odd" | |
, "Natural/toInteger" | |
, "Natural/show" | |
, "Natural/subtract" | |
, "Integer/toDouble" | |
, "Integer/show" | |
, "Integer/negate" | |
, "Integer/clamp" | |
, "Double/show" | |
, "List/build" | |
, "List/fold" | |
, "List/length" | |
, "List/head" | |
, "List/last" | |
, "List/indexed" | |
, "List/reverse" | |
, "Text/show" | |
, "Text/replace" | |
, "Bool" | |
, "Optional" | |
, "Natural" | |
, "Integer" | |
, "Double" | |
, "Text" | |
, "List" | |
, "True" | |
, "False" | |
, "None" | |
, "Date" | |
, "Time" | |
, "TimeZone" | |
) | |
rules = Description\ | |
( Description.Types | |
# Just a sketch for now | |
# but the idea is that Text and List are the only primitives | |
, ("primitive", "Text") | |
, ("primitive", "List") | |
# and everything else is derived as like subtypes satisfying predicates | |
# FIXME | |
, ("subtype", "Natural", "[0-9]+") | |
, ("subtype", "Integer", "[-+][0-9]+") | |
, ("subtype", "Double", "[-+][0-9]+(.[0-9]+)?") | |
, ("enum", "Bool", "True", "False") | |
, ("enum", "Constant", "Type", "Kind", "Sort") | |
, ("alias", "VariableName", "Text") | |
, ("alias", "VariableIndex", "Natural") | |
# note to self: m.a() kind annotation, takes 0 arguments | |
, ("adt", m.a(), "Optional", "None", ("Some", m.a)) | |
, ("adt", m.a(), m.b(), "These", ("This", m.a), ("That", m.b), ("These", m.a, m.b)) | |
, ("adt", m.a(), "Projection", ("Labels", ("ByList", "Text")), ("ByType", m.a)) | |
, ("adt", m.a(), "TextLitF", ("TextLit", "Text"), ("TextInterp", "Text", m.a, ("TextLitF", m.a))) | |
, ("adt", m.a(), "ExprF", | |
("Variable", "VariableName", "VariableIndex"), | |
("Lambda", "Text", m.a, m.a), | |
("Forall", "Text", m.a, m.a), | |
("Let", "Text", ("Optional", m.a), m.a, m.a), | |
("If", m.a, m.a, m.a), | |
("Merge", m.a, m.a, ("Optional", m.a)), | |
("ToMap", m.a, ("Optional", m.a)), | |
("ListLit", ("List", m.a), ("Optional", m.a)), | |
("Annotation", m.a, m.a), | |
("||", m.a, m.a), | |
("+", m.a, m.a), | |
("++", m.a, m.a), | |
("#", m.a, m.a), | |
("&&", m.a, m.a), | |
("/\\", m.a, m.a), | |
("//", m.a, m.a), | |
("//\\\\", m.a, m.a), | |
("*", m.a, m.a), | |
("==", m.a, m.a), | |
("!=", m.a, m.a), | |
("===", m.a, m.a), | |
("?", m.a, m.a), | |
("Application", m.a, m.a), | |
("Field", m.a, "Text"), | |
("Project", m.a, ("Projection", m.a)), | |
("Completion", m.a, m.a), | |
("Assert", m.a), | |
("With", m.a, ("NonEmpty", "Text"), (m.a)), | |
("DoubleLit", "Double"), | |
("NaturalLit", "Natural"), | |
("IntegerLit", "Integer"), | |
("TextLit", ("TextLitF", m.a)), | |
("DateLit", "Date"), | |
("TimeLit", "Time"), | |
("TimeZoneLit", "TimeZone"), | |
("RecordType", ("Map", "Text", m.a)), | |
("RecordLiteral", ("Map", "Text", m.a)), | |
("UnionType", ("Map", "Text", ("Optional", m.a))), | |
("Import", "Import"), | |
("Some", m.a), | |
*Builtins, | |
("Constant", "Constant"), | |
) | |
, Description.Patterns | |
# Desugar ("Application", f, a, b, c) to ("Application", ("Application", ("Application", f, a), b), c) | |
, ("Expr", ("Application", m.a[...], m.a1, m.a2, m.a3), ("Application", ("Application", m.a[...], m.a1, m.a2), m.a3)) | |
# Desugar ("List", a) to ("Application", "List", a) | |
, ("Expr", ("List", m.a), ("Application", "List", m.a)) | |
, Description.Rules | |
# Potential for optimization to add unsafeRefEq for comparing expressions | |
# Note: these equality operators take two arguments and return the "merged" | |
# expression (important for metadata later) | |
, (("reference-equality", "refeq"), ("external",), m.a, m.a, m.a) | |
, ("reference-equality/", m.o, m.o, m.o) | |
# Syntactic equality | |
, (("syntactic-equality", "eq"), (), "Expr", "Expr", "Expr") | |
, ("syntactic-equality/reference-equality", m.l, m.r, m("reference-equality", m.l, m.r, m.o), m.o) # optimization | |
, ("syntactic-equality/", m.l, m.r, | |
m("traverseRTogether", m[(m.x, m.y), m("syntactic-equality", m.x, m.y, m.z), m.z], m.l, m.r, ("Some", m.o)), | |
m.o | |
) | |
# Judgmental equality via alpha-beta-normalization | |
, (("judgmental-equality", "judgeq"), (), "Expr", "Expr", "Expr") | |
, ("judgmental-equality/reference-equality", m.l, m.r, m("reference-equality", m.l, m.r, m.o), m.o) # optimization | |
, ("judgmental-equality/", m.l, m.r, | |
m("alpha-beta-normalize", m.l, m.x), | |
m("alpha-beta-normalize", m.r, m.y), | |
m("syntactic-equality", m.x, m.y, m.o), | |
m.o | |
) | |
# If the Expr is constant on a variable (considered at index 0) | |
# then return the constant (i.e. shift out the variable) | |
, ("constant", (), "Text", "Expr", "Expr") | |
, ("constant/", m.v, m.e, | |
m("shift", "-1", m.v, "0", m.e, m.r), | |
m.r | |
) | |
# ("shift-nat", d, n, n - d) if n-d>=0 | |
, ("shift-nat", ("external",), "Integer", "Natural", "Natural") | |
, ("le", ("external",), "Natural", "Natural", "Bool") | |
# Increment the last argument if the first two are equal | |
, ("if-eq-suc", (), "Text", "Text", "Natural", "Natural") | |
, ("if-eq-suc/eq", m.v, m.v, m.m, m("suc", m.m, m.m1), m.m1) | |
, ("if-eq-suc/neq", m._, m._, m.m, m.m) | |
, ("shift", (), "Integer", "Text", "Natural", "Expr", "Expr") | |
, ("shift/Variable", m.d, m.v, m.m, m.e("Variable", m.v, m.n), | |
m("le", m.m, m.n, "True"), | |
m("ensure-shift-nat", m.d, m.n, m.nd), | |
("Variable", m.v, m.nd), | |
) | |
, ("shift/Lambda", m.d, m.v, m.m, m.e("Lambda", m.u, m.A0, m.b0), | |
m("if-eq-suc", m.v, m.u, m.m, m.m1), | |
m("shift", m.d, m.v, m.m, m.A0, m.A1), | |
m("shift", m.d, m.v, m.m1, m.b0, m.b1), | |
("Lambda", m.u, m.A1, m.b1) | |
) | |
, ("shift/Forall", m.d, m.v, m.m, m.e("Forall", m.u, m.A0, m.B0), | |
m("if-eq-suc", m.v, m.u, m.m, m.m1), | |
m("shift", m.d, m.v, m.m, m.A0, m.A1), | |
m("shift", m.d, m.v, m.m1, m.B0, m.B1), | |
("Forall", m.u, m.A1, m.B1) | |
) | |
, ("shift/Let", m.d, m.v, m.m, m.e("Let", m.u, m.mA0, m.a0, m.b0), | |
m("if-eq-suc", m.v, m.u, m.m, m.m1), | |
m("traverse", m.mA0, m[m.A0, m("shift", m.d, m.v, m.m, m.A0, m.A1), m.A1], m.mA1), | |
m("shift", m.d, m.v, m.m, m.a0, m.a1), | |
m("shift", m.d, m.v, m.m1, m.b0, m.b1), | |
("Let", m.u, m.mA1, m.a0, m.b1) | |
) | |
, ("shift/Application", m.d, m.v, m.m, ("Application", m.f0, m.a0), | |
m("shift", m.d, m.v, m.m, m.f0, m.f1), | |
m("shift", m.d, m.v, m.m, m.a0, m.a1), | |
("Application", m.f1, m.a1) | |
) | |
, ("shift/Type", m.d, m.v, m.m, "Type", "Type") | |
, ("shift/Variable", m._, m._, m._, m.v("Variable", m._, m._), m.v) | |
, ("shift/", m.d, m.v, m.m, m.e1, | |
m("traverseR", m.e1, m[m.se1, m("shift", m.d, m.v, m.m, m.se1, m.se2), m.se2], m.e2), | |
m.e2 | |
) | |
, (("substitute", "subst"), (), "Text", "Natural", "Expr", "Expr", "Expr") | |
, ("substitute/Variable-match", m.v, m.m, m.r, ("Variable", m.v, m.m), m.r) | |
, ("substitute/Lambda", m.v, m.m, m.r, ("Lambda", m.u, m.A0, m.b0), | |
m("if-eq-suc", m.v, m.u, m.m, m.m1), | |
m("substitute", m.v, m.m, m.r, m.A0, m.A1), | |
m("shift", "1", m.u, "0", m.r, m.r1), | |
m("substitute", m.v, m.m1, m.r1, m.b0, m.b1), | |
("Lambda", m.u, m.A1, m.b1) | |
) | |
, ("substitute/Forall", m.v, m.m, m.r, ("Forall", m.u, m.A0, m.B0), | |
m("if-eq-suc", m.v, m.u, m.m, m.m1), | |
m("substitute", m.v, m.m, m.r, m.A0, m.A1), | |
m("shift", "1", m.u, "0", m.r, m.r1), | |
m("substitute", m.v, m.m, m.r1, m.B0, m.B1), | |
("Forall", m.u, m.A1, m.B1) | |
) | |
, ("substitute/Let", m.v, m.m, m.r, ("Let", m.v, m.mA0, m.a0, m.b0), | |
m("if-eq-suc", m.v, m.u, m.m, m.m1), | |
m("substitute", m.v, m.m, m.r, m.A0, m.A1), | |
m("shift", "1", m.v, "0", m.r, m.r1), | |
m("substitute", m.v, m.m1, m.r1, m.b0, m.b1), | |
("Lambda", m.v, m.A1, m.b1) | |
) | |
, ("substitute/", m.v, m.m, m.r, m.e1, | |
m("traverseR", m.e1, m[m.se1, m("substitute", m.v, m.m, m.r, m.se1, m.se2), m.se2], m.e2), | |
m.e2 | |
) | |
, ("shift-substitute-shift", ("inline",), "Text", "Expr", "Expr", "Expr") | |
, ("shift-substitute-shift/", m.v, m.r0, m.e0, | |
m("shift", "1", m.v, "0", m.r0, m.r1), | |
m("substitute", m.v, "0", m.r1, m.e0, m.e1), | |
m("shift", "-1", m.v, "0", m.e1, m.e2), | |
m.e2 | |
) | |
, ("rename-immediate", (), "Text", "Text", "Expr", "Expr") | |
, "Interestingly, this case is needed for correctness, not efficiency." | |
, ("rename-immediate/noop", m.v, m.v, m.e, m.e) | |
, ("rename-immediate/", m.v, m.u, m.e0, | |
m("shift-substitute-shift", m.v, ("Variable", m.u, "0"), m.e0, m.e1), | |
m.e1 | |
) | |
, (("alpha-normalize", "alpha"), (), "Expr", "Expr") | |
, ("alpha-normalize/Lambda", ("Lambda", m.v, m.A0, m.b0), | |
m("alpha-normalize", m.A0, m.A1), | |
m("rename-immediate", m.v, "_", m.b0, m.b1), | |
m("alpha-normalize", m.b1, m.b2), | |
("Lambda", "_", m.A1, m.b2) | |
) | |
, ("alpha-normalize/Forall", ("Forall", m.v, m.A0, m.B0), | |
m("alpha-normalize", m.A0, m.A1), | |
m("rename-immediate", m.v, "_", m.B0, m.B1), | |
m("alpha-normalize", m.B1, m.B2), | |
("Forall", "_", m.A1, m.B2) | |
) | |
, ("alpha-normalize/Let", ("Let", m.v, m.mA0, m.a0, m.b0), | |
m("traverse", m.mA0, m[m.A0, m("alpha-normalize", m.A0, m.A1), m.A1], m.mA1), | |
m("alpha-normalize", m.a0, m.a1), | |
m("rename-immediate", m.v, "_", m.b0, m.b1), | |
m("alpha-normalize", m.b1, m.b2), | |
("Let", "_", m.mA1, m.a1, m.b2) | |
) | |
, ("alpha-normalize/", m.e0, | |
m("traverseR", m.e0, m[m.se0, m("alpha-normalize", m.se0, m.se1), m.se1], m.e1), | |
m.e1 | |
) | |
, (("beta-normalize", "beta"), ("match:judgmental-equality",), "Expr", "Expr") | |
, ("beta-normalize/Bool/if_then_else_", ("if_then_else_", ("BoolLit", m.b), m.l, m.r), m(builtins["if_then_else_"], m.b, m.l, m.r, m.o), m.o) | |
, ("beta-normalize/Bool/if_then_else_/identity", ("if_then_else_", m.b, ("BoolLit", "true"), ("BoolLit", "false")), m.b) | |
, ("beta-normalize/Bool/if_then_else_/constant", ("if_then_else_", m._, m.e, m.e), m.e) | |
# It would be cool if we could automatically check confluence | |
# (unify patterns and check equality) | |
# Maybe generate runtime assertions that builtins["||"]("True", "True") == "True" | |
, ("beta-normalize/Bool/||/L-absorb", ("||", m.l("BoolLit", "True"), m._), m.l) | |
, ("beta-normalize/Bool/||/L-identity", ("||", m._("BoolLit", "False"), m.r), m.r) | |
, ("beta-normalize/Bool/||", ("||", ("BoolLit", m.l), ("BoolLit", m.r)), m(builtins["||"], m.l, m.r, m.o), ("BoolLit", m.o)) | |
, ("beta-normalize/Bool/||/R-absorb", ("||", m._, m.r("BoolLit", "True")), m.r) | |
, ("beta-normalize/Bool/||/R-identity", ("||", m.l, m._("BoolLit", "False")), m.l) | |
, ("beta-normalize/Bool/||/idempotence", ("||", m.e, m.e), m.e) | |
, ("beta-normalize/Bool/&&/L-absorb", ("&&", m.l("BoolLit", "False"), m._), m.l) | |
, ("beta-normalize/Bool/&&/L-identity", ("&&", m._("BoolLit", "True"), m.r), m.r) | |
, ("beta-normalize/Bool/&&", ("&&", ("BoolLit", m.l), ("BoolLit", m.r)), m(builtins["&&"], m.l, m.r, m.o), ("BoolLit", m.o)) | |
, ("beta-normalize/Bool/&&/R-absorb", ("&&", m._, m.r("BoolLit", "False")), m.r) | |
, ("beta-normalize/Bool/&&/R-identity", ("&&", m.l, m._("BoolLit", "True")), m.l) | |
, ("beta-normalize/Bool/&&/idempotence", ("&&", m.e, m.e), m.e) | |
, ("beta-normalize/Bool/==/L-identity", ("==", m._("BoolLit", "True"), m.r), m.r) | |
, ("beta-normalize/Bool/==", ("==", ("BoolLit", m.l), ("BoolLit", m.r)), m(builtins["=="], m.l, m.r, m.o), ("BoolLit", m.o)) | |
, ("beta-normalize/Bool/==/R-identity", ("==", m.l, m._("BoolLit", "True")), m.l) | |
, ("beta-normalize/Bool/==/idempotence", ("==", m.e, m.e), m.e) | |
, ("beta-normalize/Bool/!=/L-identity", ("!=", m._("BoolLit", "False"), m.r), m.r) | |
, ("beta-normalize/Bool/!=", ("!=", ("BoolLit", m.l), ("BoolLit", m.r)), m(builtins["!="], m.l, m.r, m.o), ("BoolLit", m.o)) | |
, ("beta-normalize/Bool/!=/R-identity", ("!=", m.l, m._("BoolLit", "False")), m.l) | |
, ("beta-normalize/Bool/!=/idempotence", ("!=", m.e, m.e), m.e) | |
, ("beta-normalize/Natural/build", ("Application", "Natural/build", m.g), | |
m("identity", ("Lambda", "x", "Natural", ("+", ("Variable", "x", "0"), ("NaturalLit", "1"))), m.succ), | |
m("identity", ("NaturalLit", "0"), m.zero), | |
m("beta-normalize", | |
("Application", m.g, "Natural", m.succ, m.zero), | |
m.b | |
), | |
m.b | |
) | |
, ("beta-normalize/Natural/fold", ("Application", "Natural/fold", ("NaturalLit", m.n), m.B, m.g, m.b), | |
m("fold-natural", m.n, m.b, m[m.r0, ("Application", m.g, m.r0)], m.r), | |
m.r | |
) | |
, ("beta-normalize/Natural/*/L-absorb", ("*", m.l("NaturalLit", "0"), m._), m.l) | |
, ("beta-normalize/Natural/*/L-identity", ("*", m._("NaturalLit", "1"), m.r), m.r) | |
, ("beta-normalize/Natural/*", ("*", ("NaturalLit", m.l), ("NaturalLit", m.r)), m(builtins["*"], m.l, m.r, m.o), ("NaturalLit", m.o)) | |
, ("beta-normalize/Natural/*/R-absorb", ("*", m.r("NaturalLit", "0"), m._), m.r) | |
, ("beta-normalize/Natural/*/R-identity", ("*", m.l, m._("NaturalLit", "1")), m.l) | |
, ("beta-normalize/Natural/+/L-identity", ("+", m._("NaturalLit", "0"), m.r), m.r) | |
, ("beta-normalize/Natural/+", ("+", ("NaturalLit", m.l), ("NaturalLit", m.r)), m(builtins["+"], m.l, m.r, m.o), ("NaturalLit", m.o)) | |
, ("beta-normalize/Natural/+/R-identity", ("+", m.l, m._("NaturalLit", "0")), m.l) | |
, ("beta-normalize/Natural/isZero", ("Application", "Natural/isZero", ("NaturalLit", m.n)), m(builtins["Natural/isZero"], m.n, m.o), ("BoolLit", m.o)) | |
, ("beta-normalize/Natural/even", ("Application", "Natural/even", ("NaturalLit", m.n)), m(builtins["Natural/even"], m.n, m.o), ("BoolLit", m.o)) | |
, ("beta-normalize/Natural/odd", ("Application", "Natural/odd", ("NaturalLit", m.n)), m(builtins["Natural/odd"], m.n, m.o), ("BoolLit", m.o)) | |
, ("beta-normalize/Natural/toInteger", ("Application", "Natural/toInteger", ("NaturalLit", m.n)), m(builtins["Natural/toInteger"], m.n, m.o), ("IntegerLit", m.o)) | |
, ("beta-normalize/Natural/show", ("Application", "Natural/show", ("NaturalLit", m.n)), m(builtins["Natural/show"], m.n, m.o), ("TextLit", m.o)) | |
, ("beta-normalize/Natural/subtract/L-zero", ("Application", "Natural/subtract", ("NaturalLit", "0"), m.n), m.n) | |
, ("beta-normalize/Natural/subtract/R-zero", ("Application", "Natural/subtract", m._, m.l("NaturalLit", "0")), m.l) | |
, ("beta-normalize/Natural/subtract/equal", ("Application", "Natural/subtract", m.n, m.n), ("NaturalLit", "0")) | |
, ("beta-normalize/Natural/subtract", ("Application", "Natural/subtract", ("NaturalLit", m.m), ("NaturalLit", m.n)), m(builtins["Natural/subtract"], m.m, m.n, m.o), ("NaturalLit", m.o)) | |
, ("beta-normalize/List/build", ("Application", "List/build", m.A0, m.g), | |
m("shift", "1", "a", "0", m.A0, m.A1), | |
m("identity", ("Lambda", "a", m.A0, ("Lambda", "as", ("Application", "List", m.A1), ("#", ("ListLit", (("Variable", "a", "0"),), "None"), ("Variable", "as", "0")))), m.succ), | |
m("identity", ("ListLit", (), ("Some", ("Application", "List", m.A0))), m.zero), | |
m("beta-normalize", | |
("Application", m.g, ("Application", "List", m.A0), m.succ, m.zero), | |
m.b | |
), | |
m.b | |
) | |
, ("beta-normalize/List/fold", ("Application", "List/fold", m.A0, ("ListLit", m.l, m._), m.B, m.g, m.b), | |
m("fold-list", m.l, m.b, m[m.a0, m.r0, ("Application", m.g, m.a0, m.r0)], m.r), | |
m.r | |
) | |
, ("beta-normalize/List/#/L-identity", ("#", ("ListLit", (), m._), m.r), m.r) | |
, ("beta-normalize/List/#/R-identity", ("#", m.l, ("ListLit", (), m._)), m.l) | |
, ("beta-normalize/List/#", ("#", ("ListLit", m.ls, "None"), ("ListLit", m.rs, "None")), | |
m(builtins["List/#"], m.ls, m.rs, m.lrs), | |
("ListLit", m.lrs, ()) | |
) | |
, """builtins…""" | |
, ("beta-normalize/Record/Field", ("Field", ("RecordLit", m.kvs), m.k), | |
m("find", m.kvs, m.k, m.v), | |
m.v | |
) | |
, ("beta-normalize/Record/Field/Project", ("Field", ("Project", m.rec, m.ks), m.k), | |
("Field", m.rec, m.k) | |
) | |
, ("beta-normalize/Record/Field/Prefer/L-yes", ("Field", ("Prefer", ("RecordLit", m.kvs), m.r), m.k), | |
m("find", m.kvs, m.k, m.v), | |
m.v | |
) | |
, ("beta-normalize/Record/Field/Prefer/L-no", ("Field", ("Prefer", ("RecordLit", m.kvs), m.r), m.k), | |
#m("not-found", m.kvs, m.k, ()), | |
("Field", m.r, m.k) | |
) | |
, ("beta-normalize/Record/Field/Prefer/R-yes", ("Field", ("Prefer", m.l, ("RecordLit", m.kvs)), m.k), | |
m("find", m.kvs, m.k, m.v), | |
m.v | |
) | |
, ("beta-normalize/Record/Field/Prefer/R-no", ("Field", ("Prefer", m.l, ("RecordLit", m.kvs)), m.k), | |
#m("not-found", m.kvs, m.k, ()), | |
("Field", m.l, m.k) | |
) | |
, ("beta-normalize/Record/Field/Combine/L-yes", ("Field", ("Combine", ("RecordLit", m.kvs), m.r), m.k), | |
m("find", m.kvs, m.k, m.v), | |
("Field", ("Combine", ("RecordLit", ((m.k, m.v),)), m.r), m.k) | |
) | |
, ("beta-normalize/Record/Field/Combine/L-no", ("Field", ("Combine", ("RecordLit", m.kvs), m.r), m.k), | |
#m("not-found", m.kvs, m.k, ()), | |
("Field", m.r, m.k) | |
) | |
, ("beta-normalize/Record/Field/Combine/R-yes", ("Field", ("Combine", m.l, ("RecordLit", m.kvs)), m.k), | |
m("find", m.kvs, m.k, m.v), | |
("Field", ("Combine", m.l, ("RecordLit", ((m.k, m.v),))), m.k) | |
) | |
, ("beta-normalize/Record/Field/Combine/R-no", ("Field", ("Combine", m.l, ("RecordLit", m.kvs)), m.k), | |
#m("not-found", m.kvs, m.k, ()), | |
("Field", m.l, m.k) | |
) | |
, ("beta-normalize/Record/Project/empty", ("Project", m.rec, ("ByLabels", ())), | |
("RecordLit", ()) | |
) | |
, ("beta-normalize/Record/Project", ("Project", ("RecordLit", m.kvs0), ("ByLabels", m.ks)), | |
# TODO | |
m("select", m.kvs0, m.ks, m.kvs1), | |
("RecordLit", m.kvs1) | |
) | |
, ("beta-normalize/Record/Project/Project", ("Project", ("Project", m.rec, m._), ("ByLabels", m.ks)), | |
("Project", m.rec, ("ByLabels", m.ks)) | |
) | |
, ("beta-normalize/Record/Project/Prefer", ("Project", ("Prefer", m.l, ("RecordLit", m.kvs)), ("ByLabels", m.ks)), | |
# TODO | |
m("separate", m.kvs, m.ks, m.lks, m.rks), | |
("Prefer", ("Project", m.l, ("ByFields", m.lks)), ("Project", m.r, ("ByFields", m.rks))) | |
) | |
, ("beta-normalize/Record/Project/Record", ("Project", m.rec, ("ByType", ("RecordType", m.kvs))), | |
m("void", m.kvs, m.ks), | |
("Project", m.rec, ("ByFields", m.ks)) | |
) | |
, """TODO""" | |
, ("beta-normalize/Application", ("Application", ("Lambda", m.v, m._, m.b), m.a), | |
m("shift-substitute-shift", m.v, m.a, m.b, m.r), | |
m.r | |
) | |
, ("beta-normalize/Let", ("Let", m.v, m._, m.a, m.b), | |
m("shift-substitute-shift", m.v, m.a, m.b, m.r), | |
m.r | |
) | |
, ("beta-normalize/Annotation", ("Annotation", m.v, m._), m.v) | |
, (("eta-normalize", "eta"), ("match:judgmental-equality",), "Expr", "Expr") | |
, ("eta-normalize/", | |
("Lambda", m.v, m.t, ("Application", m.f, ("Variable", m.v, "0"))), | |
m("constant", m.v, m.f, m.o), | |
m.o | |
) | |
, (("typecheck", "type"), ("match:judgmental-equality",), ("Context", "Expr"), "Expr", "Expr") | |
, ("typecheck/Variable", | |
m.ctx, | |
("Variable", m.x, m.n), | |
m("find-ctx", m.ctx, m.x, m.n, m.T), | |
m.T | |
) | |
, ("typecheck/Bool", m.ctx, "Bool", "Type") | |
, ("typecheck/BoolLit", m.ctx, ("BoolLit", m._), "Bool") | |
, ("typecheck/if_then_else_", m.ctx, ("if_then_else_", m.b, m.l, m.r), | |
m("typecheck", m.ctx, m.b, "Bool"), | |
m("typecheck", m.ctx, m.l, m.T), | |
m("typecheck", m.ctx, m.r, m.T), | |
m.T | |
) | |
, ("typecheck/||", m.ctx, ("||", m.l, m.r), | |
m("typecheck", m.ctx, m.l, "Bool"), | |
m("typecheck", m.ctx, m.r, "Bool"), | |
"Bool" | |
) | |
, ("typecheck/&&", m.ctx, ("&&", m.l, m.r), | |
m("typecheck", m.ctx, m.l, "Bool"), | |
m("typecheck", m.ctx, m.r, "Bool"), | |
"Bool" | |
) | |
, ("typecheck/==", m.ctx, ("==", m.l, m.r), | |
m("typecheck", m.ctx, m.l, "Bool"), | |
m("typecheck", m.ctx, m.r, "Bool"), | |
"Bool" | |
) | |
, ("typecheck/!=", m.ctx, ("!=", m.l, m.r), | |
m("typecheck", m.ctx, m.l, "Bool"), | |
m("typecheck", m.ctx, m.r, "Bool"), | |
"Bool" | |
) | |
, ("typecheck/Natural", m.ctx, "Natural", "Type") | |
, ("typecheck/NaturalLit", m.ctx, ("NaturalLit", m._), "Natural") | |
, ("typecheck/+", m.ctx, ("+", m.l, m.r), | |
m("typecheck", m.ctx, m.l, "Natural"), | |
m("typecheck", m.ctx, m.r, "Natural"), | |
"Natural" | |
) | |
, ("typecheck/*", m.ctx, ("*", m.l, m.r), | |
m("typecheck", m.ctx, m.l, "Natural"), | |
m("typecheck", m.ctx, m.r, "Natural"), | |
"Natural" | |
) | |
, ("typecheck/Natural/build", m.ctx, "Natural/build", | |
("Forall", "_", | |
("Forall", "natural", "Type", | |
("Forall", "succ", ("Forall", "_", ("Variable", "natural", "0"), ("Variable", "natural", "0")), | |
("Forall", "zero", ("Variable", "natural", "0"), | |
("Variable", "natural", "0") | |
))), | |
"Natural" | |
) | |
) | |
, ("typecheck/Natural/fold", m.ctx, "Natural/fold", | |
("Forall", "_", | |
"Natural", | |
("Forall", "natural", "Type", | |
("Forall", "succ", ("Forall", "_", ("Variable", "natural", "0"), ("Variable", "natural", "0")), | |
("Forall", "zero", ("Variable", "natural", "0"), | |
("Variable", "natural", "0") | |
))) | |
) | |
) | |
, ("typecheck/Natural/isZero", m.ctx, "Natural/isZero", | |
("Forall", "_", "Natural", "Bool") | |
) | |
, ("typecheck/Natural/even", m.ctx, "Natural/even", | |
("Forall", "_", "Natural", "Bool") | |
) | |
, ("typecheck/Natural/odd", m.ctx, "Natural/odd", | |
("Forall", "_", "Natural", "Bool") | |
) | |
, ("typecheck/Natural/toInteger", m.ctx, "Natural/toInteger", | |
("Forall", "_", "Natural", "Integer") | |
) | |
, ("typecheck/Natural/show", m.ctx, "Natural/show", | |
("Forall", "_", "Natural", "Text") | |
) | |
, ("typecheck/Natural/subtract", m.ctx, "Natural/subtract", | |
("Forall", "_", "Natural", ("Forall", "_", "Natural", "Natural")) | |
) | |
, ("typecheck/Text", m.ctx, "Text", "Type") | |
, ("typecheck/TextLiteral", m.ctx, ("TextLiteral", m.txt), | |
m("traverse_", m[m.t, m("typecheck", m.ctx, m.t, "Text"), ()], m.txt, ()), | |
"Text" | |
) | |
, ("typecheck/Text/show", m.ctx, "Text/show", | |
("Forall", "_", "Text", "Text") | |
) | |
, ("typecheck/Text/replace", m.ctx, "Text/replace", | |
("Forall", "needle", "Text", | |
("Forall", "replacement", "Text", | |
("Forall", "haystack", "Text", | |
"Text"))) | |
) | |
, ("typecheck/Text/++", m.ctx, ("++", m.l, m.r), | |
m("typecheck", m.ctx, m.l, "Text"), | |
m("typecheck", m.ctx, m.r, "Text"), | |
"Text", | |
) | |
, ("typecheck/Date", m.ctx, "Date", "Type") | |
, ("typecheck/Time", m.ctx, "Time", "Type") | |
, ("typecheck/TimeZone", m.ctx, "TimeZone", "Type") | |
, ("typecheck/Date", m.ctx, ("DateLiteral", m._), "Date") | |
, ("typecheck/Time", m.ctx, ("TimeLiteral", m._), "Time") | |
, ("typecheck/TimeZone", m.ctx, ("TimeZoneLiteral", m._), "TimeZone") | |
, ("typecheck/List", m.ctx, "List", ("Forall", "_", "Type", "Type")) | |
, ("typecheck/List/#", m.ctx, ("#", m.l, m.r), | |
m("typecheck", m.ctx, m.l, ("Application", "List", m.T)), | |
m("typecheck", m.ctx, m.r, ("Application", "List", m.T)), | |
("Application", "List", m.T) | |
) | |
, ("typecheck/RecordLit", | |
m.ctx, | |
("RecordLit", m.kvs), | |
m("ensureNodupes", m.kvs, ()), | |
m("traverse", m.typecheck, m.kvs, m.kts), | |
m.kts | |
) | |
, ("typecheck/Field", | |
m.ctx, | |
("Field", m.expr, m.field), | |
m("typecheck", m.expr, m.ty), | |
m(m | |
[("Record", m.kts), m("find", m.kts, m.field, m.fieldType), m.fieldType] | |
[("Const", m.c), m(m | |
[("Union", m.kts), | |
m("find", m.kts, m.field, m.mt), | |
m(m | |
[("Some", m.ty), | |
m("shift", m.field, "1", m.expr, m.result), | |
("Pi", m.field, m.ty, m.result) | |
] | |
["None", m.expr], | |
m.mt, | |
m.fieldType | |
), | |
m.fieldType | |
], | |
m.expr, | |
m.fieldType, | |
), m.fieldType], | |
m.ty, | |
m.fieldType | |
), | |
m.fieldType | |
) | |
, ("typecheck/Integer", m.ctx, "Integer", "Type") | |
, ("typecheck/IntegerLit", m.ctx, ("IntegerLit", m._), "Integer") | |
, ("typecheck/Integer/show", m.ctx, "Integer/show", | |
("Forall", "_", "Integer", "Text") | |
) | |
, ("typecheck/Integer/toDouble", m.ctx, "Integer/toDouble", | |
("Forall", "_", "Integer", "Double") | |
) | |
, ("typecheck/Integer/negate", m.ctx, "Integer/negate", | |
("Forall", "_", "Integer", "Integer") | |
) | |
, ("typecheck/Integer/clamp", m.ctx, "Integer/clamp", | |
("Forall", "_", "Integer", "Natural") | |
) | |
, ("typecheck/Double", m.ctx, "Double", "Type") | |
, ("typecheck/DoubleLit", m.ctx, ("DoubleLit", m._), "Double") | |
, ("typecheck/Double/show", m.ctx, "Double/show", | |
("Forall", "_", "Double", "Text") | |
) | |
, ("typecheck/Forall", m.ctx, | |
("Forall", m.x, m.A, m.B), | |
m("typecheck", m.ctx, m.A, ("Const", m.i)), | |
m("add-ctx", m.x, m.A, m.ctx, m.ctx1), | |
m("typecheck", m.ctx1, m.B, ("Const", m.o)), | |
m("imax", m.i, m.o, m.c), | |
("Const", m.c) | |
) | |
, ("typecheck/Lambda", m.ctx, | |
("Lambda", m.x, m.A, m.b), | |
m("typecheck", m.ctx, m.A, ("Const", m._)), | |
m("add-ctx", m.x, m.A, m.ctx, m.ctx1), | |
m("typecheck", m.ctx1, m.b, m.B), | |
("Forall", m.x, m.A, m.B) | |
) | |
, ("typecheck/Application", m.ctx, | |
("Application", m.f, m.a), | |
m("typecheck", m.ctx, m.f, ("Forall", m.x, m.A, m.B)), | |
m("typecheck", m.ctx, m.a, m.A), | |
("Application", ("Lambda", m.x, m.A, m.B), m.a), | |
) | |
, ("typecheck/Let", m.ctx, | |
("Let", m.x, m.mA, m.a, m.b), | |
m("typecheck", m.ctx, m.a, m.A), | |
m("traverse_", m[m.A, ()], m.mA, ()), | |
m("shift-substitute-shift", m.x, m.a, m.b, m.b1), | |
m("typecheck", m.ctx, m.b1, m.B), | |
m.B | |
) | |
, ("typecheck/Annot", m.ctx, ("Annot", m.a, m.A), | |
m("typecheck", m.ctx, m.a, m.A), | |
m.A | |
) | |
, ("typecheck/Assert", m.ctx, ("Assert", m.T), | |
m("typecheck", m.ctx, m.T, "Type"), | |
m("beta-normalize", m.T, ("Equivalent", m.x, m.x)), ("Equivalent", m.x, m.x) | |
) | |
, ("typecheck/Equivalent", m.ctx, ("Equivalent", m.x, m.y), | |
m("typecheck", m.ctx, m.x, m.A), | |
m("typecheck", m.ctx, m.y, m.A), | |
m("typecheck", m.ctx, m.A, "Type"), | |
"Type", | |
) | |
, Description.Laws | |
) | |
# Basic codegen for JS, including pattern matching and stuff | |
def genJS(d): | |
import json | |
r = "" | |
def mangle(name): | |
return name.replace("-", "_") | |
r += "const matchError = new Error(\"Match failure\");\n" | |
r += "const check = (c) => {if (!c) {throw matchError;}};\n" | |
r += "function $or(...fns) {\n" | |
r += " return function(...args) {\n" | |
r += " for (let fn of fns) {\n" | |
r += " try {\n" | |
r += " return fn(...args);\n" | |
r += " } catch(e) {\n" | |
r += " if (e !== matchError) throw e;\n" | |
r += " }\n" | |
r += " }\n" | |
r += " throw matchError;\n" | |
r += " }\n" | |
r += "}\n" | |
r += "function are_eq(a, b) {\n" | |
r += " if (a === b) return true;\n" | |
r += " if (typeof a !== typeof b) return false;\n" | |
r += " return (({\n" | |
r += " 'array': function() {\n" | |
r += " if (a.length !== b.length) return false;\n" | |
r += " return a.every((x, i) => are_eq(x, b[i]));\n" | |
r += " },\n" | |
r += " 'object': function() {\n" | |
r += " var ks = Object.keys(a);\n" | |
r += " if (!are_eq(ks, Object.keys(b))) return false;\n" | |
r += " return ks.every(k => are_eq(a[k], b[k]));\n" | |
r += " },\n" | |
r += " })[typeof a] || (() => false))();\n" | |
r += "}\n" | |
r += "function eq(a, b) {\n" | |
r += " if (are_eq(a,b)) {\n" | |
r += " return a;\n" | |
r += " } else {\n" | |
r += " throw matchError;\n" | |
r += " }\n" | |
r += "}\n" | |
r += "function identity(a) {\n" | |
r += " return a;\n" | |
r += "}\n" | |
def genFn(fn): | |
if len(fn.cases) == 1: | |
return "("+genCase(fn.cases[0])+")" | |
return "$or(\n" + ",\n".join(genCase(case) for case in fn.cases) + "\n)" | |
def genCase(case): | |
inputs = {"$i"+str(k):v for k,v in enumerate(case.inputs)} | |
r2 = "function ("+", ".join(inputs)+") {\n" | |
for k,i in inputs.items(): | |
r2 += genInput(k, i) | |
for k,i in enumerate(case.stmts): | |
r2 += genStatement(k, i) | |
r2 += "return " + genOutput(case.output) + ";\n" | |
r2 += "}" | |
return r2 | |
def check(cond): | |
return "if(!("+cond+")) {throw matchError;}\n" | |
def genInput(var, m): | |
if m is None: | |
return "" | |
if isinstance(m, str): | |
return check(f"{var} === {json.dumps(m)}") | |
if isinstance(m, tuple): | |
r2 = "" | |
r2 += check(f"{var}.length === {str(len(m))}") | |
for i,v in enumerate(m): | |
r2 += genInput(var+f"[{str(i)}]", v) | |
return r2 | |
if isinstance(m, Matcher): | |
r2 = genInput(var, m.value) | |
if m.name is not None and m.name != (): | |
r2 += "const " + "$".join(m.name) + " = " + var + ";\n" | |
return r2 | |
raise ValueError(f"Unhandled input matcher? {m!r}") | |
def genOutput(m): | |
if isinstance(m, str): | |
return json.dumps(m) | |
if isinstance(m, tuple): | |
return "[" + ", ".join(genOutput(o) for o in m) + "]" | |
if isinstance(m, Matcher.Lambda): | |
return genFn(m) | |
if not isinstance(m, Matcher): | |
raise TypeError(f"Not a valid output? {m!r}") | |
if m.name is not None and m.name != (): | |
if m.value is not None: | |
raise ValueError(f"Cannot have both name and value as output {m!r}") | |
return "$".join(m.name) | |
if m.value is None: | |
raise ValueError(f"Empty output match? {m!r}") | |
return genOutput(m.value) | |
def genStatement(i, m): | |
r2 = "const $s"+str(i) + " = " | |
if isinstance(m.fn, str): | |
r2 += mangle(m.fn) | |
elif isinstance(m.fn, Builtin): | |
r2 += "builtins["+json.dumps(m.fn.key)+"]" | |
else: | |
r2 += genFn(m.fn) | |
if len(m.inputs): | |
r2 += "(" | |
r2 += ", ".join(genOutput(v) for v in m.inputs) | |
r2 += ")" | |
r2 += ";\n" | |
r2 += genInput("$s"+str(i), m.output) | |
return r2 | |
for name in d.funcs: | |
r += "function " + mangle(name) + "(...$args) {\n" | |
r += " return " + genFn(d.funcs[name].spec) + "(...$args);\n" | |
r += "}\n" | |
try: | |
import jsbeautifier | |
return jsbeautifier.beautify(r)+"\n" | |
except Exception: | |
return r |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment