Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Squashed commit of the following:

Browse source 
commit 677a200a15
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri May 5 15:12:37 2023 +0200

    Removed GC, merge it into main to save correct commit history

commit a720b9ffd8
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri May 5 15:09:51 2023 +0200

    Peano

commit 22d9dd8efa
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri May 5 14:28:05 2023 +0200

    Fixed incorrect constructor name with Gilliam

commit 63fef958a7
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri May 5 14:09:54 2023 +0200

    Improved prelude

commit 7562949909
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri May 5 12:24:13 2023 +0200

    Finally, bug nr4 fixed

commit 513cb34eb5
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri May 5 12:22:36 2023 +0200

    back to inj

commit 47cbf12cd1
Merge: 010ca29 747de6a
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri May 5 11:44:17 2023 +0200

    Merge branch 'pattern-matching-with-typechecking' of github.com:bachelor-group-66-systemf/churf into pattern-matching-with-typechecking

commit 010ca29ced
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri May 5 11:44:08 2023 +0200

    Fixed wrong name bug -- samuel

commit 747de6a34e
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri May 5 11:43:17 2023 +0200

    Renaming symbols in desugar, removed incorrect comment in emits

commit fe25f18eb7
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri May 5 11:28:40 2023 +0200

    Fixed naming-cons bug in monomorphizer

commit 4aa72beccb
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Fri May 5 09:02:10 2023 +0200

    Add missing clauses. Still broken

commit 1d551e5874
Author: sebastian <sebastian.selander@gmail.com>
Date:   Fri May 5 00:35:48 2023 +0200

    added alternative better implemenatation of checkBind

commit 0a588c4e14
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu May 4 23:54:19 2023 +0200

    Revert AnnForall change

commit 15025a67f9
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu May 4 23:15:24 2023 +0200

    removed unused imports

commit 988d0dbb53
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu May 4 23:03:11 2023 +0200

    moved stuff

commit 4f21a58200
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu May 4 23:00:51 2023 +0200

    more symbols and changed err msg

commit 0dc06eaf80
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu May 4 22:50:15 2023 +0200

    Parens removed on types and infix symbols work almost, just need to adapt in LLVM

commit c309c439cb
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu May 4 21:30:19 2023 +0200

    Fixed bug when freshening types

commit 122bff7436
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu May 4 21:29:24 2023 +0200

    Sugar has arrived

commit c7b76cbbb4
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed May 3 18:56:16 2023 +0200

    Fixed a bug of repeated application of same function to arguments of
    differing types. More bufs appeared

commit 5a28f9d909
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed May 3 17:59:09 2023 +0200

    Bind now does correct subtype check.

commit f8a70b4cf4
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed May 3 17:58:50 2023 +0200

    Improved error messages

commit 4038f34cc5
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed May 3 15:08:07 2023 +0200

    Fixed woring order of monomorphization in ECase

commit e70eae776a
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue May 2 17:25:22 2023 +0200

    Maybe made lets work in monomorphizer 🙃

commit eba91ec646
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon May 1 22:50:37 2023 +0200

    The log folder is now created as well.

commit 22dcbc6a13
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon May 1 22:50:22 2023 +0200

    Various codegen fixes

commit 45578a79b1
Merge: 59da6d8 0452a30
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon May 1 16:14:10 2023 +0200

    Merge branch 'pattern-matching-with-typechecking' of github.com:bachelor-group-66-systemf/churf into pattern-matching-with-typechecking

commit 59da6d8864
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon May 1 16:14:01 2023 +0200

    Fixed printing bug in MorbIr, fixed Monomorphizer forgetting to output constructors on EInj

commit 0452a30409
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon May 1 16:01:39 2023 +0200

    Yoinked newer GC.

commit 3377879dd0
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon May 1 11:57:06 2023 +0200

    Small fix in morphBind

commit 0af2aac61e
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon May 1 11:53:18 2023 +0200

    Removed some warnings, better internal error

commit 6b72d08b94
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon May 1 11:09:23 2023 +0200

    Commented out `customHelperFunctionCuzPoorImplementation` as it is not needed with type annotations.

commit 78af9431b9
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon May 1 11:10:47 2023 +0200

    Remove clang 11

commit 63d805fa13
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon May 1 10:55:34 2023 +0200

    Uncomment prelude

commit 0fb13f59fb
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon May 1 10:47:07 2023 +0200

    Remove bad program

commit 8463dc2887
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Apr 29 21:58:39 2023 +0200

    Small fix to lambda lifter

commit d7a09a720b
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Sat Apr 29 17:55:18 2023 +0200

    Fixed more precise type annotation for monomorphizer

commit a87862a99f
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Apr 29 16:02:51 2023 +0200

    Fix sample programs

commit a2f61ea910
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Apr 29 15:56:01 2023 +0200

    Fix missing pattern synonym

commit 619242ccaf
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Apr 29 15:52:37 2023 +0200

    Fix lambda lifter

commit df1a5de04a
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Fri Apr 28 19:45:15 2023 +0200

    Add module to sort definitions

commit de03a2cc34
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Apr 28 14:52:47 2023 +0200

    The code generator can now compile without the GC.

commit f9d28028b5
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Apr 28 14:24:44 2023 +0200

    The GC argument is now passed to the compiler and codegen.

commit ddffe7913c
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Apr 28 14:22:02 2023 +0200

    Added an option to disable the garbage collector (this feature is not implemented fully yet.).

commit 38b88d36b5
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Fri Apr 28 14:20:24 2023 +0200

    Use throwError instead of error

commit e8d37c77cb
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Apr 28 14:10:39 2023 +0200

    Fixed a typo.

commit cb619c96a8
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Apr 28 14:10:22 2023 +0200

    Removed a stupid file

commit 1723796006
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Apr 28 14:01:05 2023 +0200

    renamed and fixed const in prelude

commit b27988b4d8
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Fri Apr 28 14:04:47 2023 +0200

    Add checking for case

commit 22ffdffa5a
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Apr 27 18:59:16 2023 +0200

    Fix pretty printer

commit 072f2206e6
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Apr 28 12:53:29 2023 +0200

    added const body again

commit e42c775135
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Apr 27 17:29:13 2023 +0200

    Fix prelude

commit 3729278041
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Apr 27 16:44:30 2023 +0200

    Unreachable branhces are removed, fixed a nasty bug in monomorphizer 😸

commit 46a4d3d252
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Apr 27 16:01:22 2023 +0200

    Fixed a bug with penums

commit e19c809d5e
Merge: 509b51d 39d0650
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Apr 27 15:09:45 2023 +0200

    Merge branch 'pattern-matching-with-typechecking' of github.com:bachelor-group-66-systemf/churf into pattern-matching-with-typechecking

commit 509b51d2de
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Apr 27 15:09:39 2023 +0200

    No output of wrongly typed cons

commit 39d0650115
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Apr 27 15:06:42 2023 +0200

    Fixed a booleans not being outputted as literals.

commit 579153b679
Merge: 60e12b6 d026dca
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Apr 27 14:02:10 2023 +0200

    Merged

commit 60e12b622e
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Apr 27 13:55:54 2023 +0200

    Using type annotations in case expressions, monomorphizer now handles case expressions without crashing

commit d026dca42f
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Apr 27 13:49:00 2023 +0200

    Attacked the code generator and added bool support.

commit 1a21698772
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Apr 27 12:57:36 2023 +0200

    mono fixier

commit 55fd35d661
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Apr 27 12:49:29 2023 +0200

    mono fix

commit e9852079ab
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Apr 27 12:43:02 2023 +0200

    bool now lit

commit 8782556603
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Apr 27 12:22:20 2023 +0200

    Fix types in pattersgit add .git add .

commit fc306d5f25
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Apr 27 11:43:56 2023 +0200

    Fix pattern types

commit fd418faa5f
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Apr 27 12:18:56 2023 +0200

    introduced lt in prelude

commit 2cb8527848
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Apr 25 23:02:56 2023 +0200

    Rename variables

commit e138cb27ec
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Apr 25 22:59:33 2023 +0200

    Simplify pattern matching

commit 9ffcbf66b9
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Apr 18 15:28:03 2023 +0200

    Added support for running GC profiller.

commit b5384bf2c3
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Apr 25 13:22:33 2023 +0200

    Fix typo

commit 2d96a50219
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 24 10:47:33 2023 +0200

    Change name

commit 804d0da167
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 24 10:10:15 2023 +0200

    Check number of arguments in pattern match

commit 25075ccaac
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Apr 20 15:36:36 2023 +0200

    added simple script for running benchmarks

commit 4bd5801c97
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Apr 18 15:52:33 2023 +0200

    Removed traces

commit 2611ddc2b2
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Apr 18 15:48:25 2023 +0200

    Fixed wrong handeling of EAdd in monomorphizer, as well as more documentation and cleanup

commit 7ab0e65981
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Apr 17 16:05:23 2023 +0200

    removed minor thing in EAdd

commit a23269f907
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon Apr 17 15:53:16 2023 +0200

    Fixed small bug in monomorphizer

commit c2bf6312f6
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Apr 12 16:36:22 2023 +0200

    Monomorphizer now outputs constructors that are matched on but not created

commit 0ab13e5979
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Apr 12 15:15:38 2023 +0200

    Fixed the ordering of data types.

commit 2b7715714e
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Apr 11 18:56:53 2023 +0200

    Use better names

commit 9730552eab
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Apr 11 13:46:54 2023 +0200

    Remove parenthesis from EAnn

commit a109b3010d
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Apr 8 21:52:57 2023 +0200

    Fix bad inference on case expression, and make pretty for report

commit 29de6c49e4
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Apr 8 13:39:00 2023 +0200

    Fix naming

commit 9cb4a620bb
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Apr 8 13:38:30 2023 +0200

    Fix redundant print paren

commit 21b1ba7b1f
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Apr 7 16:01:23 2023 +0200

    Replaced # with $

commit 9c699ecb63
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Apr 6 14:29:30 2023 +0200

    Fixed output of monomorphizer in main

commit 0d30cb80e0
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu Apr 6 14:19:54 2023 +0200

    removed pretty printing of tvars

commit e7cd3b2c3a
Author: Rakarake <51128488+Rakarake@users.noreply.github.com>
Date:   Thu Apr 6 14:12:45 2023 +0200

    Added README section about Nix

commit 90352449f4
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Apr 5 18:25:41 2023 +0200

    added todo for semi monomorphization

commit 05ea23d22c
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Wed Apr 5 17:41:17 2023 +0200

    Fix test error message

commit 9870802371
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 17:34:33 2023 +0200

    Add implicit foralls for bidir, update and unify pipeline

commit 12bca1c32d
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Apr 5 12:56:57 2023 +0200

    Added small comment about incorrect subtyping

commit c6e0e40ef1
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Apr 5 03:03:42 2023 +0200

    Monomorphizer now monomorphizes data

commit 5e5d258bb1
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 12:31:29 2023 +0200

    Update readme with identation syntax

commit 077f76eb12
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 12:24:22 2023 +0200

    Separate make file actions

commit e5dc28b282
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 12:11:21 2023 +0200

    Add pdf of grammar

commit a1b1343d67
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 12:04:52 2023 +0200

    Add latex file

commit 03bb6a8534
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 09:42:14 2023 +0200

    Fix sample-program

commit c998241c65
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 09:39:24 2023 +0200

    Fix tests

commit 0d6c5920a9
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 09:24:27 2023 +0200

    Fix type checker

commit cc5755c3a9
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Apr 3 09:24:13 2023 +0200

    Add layout grammar

commit bd02f52795
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Apr 2 13:48:11 2023 +0200

    Fixed structure a bit morer

commit faffb2744e
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Apr 2 13:47:35 2023 +0200

    Fixed structure a bit more

commit 6a2ebf4ecd
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Apr 2 13:46:46 2023 +0200

    Fixed structure a bit

commit 03a486410f
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Apr 2 13:42:47 2023 +0200

    Added somewhat detailed README

commit aaaff776e0
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Apr 2 00:42:42 2023 +0200

    Add some boiler plate for warnings

commit 6c180554ec
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Apr 2 00:04:33 2023 +0200

    Reworked order of inference, added prettifier for tvars etc etc.

commit ec8d554af1
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Apr 1 18:45:08 2023 +0200

    Disabled shadowing in pattern match with nice error message, added aux functions

commit 4b14cbdebf
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Apr 1 17:10:26 2023 +0200

    reverted Hindley-Milner type checker to before mutual recursion merge

commit ec57712eec
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 31 19:43:05 2023 +0200

    Fixed bad names after monomorphizer

commit c6173c0077
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 31 19:25:48 2023 +0200

    Plus now working in monomorphizer

commit b8f717f39f
Merge: 0749ca0 00e23a1
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 31 18:59:05 2023 +0200

    Merge branch 'monomorphizer-data' into pattern-matching-with-typechecking

commit 00e23a16dd
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 31 18:58:33 2023 +0200

    Monomorphization of datatypes done!

commit 0749ca062d
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 31 18:28:04 2023 +0200

    Merge in mutual recursion handling

commit b7420b5adb
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 31 18:27:30 2023 +0200

    Merge in mutual recursion handling

commit c4f78ca37d
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 31 18:26:58 2023 +0200

    Merge in mutual recursion handling

commit e2e469d84e
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 31 18:17:28 2023 +0200

    Added some examples that were shown to our handledare.

commit b0ec5a2333
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 31 18:16:26 2023 +0200

    Started working on a Case Desugar phase.

commit 15c18271ba
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 31 17:53:56 2023 +0200

    Monomorphizer, fixed problem with type of bind

commit d097cd28e8
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 31 17:02:54 2023 +0200

    New morb tree for internal use in monomorphizer, data types implemented

commit 7d2a0e60d8
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Mar 30 19:07:12 2023 +0200

    Fixes

commit 72352d9619
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Mar 30 18:46:37 2023 +0200

    Use use tevars for bind without type signatures, fix recursive functions

commit 4831205e67
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Mar 30 12:49:27 2023 +0200

    Remove incorrect test

commit 5d2c0e787e
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 30 15:08:40 2023 +0200

    The compiler is now compiled with O3.

commit 9b38c6d804
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 30 12:37:24 2023 +0200

    Main now prints the exit code of the program, as Haskell likes to hide segfaults.

commit b3525db7fd
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 30 12:31:03 2023 +0200

    Integrated the garbage collector.

commit bbe0d77a19
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Mar 30 12:35:47 2023 +0200

    Add signature of inferred bind to allow some mutually defined definitions

commit a37a52d9f8
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Mar 30 11:49:13 2023 +0200

    Apply env to return type. fixes #14

commit 2851c408d1
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 30 11:41:10 2023 +0200

    Added the updated GC.

commit c4477d3df4
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 30 11:38:06 2023 +0200

    moved some funcs to aux, added a universal definition of int and char, updated usages in both tcs

commit 59676605cd
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 30 10:55:01 2023 +0200

    moved injections back to state

commit c34041860d
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 30 10:21:04 2023 +0200

    duplicate signatures / declarations correct

commit c4931c3996
Author: sebastian <sebastian.selander@gmail.com>
Date:   Wed Mar 29 22:59:21 2023 +0200

    Fixed bug in EApp, cleaned a bit, added todo for disallowing mutual recursion

commit aa1ff630a5
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Wed Mar 29 22:48:26 2023 +0200

    Fix double vars

commit 343be08a4a
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Mar 29 18:47:14 2023 +0200

    Tried solving bug, failed, added todo message, fixed printing

commit 61f364cd75
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 29 17:34:47 2023 +0200

    Splat up the codegenerator a bit.

commit 36b6a8f781
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Mar 29 17:32:21 2023 +0200

    removed trace

commit 4efe7cf9a2
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Mar 29 17:30:31 2023 +0200

    inference does not depend on order. mutual recursion still not working correctly

commit 29fcddf44c
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Mar 29 17:05:56 2023 +0200

    Data defs in monomorphizer output environment

commit 53589e8d50
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 29 16:54:30 2023 +0200

    Made the output from running the compiler a bit clearer.

commit d26bde6a7f
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 29 16:47:52 2023 +0200

    Added a fun Maybe example!

commit d4115fd2f5
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Mar 29 16:45:30 2023 +0200

    Monomoprhizer handles new types

commit c59cd02361
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Wed Mar 29 16:37:52 2023 +0200

    Lift lambdas in the scrutinized expression

commit 2f12fdd7e2
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 29 15:29:53 2023 +0200

    Removed a trace.

commit f69151a7ce
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 29 15:12:33 2023 +0200

    Fixed a bug with pattern matching on literals.

commit 82f1b38f1b
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 29 14:41:52 2023 +0200

    Removed the Tjabatjena comment that the compiler generated.

commit 100b7b113a
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 29 14:31:24 2023 +0200

    We got pattern matching on data types!

commit 2860d47f11
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Mar 29 13:48:00 2023 +0200

    Case expressions implemented in monomorphizer

commit 4755f434fd
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Wed Mar 29 11:25:45 2023 +0200

    Add test for pattern matching on recursive data types, and remove traces

commit 52db1943bb
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Wed Mar 29 11:12:33 2023 +0200

    Finished new check pattern

commit 76b1c55065
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Mar 28 15:33:03 2023 +0200

    Progress

commit 133cc31e77
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Mar 28 14:36:43 2023 +0200

    Fix lambda lifter

commit 528369c95c
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Mar 27 23:55:04 2023 +0200

    Progress on new checkPattern

commit f20b80cab3
Author: sebastian <sebastian.selander@gmail.com>
Date:   Tue Mar 28 23:19:04 2023 +0200

    added skomeliation on given type signatures

commit 7c5041d270
Author: sebastian <sebastian.selander@gmail.com>
Date:   Tue Mar 28 21:52:09 2023 +0200

    added this stupid complex bug to Bugs.md

commit 9e6fe454ce
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 17:57:44 2023 +0200

    reverted back to most close to correct version

commit d8a75d6643
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 17:49:47 2023 +0200

    Solved 30+ WARNINGS!! 😎

commit c77139dfa8
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 17:47:43 2023 +0200

    Added a Malloc instruction.

commit 230a205965
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 17:37:29 2023 +0200

    Fixed wrongly typed functions in the code generator.

commit e87e2d3870
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 17:33:14 2023 +0200

    sneaky buggy fixy

commit 8910d8adc0
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 17:13:51 2023 +0200

    temporary commit incase of breakage

commit 91d6332dc5
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 28 17:14:55 2023 +0200

    Fixed removed args in tree after monomorphizer

commit 92a2ff3235
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 17:13:38 2023 +0200

    Fixed a broken path.

commit 4809cad1cb
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 16:54:11 2023 +0200

    Fixed chars.

commit ba832ba288
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 16:07:39 2023 +0200

    added printTree for monomorphizer

commit cf12c3443d
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 28 15:57:35 2023 +0200

    Main had a weird look

commit a7401f0ee3
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 28 15:55:06 2023 +0200

    Monomorphizer main fix

commit 43a863c153
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 15:44:03 2023 +0200

    fixed coerce type error

commit cca2f853ea
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 15:36:08 2023 +0200

    Added a variable lookup.

commit 5a70286802
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 15:35:34 2023 +0200

    Added a files back.

commit 7f0dab6dcb
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 15:35:48 2023 +0200

    adapted changes to work

commit 59d9be87cb
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Tue Mar 28 15:35:01 2023 +0200

    Add cases for lambda lifter

commit 5986e2108e
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 15:32:54 2023 +0200

    Added c output files to the gitignore

commit b35c19572f
Merge: b1d3e31 4a6c72f
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 28 15:26:35 2023 +0200

    Newer changes

commit b1d3e31efd
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 14:31:20 2023 +0200

    Fixed previously incorrect type equality check, commented code, add test

commit 85f31b129b
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 14:15:22 2023 +0200

    Yoinked over the garbage collector.

commit 2aff7a7743
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 13:50:19 2023 +0200

    Fixed argumentless constructors being treated as variables.

commit d7549d421c
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 13:49:34 2023 +0200

    Fixed a missing dependency.

commit 66e419efa6
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 11:53:25 2023 +0200

    Fixed the unnamed temporary bugs.

commit 58fe92affe
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 10:50:45 2023 +0200

    Revert "restructured layout of code a bit"

    This reverts commit 0639489d28.

commit 0639489d28
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 10:50:05 2023 +0200

    restructured layout of code a bit

commit 1558c98d10
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 10:46:04 2023 +0200

    improved the idea of error messages, still not very clean

commit 54f7d54bf9
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 10:10:26 2023 +0200

    fixed EAdd conversion bug in RemoveTEVars

commit 437c193ea8
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 28 10:07:30 2023 +0200

    fixed EAnn

commit 4d3d90c6a3
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 28 09:48:27 2023 +0200

    Added some debug options to the just file.

commit 0d2fe862e0
Author: sebastian <sebastian.selander@gmail.com>
Date:   Mon Mar 27 23:05:40 2023 +0200

    fixed bug and additional test

commit 4b24755b93
Author: sebastian <sebastian.selander@gmail.com>
Date:   Mon Mar 27 22:38:39 2023 +0200

    cleaned up implementations and added check for duplicate constructors

commit e1633ea147
Author: sebastian <sebastian.selander@gmail.com>
Date:   Mon Mar 27 21:16:48 2023 +0200

    small fixed and added qualifiedDo

commit a38e96a83b
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Mar 27 20:51:00 2023 +0200

    Fix Ident print instance

commit ad2bd645d9
Author: sebastian <sebastian.selander@gmail.com>
Date:   Mon Mar 27 20:33:11 2023 +0200

    tests are running now

commit 4a6c72fce0
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon Mar 27 20:11:49 2023 +0200

    Removed codegen to compile, type seem to work for newly added example

commit 0d23a59f0c
Merge: 2137414 bef7821
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon Mar 27 19:14:35 2023 +0200

    Merged into commit not compiling on codegen 😤

commit 506d8733d9
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 16:54:10 2023 +0200

    added old tests, still broken

commit 2adc3dceee
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 16:53:29 2023 +0200

    added old tests

commit d5ce73beae
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 16:52:22 2023 +0200

    hm is compatible

commit 6e54378327
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 16:48:23 2023 +0200

    Fixed errors in tc hm

commit 847ec37117
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Mar 27 16:32:48 2023 +0200

    Fixed the dependency on the Grammar Ident.

commit 750503063a
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Mar 27 16:31:47 2023 +0200

    Fixed the dependency on the Grammar Ident.

commit 72f4f26078
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Mar 27 16:31:30 2023 +0200

    Fixed the dependency on the Grammar Ident.

commit db2f8cd197
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Mar 27 16:21:01 2023 +0200

    Fix Codegen

commit 22783cf817
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 16:14:40 2023 +0200

    Removed custom Character in favor of BNFC Char

commit b7be75aa1e
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Mar 27 16:14:14 2023 +0200

    Fix TypeCheckerIr

commit 623c6d1e58
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Mar 27 16:11:33 2023 +0200

    Fixed language.cabal.

commit aab75a10f2
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 16:10:13 2023 +0200

    fixed justfile

commit 45527abd50
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Mon Mar 27 16:10:02 2023 +0200

    Fix module name

commit ac3f222753
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sat Feb 18 14:49:33 2023 +0100

    Add bidirectional type checker, lambda lifter.

commit 2fa30faa87
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 15:37:58 2023 +0200

    renamed stuff

commit aa4a615c28
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 27 14:44:21 2023 +0200

    fixed one bug

commit bd3cf3c3f1
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Mar 27 13:40:18 2023 +0200

    Fixed simple pattern matching.

commit 582747a997
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Mar 27 10:07:04 2023 +0200

    The created binary is now saved in the output folder.

commit 5062356cef
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Mar 27 10:05:39 2023 +0200

    Fixed broken padding on datatypes.

commit 91cfb21a35
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Sun Mar 26 22:21:44 2023 +0200

    Almost got a lot of bugs fixed.

commit 9952eb0279
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Sun Mar 26 21:10:20 2023 +0200

    Fixed the printing of TypeCheckerIr

commit c37db41431
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Mar 26 18:52:25 2023 +0200

    fixed bug

commit ccfae19541
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Sun Mar 26 18:38:07 2023 +0200

    Added .crf to every sample-program

commit 9ea3a3dc56
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Sun Mar 26 18:37:55 2023 +0200

    Added another bug.

commit ebac869761
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Sun Mar 26 18:24:12 2023 +0200

    Fixed a type error in teh codegen.

commit 4e92f86d60
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Mar 26 16:57:34 2023 +0200

    added test for bug. experimented with solutions, none found

commit 2af7855a77
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Mar 26 14:12:09 2023 +0200

    documented 3 bugs

commit 213741407b
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Mar 26 00:41:26 2023 +0100

    small add to Justfile

commit 2974c10c0c
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Mar 26 00:13:10 2023 +0100

    moved tests

commit d49e2401bf
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sun Mar 26 00:09:47 2023 +0100

    added file suffix and check

commit ac43af8110
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Mar 25 22:40:15 2023 +0100

    fixed a substitution bug where `ap` was incorrectly inferred.
    also added cleaner fresh variables

commit 975dd34063
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Mar 25 20:43:19 2023 +0100

    Better inference & stuff on pattern matches, added more tests for regression

commit 88eaa466e4
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Mar 25 19:17:46 2023 +0100

    Nested pattern matching should work correctly, added more tests

commit 3082444347
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Mar 25 18:42:11 2023 +0100

    fixed bugs potentially. tests are working atleast

commit 368413515b
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Mar 25 12:04:00 2023 +0100

    found incorrectly accepted program. added test

commit 05333c5689
Author: sebastian <sebastian.selander@gmail.com>
Date:   Sat Mar 25 00:02:38 2023 +0100

    started on cleaner unit tests

commit accbd4eea6
Author: sebastian <sebastian.selander@gmail.com>
Date:   Fri Mar 24 22:03:43 2023 +0100

    dummy monomorphizer complete

commit 7e246a94e5
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 19:57:49 2023 +0100

    Fixed a segfault.

commit f531afb3ab
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 19:04:29 2023 +0100

    added comment when codegen ok

commit 2566c53f58
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 19:01:33 2023 +0100

    mono adapt

commit 3e31fe0ea5
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 18:52:12 2023 +0100

    The compiler now also runs the outputed program.

commit b08ae7aef1
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 18:48:40 2023 +0100

    rewrote unification for data type and variable.
    could definitely be wrong. have to double check

commit e500c70529
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 18:46:12 2023 +0100

    Programs are now actually compiled all the way through.

commit e0c78f5783
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 18:32:33 2023 +0100

    debug for parse tree

commit b4cae11c0d
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 18:26:59 2023 +0100

    added debug info

commit 23c174607b
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 18:22:37 2023 +0100

    temp merge

commit 56ccd793ac
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 18:21:07 2023 +0100

    more error messages and better unification

commit 867485be12
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 17:40:57 2023 +0100

    removed trace

commit 41fc863658
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 17:39:10 2023 +0100

    added PEnum

commit d6d0fb7146
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 17:29:00 2023 +0100

    Enabled compiling to llvm again.

commit b1209b3353
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 17:13:56 2023 +0100

    Updated the monomorphizer to the new tree.

commit 3c2cb1a713
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 17:06:32 2023 +0100

    new good version works

commit f404acdbad
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 17:00:31 2023 +0100

    Updated some more changes.

commit 481667f2d8
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 16:10:46 2023 +0100

    added tc as well

commit 38680a4dcb
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 16:10:25 2023 +0100

    adapted new tree to fuck with samuel

commit 50bea83a18
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 13:55:06 2023 +0100

    Got some more stuff working.

commit f4163bbb7d
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 14:56:33 2023 +0100

    formatting

commit ce3971cf75
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 12:21:54 2023 +0100

    renamed stuff

commit 3f618e77f9
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 11:55:05 2023 +0100

    Got most of the codegenerator working.

commit 32f8a3e8a9
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 11:27:19 2023 +0100

    duplicate signatures disallowed

commit aa73f147f0
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 11:21:46 2023 +0100

    Remade lets with bind & improvements

commit 3371c3a146
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 24 11:21:25 2023 +0100

    Remade lets with bind & improvements

commit 30a79f34af
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Mar 24 10:57:21 2023 +0100

    Added some missing functionality to the dummy monomorphizer.

commit bef7821756
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 24 00:55:05 2023 +0100

    ReaderT rewrite, recursive and cyclic calls should work

commit fc60112877
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu Mar 23 22:07:55 2023 +0100

    Made binds keep args instead of lambda converting

commit 0012efabb7
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 22:01:40 2023 +0100

    Fixed some more stuff.

commit 75fa232e21
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 21:35:52 2023 +0100

    No more warnings, but everything to do with datatypes is outcommented.

commit 6cbc83c5d9
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 20:22:36 2023 +0100

    Fixed a miss.

commit c85010a8a1
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 20:20:17 2023 +0100

    Fixed ExpT

commit c6e8305215
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 23 18:15:25 2023 +0100

    created dummy monomorphizer

commit c19f821892
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 17:54:41 2023 +0100

    Switched around EId.

commit e283e83486
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 17:49:37 2023 +0100

    Fixed some reexports.

commit e3df4192bb
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 23 17:20:19 2023 +0100

    created dummy monomorphizer

commit 42c8ebc7b6
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 23 16:49:49 2023 +0100

    Making progress towards finished product

commit d3d173eb59
Merge: bf0064d 519ed8a
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 16:33:05 2023 +0100

    Merge remote-tracking branch 'origin/typechecking-merge' into pattern-matching-with-typechecking

commit bf0064db86
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 16:13:59 2023 +0100

    Added the trait ToIr.

commit 519ed8af6c
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 23 16:06:09 2023 +0100

    Added monadic fail to renamer

commit 129a70e051
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Thu Mar 23 15:29:25 2023 +0100

    WIP Added support for more types of cases.

commit 7fa677e3d3
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 23 14:18:23 2023 +0100

    typechecker working, still unsure of quality

commit 8d1330ad42
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 23 11:13:48 2023 +0100

    typechecker is compatible with one extra addition to the spec

commit 3335ab7a57
Author: sebastian <sebastian.selander@gmail.com>
Date:   Wed Mar 22 21:26:14 2023 +0100

    compatible, EId rule for parsing is not working, testing not done yet

commit 914855e20f
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Mar 22 17:52:39 2023 +0100

    working on adapting the typechecker

commit 936cb1301f
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Mar 22 12:45:51 2023 +0100

    new grammar and adapted renamer

commit cd85297b85
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 22 11:48:40 2023 +0100

    Removed the ear operator.

commit 61c844a255
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 22 11:46:07 2023 +0100

    Revamped getNewVar

commit feeef18cfd
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 22 11:41:02 2023 +0100

    Started implementing pattern matching on data types.

commit 88a4a934b8
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Mar 22 10:32:22 2023 +0100

    added more manual tests

commit d36370329e
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 22 10:24:00 2023 +0100

    Realized that getelementptr might be doing to right thing, and that the uninitialized data comes from padding.

commit 24007313cb
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Mar 22 10:10:11 2023 +0100

    added shadowing for ECase in Renamer

commit 33b69a1895
Author: sebastian <sebastian.selander@gmail.com>
Date:   Tue Mar 21 22:07:21 2023 +0100

    Improved formatting

commit 57fe8cd0a6
Author: sebastian <sebastian.selander@gmail.com>
Date:   Tue Mar 21 22:02:28 2023 +0100

     Fixed larger bug

     where pattern matching on `Just a` with type `Maybe b` could be used for
     any type.

commit 8f151b7531
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 21 17:15:15 2023 +0100

    Monomorphization of function applications should work

commit 509de4415e
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Mar 21 17:09:03 2023 +0100

    progress on fixing bugs

commit 71d07ebf0f
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 21 15:59:47 2023 +0100

    Fixed some internal errors

commit 3026a96eb7
Author: sebastian <sebastian.selander@gmail.com>
Date:   Tue Mar 21 14:51:06 2023 +0100

    added todo for class

commit 4c015a4aac
Author: sebastian <sebastian.selander@gmail.com>
Date:   Tue Mar 21 14:33:18 2023 +0100

    initial pattern matching implementation. should be somewhat correct

commit ae34c494f5
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 21 10:14:00 2023 +0100

    Improved the visibility checkup a little bit.

commit 91816abfe6
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 21 10:11:02 2023 +0100

    Constructors are now seen as global functions.

commit bbf7a47e74
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Tue Mar 21 09:39:05 2023 +0100

    Started updating the Code Generator to the new monomorphizer tree.

commit 9cd2cdb511
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 20 17:40:09 2023 +0100

    continued work on pattern matching v2

commit ec95e0d9ef
Author: Rakarake <williambodin2001@gmail.com>
Date:   Sun Mar 12 17:53:46 2023 +0100

    Monomorphizer cleanup

commit e2db863c3e
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 10 17:24:03 2023 +0100

    Fixed name clashes

commit 96c4a2bddf
Author: Rakarake <williambodin2001@gmail.com>
Date:   Fri Mar 10 17:20:23 2023 +0100

    Added test of multiple instanciations of same polymorphic function

commit c3ea343d00
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 10 16:54:29 2023 +0100

    unified top level type with expression type

commit 224a165715
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Mar 9 18:52:35 2023 +0100

    Unique names of new binds with different types

commit f10919ac20
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Mar 9 18:32:00 2023 +0100

    Better tests

commit 0e20670343
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Mar 8 17:52:41 2023 +0100

    Added check for recursive calls

commit d377ded7e1
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Mar 8 17:38:50 2023 +0100

    Deleted bad sample programs, added polymorphic call in polymorphic function test

commit 62724964d7
Author: sebastian <sebastian.selander@gmail.com>
Date:   Wed Mar 8 15:22:42 2023 +0100

    fixed Maybe ('a -> 'a) bug. Pattern matching still wonky, will have to redo

commit 350cd3b0e9
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 8 11:01:07 2023 +0100

    Started importing Sebastian's new typechecker.

commit d5dd7896d8
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 8 10:35:07 2023 +0100

    Moved modules into a proper folder structure.

commit ac0ac2dac7
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 8 10:27:39 2023 +0100

    Removed a few imports.

commit 2af00da482
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 8 10:25:53 2023 +0100

    Renamed the `compile` function to generate `code`

commit 832efbcdd8
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 8 10:24:52 2023 +0100

    Gave the code generator a proper module name.

commit bff75bb00b
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Wed Mar 8 10:22:21 2023 +0100

    Switched an Int to Integer.

commit 63f9689f38
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 7 18:49:21 2023 +0100

    Simple polymorphic and monomorphic functions properly morphed in test demo.

commit 887c3b8391
Author: Rakarake <williambodin2001@gmail.com>
Date:   Tue Mar 7 16:42:56 2023 +0100

    Working on bugs

commit fce54e7899
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 6 16:41:59 2023 +0100

    documented possible bad functions

commit eef6fa7668
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 6 16:25:03 2023 +0100

    added new test and found another bug

commit 6947614fba
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 6 13:04:07 2023 +0100

    Updated bug list & started working on more tests

commit f5b5f11903
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 6 11:38:25 2023 +0100

    fixed formatting

commit 9c2f52f8bb
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Mar 6 11:27:17 2023 +0100

    fixed bug where bound variable didn't exist in case

commit 8ca876a101
Author: Rakarake <williambodin2001@gmail.com>
Date:   Mon Mar 6 10:47:52 2023 +0100

    Most code written, no tests yet

commit 778fec3dc4
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Sun Mar 5 14:34:39 2023 +0100

    Implemented potential fix for one of the bugs

commit fe63fa6215
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Sun Mar 5 13:24:56 2023 +0100

    Improved error message and created document for known bugs.

commit fecb71bc07
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 3 18:17:51 2023 +0100

    Found a bug.

commit 03d7080396
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Mar 3 11:46:54 2023 +0100

    pattern matching works? have to test more

commit 7656b46e3f
Author: sebastian <sebastian.selander@gmail.com>
Date:   Thu Mar 2 22:07:38 2023 +0100

    a bit more work on pattern match + case expr

commit dbc77ec5f3
Author: Rakarake <williambodin2001@gmail.com>
Date:   Thu Mar 2 18:36:50 2023 +0100

    Progress

commit 2401b6437b
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Mar 2 16:05:43 2023 +0100

    continued work pattern matching

commit 514d79bd6c
Author: Rakarake <williambodin2001@gmail.com>
Date:   Wed Mar 1 13:50:01 2023 +0100

    Strucute in place, MonomorpherIr module created

commit 05313652f9
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Feb 28 17:15:48 2023 +0100

    unit tests, started on pattern matching

commit d23d417ff3
Author: Sebastian Selander <70573736+sebastianselander@users.noreply.github.com>
Date:   Mon Feb 27 19:38:45 2023 +0100

    Update TypeChecker.hs

commit bbf6e159c7
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Feb 27 17:22:42 2023 +0100

    Type inference/checking on ADTs mostly complete(?). Still have to test

commit 2f45f39435
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Feb 27 11:12:05 2023 +0100

    Incorporated most of main, as well as started on quickcheck

commit 7cf6f30835
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Feb 24 18:37:31 2023 +0100

    Data type constructors now properly tag the data.

commit 262543931c
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Feb 24 16:05:49 2023 +0100

    Types for data types are now created.

commit 272fbe3504
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Feb 24 09:29:55 2023 +0100

    Removed some unused code.

commit 5d004f4286
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Fri Feb 24 09:00:29 2023 +0100

    Added calling conventions to functions.

commit 06e65de235
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Feb 23 11:54:35 2023 +0100

    started on a test suite

commit 5daa5573f2
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Feb 22 15:24:38 2023 +0100

    Added more comments to the code

commit 8065576c31
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Feb 20 20:38:36 2023 +0100

    Let has a bug, otherwise probably(?) done

commit a98135827c
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Feb 20 16:51:44 2023 +0100

    EAdd is bugged. Mostly complete though.

commit 4df3f705ed
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Feb 20 16:44:27 2023 +0100

    LLVMIr code now has the fastcc flag to enable speeed 😎

commit afbc700db2
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Feb 20 16:43:54 2023 +0100

    Fixed the type checker accidentally chucking cases in some cases.

commit cd0f9dd456
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Feb 20 15:27:13 2023 +0100

    The output directory is now cleared when the program is ran.

commit a36de2bde1
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Feb 20 14:52:11 2023 +0100

    Added support for the minus operator.

commit fe4533c7ae
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Feb 20 14:39:56 2023 +0100

    Added an option to output some debug info.

commit 6749650223
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Feb 20 14:39:43 2023 +0100

    Added support for pattern matching on ints. Might need a lookover.

commit 18e0a92fe0
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Mon Feb 20 14:39:00 2023 +0100

    Added grammar for case matching.

commit dfbdb6678e
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Feb 20 12:09:31 2023 +0100

    Working on non-ugly version of algorithm W (Hindley-Milner)

commit 420fb107f0
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Sun Feb 19 15:25:49 2023 +0100

    Commented code and fixed some bugs I think. Still not complete

    id : Int -> Int
    id x = x
    does not type check

commit db932048ba
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Sun Feb 19 02:10:57 2023 +0100

    Tried fixing bug. Failed.

commit 8b5cd3cf9a
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Sat Feb 18 23:08:27 2023 +0100

    Remade the algorithm myself. Still some bugs.

commit a4c12ede79
Merge: 287f843 4ab6681
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Sat Feb 18 15:03:11 2023 +0100

    Merge branch 'prep-tc-martin' of github.com:bachelor-group-66-systemf/language into prep-tc-martin

commit 287f84377c
Author: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date:   Sat Feb 18 14:36:46 2023 +0100

    Implemented case matching on ints in the code generator

commit f188cffb8d
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 17 18:42:50 2023 +0100

    Unification part works (probably). Have a hard time understanding it.

commit 764faa582b
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 17 12:01:57 2023 +0100

    Remove hls pragmas

commit f2e8a02255
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 17 12:01:22 2023 +0100

    Removed adhoc tests

commit a9f54dbca1
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 17 11:09:48 2023 +0100

    Simplified quite a bit. Made a unify function. Still bugs left

commit eafe0fea0b
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Feb 16 16:37:36 2023 +0100

    Rewrote using unification-fd. Heavily inspired (aka copied) from:
    https://byorgey.wordpress.com/2021/09/08/implementing-hindley-milner-with-the-unification-fd-library/

commit f1b77a7efa
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Feb 15 19:52:52 2023 +0100

    Refactored. Cleaner version, ala Martin version

commit b03df17e34
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Feb 15 18:10:28 2023 +0100

    Minor changes. Added a comment

commit 7619e36c60
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Wed Feb 15 17:40:18 2023 +0100

    Inference works better now. Still work to do. Should use proper library

commit ad3f6b7011
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Feb 14 22:35:00 2023 +0100

    Attempt at fixing EApp, failed.

commit 5d247057f5
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Feb 14 22:03:56 2023 +0100

    Minor rewrite of tc. Some bugs still left

commit 6218efac20
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Feb 14 16:44:38 2023 +0100

    Renamer done.
    It renames bound variables to numbers, converts let to lambda, and
    removes all variables from binds

commit 53314551f5
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Feb 14 12:56:07 2023 +0100

    A bit cleaner code. A renamer is the focus to make the tc simpler

commit 200a9e57ed
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Feb 14 10:12:38 2023 +0100

    Fixed EId, more work on other expressions needed

commit c10d7703ad
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Feb 13 19:03:06 2023 +0100

    Progression on type checker ;)

commit 73dc2e4b6a
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Feb 13 12:17:49 2023 +0100

    Inference on most expressions. HM based.
    Still have to figure out how to infer type of lambda variables, as well
    as how function application on polymorphic should work

commit a1e9624d5e
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 10 12:09:08 2023 +0100

    TTGing the lambda lifter

commit f4f1786be3
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 10 10:41:16 2023 +0100

    Revert "Merge branch 'typechecking' into codegen-martin-3"

    This reverts commit e000e5159f, reversing
    changes made to 3ac8377fa0.

commit 771c73c0db
Merge: b6f03e9 e000e51
Author: Sebastian Selander <70573736+sebastianselander@users.noreply.github.com>
Date:   Fri Feb 10 10:33:50 2023 +0100

    Merge pull request #5 from bachelor-group-66-systemf/codegen-martin-3

    Codegen martin 3

commit e000e5159f
Merge: 3ac8377 b6f03e9
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 10 10:33:15 2023 +0100

    Merge branch 'typechecking' into codegen-martin-3

commit 3ac8377fa0
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 20:25:00 2023 +0100

    Fix auxiliary path

commit 59fb773bc1
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 20:24:25 2023 +0100

    Some clean up and documenting

commit 07bec3e7ef
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 20:24:06 2023 +0100

    Add auxiliary module

commit 7c313b3faa
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 20:23:49 2023 +0100

    Fix basic tests

commit 23261ec380
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 20:23:20 2023 +0100

    Add llvm dep

commit ce31e4d490
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 17:53:39 2023 +0100

    Fix first unnecessary supercombinator

commit b6f03e953b
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Thu Feb 9 09:42:44 2023 +0100

    deprecated branch

commit 7a2404cf74
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 06:19:58 2023 +0100

    Finish Lambda Lifter

commit 1f47288fcf
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 05:19:51 2023 +0100

    Implement lambda lifting passes: freeVars, abstract, and rename

commit b669381572
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Thu Feb 9 05:18:49 2023 +0100

    Remove files from git

commit 84eb430c41
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Fri Feb 3 11:29:42 2023 +0100

    relaxed base dependency and added overwrite

commit 6607173b93
Author: Patrik Jansson <patrik.ja@gmail.com>
Date:   Fri Feb 3 11:12:44 2023 +0100

    Typo fix (to check access).

commit be3fcfc9e3
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Tue Jan 24 16:39:22 2023 +0100

    Typeinference/checking on expressions done.

    Simplified the typechecker a bit, removed GADT solution for now.
    Still not fully working

commit b6b2dfa25f
Author: sebastianselander <sebastian.selander@gmail.com>
Date:   Mon Jan 23 17:17:06 2023 +0100

    Some work on a typechecker

commit 43e0f67fe2
Author: Martin Fredin <fredin.martin@gmail.com>
Date:   Sun Jan 22 20:16:03 2023 +0100

    Fix conflict
This commit is contained in:
sebastianselander 2023-05-05 15:20:55 +02:00
parent d115efe34b
commit 7663c7ad4e
65 changed files with 7018 additions and 1248 deletions
Download patch file Download diff file Expand all files Collapse all files

48
src/TypeChecker/Bugs.md Normal file
View file

@ -0,0 +1,48 @@
# Bugs
## Using uninstantiated type variables
Program below should not type check
```hs
data Test (a) where {
Test : b -> Test (a)
};
```
## Duplicate definitions of functions
Program below should not type check
```hs
id x = x ;
id x = x ;
```
## What?
Program below should not type check
```hs
main : a -> b ;
main x = x;
```
## Pattern match on functions
Program below should not type check
```hs
main = case \x. x of {
_ => 0;
};
```
# Inference should not depend on order
This one is really tough, strangely
Spent many hours on this so far
```hs
main = id 0 ;
id x = x;
```

49
src/TypeChecker/RemoveForall.hs Normal file
View file

@ -0,0 +1,49 @@
{-# LANGUAGE LambdaCase #-}
module TypeChecker.RemoveForall (removeForall) where
import Auxiliary (onM)
import Control.Applicative (Applicative (liftA2))
import Data.Function (on)
import Data.List (partition)
import Data.Tuple.Extra (second)
import Grammar.ErrM (Err)
import qualified TypeChecker.ReportTEVar as R
import TypeChecker.TypeCheckerIr
removeForall :: Program' R.Type -> Program
removeForall (Program defs) = Program $ map (DData . rfData) ds
++ map (DBind . rfBind) bs
where
(ds, bs) = ([d | DData d <- defs ], [ b | DBind b <- defs ])
rfData (Data typ injs) = Data (rfType typ) (map rfInj injs)
rfInj (Inj name typ) = Inj name (rfType typ)
rfBind (Bind name vars rhs) = Bind (rfId name) (map rfId vars) (rfExpT rhs)
rfId = second rfType
rfExpT (e, t) = (rfExp e, rfType t)
rfExp = \case
EApp e1 e2 -> on EApp rfExpT e1 e2
EAdd e1 e2 -> on EAdd rfExpT e1 e2
ELet bind e -> ELet (rfBind bind) (rfExpT e)
EAbs name e -> EAbs name (rfExpT e)
ECase e bs -> ECase (rfExpT e) (map rfBranch bs)
ELit lit -> ELit lit
EVar name -> EVar name
EInj name -> EInj name
rfBranch (Branch p e) = Branch (rfPatternT p) (rfExpT e)
rfPatternT (p, t) = (rfPattern p, rfType t)
rfPattern = \case
PVar name -> PVar name
PLit lit -> PLit lit
PCatch -> PCatch
PEnum name -> PEnum name
PInj name ps -> PInj name (map rfPatternT ps)
rfType :: R.Type -> Type
rfType = \case
R.TAll _ t -> rfType t
R.TFun t1 t2 -> on TFun rfType t1 t2
R.TData name ts -> TData name (map rfType ts)
R.TLit lit -> TLit lit
R.TVar tvar -> TVar tvar

84
src/TypeChecker/ReportTEVar.hs Normal file
View file

@ -0,0 +1,84 @@
{-# LANGUAGE LambdaCase #-}
module TypeChecker.ReportTEVar where
import Auxiliary (onM)
import Control.Applicative (Applicative (liftA2), liftA3)
import Control.Monad.Except (MonadError (throwError))
import Data.Coerce (coerce)
import Data.Tuple.Extra (secondM)
import Grammar.Abs qualified as G
import Grammar.ErrM (Err)
import Grammar.Print (printTree)
import TypeChecker.TypeCheckerIr hiding (Type (..))
data Type
= TLit Ident
| TVar TVar
| TData Ident [Type]
| TFun Type Type
| TAll TVar Type
deriving (Eq, Ord, Show, Read)
class ReportTEVar a b where
reportTEVar :: a -> Err b
instance ReportTEVar (Program' G.Type) (Program' Type) where
reportTEVar (Program defs) = Program <$> reportTEVar defs
instance ReportTEVar (Def' G.Type) (Def' Type) where
reportTEVar = \case
DBind bind -> DBind <$> reportTEVar bind
DData dat -> DData <$> reportTEVar dat
instance ReportTEVar (Bind' G.Type) (Bind' Type) where
reportTEVar (Bind id vars rhs) = liftA3 Bind (reportTEVar id) (reportTEVar vars) (reportTEVar rhs)
instance ReportTEVar (Exp' G.Type) (Exp' Type) where
reportTEVar exp = case exp of
EVar name -> pure $ EVar name
EInj name -> pure $ EInj name
ELit lit -> pure $ ELit lit
ELet bind e -> liftA2 ELet (reportTEVar bind) (reportTEVar e)
EApp e1 e2 -> onM EApp reportTEVar e1 e2
EAdd e1 e2 -> onM EAdd reportTEVar e1 e2
EAbs name e -> EAbs name <$> reportTEVar e
ECase e branches -> liftA2 ECase (reportTEVar e) (reportTEVar branches)
instance ReportTEVar (Branch' G.Type) (Branch' Type) where
reportTEVar (Branch (patt, t_patt) e) = liftA2 Branch (liftA2 (,) (reportTEVar patt) (reportTEVar t_patt)) (reportTEVar e)
instance ReportTEVar (Pattern' G.Type, G.Type) (Pattern' Type, Type) where
reportTEVar (p, t) = liftA2 (,) (reportTEVar p) (reportTEVar t)
instance ReportTEVar (Pattern' G.Type) (Pattern' Type) where
reportTEVar = \case
PVar name -> pure $ PVar name
PLit lit -> pure $ PLit lit
PCatch -> pure PCatch
PEnum name -> pure $ PEnum name
PInj name ps -> PInj name <$> reportTEVar ps
instance ReportTEVar (Data' G.Type) (Data' Type) where
reportTEVar (Data typ injs) = liftA2 Data (reportTEVar typ) (reportTEVar injs)
instance ReportTEVar (Inj' G.Type) (Inj' Type) where
reportTEVar (Inj name typ) = Inj name <$> reportTEVar typ
instance ReportTEVar (Id' G.Type) (Id' Type) where
reportTEVar = secondM reportTEVar
instance ReportTEVar (ExpT' G.Type) (ExpT' Type) where
reportTEVar (exp, typ) = liftA2 (,) (reportTEVar exp) (reportTEVar typ)
instance ReportTEVar a b => ReportTEVar [a] [b] where
reportTEVar = mapM reportTEVar
instance ReportTEVar G.Type Type where
reportTEVar = \case
G.TLit lit -> pure $ TLit (coerce lit)
G.TVar (G.MkTVar i) -> pure $ TVar (MkTVar $ coerce i)
G.TData name typs -> TData (coerce name) <$> reportTEVar typs
G.TFun t1 t2 -> liftA2 TFun (reportTEVar t1) (reportTEVar t2)
G.TAll (G.MkTVar i) t -> TAll (MkTVar $ coerce i) <$> reportTEVar t
G.TEVar tevar -> throwError ("Found TEVar: " ++ printTree tevar)

20
src/TypeChecker/TypeChecker.hs Normal file
View file

@ -0,0 +1,20 @@
module TypeChecker.TypeChecker (typecheck, TypeChecker (..)) where
import Control.Monad ((<=<))
import qualified Grammar.Abs as G
import Grammar.ErrM (Err)
import TypeChecker.RemoveForall (removeForall)
import qualified TypeChecker.ReportTEVar as R
import TypeChecker.ReportTEVar (reportTEVar)
import qualified TypeChecker.TypeCheckerBidir as Bi
import qualified TypeChecker.TypeCheckerHm as Hm
import TypeChecker.TypeCheckerIr
data TypeChecker = Bi | Hm deriving Eq
typecheck :: TypeChecker -> G.Program -> Err Program
typecheck tc = fmap removeForall . (reportTEVar <=< f)
where
f = case tc of
Bi -> Bi.typecheck
Hm -> fmap fst . Hm.typecheck

858
src/TypeChecker/TypeCheckerBidir.hs Normal file
View file

@ -0,0 +1,858 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module TypeChecker.TypeCheckerBidir (typecheck) where
import Auxiliary (int, litType, maybeToRightM, snoc)
import Control.Applicative (Applicative (liftA2), (<|>))
import Control.Monad.Except (ExceptT, MonadError (throwError),
forM, runExceptT, unless, zipWithM,
zipWithM_)
import Control.Monad.Extra (fromMaybeM, ifM)
import Control.Monad.State (MonadState, State, evalState, gets,
modify)
import Data.Coerce (coerce)
import Data.Foldable (foldlM)
import Data.Function (on)
import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isNothing)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as S
import qualified Data.Set as Set
import Data.Tuple.Extra (second)
import Debug.Trace (trace)
import Grammar.Abs
import Grammar.ErrM
import Grammar.Print (printTree)
import Prelude hiding (exp)
import qualified TypeChecker.TypeCheckerIr as T
-- Implementation is derived from the paper (Dunfield and Krishnaswami 2013)
-- https://doi.org/10.1145/2500365.2500582
--
-- TODO
-- • Fix problems with types in Pattern/Branch in TypeCheckerIr
-- • Remove EAdd
-- • Add kinds!!
data EnvElem = EnvVar LIdent Type -- ^ Term variable typing. x : A
| EnvTVar TVar -- ^ Universal type variable. α
| EnvTEVar TEVar -- ^ Existential unsolved type variable. ά
| EnvTEVarSolved TEVar Type -- ^ Existential solved type variable. ά = τ
| EnvMark TEVar -- ^ Scoping Marker. ▶ ά
deriving (Eq, Show)
type Env = Seq EnvElem
-- | Ordered context
-- Γ ::= ・| Γ, α | Γ, ά | Γ, ▶ ά | Γ, x:A
data Cxt = Cxt
{ env :: Env -- ^ Local scope context Γ
, sig :: Map LIdent Type -- ^ Top-level signatures x : A
, binds :: Map LIdent Exp -- ^ Top-level binds x : e
, next_tevar :: Int -- ^ Counter to distinguish ά
, data_injs :: Map UIdent Type -- ^ Data injections (constructors) K/inj : A
, currentBind :: LIdent -- ^ Used for recursive functions
} deriving (Show, Eq)
newtype Tc a = Tc { runTc :: ExceptT String (State Cxt) a }
deriving (Functor, Applicative, Monad, MonadState Cxt, MonadError String)
initCxt :: [Def] -> Cxt
initCxt defs = Cxt
{ env = mempty
, sig = Map.fromList [ (name, t)
| DSig' name t <- defs
]
, binds = Map.fromList [ (name, foldr EAbs rhs vars)
| DBind' name vars rhs <- defs
]
, next_tevar = 0
, data_injs = Map.fromList [ (name, foldr TAll t $ unboundedTVars t)
| DData (Data _ injs) <- defs
, Inj name t <- injs
]
, currentBind = ""
}
where
unboundedTVars = uncurry (Set.\\) . go (mempty, mempty)
where
go (unbounded, bounded) = \case
TAll tvar t -> go (unbounded, Set.insert tvar bounded) t
TVar tvar -> (Set.insert tvar unbounded, bounded)
TFun t1 t2 -> foldl go (unbounded, bounded) [t1, t2]
TData _ typs -> foldl go (unbounded, bounded) typs
_ -> (unbounded, bounded)
typecheck :: Program -> Err (T.Program' Type)
typecheck (Program defs) = do
dataTypes' <- mapM typecheckDataType [ d | DData d <- defs ]
binds' <- typecheckBinds (initCxt defs) [b | DBind b <- defs]
pure . T.Program $ map T.DData dataTypes' ++ map T.DBind binds'
typecheckBinds :: Cxt -> [Bind] -> Err [T.Bind' Type]
typecheckBinds cxt = flip evalState cxt
. runExceptT
. runTc
. mapM typecheckBind
typecheckBind :: Bind -> Tc (T.Bind' Type)
typecheckBind (Bind name vars rhs) = do
modify $ \cxt -> cxt { currentBind = name }
bind'@(T.Bind (name, typ) _ _) <- lookupSig name >>= \case
Just t -> do
(rhs', _) <- check (foldr EAbs rhs vars) t
pure (T.Bind (coerce name, t) [] (rhs', t))
Nothing -> do
(e, t) <- apply =<< infer (foldr EAbs rhs vars)
pure (T.Bind (coerce name, t) [] (e, t))
env <- gets env
unless (isComplete env) err
insertSig (coerce name) typ
putEnv Empty
pure bind'
where
err = throwError $ unlines
[ "Type inference failed: " ++ printTree (Bind name vars rhs)
, "Did you forget to add type annotation to a polymorphic function?"
]
-- TODO remove some checks
typecheckDataType :: Data -> Err (T.Data' Type)
typecheckDataType (Data typ injs) = do
(name, tvars) <- go [] typ
injs' <- mapM (\i -> typecheckInj i name tvars) injs
pure (T.Data typ injs')
where
go tvars = \case
TAll tvar t -> go (tvar:tvars) t
TData name typs
| Right tvars' <- mapM toTVar typs
, all (`elem` tvars) tvars'
-> pure (name, tvars')
_ -> throwError $ unwords ["Bad data type definition: ", ppT typ]
-- TODO remove some checks
typecheckInj :: Inj -> UIdent -> [TVar] -> Err (T.Inj' Type)
typecheckInj (Inj inj_name inj_typ) name tvars
| not $ boundTVars tvars inj_typ
= throwError "Unbound type variables"
| TData name' typs <- getDataId inj_typ
, name' == name
, Right tvars' <- mapM toTVar typs
, all (`elem` tvars) tvars'
= pure $ T.Inj (coerce inj_name) (foldr TAll inj_typ tvars')
| otherwise
= throwError $ unwords
["Bad type constructor: ", show name
, "\nExpected: ", ppT . TData name $ map TVar tvars
, "\nActual: ", ppT $ getDataId inj_typ
]
where
boundTVars :: [TVar] -> Type -> Bool
boundTVars tvars' = \case
TAll tvar t -> boundTVars (tvar:tvars') t
TFun t1 t2 -> on (&&) (boundTVars tvars') t1 t2
TVar tvar -> elem tvar tvars'
TData _ typs -> all (boundTVars tvars) typs
TLit _ -> True
TEVar _ -> error "TEVar in data type declaration"
---------------------------------------------------------------------------
-- * Typing rules
---------------------------------------------------------------------------
-- | Γ ⊢ e ↑ A ⊣ Δ
-- Under input context Γ, e checks against input type A, with output context ∆
check :: Exp -> Type -> Tc (T.ExpT' Type)
-- Γ,α ⊢ e ↑ A ⊣ Δ,α,Θ
-- ------------------- ∀I
-- Γ ⊢ e ↑ ∀α.A ⊣ Δ
check e (TAll alpha a) = do
let env_tvar = EnvTVar alpha
insertEnv env_tvar
e' <- check e a
(env_l, _) <- gets (splitOn env_tvar . env)
putEnv env_l
apply e'
-- Γ,(x:A) ⊢ e ↑ B ⊢ Δ,(x:A),Θ
-- --------------------------- →I
-- Γ ⊢ λx.e ↑ A → B ⊣ Δ
check (EAbs x e) (TFun a b) = do
let env_var = EnvVar x a
insertEnv env_var
e' <- check e b
(env_l, _) <- gets (splitOn env_var . env)
putEnv env_l
apply (T.EAbs (coerce x) e', TFun a b)
--FIXME
-- Γ ⊢ e ↑ A ⊣ Θ Θ ⊢ Π ∷ [Θ]A ↓ C ⊣ Δ
-- ------------------------------------ Case
-- Γ ⊢ case e of Π ↓ C ⊣ Δ
check (ECase scrut pi) c = do
(scrut', a) <- infer scrut
case pi of
[] -> do
subtype a c
apply (T.ECase (scrut', a) [], a)
_ -> do
pi' <- forM pi $ \(Branch p e) -> do
p' <- checkPattern p =<< apply a
e' <- check e c
pure (T.Branch p' e')
apply (T.ECase (scrut', a) pi', c)
where
go (pi, b) (Branch p e) = do
p' <- checkPattern p =<< apply a
e'@(_, b') <- infer e
subtype b' b
apply (T.Branch p' e' : pi, b')
-- Γ,α ⊢ e ↓ A ⊣ Θ Θ ⊢ [Θ]A <: [Θ]B ⊣ Δ
-- -------------------------------------- Sub
-- Γ ⊢ e ↑ B ⊣ Δ
check e b = do
(e', a) <- infer e
b' <- apply b
subtype a b'
apply (e', b)
checkPattern :: Pattern -> Type -> Tc (T.Pattern' Type, Type)
checkPattern patt t_patt = case patt of
-- -------------------
-- Γ ⊢ x ↑ A ⊣ Γ,(x:A)
PVar x -> do
insertEnv $ EnvVar x t_patt
apply (T.PVar (coerce x), t_patt)
-- -------------
-- Γ ⊢ _ ↑ A ⊣ Γ
PCatch -> apply (T.PCatch, t_patt)
-- Γ ⊢ τ ↓ A ⊣ Γ Γ ⊢ A <: B ⊣ Δ
-- ------------------------------
-- Γ ⊢ τ ↑ B ⊣ Δ
PLit lit -> do
subtype (litType lit) t_patt
apply (T.PLit lit, t_patt)
-- Γ ∋ (K : A) Γ ⊢ A <: B ⊣ Δ
-- ---------------------------
-- Γ ⊢ K ↑ B ⊣ Δ
PEnum name -> do
t <- maybeToRightM ("Unknown constructor " ++ show name)
=<< lookupInj name
subtype t t_patt
apply (T.PEnum (coerce name), t_patt)
-- Example
-- Γ ∋ (K : A) let A = ∀α. A₁ -> A₂ -> Tτs
-- Γ ⊢ [ά/α]Tτs <: B ⊣ Θ₁
-- Θ ⊢ p₁ ↑ [Θ][ά/α]A₁ ⊣ Θ₂
-- Θ₂ ⊢ p₂ ↑ [Θ₂][ά/α]A₂ ⊣ Δ
-- ---------------------------
-- Γ ⊢ K p₁ p₂ ↑ B ⊣ Δ
PInj name ps -> do
t_inj <- maybeToRightM "unknown constructor" =<< lookupInj name
let ts = getArgs t_inj
unless (length ts == length ps)
$ throwError "Wrong number of arguments!"
-- [ά/α]
sub <- substituteTVarsOf t_inj
subtype (sub $ getDataId t_inj) t_patt
let check p t = checkPattern p =<< apply (sub t)
ps' <- zipWithM check ps ts
apply (T.PInj (coerce name) ps', t_patt)
where
substituteTVarsOf = \case
TAll tvar t -> do
tevar <- fresh
(substitute tvar tevar .) <$> substituteTVarsOf t
_ -> pure id
getArgs = \case
TAll _ t -> getArgs t
t -> go [] t
where
go acc = \case
TFun t1 t2 -> go (snoc t1 acc) t2
_ -> acc
-- | Γ ⊢ e ↓ A ⊣ Δ
-- Under input context Γ, e infers output type A, with output context ∆
infer :: Exp -> Tc (T.ExpT' Type)
infer (ELit lit) = apply (T.ELit lit, litType lit)
-- Γ ∋ (x : A) Γ ⊢ rec(x)
-- ------------- Var --------------------- VarRec
-- Γ ⊢ x ↓ A ⊣ Γ Γ ⊢ x ↓ ά ⊣ Γ,(x : ά)
infer (EVar x) = do
a <- ifM (gets $ (x==) . currentBind) varRec var
apply (T.EVar (coerce x), a)
where
var = maybeToRightM "Can't infer" =<<
liftA2 (<|>) (lookupEnv x) (lookupSig x)
varRec = do
alpha <- TEVar <$> fresh
insertEnv (EnvVar x alpha)
pure alpha
infer (EInj kappa) = do
t <- maybeToRightM ("Unknown constructor: " ++ show kappa)
=<< lookupInj kappa
apply (T.EInj $ coerce kappa, t)
-- Γ ⊢ A Γ ⊢ e ↑ A ⊣ Δ
-- --------------------- Anno
-- Γ ⊢ (e : A) ↓ A ⊣ Δ
infer (EAnn e a) = do
_ <- gets $ (`wellFormed` a) . env
(e', _) <- check e a
apply (e', a)
-- Γ ⊢ e₁ ↓ A ⊣ Θ Γ ⊢ [Θ]A • ⇓ C ⊣ Δ
-- ----------------------------------- →E
-- Γ ⊢ e₁ e₂ ↓ C ⊣ Δ
infer (EApp e1 e2) = do
e1'@(_, a) <- infer e1
(e2', c) <- applyInfer a e2
apply (T.EApp e1' e2', c)
-- Γ,ά,έ,(x:ά) ⊢ e ↑ έ ⊣ Δ,(x:ά),Θ
-- ------------------------------- →I
-- Γ ⊢ λx.e ↓ ά → έ ⊣ Δ
infer (EAbs name e) = do
alpha <- fresh
epsilon <- fresh
insertEnv $ EnvTEVar alpha
insertEnv $ EnvTEVar epsilon
let env_var = EnvVar name (TEVar alpha)
insertEnv env_var
e' <- check e $ TEVar epsilon
dropTrailing env_var
apply (T.EAbs (coerce name) e', on TFun TEVar alpha epsilon)
-- Γ ⊢ rhs ↓ A ⊣ Θ Θ,(x:A) ⊢ e ↑ C ⊣ Δ,(x:A),Θ
-- -------------------------------------------- LetI
-- Γ ⊢ let x = rhs in e ↑ C ⊣ Δ
infer (ELet (Bind x vars rhs) e) = do
(rhs', a) <- infer $ foldr EAbs rhs vars
let env_var = EnvVar x a
insertEnv env_var
e'@(_, c) <- infer e
(env_l, _) <- gets (splitOn env_var . env)
putEnv env_l
apply (T.ELet (T.Bind (coerce x, a) [] (rhs', a)) e', c)
-- Γ ⊢ e₁ ↑ Int ⊣ Θ Θ ⊢ e₂ ↑ Int
-- --------------------------- +I
-- Γ ⊢ e₁ + e₂ ↓ Int ⊣ Δ
infer (EAdd e1 e2) = do
e1' <- check e1 int
e2' <- check e2 int
apply (T.EAdd e1' e2', int)
--FIXME
-- Γ ⊢ e ↑ A ⊣ Θ Θ ⊢ Π ∷ [Θ]A ↑ C ⊣ Δ
-- ------------------------------------ Case
-- Γ ⊢ case e of Π ↓ C ⊣ Δ
infer (ECase scrut pi) = do
(scrut', a) <- infer scrut
case pi of
[] -> apply (T.ECase (scrut', a) [], a)
(Branch _ e):_ -> do
(_, b)<- infer e
(pi', b') <- foldlM go ([], b) pi
apply (T.ECase (scrut', a) pi', b')
where
go (pi, b) (Branch p e) = do
p' <- checkPattern p =<< apply a
e'@(_, b') <- infer e
subtype b' b
apply (T.Branch p' e' : pi, b')
-- | Γ ⊢ A • e ⇓ C ⊣ Δ
-- Under input context Γ , applying a function of type A to e infers type C, with output context ∆
-- Instantiate existential type variables until there is an arrow type.
applyInfer :: Type -> Exp -> Tc (T.ExpT' Type, Type)
-- Γ,ά ⊢ [ά/α]A • e ⇓ C ⊣ Δ
-- ------------------------ ∀App
-- Γ ⊢ ∀α.A • e ⇓ C ⊣ Δ
applyInfer (TAll alpha a) e = do
alpha' <- fresh
insertEnv $ EnvTEVar alpha'
applyInfer (substitute alpha alpha' a) e
-- Γ[ά₂,ά₁,(ά=ά₁→ά₂)] ⊢ e ↑ ά₁ ⊣ Δ
-- ------------------------------- άApp
-- Γ[ά] ⊢ ά • e ⇓ ά₂ ⊣ Δ
applyInfer (TEVar alpha) e = do
alpha1 <- fresh
alpha2 <- fresh
(env_l, env_r) <- gets (splitOn (EnvTEVar alpha) . env)
putEnv $ (env_l
:|> EnvTEVar alpha2
:|> EnvTEVar alpha1
:|> EnvTEVarSolved alpha (on TFun TEVar alpha1 alpha2)
) <> env_r
e' <- check e $ TEVar alpha1
apply (e', TEVar alpha2)
-- Γ ⊢ e ↑ A ⊣ Δ
-- --------------------- →App
-- Γ ⊢ A → C • e ⇓ C ⊣ Δ
applyInfer (TFun a c) e = do
exp' <- check e a
apply (exp', c)
applyInfer a e = throwError ("Cannot apply type " ++ show a ++ " with expression " ++ show e)
---------------------------------------------------------------------------
-- * Subtyping rules
---------------------------------------------------------------------------
-- | Γ ⊢ A <: B ⊣ Δ
-- Under input context Γ, type A is a subtype of B, with output context ∆
subtype :: Type -> Type -> Tc ()
subtype (TLit lit1) (TLit lit2) | lit1 == lit2 = pure ()
-- -------------------- <:Var
-- Γ[α] ⊢ α <: α ⊣ Γ[α]
subtype (TVar alpha) (TVar alpha') | alpha == alpha' = pure ()
-- -------------------- <:Exvar
-- Γ[ά] ⊢ ά <: ά ⊣ Γ[ά]
subtype (TEVar alpha) (TEVar alpha') | alpha == alpha' = pure ()
-- Γ ⊢ B₁ <: A₁ ⊣ Θ Θ ⊢ [Θ]A₂ <: [Θ]B₂ ⊣ Δ
-- ----------------------------------------- <:→
-- Γ ⊢ A₁ → A₂ <: B₁ → B₂ ⊣ Δ
subtype (TFun a1 a2) (TFun b1 b2) = do
subtype b1 a1
a2' <- apply a2
b2' <- apply b2
subtype a2' b2'
-- Γ, α ⊢ A <: B ⊣ Δ,α,Θ
-- --------------------- <:∀R
-- Γ ⊢ A <: ∀α. B ⊣ Δ
subtype a (TAll alpha b) = do
let env_tvar = EnvTVar alpha
insertEnv env_tvar
subtype a b
dropTrailing env_tvar
-- Γ,▶ ά,ά ⊢ [ά/α]A <: B ⊣ Δ,▶ ά,Θ
-- ------------------------------- <:∀L
-- Γ ⊢ ∀α.A <: B ⊣ Δ
subtype (TAll alpha a) b = do
alpha' <- fresh
let env_marker = EnvMark alpha'
insertEnv env_marker
insertEnv $ EnvTEVar alpha'
let a' = substitute alpha alpha' a
subtype a' b
dropTrailing env_marker
-- ά ∉ FV(A) Γ[ά] ⊢ ά :=< A ⊣ Δ
-- ------------------------------ <:instantiateL
-- Γ[ά] ⊢ ά <: A ⊣ Δ
subtype (TEVar alpha) a | notElem alpha $ frees a = instantiateL alpha a
-- ά ∉ FV(A) Γ[ά] ⊢ A =:< ά ⊣ Δ
-- ------------------------------ <:instantiateR
-- Γ[ά] ⊢ A <: ά ⊣ Δ
subtype a (TEVar alpha) | notElem alpha $ frees a = instantiateR a alpha
subtype (TData name1 typs1) (TData name2 typs2)
-- D₁ = D₂
-- ----------------
-- Γ ⊢ D₁ () <: D₂ ()
| name1 == name2
, [] <- typs1
, [] <- typs2
= pure ()
-- Γ ⊢ ά₁ <: έ₁ ⊣ Θ₁
-- ...
-- D₁ = D₂ Θₙ₋₁ ⊢ [Θₙ₋₁]άₙ <: [Θₙ₋₁]έₙ ⊣ Δ
-- -------------------------------------------
-- Γ ⊢ D (ά₁ ‥ άₙ) <: D (έ₁ ‥ έₙ) ⊣ Δ
| name1 == name2
, t1:t1s <- typs1
, t2:t2s <- typs2
= do
subtype t1 t2
zipWithM_ go t1s t2s
where
go t1' t2' = do
t1'' <- apply t1'
t2'' <- apply t2'
subtype t1'' t2''
subtype (TIdent t1) (TIdent t2) | t1 == t2 = pure ()
subtype t1 t2 = throwError $ unwords ["Types", show t1, "and", show t2, "doesn't match!"]
---------------------------------------------------------------------------
-- * Instantiation rules
---------------------------------------------------------------------------
-- | Γ ⊢ ά :=< A ⊣ Δ
-- Under input context Γ, instantiate ά such that ά <: A, with output context ∆
instantiateL :: TEVar -> Type -> Tc ()
instantiateL alpha a = gets env >>= \env -> go env alpha a
where
go env alpha tau
| isMono tau
, (env_l, env_r) <- splitOn (EnvTEVar alpha) env
, Right _ <- wellFormed env_l tau
= putEnv $ (env_l :|> EnvTEVarSolved alpha tau) <> env_r
-- Γ ⊢ τ
-- ----------------------------- InstLSolve
-- Γ,ά,Γ' ⊢ ά :=< τ ⊣ Γ,(ά=τ),Γ'
go env alpha tau
| isMono tau
, (env_l, env_r) <- splitOn (EnvTEVar alpha) env
, Right _ <- wellFormed env_l tau
= putEnv $ (env_l :|> EnvTEVarSolved alpha tau) <> env_r
-- ----------------------------- InstLReach
-- Γ[ά][έ] ⊢ ά :=< έ ⊣ Γ[ά][έ=ά]
go env alpha (TEVar epsilon) = do
let (env_l, env_r) = splitOn (EnvTEVar epsilon) env
putEnv $ (env_l :|> EnvTEVarSolved epsilon (TEVar alpha)) <> env_r
-- Γ[ά₂ά₁,(ά=ά₁→ά₂)] ⊢ A₁ =:< ά₁ ⊣ Θ Θ ⊢ ά₂ :=< [Θ]A₂ ⊣ Δ
-- ------------------------------------------------------- InstLArr
-- Γ[ά] ⊢ ά :=< A₁ → A₂ ⊣ Δ
go _ alpha (TFun a1 a2) = do
alpha1 <- fresh
alpha2 <- fresh
insertEnv $ EnvTEVar alpha2
insertEnv $ EnvTEVar alpha1
insertEnv $ EnvTEVarSolved alpha (on TFun TEVar alpha1 alpha2)
instantiateR a1 alpha1
instantiateL alpha2 =<< apply a2
-- Γ[ά],ε ⊢ ά :=< E ⊣ Δ,ε,Δ'
-- ------------------------- InstLAIIR
-- Γ[ά] ⊢ ά :=< ∀ε.Ε ⊣ Δ
go env tevar (TAll tvar t) = do
instantiateL tevar t
let (env_l, _) = splitOn (EnvTVar tvar) env
putEnv env_l
go _ alpha a = error $ "Trying to instantiateL: " ++ ppT (TEVar alpha)
++ " <: " ++ ppT a
-- | Γ ⊢ A =:< ά ⊣ Δ
-- Under input context Γ, instantiate ά such that A <: ά, with output context ∆
instantiateR :: Type -> TEVar -> Tc ()
instantiateR a alpha = gets env >>= \env -> go env a alpha
where
-- Γ ⊢ τ
-- ----------------------------- InstRSolve
-- Γ,ά,Γ' ⊢ τ =:< ά ⊣ Γ,(ά=τ),Γ'
go env tau alpha
| isMono tau
, (env_l, env_r) <- splitOn (EnvTEVar alpha) env
, Right _ <- wellFormed env_l tau
= putEnv $ (env_l :|> EnvTEVarSolved alpha tau) <> env_r
--
-- ----------------------------- InstRReach
-- Γ[ά][έ] ⊢ έ =:< ά ⊣ Γ[ά][έ=ά]
go env (TEVar epsilon) alpha = do
let (env_l, env_r) = splitOn (EnvTEVar epsilon) env
putEnv $ (env_l :|> EnvTEVarSolved epsilon (TEVar alpha)) <> env_r
-- Γ[ά₂ά₁,(ά=ά₁→ά₂)] ⊢ A₁ :=< ά₁ ⊣ Θ Θ ⊢ ά₂ =:< [Θ]A₂ ⊣ Δ
-- ------------------------------------------------------- InstRArr
-- Γ[ά] ⊢ A₁ → A₂ =:< ά ⊣ Δ
go _ (TFun a1 a2) alpha = do
alpha1 <- fresh
alpha2 <- fresh
insertEnv $ EnvTEVar alpha2
insertEnv $ EnvTEVar alpha1
insertEnv $ EnvTEVarSolved alpha (on TFun TEVar alpha1 alpha2)
instantiateL alpha1 a1
a2' <- apply a2
instantiateR a2' alpha2
-- Γ[ά],▶έ,ε ⊢ [έ/ε]E =:< ά ⊣ Δ,▶έ,Δ'
-- ---------------------------------- InstRAIIL
-- Γ[ά] ⊢ ∀ε.Ε =:< ά ⊣ Δ
go env (TAll epsilon e) alpha = do
epsilon' <- fresh
insertEnv $ EnvMark epsilon'
insertEnv $ EnvTVar epsilon
instantiateR (substitute epsilon epsilon' e) alpha
let (env_l, _) = splitOn (EnvMark epsilon') env
putEnv env_l
go _ a alpha = throwError $ "Trying to instantiateR: " ++ ppT a ++ " <: "
++ ppT (TEVar alpha)
---------------------------------------------------------------------------
-- * Auxiliary
---------------------------------------------------------------------------
frees :: Type -> [TEVar]
frees = \case
TLit _ -> []
TVar _ -> []
TEVar tevar -> [tevar]
TFun t1 t2 -> on (++) frees t1 t2
TAll _ t -> frees t
TData _ typs -> concatMap frees typs
-- | [ά/α]A
substitute :: TVar -- α
-> TEVar -- ά
-> Type -- A
-> Type -- [ά/α]A
substitute tvar tevar typ = case typ of
TLit _ -> typ
TVar tvar' | tvar' == tvar -> TEVar tevar
| otherwise -> typ
TEVar _ -> typ
TFun t1 t2 -> on TFun substitute' t1 t2
TAll tvar' t -> TAll tvar' (substitute' t)
TData name typs -> TData name $ map substitute' typs
where
substitute' = substitute tvar tevar
-- | Γ,x,Γ' → (Γ, Γ')
splitOn :: EnvElem -> Env -> (Env, Env)
splitOn x env = second (S.drop 1) $ S.breakl (==x) env
-- | Drop frontmost elements until and including element @x@.
dropTrailing :: EnvElem -> Tc ()
dropTrailing x = modifyEnv $ S.takeWhileL (/= x)
findSolved :: TEVar -> Env -> Maybe Type
findSolved _ Empty = Nothing
findSolved tevar (xs :|> x) = case x of
EnvTEVarSolved tevar' t | tevar == tevar' -> Just t
_ -> findSolved tevar xs
-- | Γ ⊢ A
-- Under context Γ, type A is well-formed
wellFormed :: Env -> Type -> Err ()
wellFormed env = \case
TLit _ -> pure ()
-- -------- UvarWF
-- Γ[α] ⊢ α
TVar tvar -> unless (EnvTVar tvar `elem` env) $
throwError ("Unbound type variable: " ++ show tvar)
-- Γ ⊢ A Γ ⊢ B
-- ------------- ArrowWF
-- Γ ⊢ A → B
TFun t1 t2 -> do { wellFormed env t1; wellFormed env t2 }
-- Γ,α ⊢ A
-- -------- ForallWF
-- Γ ⊢ ∀α.A
TAll tvar t -> wellFormed (env :|> EnvTVar tvar) t
TEVar tevar
-- ---------- EvarWF
-- Γ[ά] ⊢ ά
| EnvTEVar tevar `elem` env -> pure ()
-- ---------- SolvedEvarWF
-- Γ[ά=τ] ⊢ ά
| Just _ <- findSolved tevar env -> pure ()
| otherwise -> throwError ("Can't find type: " ++ show tevar)
TData _ typs -> mapM_ (wellFormed env) typs
isMono :: Type -> Bool
isMono = \case
TAll{} -> False
TFun t1 t2 -> on (&&) isMono t1 t2
TData _ typs -> all isMono typs
TVar _ -> True
TEVar _ -> True
TLit _ -> True
fresh :: Tc TEVar
fresh = do
tevar <- gets (MkTEVar . LIdent . show . next_tevar)
modify $ \cxt -> cxt { next_tevar = succ cxt.next_tevar }
pure tevar
isComplete :: Env -> Bool
isComplete = isNothing . S.findIndexL unSolvedTEVar
where
unSolvedTEVar = \case
EnvTEVar _ -> True
_ -> False
getDataId :: Type -> Type
getDataId typ = case typ of
TAll _ t -> getDataId t
TFun _ t -> getDataId t
TData {} -> typ
toTVar :: Type -> Err TVar
toTVar = \case
TVar tvar -> pure tvar
_ -> throwError "Not a type variable"
insertEnv :: EnvElem -> Tc ()
insertEnv x = modifyEnv (:|> x)
lookupSig :: LIdent -> Tc (Maybe Type)
lookupSig x = gets (Map.lookup x . sig)
insertSig :: LIdent -> Type -> Tc ()
insertSig name t = modify $ \cxt -> cxt { sig = Map.insert name t cxt.sig }
lookupEnv :: LIdent -> Tc (Maybe Type)
lookupEnv x = gets (findId . env)
where
findId Empty = Nothing
findId (ys :|> y) = case y of
EnvVar x' t | x==x' -> Just t
_ -> findId ys
lookupInj :: UIdent -> Tc (Maybe Type)
lookupInj x = gets (Map.lookup x . data_injs)
putEnv :: Env -> Tc ()
putEnv = modifyEnv . const
modifyEnv :: (Env -> Env) -> Tc ()
modifyEnv f =
modify $ \cxt -> {- trace (ppEnv (f cxt.env)) -} cxt { env = f cxt.env }
pattern DBind' name vars exp = DBind (Bind name vars exp)
pattern DSig' name typ = DSig (Sig name typ)
---------------------------------------------------------------------------
-- * Apply
---------------------------------------------------------------------------
class Apply a where
apply :: a -> Tc a
instance Apply Type where apply = applyType
instance Apply (T.Exp' Type) where apply = applyExp
instance Apply (T.Branch' Type) where apply = applyBranch
instance Apply (T.Pattern' Type) where apply = applyPattern
instance Apply a => Apply [a] where apply = mapM apply
instance (Apply a, Apply b) => Apply (a, b) where apply = applyPair
instance Apply T.Ident where apply = pure
applyType :: Type -> Tc Type
applyType t = gets $ (`applyType'` t) . env
-- | [Γ]A. Applies context to type until fully applied.
applyType' :: Env -> Type -> Type
applyType' cxt typ | typ == typ' = typ'
| otherwise = applyType' cxt typ'
where
typ' = case typ of
TLit _ -> typ
TData name typs -> TData name $ map (applyType' cxt) typs
-- [Γ]α = α
TVar _ -> typ
-- [Γ[ά=τ]]ά = [Γ[ά=τ]]τ
-- [Γ[ά]]ά = [Γ[ά]]ά
TEVar tevar -> fromMaybe typ $ findSolved tevar cxt
-- [Γ](A → B) = [Γ]A → [Γ]B
TFun t1 t2 -> on TFun (applyType' cxt) t1 t2
-- [Γ](∀α. A) = (∀α. [Γ]A)
TAll tvar t -> TAll tvar $ applyType' cxt t
TIdent t -> typ
applyExp :: T.Exp' Type -> Tc (T.Exp' Type)
applyExp exp = case exp of
T.ELet (T.Bind id vars rhs) exp -> do
id <- apply id
vars' <- mapM apply vars
rhs' <- apply rhs
exp' <- apply exp
pure $ T.ELet (T.Bind id vars' rhs') exp'
T.EApp e1 e2 -> liftA2 T.EApp (apply e1) (apply e2)
T.EAdd e1 e2 -> liftA2 T.EAdd (apply e1) (apply e2)
T.EAbs name e -> T.EAbs name <$> apply e
T.ECase e branches -> liftA2 T.ECase (apply e)
(mapM apply branches)
_ -> pure exp
applyBranch :: T.Branch' Type -> Tc (T.Branch' Type)
applyBranch (T.Branch (p, t) e) = do
pt <- liftA2 (,) (apply p) (apply t)
e' <- apply e
pure $ T.Branch pt e'
applyPattern :: T.Pattern' Type -> Tc (T.Pattern' Type)
applyPattern = \case
T.PVar id -> T.PVar <$> apply id
T.PInj name ps -> T.PInj name <$> apply ps
p -> pure p
applyPair :: (Apply a, Apply b) => (a, b) -> Tc (a, b)
applyPair (x, y) = liftA2 (,) (apply x) (apply y)
---------------------------------------------------------------------------
-- * Debug
---------------------------------------------------------------------------
traceEnv s = do
env <- gets env
trace (s ++ " " ++ ppEnv env) pure ()
traceD s x = trace (s ++ " " ++ show x) pure ()
traceT s x = trace (s ++ " : " ++ ppT x) pure ()
traceTs s xs = trace (s ++ " [ " ++ intercalate ", " (map ppT xs) ++ " ]") pure ()
ppT = \case
TLit (UIdent s) -> s
TVar (MkTVar (LIdent s)) -> "tvar_" ++ s
TFun t1 t2 -> ppT t1 ++ "->" ++ ppT t2
TAll (MkTVar (LIdent s)) t -> "forall " ++ s ++ ". " ++ ppT t
TEVar (MkTEVar (LIdent s)) -> "tevar_" ++ s
TData (UIdent name) typs -> name ++ " (" ++ unwords (map ppT typs)
++ " )"
TIdent (UIdent name) -> name
ppEnvElem = \case
EnvVar (LIdent s) t -> s ++ ":" ++ ppT t
EnvTVar (MkTVar (LIdent s)) -> "tvar_" ++ s
EnvTEVar (MkTEVar (LIdent s)) -> "tevar_" ++ s
EnvTEVarSolved (MkTEVar (LIdent s)) t -> "tevar_" ++ s ++ "=" ++ ppT t
EnvMark (MkTEVar (LIdent s)) -> "▶" ++ "tevar_" ++ s
ppEnv = \case
Empty -> "·"
(xs :|> x) -> ppEnv xs ++ " (" ++ ppEnvElem x ++ ")"

945
src/TypeChecker/TypeCheckerHm.hs Normal file
View file

@ -0,0 +1,945 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QualifiedDo #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
-- | A module for type checking and inference using algorithm W, Hindley-Milner
module TypeChecker.TypeCheckerHm where
import Auxiliary (int, litType, maybeToRightM, unzip4)
import Auxiliary qualified as Aux
import Control.Monad.Except
import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Coerce (coerce)
import Data.Function (on)
import Data.List (foldl', nub, sortOn)
import Data.List.Extra (unsnoc)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromJust)
import Data.Set (Set)
import Data.Set qualified as S
import Debug.Trace (trace, traceShow)
import Grammar.Abs
import Grammar.Print (printTree)
import TypeChecker.TypeCheckerIr qualified as T
{-
TODO
Prettifying the types of generated variables does only need to be done when
presenting the types to the user, i.e, when the user has made a mistake.
For succesfully typed programs the types only need to match.
-}
-- | Type check a program
typecheck :: Program -> Either String (T.Program' Type, [Warning])
typecheck = onLeft msg . run . checkPrg
where
onLeft :: (Error -> String) -> Either Error a -> Either String a
onLeft f (Left x) = Left $ f x
onLeft _ (Right x) = Right x
checkPrg :: Program -> Infer (T.Program' Type)
checkPrg (Program bs) = do
preRun bs
-- sgs <- gets sigs
bs <- map snd . sortOn fst <$> bindCount bs
bs <- checkDef bs
-- return . prettify sgs . T.Program $ bs
return . T.Program $ bs
-- | Send the map of user declared signatures to not rename stuff the user defined
prettify :: Map T.Ident (Maybe Type) -> T.Program' Type -> T.Program' Type
prettify s (T.Program defs) = T.Program $ map (go s) defs
where
go :: Map T.Ident (Maybe Type) -> T.Def' Type -> T.Def' Type
go _ (T.DData d) = T.DData d
go m b@(T.DBind (T.Bind (name, t) args (e, et)))
| Just (Just _) <- M.lookup name m = b
| otherwise =
let fvs = nub $ freeOrdered t
m = M.fromList $ zip fvs letters
in T.DBind $ T.Bind (name, replace m t) args (fmap (replace m) e, replace m et)
replace :: Map T.Ident T.Ident -> Type -> Type
replace m def@(TVar (MkTVar (LIdent a))) = case M.lookup (coerce a) m of
Just t -> TVar . MkTVar . LIdent $ coerce t
Nothing -> def
replace m (TFun t1 t2) = (TFun `on` replace m) t1 t2
replace m (TData name ts) = TData name (map (replace m) ts)
replace m def@(TAll (MkTVar forall_) t) = case M.lookup (coerce forall_) m of
Just found -> TAll (MkTVar $ coerce found) (replace m t)
Nothing -> def
replace _ t = t
bindCount :: [Def] -> Infer [(Int, Def)]
bindCount [] = return []
bindCount (x : xs) = do
(o, d) <- go x
b <- bindCount xs
return $ (o, d) : b
where
go :: Def -> Infer (Int, Def)
go b@(DBind (Bind _ _ e)) = do
db <- gets declaredBinds
let n = runIdentity $ evalStateT (countBinds db e) mempty
return (n, b)
go (DSig sig) = pure (0, DSig sig)
go (DData data_) = pure (-1, DData data_)
countBinds :: Set T.Ident -> Exp -> StateT (Set T.Ident) Identity Int
countBinds declared = \case
EVar i -> do
found <- get
if coerce i `S.member` declared && not (coerce i `S.member` found)
then put (S.insert (coerce i) found) >> return 1
else return 0
ELet _ e -> countBinds declared e
EApp e1 e2 -> (+) <$> countBinds declared e1 <*> countBinds declared e2
EAdd e1 e2 -> (+) <$> countBinds declared e1 <*> countBinds declared e2
EAbs _ e -> countBinds declared e
ECase e1 brnchs -> do
let f (Branch _ e2) = countBinds declared e2
(+) . sum <$> mapM f brnchs <*> countBinds declared e1
_ -> return 0
preRun :: [Def] -> Infer ()
preRun [] = return ()
preRun (x : xs) = case x of
DSig (Sig n t) -> do
collect (collectTVars t)
s <- gets (M.keys . sigs)
duplicateDecl n s $ Aux.do
"Multiple signatures of function"
quote $ printTree n
insertSig (coerce n) (Just t) >> preRun xs
DBind (Bind n _ e) -> do
s <- gets (S.toList . declaredBinds)
duplicateDecl n s $ Aux.do
"Multiple declarations of function"
quote $ printTree n
collect (collectTVars e)
insertBind $ coerce n
s <- gets sigs
case M.lookup (coerce n) s of
Nothing -> insertSig (coerce n) Nothing >> preRun xs
Just _ -> preRun xs
DData d@(Data t _) -> collect (collectTVars t) >> checkData d >> preRun xs
where
-- Check if function body / signature has been declared already
duplicateDecl n env msg = when (coerce n `elem` env) (uncatchableErr msg)
checkDef :: [Def] -> Infer [T.Def' Type]
checkDef [] = return []
checkDef (x : xs) = case x of
(DBind b) -> do
b' <- checkBind b
xs' <- checkDef xs
return $ T.DBind b' : xs'
(DData d) -> do
xs' <- checkDef xs
return $ T.DData (coerceData d) : xs'
(DSig _) -> checkDef xs
where
coerceData (Data t injs) =
T.Data t $ map (\(Inj name typ) -> T.Inj (coerce name) typ) injs
freeOrdered :: Type -> [T.Ident]
freeOrdered (TVar (MkTVar a)) = return (coerce a)
freeOrdered (TAll (MkTVar bound) t) = return (coerce bound) ++ freeOrdered t
freeOrdered (TFun a b) = freeOrdered a ++ freeOrdered b
freeOrdered (TData _ a) = concatMap freeOrdered a
freeOrdered _ = mempty
-- Much cleaner implementation, unfortunately one minor bug
-- checkBind :: Bind -> Infer (T.Bind' Type)
-- checkBind (Bind name args expr) = do
-- fr <- fresh
-- let lambda = makeLambda expr (reverse (coerce args))
-- withBinding (coerce name) fr $ do
-- (sub, (e, infSig)) <- algoW lambda
-- env <- asks vars
-- let genInfSig = generalize (apply sub env) infSig
-- maybeSig <- gets (join . M.lookup (coerce name) . sigs)
-- case maybeSig of
-- Just typSig -> do
-- unless
-- (genInfSig <<= typSig)
-- ( throwError $
-- Error
-- ( Aux.do
-- "Inferred type"
-- quote $ printTree infSig
-- "doesn't match given type"
-- quote $ printTree typSig
-- )
-- False
-- )
-- return $ T.Bind (coerce name, typSig) [] (apply sub e, typSig)
-- _ -> do
-- insertSig (coerce name) (Just genInfSig)
-- return $ T.Bind (coerce name, genInfSig) [] (apply sub e, genInfSig)
checkBind :: Bind -> Infer (T.Bind' Type)
checkBind (Bind name args e) = do
let lambda = makeLambda e (reverse (coerce args))
(e, infSig) <- inferExp lambda
s <- gets sigs
case M.lookup (coerce name) s of
Just (Just typSig) -> do
env <- asks vars
trace ("ENV IN CHECKBIND: " ++ show env) pure ()
let genInfSig = generalize mempty infSig
sub <- genInfSig `unify` typSig
unless
(genInfSig <<= typSig)
( throwError $
Error
( Aux.do
"Inferred type"
quote $ printTree infSig
"doesn't match given type"
quote $ printTree typSig
)
False
)
-- Applying sub to typSig will worsen error messages.
-- Unfortunately I do not know a better solution at the moment.
return $ T.Bind (coerce name, apply sub typSig) [] (apply sub e, typSig)
_ -> do
insertSig (coerce name) (Just infSig)
return (T.Bind (coerce name, infSig) [] (e, infSig))
checkData :: (MonadState Env m, Monad m, MonadError Error m) => Data -> m ()
checkData err@(Data typ injs) = do
(name, tvars) <- go (skipForalls typ)
dataErr (mapM_ (\i -> checkInj i name tvars) injs) err
where
go = \case
TData name typs
| Right tvars' <- mapM toTVar typs ->
pure (name, tvars')
_ ->
uncatchableErr $
unwords ["Bad data type definition: ", printTree typ]
checkInj :: (MonadError Error m, MonadState Env m, Monad m) => Inj -> UIdent -> [TVar] -> m ()
checkInj (Inj c inj_typ) name tvars
| TData name' typs <- returnType inj_typ
, Right tvars' <- mapM toTVar typs
, name' == name
, tvars' == tvars = do
exist <- existInj (coerce c)
case exist of
Just t -> uncatchableErr $ Aux.do
"Constructor"
quote $ coerce name
"with type"
quote $ printTree t
"already exist"
Nothing -> insertInj (coerce c) inj_typ
| otherwise =
uncatchableErr $
unwords
[ "Bad type constructor: "
, show name
, "\nExpected: "
, printTree . TData name $ map TVar tvars
, "\nActual: "
, printTree $ returnType inj_typ
]
toTVar :: Type -> Either Error TVar
toTVar = \case
TVar tvar -> pure tvar
_ -> uncatchableErr "Not a type variable"
returnType :: Type -> Type
returnType (TFun _ t2) = returnType t2
returnType a = a
inferExp :: Exp -> Infer (T.ExpT' Type)
inferExp e = do
(s, (e', t)) <- algoW e
let subbed = apply s t
return (e', subbed)
class CollectTVars a where
collectTVars :: a -> Set T.Ident
instance CollectTVars Exp where
collectTVars (EAnn e t) = collectTVars t `S.union` collectTVars e
collectTVars _ = S.empty
instance CollectTVars Type where
collectTVars (TVar (MkTVar i)) = S.singleton (coerce i)
collectTVars (TAll _ t) = collectTVars t
collectTVars (TFun t1 t2) = (S.union `on` collectTVars) t1 t2
collectTVars (TData _ ts) =
foldl' (\acc x -> acc `S.union` collectTVars x) S.empty ts
collectTVars _ = S.empty
collect :: Set T.Ident -> Infer ()
collect s = modify (\st -> st{takenTypeVars = s `S.union` takenTypeVars st})
algoW :: Exp -> Infer (Subst, T.ExpT' Type)
algoW = \case
err@(EAnn e t) -> do
(sub0, (e', t')) <- exprErr (algoW e) err
sub1 <- unify t t'
sub2 <- unify t' t
unless
(apply sub1 t <<= apply sub2 t')
( uncatchableErr $ Aux.do
"Annotated type"
quote $ printTree t
"does not match inferred type"
quote $ printTree t'
)
let comp = sub2 `compose` sub1 `compose` sub0
return (comp, (apply comp e', t))
-- \| ------------------
-- \| Γ ⊢ i : Int, ∅
ELit lit -> return (nullSubst, (T.ELit lit, litType lit))
-- \| x : σ ∈ Γ   τ = inst(σ)
-- \| ----------------------
-- \| Γ ⊢ x : τ, ∅
EVar (LIdent i) -> do
var <- asks vars
case M.lookup (coerce i) var of
Just t ->
inst t >>= \x ->
return (nullSubst, (T.EVar $ coerce i, x))
Nothing -> do
sig <- gets sigs
case M.lookup (coerce i) sig of
Just (Just t) -> do
t <- freshen t
return (nullSubst, (T.EVar $ coerce i, t))
Just Nothing -> do
fr <- fresh
return (nullSubst, (T.EVar $ coerce i, fr))
Nothing ->
uncatchableErr $
"Unbound variable: "
<> printTree i
EInj i -> do
constr <- gets injections
case M.lookup (coerce i) constr of
Just t -> do
t <- freshen t
return (nullSubst, (T.EInj $ coerce i, t))
Nothing ->
uncatchableErr $ Aux.do
"Constructor:"
quote $ printTree i
"is not defined"
-- \| τ = newvar Γ, x : τ ⊢ e : τ', S
-- \| ---------------------------------
-- \| Γ ⊢ w λx. e : Sτ → τ', S
err@(EAbs name e) -> do
fr <- fresh
withBinding (coerce name) fr $ do
(s1, (e', t')) <- exprErr (algoW e) err
let varType = apply s1 fr
let newArr = TFun varType t'
return (s1, apply s1 (T.EAbs (coerce name) (e', t'), newArr))
-- \| Γ ⊢ e₀ : τ₀, S₀ S₀Γ ⊢ e₁ : τ₁, S₁
-- \| s₂ = mgu(s₁τ₀, Int) s₃ = mgu(s₂τ₁, Int)
-- \| ------------------------------------------
-- \| Γ ⊢ e₀ + e₁ : Int, S₃S₂S₁S₀
-- This might be wrong
err@(EAdd e0 e1) -> do
(s1, (e0', t0)) <- algoW e0
(s2, (e1', t1)) <- algoW e1
s3 <- exprErr (unify t0 int) err
s4 <- exprErr (unify t1 int) err
let comp = s4 `compose` s3 `compose` s2 `compose` s1
return
( comp
, apply comp (T.EAdd (e0', t0) (e1', t1), int)
)
-- \| Γ ⊢ e₀ : τ₀, S₀ S₀Γ ⊢ e₁ : τ₁, S1
-- \| τ' = newvar S₂ = mgu(S₁τ₀, τ₁ → τ')
-- \| --------------------------------------
-- \| Γ ⊢ e₀ e₁ : S₂τ', S₂S₁S₀
EApp e0 e1 -> do
fr <- fresh
(s0, (e0', t0)) <- algoW e0
applySt s0 $ do
(s1, (e1', t1)) <- algoW e1
s2 <- unify (apply s1 t0) (TFun t1 fr)
let t = apply s2 fr
let comp = s2 `compose` s1 `compose` s0
return (comp, apply comp (T.EApp (e0', t0) (e1', t1), t))
-- \| Γ ⊢ e₀ : τ, S₀ S₀Γ, x : S̅₀Γ̅(τ) ⊢ e₁ : τ', S₁
-- \| ----------------------------------------------
-- \| Γ ⊢ let x = e₀ in e₁ : τ', S₁S₀
-- The bar over S₀ and Γ means "generalize"
ELet (Bind name args e) e1 -> do
fr <- fresh
withBinding (coerce name) fr $ do
(s1, e@(_, t0)) <- algoW (makeLambda e (coerce args))
env <- asks vars
let t' = generalize (apply s1 env) t0
withBinding (coerce name) t' $ do
(s2, (e1', t2)) <- algoW e1
let comp = s2 `compose` s1
return
( comp
, apply
comp
(T.ELet (T.Bind (coerce name, t0) [] e) (e1', t2), t2)
)
ECase caseExpr injs -> do
(sub, (e', t)) <- algoW caseExpr
(subst, injs, ret_t) <- checkCase t injs
let comp = subst `compose` sub
return (comp, apply comp (T.ECase (e', t) injs, ret_t))
checkCase :: Type -> [Branch] -> Infer (Subst, [T.Branch' Type], Type)
checkCase _ [] = do
fr <- fresh
return (nullSubst, [], fr)
checkCase expT brnchs = do
(subs, branchTs, injs, returns) <- unzip4 <$> mapM inferBranch brnchs
let sub0 = composeAll subs
(sub1, _) <-
foldM
( \(sub, acc) x ->
(\a -> (a `compose` sub, a `apply` acc)) <$> unify x acc
)
(nullSubst, expT)
branchTs
(sub2, returns_type) <-
foldM
( \(sub, acc) x ->
(\a -> (a `compose` sub, a `apply` acc)) <$> unify x acc
)
(nullSubst, head returns)
(tail returns)
let comp = sub2 `compose` sub1 `compose` sub0
return (comp, apply comp injs, apply comp returns_type)
inferBranch :: Branch -> Infer (Subst, Type, T.Branch' Type, Type)
inferBranch err@(Branch pat expr) = do
pat@(_, branchT) <- inferPattern pat
(sub, newExp@(_, exprT)) <- catchError (withPattern pat (algoW expr)) (\x -> throwError Error{msg = x.msg <> " in pattern '" <> printTree err <> "'", catchable = False})
return
( sub
, apply sub branchT
, T.Branch (apply sub pat) (apply sub newExp)
, apply sub exprT
)
inferPattern :: Pattern -> Infer (T.Pattern' Type, Type)
inferPattern = \case
PLit lit -> let lt = litType lit in return (T.PLit lit, lt)
PCatch -> (T.PCatch,) <$> fresh
PVar x -> do
fr <- fresh
let pvar = T.PVar (coerce x)
return (pvar, fr)
PEnum p -> do
t <- gets (M.lookup (coerce p) . injections)
t <-
maybeToRightM
( Error
( Aux.do
"Constructor:"
quote $ printTree p
"does not exist"
)
True
)
t
unless
(typeLength t == 1)
( catchableErr $ Aux.do
"The constructor"
quote $ printTree p
" should have "
show (typeLength t - 1)
" arguments but has been given 0"
)
let (TData _data _ts) = t -- nasty nasty
frs <- mapM (const fresh) _ts
return (T.PEnum $ coerce p, TData _data frs)
PInj constr patterns -> do
t <- gets (M.lookup (coerce constr) . injections)
t <-
maybeToRightM
( Error
( Aux.do
"Constructor:"
quote $ printTree constr
"does not exist"
)
True
)
t
let numArgs = typeLength t - 1
let (vs, ret) = fromJust (unsnoc $ flattenType t)
patterns <- mapM inferPattern patterns
unless
(length patterns == numArgs)
( catchableErr $ Aux.do
"The constructor"
quote $ printTree constr
" should have "
show numArgs
" arguments but has been given "
show (length patterns)
)
sub <- composeAll <$> zipWithM unify vs (map snd patterns)
return
( T.PInj (coerce constr) (apply sub patterns)
, apply sub ret
)
-- | Unify two types producing a new substitution
unify :: Type -> Type -> Infer Subst
unify t0 t1 =
let fvs = S.toList $ free t0 `S.union` free t1
m = M.fromList $ zip fvs letters
in case (t0, t1) of
(TFun a b, TFun c d) -> do
s1 <- unify a c
s2 <- unify (apply s1 b) (apply s1 d)
return $ s2 `compose` s1
(TVar (MkTVar a), t@(TData _ _)) -> return $ M.singleton (coerce a) t
(t@(TData _ _), TVar (MkTVar b)) -> return $ M.singleton (coerce b) t
(TVar (MkTVar a), t) -> occurs (coerce a) t
(t, TVar (MkTVar b)) -> occurs (coerce b) t
-- Forall unification should change
(TAll _ t, b) -> unify t b
(a, TAll _ t) -> unify a t
(TLit a, TLit b) ->
if a == b
then return M.empty
else catchableErr $
Aux.do
"Can not unify"
quote $ printTree (TLit a)
"with"
quote $ printTree (TLit b)
(TData name t, TData name' t') ->
if name == name' && length t == length t'
then do
xs <- zipWithM unify t t'
return $ foldr compose nullSubst xs
else catchableErr $
Aux.do
"Type constructor:"
printTree name
quote $ printTree $ map (replace m) t
"does not match with:"
printTree name'
quote $ printTree $ map (replace m) t'
(TEVar a, TEVar b) ->
if a == b
then return M.empty
else catchableErr $
Aux.do
"Can not unify"
quote $ printTree (TEVar a)
"with"
quote $ printTree (TEVar b)
(a, b) -> do
catchableErr $
Aux.do
"Can not unify"
quote $ printTree $ replace m a
"with"
quote $ printTree $ replace m b
{- | Check if a type is contained in another type.
I.E. { a = a -> b } is an unsolvable constraint since there is no substitution
where these are equal
-}
occurs :: T.Ident -> Type -> Infer Subst
occurs i t@(TEVar _) = return (M.singleton i t)
occurs i t@(TVar _) = return (M.singleton i t)
occurs i t =
let fvs = S.toList $ free t
m = M.fromList $ zip fvs letters
in if S.member i (free t)
then
catchableErr
( Aux.do
"Occurs check failed, can't unify"
quote $ printTree $ replace m (TVar $ MkTVar (coerce i))
"with"
quote $ printTree $ replace m t
)
else return $ M.singleton i t
{- | Generalize a type over all free variables in the substitution set
Used for let bindings to allow expression that do not type check in
equivalent lambda expressions:
Type checks: let f = \x. x in (f True, f 'a')
Does not type check: (\f. (f True, f 'a')) (\x. x)
-}
generalize :: Map T.Ident Type -> Type -> Type
generalize env t = go (S.toList $ free t S.\\ free env) (removeForalls t)
where
go :: [T.Ident] -> Type -> Type
go [] t = t
go (x : xs) t = TAll (MkTVar (coerce x)) (go xs t)
removeForalls :: Type -> Type
removeForalls (TAll _ t) = removeForalls t
removeForalls (TFun t1 t2) = TFun (removeForalls t1) (removeForalls t2)
removeForalls t = t
{- | Instantiate a polymorphic type. The free type variables are substituted
with fresh ones.
-}
inst :: Type -> Infer Type
inst = \case
TAll (MkTVar bound) t -> do
fr <- fresh
let s = M.singleton (coerce bound) fr
apply s <$> inst t
TFun t1 t2 -> TFun <$> inst t1 <*> inst t2
rest -> return rest
-- | Generate a new fresh variable
fresh :: Infer Type
fresh = do
n <- gets count
modify (\st -> st{count = succ (count st)})
return $ TVar $ MkTVar $ LIdent $ show n
-- Is the left a subtype of the right
(<<=) :: Type -> Type -> Bool
(<<=) a b = case (a, b) of
(TVar _, _) -> True
(TFun a b, TFun c d) -> a <<= c && b <<= d
(TAll tvar1 t1, TAll tvar2 t2) -> ungo [tvar1, tvar2] t1 t2
(TAll tvar t1, t2) -> ungo [tvar] t1 t2
(t1, TAll tvar t2) -> ungo [tvar] t1 t2
(TData n1 ts1, TData n2 ts2) ->
n1 == n2
&& length ts1 == length ts2
&& and (zipWith (<<=) ts1 ts2)
(t1, t2) -> t1 == t2
where
ungo :: [TVar] -> Type -> Type -> Bool
ungo tvars t1 t2 = case run (go tvars t1 t2) of
Right (b, _) -> b
_ -> False
-- TODO: Fix the following
-- Maybe locally using the Infer monad can cause trouble.
-- Since the fresh count starts from zero
go :: [TVar] -> Type -> Type -> Infer Bool
go tvars t1 t2 = do
fr <- fresh
let sub = M.fromList [(coerce x, fr) | (MkTVar x) <- tvars]
return (apply sub t1 <<= apply sub t2)
skipForalls :: Type -> Type
skipForalls = \case
TAll _ t -> skipForalls t
t -> t
freshen :: Type -> Infer Type
freshen t = do
let frees = S.toList (free t)
xs <- mapM (const fresh) frees
let sub = M.fromList $ zip frees xs
return $ apply sub t
{-
a = TVar $ MkTVar "a"
single = TData "single" [a]
arr = a `TFun` single
-}
-- | A class for substitutions
class SubstType t where
-- | Apply a substitution to t
apply :: Subst -> t -> t
class FreeVars t where
-- | Get all free variables from t
free :: t -> Set T.Ident
instance FreeVars (T.Bind' Type) where
free (T.Bind (_, t) _ _) = free t
instance FreeVars Type where
free :: Type -> Set T.Ident
free (TVar (MkTVar a)) = S.singleton (coerce a)
free (TAll (MkTVar bound) t) =
S.singleton (coerce bound) `S.intersection` free t
free (TLit _) = mempty
free (TFun a b) = free a `S.union` free b
free (TData _ a) = free a
free (TEVar _) = S.empty
instance FreeVars a => FreeVars [a] where
free = let f acc x = acc `S.union` free x in foldl' f S.empty
instance SubstType Type where
apply :: Subst -> Type -> Type
apply sub t = do
case t of
TLit _ -> t
TVar (MkTVar a) -> case M.lookup (coerce a) sub of
Nothing -> TVar (MkTVar $ coerce a)
Just t -> t
TAll (MkTVar i) t -> case M.lookup (coerce i) sub of
Nothing -> TAll (MkTVar i) (apply sub t)
Just _ -> apply sub t
TFun a b -> TFun (apply sub a) (apply sub b)
TData name a -> TData name (apply sub a)
TEVar (MkTEVar _) -> t
instance FreeVars (Map T.Ident Type) where
free :: Map T.Ident Type -> Set T.Ident
free = free . M.elems
instance SubstType (Map T.Ident Type) where
apply :: Subst -> Map T.Ident Type -> Map T.Ident Type
apply = M.map . apply
instance SubstType (Map T.Ident (Maybe Type)) where
apply s = M.map (fmap $ apply s)
instance SubstType (T.ExpT' Type) where
apply s (e, t) = (apply s e, apply s t)
instance SubstType (T.Exp' Type) where
apply s = \case
T.EVar i -> T.EVar i
T.ELit lit -> T.ELit lit
T.ELet (T.Bind (ident, t1) args e1) e2 ->
T.ELet
(T.Bind (ident, apply s t1) args (apply s e1))
(apply s e2)
T.EApp e1 e2 -> T.EApp (apply s e1) (apply s e2)
T.EAdd e1 e2 -> T.EAdd (apply s e1) (apply s e2)
T.EAbs ident e -> T.EAbs ident (apply s e)
T.ECase e brnch -> T.ECase (apply s e) (apply s brnch)
T.EInj i -> T.EInj i
instance SubstType (T.Def' Type) where
apply s = \case
T.DBind (T.Bind name args e) ->
T.DBind $ T.Bind (apply s name) (apply s args) (apply s e)
d -> d
instance SubstType (T.Branch' Type) where
apply s (T.Branch (i, t) e) = T.Branch (apply s i, apply s t) (apply s e)
instance SubstType (T.Pattern' Type) where
apply s = \case
T.PVar iden -> T.PVar iden
T.PLit lit -> T.PLit lit
T.PInj i ps -> T.PInj i $ apply s ps
T.PCatch -> T.PCatch
T.PEnum i -> T.PEnum i
instance SubstType (T.Pattern' Type, Type) where
apply s (p, t) = (apply s p, apply s t)
instance SubstType a => SubstType [a] where
apply s = map (apply s)
instance SubstType (T.Id' Type) where
apply s (name, t) = (name, apply s t)
-- | Represents the empty substition set
nullSubst :: Subst
nullSubst = mempty
-- | Compose two substitution sets
compose :: Subst -> Subst -> Subst
compose m1 m2 = M.map (apply m1) m2 `M.union` m1
-- | Compose a list of substitution sets into one
composeAll :: [Subst] -> Subst
composeAll = foldl' compose nullSubst
{- | Convert a function with arguments to its pointfree version
> makeLambda (add x y = x + y) = add = \x. \y. x + y
-}
makeLambda :: Exp -> [T.Ident] -> Exp
makeLambda = foldl (flip (EAbs . coerce))
-- | Run the monadic action with an additional binding
withBinding :: (Monad m, MonadReader Ctx m) => T.Ident -> Type -> m a -> m a
withBinding i p = local (\st -> st{vars = M.insert i p (vars st)})
-- | Run the monadic action with several additional bindings
withBindings :: (Monad m, MonadReader Ctx m) => [(T.Ident, Type)] -> m a -> m a
withBindings xs =
local (\st -> st{vars = foldl' (flip (uncurry M.insert)) (vars st) xs})
-- | Run the monadic action with a pattern
withPattern :: (Monad m, MonadReader Ctx m) => (T.Pattern' Type, Type) -> m a -> m a
withPattern (p, t) ma = case p of
T.PVar x -> withBinding x t ma
T.PInj _ ps -> foldl' (flip withPattern) ma ps
T.PLit _ -> ma
T.PCatch -> ma
T.PEnum _ -> ma
-- | Insert a function signature into the environment
insertSig :: T.Ident -> Maybe Type -> Infer ()
insertSig i t = modify (\st -> st{sigs = M.insert i t (sigs st)})
insertBind :: T.Ident -> Infer ()
insertBind i = modify (\st -> st{declaredBinds = S.insert i st.declaredBinds})
-- | Insert a constructor into the start with its type
insertInj :: (Monad m, MonadState Env m) => T.Ident -> Type -> m ()
insertInj i t =
modify (\st -> st{injections = M.insert i t (injections st)})
applySt :: Subst -> Infer a -> Infer a
applySt s = local (\st -> st{vars = apply s st.vars})
{- | Check if an injection (constructor of data type)
with an equivalent name has been declared already
-}
existInj :: (Monad m, MonadState Env m) => T.Ident -> m (Maybe Type)
existInj n = gets (M.lookup n . injections)
flattenType :: Type -> [Type]
flattenType (TFun a b) = flattenType a <> flattenType b
flattenType a = [a]
typeLength :: Type -> Int
typeLength (TFun _ b) = 1 + typeLength b
typeLength _ = 1
{- | Catch an error if possible and add the given
expression as addition to the error message
-}
exprErr :: (Monad m, MonadError Error m) => m a -> Exp -> m a
exprErr ma exp =
catchError
ma
( \err ->
if err.catchable
then
throwError
( err
{ msg =
err.msg
<> " in expression: \n"
<> printTree exp
, catchable = False
}
)
else throwError err
)
bindErr :: (Monad m, MonadError Error m) => m a -> Bind -> m a
bindErr ma bind =
catchError
ma
( \err ->
if err.catchable
then
throwError
( err
{ msg =
err.msg
<> " in function: \n"
<> printTree bind
, catchable = False
}
)
else throwError err
)
{- | Catch an error if possible and add the given
data as addition to the error message
-}
dataErr :: (MonadError Error m, Monad m) => m a -> Data -> m a
dataErr ma d =
catchError
ma
( \err ->
if err.catchable
then
throwError
( err
{ msg =
err.msg
<> " in data: \n"
<> printTree d
}
)
else throwError (err{catchable = False})
)
initCtx = Ctx mempty
initEnv = Env 0 'a' mempty mempty mempty mempty
run :: Infer a -> Either Error (a, [Warning])
run = run' initEnv initCtx
run' :: Env -> Ctx -> Infer a -> Either Error (a, [Warning])
run' e c =
runIdentity
. runExceptT
. runWriterT
. flip runReaderT c
. flip evalStateT e
. runInfer
newtype Ctx = Ctx {vars :: Map T.Ident Type}
deriving (Show)
data Env = Env
{ count :: Int
, nextChar :: Char
, sigs :: Map T.Ident (Maybe Type)
, takenTypeVars :: Set T.Ident
, injections :: Map T.Ident Type
, declaredBinds :: Set T.Ident
}
deriving (Show)
data Error = Error {msg :: String, catchable :: Bool}
deriving (Show)
type Subst = Map T.Ident Type
newtype Warning = NonExhaustive String
deriving (Show)
newtype Infer a = Infer {runInfer :: StateT Env (ReaderT Ctx (WriterT [Warning] (ExceptT Error Identity))) a}
deriving (Functor, Applicative, Monad, MonadReader Ctx, MonadError Error, MonadState Env)
catchableErr :: MonadError Error m => String -> m a
catchableErr msg = throwError $ Error msg True
uncatchableErr :: MonadError Error m => String -> m a
uncatchableErr msg = throwError $ Error msg False
quote :: String -> String
quote s = "'" ++ s ++ "'"
letters :: [T.Ident]
letters = map T.Ident $ [1 ..] >>= flip replicateM ['a' .. 'z']

196
src/TypeChecker/TypeCheckerIr.hs Normal file
View file

@ -0,0 +1,196 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
module TypeChecker.TypeCheckerIr (
module Grammar.Abs,
module TypeChecker.TypeCheckerIr,
) where
import Data.String (IsString)
import Grammar.Abs (Lit (..))
import Grammar.Print
import Prelude
import qualified Prelude as C (Eq, Ord, Read, Show)
newtype Program' t = Program [Def' t]
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
data Def' t
= DBind (Bind' t)
| DData (Data' t)
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
data Type
= TLit Ident
| TVar TVar
| TData Ident [Type]
| TFun Type Type
deriving (Eq, Ord, Show, Read)
data Data' t = Data t [Inj' t]
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
data Inj' t = Inj Ident t
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
newtype Ident = Ident String
deriving (C.Eq, C.Ord, C.Show, C.Read, IsString)
data Pattern' t
= PVar Ident
| PLit Lit
| PCatch
| PEnum Ident
| PInj Ident [(Pattern' t, t)]
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
data Exp' t
= EVar Ident
| EInj Ident
| ELit Lit
| ELet (Bind' t) (ExpT' t)
| EApp (ExpT' t) (ExpT' t)
| EAdd (ExpT' t) (ExpT' t)
| EAbs Ident (ExpT' t)
| ECase (ExpT' t) [Branch' t]
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
newtype TVar = MkTVar Ident
deriving (C.Eq, C.Ord, C.Show, C.Read)
type Id' t = (Ident, t)
type ExpT' t = (Exp' t, t)
data Bind' t = Bind (Id' t) [Id' t] (ExpT' t)
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
data Branch' t = Branch (Pattern' t, t) (ExpT' t)
deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
instance Print Ident where
prt _ (Ident s) = doc $ showString s
instance Print t => Print (Program' t) where
prt i (Program sc) = prt i sc
instance Print t => Print (Bind' t) where
prt i (Bind sig parms rhs) = concatD
[ prtSig sig
, prt i parms
, doc $ showString "="
, prt i rhs
]
prtSig :: Print t => Id' t -> Doc
prtSig (name, t) =
concatD
[ prt 0 name
, doc $ showString ":"
, prt 0 t
]
instance Print t => Print (ExpT' t) where
prt i (e, t) =
concatD
[ doc $ showString "("
, prt i e
, doc $ showString ":"
, prt 0 t
, doc $ showString ")"
]
instance Print t => Print [Bind' t] where
prt _ [] = concatD []
prt i [x] = concatD [prt i x]
prt i (x : xs) = concatD [prt i x, doc (showString ";"), prt i xs]
instance Print t => Print (Id' t) where
prt i (name, t) =
concatD
[ doc $ showString "("
, prt i name
, doc $ showString ","
, prt i t
, doc $ showString ")"
]
instance Print t => Print (Exp' t) where
prt i = \case
EVar lident -> prPrec i 3 (concatD [prt 0 lident])
EInj uident -> prPrec i 3 (concatD [prt 0 uident])
ELit lit -> prPrec i 3 (concatD [prt 0 lit])
EApp exp1 exp2 -> prPrec i 2 (concatD [prt 2 exp1, prt 3 exp2])
EAdd exp1 exp2 -> prPrec i 1 (concatD [prt 1 exp1, doc (showString "+"), prt 2 exp2])
ELet bind exp -> prPrec i 0 (concatD [doc (showString "let"), prt 0 bind, doc (showString "in"), prt 0 exp])
EAbs lident exp -> prPrec i 0 (concatD [doc (showString "\\"), prt 0 lident, doc (showString "."), prt 0 exp])
ECase exp branchs -> prPrec i 0 (concatD [doc (showString "case"), prt 0 exp, doc (showString "of"), doc (showString "{"), prt 0 branchs, doc (showString "}")])
instance Print t => Print (Branch' t) where
prt i (Branch (pattern_, t) exp) = prPrec i 0 (concatD [doc (showString "("), prt 0 pattern_, doc (showString " : "), prt 0 t, doc (showString ")"), doc (showString "=>"), prt 0 exp])
instance Print t => Print [Branch' t] where
prt _ [] = concatD []
prt _ [x] = concatD [prt 0 x]
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
instance Print t => Print (Def' t) where
prt i = \case
DBind bind -> prPrec i 0 (concatD [prt 0 bind])
DData data_ -> prPrec i 0 (concatD [prt 0 data_])
instance Print t => Print (Data' t) where
prt i = \case
Data type_ injs -> prPrec i 0 (concatD [doc (showString "data"), prt 0 type_, doc (showString "where"), doc (showString "{"), prt 0 injs, doc (showString "}")])
instance Print t => Print (Inj' t) where
prt i = \case
Inj uident type_ -> prPrec i 0 (concatD [prt 0 uident, doc (showString ":"), prt 0 type_])
instance Print t => Print [Inj' t] where
prt _ [] = concatD []
prt i [x] = prt i x
prt i (x : xs) = prPrec i 0 $ concatD [prt i x, doc $ showString "\n ", prt i xs]
instance Print t => Print (Pattern' t, t) where
prt i (p, t) = prPrec i 1 (concatD [prt i p, prt i t])
instance Print t => Print (Pattern' t) where
prt i = \case
PVar name -> prPrec i 1 (concatD [prt 0 name])
PLit lit -> prPrec i 1 (concatD [prt 0 lit])
PCatch -> prPrec i 1 (concatD [doc (showString "_")])
PEnum name -> prPrec i 1 (concatD [prt 0 name])
PInj uident patterns -> prPrec i 0 (concatD [prt 0 uident, prt 1 patterns])
instance Print t => Print [Def' t] where
prt _ [] = concatD []
prt _ [x] = concatD [prt 0 x]
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
instance Print [Type] where
prt _ [] = concatD []
prt _ (x : xs) = concatD [prt 0 x, doc (showString " "), prt 0 xs]
instance Print Type where
prt i = \case
TLit uident -> prPrec i 1 (concatD [prt 0 uident])
TVar tvar -> prPrec i 1 (concatD [prt 0 tvar])
TData uident types -> prPrec i 1 (concatD [prt 0 uident, doc (showString "("), prt 0 types, doc (showString ")")])
TFun type_1 type_2 -> prPrec i 0 (concatD [prt 1 type_1, doc (showString "->"), prt 0 type_2])
instance Print TVar where
prt i (MkTVar ident) = prt i ident
type Program = Program' Type
type Def = Def' Type
type Data = Data' Type
type Bind = Bind' Type
type Branch = Branch' Type
type Pattern = Pattern' Type
type Inj = Inj' Type
type Exp = Exp' Type
type ExpT = ExpT' Type
type Id = Id' Type
pattern TVar' s = TVar (MkTVar s)
pattern DBind' id vars expt = DBind (Bind id vars expt)
pattern DData' typ injs = DData (Data typ injs)