13 Commits
ugh ... main

Author SHA1 Message Date
crumbtoo
1a0ef46df8 bump 2024-04-15 10:02:36 -06:00
crumbtoo
1436f1124f Merge branch 'main' into dev 2024-02-16 13:12:14 -07:00
crumbtoo
2e13ec2cf4 microlens -> lens
i still love you microlens..
2024-02-13 13:42:43 -07:00
crumb
36a17d092b rc (#13)
* update readme

* Literal -> Lit, LitE -> Lit

* commentary

* infer

* hindley milner inference :D

* comments and better type errors

* type IsString + test unification error

* infer nonrec let binds

infer nonrec let binds

* small

* LitE -> Lit

* LitE -> Lit

* TyInt -> TyCon "Int#"

* parse type sigs; program type sigs

* parse types

* parse programs (with types :D)

* parse programs (with type sigs :D)

* Name = Text

Name = Text

* RlpcError

* i'm on an airplane rn, my eyelids grow heavy, and i forgot my medication. should this be my final commit (of the week): gootbye

* kinda sorta typechecking

* back and medicated!

* errorful (it's not good)

* type-checked quasiquoters

* fix hm tests

* Compiler.JustRun

* lex \ instead of \\

* grammar reference

* 4:00 AM psychopath code

* oh boy am i going to hate this code in 12 hours

* application and lits

appl

* something

* goofy

* Show1 instances

* fixation fufilled - back to work!

* works

* labels

* infix decl

* expr fixups

* where

* cool

* aaaaa

* decls fix

* finally in a decent state

* replace uses of many+satisfy with takeWhileP

* layout

layouts

oh my layouts

* i did not realise my fs is case insensitive

* tysigs

* add version bounds

* grammar reference

* 4:00 AM psychopath code

* oh boy am i going to hate this code in 12 hours

* application and lits

appl

* something

* goofy

* Show1 instances

* fixation fufilled - back to work!

* works

* labels

* infix decl

* expr fixups

* where

* cool

* aaaaa

* decls fix

* finally in a decent state

* replace uses of many+satisfy with takeWhileP

* layout

layouts

oh my layouts

* i did not realise my fs is case insensitive

* tysigs

* its fine

* threaded lexer

* decent starting point

* man this sucks

* aagh

* okay layouts kinda

* kitten i'll be honest mommy's about to kill herself

* see previous commit and scale back the part where i'm joking

* version bounds

* we're so back

* fixy

* cool

* FIX REAL

* oh my god

* works

* now we're fucking GETTING SOMEWHERE

* i really need to learn git proper

* infix exprs

* remove debug flags

* renamerlp

* rename rlp

* compiles (kill me)

man

* RlpcError -> IsRlpcError

* when the "Test suite rlp-test: PASS" hits

i'm like atlas and the world is writing two lines of code

* errorful parser

* errorful parser

small

* msgenvelope

* errors!

* allow uppercase sc names in preperation for Rlp2Core

* letrec

* infer letrec expressions

* minor docs

* checklist

* minor docs

* stable enough for a demo hey?

* small fixups

* new tag syntax; preparing for Core patterns

new tag syntax; preparing for data names

* temporary pragma system

* resolve named data in case exprs

* named constr tests

* nearing release :3

* minor changes

putting this on hold; implementing TTG first

* some

* oh my god guys!!! `Located` is a lax semimonoidal endofunctor on the category Hask!!!

![abstractionjak](https://media.discordapp.net/attachments/1101767463579951154/1200248978642567168/3877820-20SoyBooru.png?ex=65c57df8&is=65b308f8&hm=67da3acb61861cab6156df014b397d78fb8815fa163f2e992474d545beb668ba&=&format=webp&quality=lossless&width=880&height=868)

* it's also a comonad. lol.

* idk

* show

* abandon ship

* at long last

more

no more undefineds

* i should've made a lisp man this sucks

* let layout

* ttg boilerplate

* fixup! ttg boilerplate

* fixup! ttg boilerplate

* organisation and cleaning

organisation and tidying

* error messages

* driver progress

* formatting

* *R functions

* -ddump-ast

* debug tags

* -ddump-eval

* core driver

* XRec fix

* rlp2core base

* ccoool

* something

* rlp TH

* sc

* expandableAlt

* expandableAlt

* fix layout_let

* parse case exprs

* case unrolling

* rose

* her light cuts deep time and time again

('her' of course referring to the field of computer science)

* tidying

* NameSupply effect

* tidy

* fix incomplete byTag

* desugar

* WIP associate postproc

corecursive

* sigh i'm gonna have to nuke the ast again in a month

* remove old files

* remove old files

* fix top-level layout

* define datatags

* diagram

* diagram

* Update README.md

* ppr debug flags

ddump-parsed

* ppr typesigs

* ppr datatags

* remove unnecessary comment

* tidying

* .hs -> .cr

update examples

* fix evil parser bug (it was a fucking typo)

* fix evil lexer bug (it was actually quite subtle unlike prev.)

* examples

* examples

* letrec + typechecking core

* Update README.md

* Rlp2Core: simple let binds

* Rlp2Core: pattern let binds

* small core fixes

* update examples

* formatting

* typed coreExpr quoter

* typechecking things

* lt

* decent state!

* constants for bool tags

* print# gm primitive

* bind VarP after pats

* fix: tag nested data names

* gte gm prim

* more nightmare GM fixes

* QuickSort example works i'm gonig to cry

* remove debug code

* remove debug tracers

* ready?

* update readme

* remove bad, incorrct, outdated docs

---------

Co-authored-by: crumbtoo <crumb@disroot.org>
2024-02-13 13:22:23 -07:00
crumbtoo
ccc71a751c remove bad, incorrct, outdated docs 2024-02-13 13:20:39 -07:00
crumbtoo
c57da862ae update readme 2024-02-13 12:57:01 -07:00
crumbtoo
4c9ceb74d1 ready? 2024-02-13 12:52:06 -07:00
crumbtoo
8267548fab remove debug tracers 2024-02-13 12:01:46 -07:00
crumbtoo
968832bfaf remove debug code 2024-02-13 11:51:10 -07:00
crumbtoo
81b019e659 QuickSort example works i'm gonig to cry 2024-02-13 11:50:10 -07:00
crumbtoo
cd2a283493 more nightmare GM fixes 2024-02-13 11:48:03 -07:00
crumbtoo
bb41d3c196 gte gm prim 2024-02-13 10:42:45 -07:00
crumbtoo
de16bf12df fix: tag nested data names 2024-02-13 10:42:17 -07:00
27 changed files with 105 additions and 267 deletions

View File

@@ -26,12 +26,14 @@ $ cabal test --test-show-details=direct
#### TLDR
```sh
# Compile and evaluate examples/factorial.cr, with evaluation info dumped to stderr
$ rlpc -ddump-eval examples/factorial.cr
# Compile and evaluate examples/rlp/QuickSort.rl
$ rlpc examples/QuickSort.rl
# Compile and evaluate t.cr, with evaluation info dumped to t.log
$ rlpc -ddump-eval -l t.log t.cr
# Compile and evaluate t.rl, dumping the desugared Core
$ rlpc -ddump-desugared t.rl
# Compile and evaluate t.rl with all compiler messages enabled
$ rlpc -dALL t.rl
```
#### Options
@@ -126,7 +128,7 @@ parsing remains.
- [x] Garbage Collection
- [ ] Stable documentation for the evaluation model
### February Release Plan
### ~~February Release Plan~~
- [x] Beta rl' to Core
- [x] UX improvements
- [x] Actual compiler errors -- no more unexceptional `error` calls
@@ -134,12 +136,14 @@ parsing remains.
- [x] Annotate the AST with token positions for errors (NOTE: As of Feb. 1,
this has been done, but the locational info is not yet used in error messages)
- [x] Compiler architecture diagram
- [ ] More examples
- [x] More examples
### March Release Plan
- [ ] Tests
- [ ] rl' parser
- [ ] rl' lexer
- [ ] Ditch TTG in favour of a simpler AST focusing on extendability via Fix, Free,
Cofree, etc. rather than boilerplate-heavy type families
### Indefinite Release Plan
@@ -150,8 +154,6 @@ than the other release plans.
- [ ] Complete all TODOs
- [ ] Replace mtl with effectful
- [ ] rl' type-checker
- [ ] Ditch TTG in favour of a simpler AST focusing on extendability via Fix, Free,
Cofree, etc. rather than boilerplate-heavy type families
- [ ] Stable rl' to Core
- [ ] Core polish
- [ ] Better, stable parser
@@ -160,3 +162,4 @@ than the other release plans.
- [ ] Less hacky pragmas
- [ ] Choose a target. LLVM, JS, C, and WASM are currently top contenders
- [ ] https://proglangdesign.net/wiki/challenges

View File

@@ -6,7 +6,7 @@ module CoreDriver
import Compiler.RLPC
import Control.Monad
import Data.Text qualified as T
import Lens.Micro.Platform
import Control.Lens.Combinators
import Core.Lex
import Core.Parse

View File

@@ -19,7 +19,7 @@ import System.Exit (exitSuccess)
import Core
import TI
import GM
import Lens.Micro.Platform
import Control.Lens.Combinators hiding (argument)
import CoreDriver qualified
import RlpDriver qualified

View File

@@ -63,52 +63,13 @@ an assembly target. The goal of our new G-Machine is to compile a *linear
sequence of instructions* which, **when executed**, build up a graph
representing the code.
**************************
Trees and Vines, in Theory
**************************
Rather than instantiating an expression at runtime -- traversing the AST and
building a graph -- we want to compile all expressions at compile-time,
generating a linear sequence of instructions which may be executed to build the
graph.
**************************
Evaluation: Slurping Vines
**************************
WIP.
Laziness
--------
WIP.
* Instead of :code:`Slide (n+1); Unwind`, do :code:`Update n; Pop n; Unwind`
****************************
Compilation: Squashing Trees
****************************
WIP.
Notice that we do not keep a (local) environment at run-time. The environment
only exists at compile-time to map local names to stack indices. When compiling
a supercombinator, the arguments are enumerated from zero (the top of the
stack), and passed to :code:`compileR` as an environment.
*************
The G-Machine
*************
.. literalinclude:: /../../src/GM.hs
:dedent:
:start-after: -- >> [ref/compileSc]
:end-before: -- << [ref/compileSc]
:caption: src/GM.hs
Of course, variables being indexed relative to the top of the stack means that
they will become inaccurate the moment we push or pop the stack a single time.
The way around this is quite simple: simply offset the stack when w
.. literalinclude:: /../../src/GM.hs
:dedent:
:start-after: -- >> [ref/compileC]
:end-before: -- << [ref/compileC]
:start-after: -- >> [ref/Instr]
:end-before: -- << [ref/Instr]
:caption: src/GM.hs

View File

@@ -62,159 +62,6 @@ braces and semicolons. In developing our *layout* rules, we will follow in the
pattern of translating the whitespace-sensitive source language to an explicitly
sectioned language.
But What About Haskell?
***********************
Parsing Haskell -- and thus rl' -- is only slightly more complex than Python,
but the design is certainly more sensitive.
.. code-block:: haskell
-- line folds
something = this is a
single expression
-- an extremely common style found in haskell
data Some = Data
{ is :: Presented
, in :: This
, silly :: Style
}
-- another style oddity
-- note that this is not a single
-- continued line! `look at`,
-- `this odd`, and `alignment` are all
-- discrete items!
anotherThing = do look at
this odd
alignment
But enough fear, lets actually think about implementation. Firstly, some
formality: what do we mean when we say layout? We will define layout as the
rules we apply to an implicitly-sectioned language in order to yield one that is
explicitly-sectioned. We will also define indentation of a lexeme as the column
number of its first character.
Thankfully for us, our entry point is quite clear; layouts only appear after a
select few keywords, (with a minor exception; TODO: elaborate) being :code:`let`
(followed by supercombinators), :code:`where` (followed by supercombinators),
:code:`do` (followed by expressions), and :code:`of` (followed by alternatives)
(TODO: all of these terms need linked glossary entries). In order to manage the
cascade of layout contexts, our lexer will record a stack for which each element
is either :math:`\varnothing`, denoting an explicit layout written with braces
and semicolons, or a :math:`\langle n \rangle`, denoting an implicitly laid-out
layout where the start of each item belonging to the layout is indented
:math:`n` columns.
.. code-block:: haskell
-- layout stack: []
module M where -- layout stack: [∅]
f x = let -- layout keyword; remember indentation of next token
y = w * w -- layout stack: [∅, <10>]
w = x + x
-- layout ends here
in do -- layout keyword; next token is a brace!
{ -- layout stack: [∅]
print y;
print x;
}
Finally, we also need the concept of "virtual" brace tokens, which as far as
we're concerned at this moment are exactly like normal brace tokens, except
implicitly inserted by the compiler. With the presented ideas in mind, we may
begin to introduce a small set of informal rules describing the lexer's handling
of layouts, the first being:
1. If a layout keyword is followed by the token '{', push :math:`\varnothing`
onto the layout context stack. Otherwise, push :math:`\langle n \rangle` onto
the layout context stack where :math:`n` is the indentation of the token
following the layout keyword. Additionally, the lexer is to insert a virtual
opening brace after the token representing the layout keyword.
Consider the following observations from that previous code sample:
* Function definitions should belong to a layout, each of which may start at
column 1.
* A layout can enclose multiple bodies, as seen in the :code:`let`-bindings and
the :code:`do`-expression.
* Semicolons should *terminate* items, rather than *separate* them.
Our current focus is the semicolons. In an implicit layout, items are on
separate lines each aligned with the previous. A naïve implementation would be
to insert the semicolon token when the EOL is reached, but this proves unideal
when you consider the alignment requirement. In our implementation, our lexer
will wait until the first token on a new line is reached, then compare
indentation and insert a semicolon if appropriate. This comparison -- the
nondescript measurement of "more, less, or equal indentation" rather than a
numeric value -- is referred to as *offside* by myself internally and the
Haskell report describing layouts. We informally formalise this rule as follows:
2. When the first token on a line is preceeded only by whitespace, if the
token's first grapheme resides on a column number :math:`m` equal to the
indentation level of the enclosing context -- i.e. the :math:`\langle n
\rangle` on top of the layout stack. Should no such context exist on the
stack, assume :math:`m > n`.
We have an idea of how to begin layouts, delimit the enclosed items, and last
we'll need to end layouts. This is where the distinction between virtual and
non-virtual brace tokens comes into play. The lexer needs only partial concern
towards closing layouts; the complete responsibility is shared with the parser.
This will be elaborated on in the next section. For now, we will be content with
naïvely inserting a virtual closing brace when a token is indented right of the
layout.
3. Under the same conditions as rule 2., when :math:`m < n` the lexer shall
insert a virtual closing brace and pop the layout stack.
This rule covers some cases including the top-level, however, consider
tokenising the :code:`in` in a :code:`let`-expression. If our lexical analysis
framework only allows for lexing a single token at a time, we cannot return both
a virtual right-brace and a :code:`in`. Under this model, the lexer may simply
pop the layout stack and return the :code:`in` token. As we'll see in the next
section, as long as the lexer keeps track of its own context (i.e. the stack),
the parser will cope just fine without the virtual end-brace.
Parsing Lonely Braces
*********************
When viewed in the abstract, parsing and tokenising are near-identical tasks yet
the two are very often decomposed into discrete systems with very different
implementations. Lexers operate on streams of text and tokens, while parsers
are typically far less linear, using a parse stack or recursing top-down. A
big reason for this separation is state management: the parser aims to be as
context-free as possible, while the lexer tends to burden the necessary
statefulness. Still, the nature of a stream-oriented lexer makes backtracking
difficult and quite inelegant.
However, simply declaring a parse error to be not an error at all
counterintuitively proves to be an elegant solution our layout problem which
minimises backtracking and state in both the lexer and the parser. Consider the
following definitions found in rlp's BNF:
.. productionlist:: rlp
VOpen : `vopen`
VClose : `vclose` | `error`
A parse error is recovered and treated as a closing brace. Another point of note
in the BNF is the difference between virtual and non-virtual braces (TODO: i
don't like that the BNF is formatted without newlines :/):
.. productionlist:: rlp
LetExpr : `let` VOpen Bindings VClose `in` Expr | `let` `{` Bindings `}` `in` Expr
This ensures that non-virtual braces are closed explicitly.
This set of rules is adequete enough to satisfy our basic concerns about line
continations and layout lists. For a more pedantic description of the layout
system, see `chapter 10
<https://www.haskell.org/onlinereport/haskell2010/haskellch10.html>`_ of the
2010 Haskell Report, which I heavily referenced here.
References
----------

31
examples/rlp/QuickSort.rl Normal file
View File

@@ -0,0 +1,31 @@
data List a = Nil | Cons a (List a)
data Bool = False | True
filter :: (a -> Bool) -> List a -> List a
filter p l = case l of
Nil -> Nil
Cons a as ->
case p a of
True -> Cons a (filter p as)
False -> filter p as
append :: List a -> List a -> List a
append p q = case p of
Nil -> q
Cons a as -> Cons a (append as q)
qsort :: List Int# -> List Int#
qsort l = case l of
Nil -> Nil
Cons a as ->
let lesser = filter (>=# a) as
greater = filter (<# a) as
in append (append (qsort lesser) (Cons a Nil)) (qsort greater)
list :: List Int#
list = Cons 9 (Cons 2 (Cons 3 (Cons 2
(Cons 5 (Cons 2 (Cons 12 (Cons 89 Nil)))))))
main = print# (qsort list)

View File

@@ -7,5 +7,5 @@ foldr f z l = case l of
list = Cons 1 (Cons 2 (Cons 3 Nil))
main = foldr (+#) 0 list
main = print# (foldr (+#) 0 list)

View File

@@ -50,32 +50,26 @@ library
build-tool-depends: happy:happy, alex:alex
-- other-extensions:
build-depends: base >=4.17 && <4.20
build-depends: base >=4.17 && <4.21
-- required for happy
, array >= 0.5.5 && < 0.6
, containers >= 0.6.7 && < 0.7
, template-haskell >= 2.20.0 && < 2.21
, template-haskell >= 2.20.0 && < 2.23
, pretty >= 1.1.3 && < 1.2
, data-default >= 0.7.1 && < 0.8
, data-default-class >= 0.1.2 && < 0.2
, hashable >= 1.4.3 && < 1.5
, mtl >= 2.3.1 && < 2.4
, text >= 2.0.2 && < 2.1
, megaparsec >= 9.6.1 && < 9.7
, microlens >= 0.4.13 && < 0.5
, microlens-mtl >= 0.2.0 && < 0.3
, microlens-platform >= 0.4.3 && < 0.5
, microlens-th >= 0.4.3 && < 0.5
, text >= 2.0.2 && < 2.3
, unordered-containers >= 0.2.20 && < 0.3
, recursion-schemes >= 5.2.2 && < 5.3
, data-fix >= 0.3.2 && < 0.4
, utf8-string >= 1.0.2 && < 1.1
, extra >= 1.7.0 && <2
, semigroupoids
, comonad
, lens
, text-ansi
, microlens-pro ^>=0.2.0
, semigroupoids >=6.0 && <6.1
, comonad >=5.0.0 && <6
, lens >=5.2.3 && <6.0
, text-ansi >=0.2.0 && <0.4
, effectful-core ^>=2.3.0.0
, deriving-compat ^>=0.6.0
, these >=0.2 && <2.0
@@ -102,10 +96,10 @@ executable rlpc
build-depends: base >=4.17.0.0 && <4.20.0.0
, rlp
, optparse-applicative >= 0.18.1 && < 0.19
, microlens-platform
, mtl >= 2.3.1 && < 2.4
, unordered-containers >= 0.2.20 && < 0.3
, text >= 2.0.2 && < 2.1
, lens >=5.2.3 && <6.0
, text >= 2.0.2 && < 2.3
hs-source-dirs: app
default-language: GHC2021

View File

@@ -11,6 +11,7 @@ module Compiler.JustRun
( justLexCore
, justParseCore
, justTypeCheckCore
, justHdbg
)
where
----------------------------------------------------------------------------------
@@ -20,14 +21,22 @@ import Core.HindleyMilner
import Core.Syntax (Program')
import Compiler.RLPC
import Control.Arrow ((>>>))
import Control.Monad ((>=>))
import Control.Monad ((>=>), void)
import Control.Comonad
import Control.Lens
import Data.Text qualified as T
import Data.Function ((&))
import System.IO
import GM
import Rlp.Parse
import Rlp2Core
----------------------------------------------------------------------------------
justHdbg :: String -> IO GmState
justHdbg s = do
p <- evalRLPCIO def (parseRlpProgR >=> desugarRlpProgR $ T.pack s)
withFile "/tmp/t.log" WriteMode $ hdbgProg p
justLexCore :: String -> Either [MsgEnvelope RlpcError] [CoreToken]
justLexCore s = lexCoreR (T.pack s)
& mapped . each %~ extract

View File

@@ -64,8 +64,8 @@ import Data.Text.IO qualified as T
import System.IO
import Text.ANSI qualified as Ansi
import Text.PrettyPrint hiding ((<>))
import Lens.Micro.Platform
import Lens.Micro.Platform.Internal
import Control.Lens
import Data.Text.Lens (packed, unpacked, IsText)
import System.Exit
----------------------------------------------------------------------------------

View File

@@ -21,8 +21,7 @@ import Control.Monad.Errorful
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Exts (IsString(..))
import Lens.Micro.Platform
import Lens.Micro.Platform.Internal
import Control.Lens
import Compiler.Types
----------------------------------------------------------------------------------

View File

@@ -20,7 +20,7 @@ import Data.Functor.Identity
import Data.Coerce
import Data.HashSet (HashSet)
import Data.HashSet qualified as H
import Lens.Micro
import Control.Lens
----------------------------------------------------------------------------------
newtype ErrorfulT e m a = ErrorfulT { runErrorfulT :: m (Maybe a, [e]) }

View File

@@ -16,9 +16,7 @@ module Core.HindleyMilner
)
where
----------------------------------------------------------------------------------
import Lens.Micro
import Lens.Micro.Mtl
import Lens.Micro.Platform
import Control.Lens hiding (Context', Context)
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Pretty (rpretty)

View File

@@ -26,8 +26,7 @@ import Compiler.RLPC
import Compiler.Types
-- TODO: unify Located definitions
import Compiler.RlpcError
import Lens.Micro
import Lens.Micro.TH
import Control.Lens
}
%wrapper "monad-strict-text"

View File

@@ -24,7 +24,7 @@ import Core.Syntax
import Core.Lex
import Compiler.RLPC
import Control.Monad
import Lens.Micro
import Control.Lens hiding (snoc)
import Data.Default.Class (def)
import Data.Hashable (Hashable)
import Data.List.Extra

View File

@@ -60,8 +60,6 @@ import Data.Bifoldable (bifoldr)
import GHC.Generics (Generic, Generically(..))
-- Lift instances for the Core quasiquoters
import Language.Haskell.TH.Syntax (Lift)
-- import Lens.Micro.TH (makeLenses)
-- import Lens.Micro
import Control.Lens
----------------------------------------------------------------------------------

View File

@@ -13,7 +13,7 @@ import Data.Functor.Foldable
import Data.Set (Set)
import Data.Set qualified as S
import Core.Syntax
import Lens.Micro
import Control.Lens
import GHC.Exts (IsList(..))
----------------------------------------------------------------------------------

View File

@@ -24,7 +24,6 @@ import Numeric (showHex)
import Data.Pretty
import Compiler.RLPC
-- import Lens.Micro.Platform
import Control.Lens
import Core.Syntax
import Core.Utils
@@ -70,7 +69,7 @@ tagData p = let ?dt = p ^. programDataTags
go x = embed x
tagAlts :: (?dt :: HashMap Name (Tag, Int)) => Alter' -> Alter'
tagAlts (Alter (AltData c) bs e) = Alter (AltTag tag) bs e
tagAlts (Alter (AltData c) bs e) = Alter (AltTag tag) bs (cata go e)
where tag = case ?dt ^. at c of
Just (t,_) -> t
-- TODO: errorful

View File

@@ -9,8 +9,12 @@ module GM
( hdbgProg
, evalProg
, evalProgR
, GmState(..)
, gmCode, gmStack, gmDump, gmHeap, gmEnv, gmStats
, Node(..)
, showState
, gmEvalProg
, Stats(..)
, finalStateOf
, resultOf
, resultOfExpr
@@ -22,11 +26,8 @@ import Data.List (mapAccumL)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid (Endo(..))
import Data.Tuple (swap)
import Lens.Micro
import Lens.Micro.Extras (view)
import Lens.Micro.TH
import Lens.Micro.Platform (packed, unpacked)
import Lens.Micro.Platform.Internal (IsText(..))
import Control.Lens
import Data.Text.Lens (IsText, packed, unpacked)
import Text.Printf
import Text.PrettyPrint hiding ((<>))
import Text.PrettyPrint.HughesPJ (maybeParens)
@@ -89,6 +90,7 @@ data Key = NameKey Name
| ConstrKey Tag Int
deriving (Show, Eq)
-- >> [ref/Instr]
data Instr = Unwind
| PushGlobal Name
| PushConstr Tag Int
@@ -103,13 +105,14 @@ data Instr = Unwind
-- arith
| Neg | Add | Sub | Mul | Div
-- comparison
| Equals | Lesser
| Equals | Lesser | GreaterEq
| Pack Tag Int -- Pack Tag Arity
| CaseJump [(Tag, Code)]
| Split Int
| Print
| Halt
deriving (Show, Eq)
-- << [ref/Instr]
data Node = NNum Int
| NAp Addr Addr
@@ -152,7 +155,7 @@ evalProg p = res <&> (,sts)
resAddr = final ^. gmStack ^? _head
res = resAddr >>= flip hLookup h
hdbgProg :: Program' -> Handle -> IO (Node, Stats)
hdbgProg :: Program' -> Handle -> IO GmState
hdbgProg p hio = do
(renderOut . showState) `traverse_` states
-- TODO: i'd like the statistics to be at the top of the file, but `sts`
@@ -160,7 +163,7 @@ hdbgProg p hio = do
-- *can't* get partial logs in the case of a crash. this is in opposition to
-- the above traversal which *will* produce partial logs. i love laziness :3
renderOut . showStats $ sts
pure (res, sts)
pure final
where
renderOut r = hPutStrLn hio $ render r ++ "\n"
@@ -228,6 +231,7 @@ step st = case head (st ^. gmCode) of
Div -> divI
Equals -> equalsI
Lesser -> lesserI
GreaterEq -> greaterEqI
Split n -> splitI n
Pack t n -> packI t n
CaseJump as -> caseJumpI as
@@ -451,9 +455,10 @@ step st = case head (st ^. gmCode) of
mulI = primitive2 boxInt unboxInt (*) st
divI = primitive2 boxInt unboxInt div st
lesserI, equalsI :: GmState
lesserI, greaterEqI, equalsI :: GmState
equalsI = primitive2 boxBool unboxInt (==) st
lesserI = primitive2 boxBool unboxInt (<) st
greaterEqI = primitive2 boxBool unboxInt (>=) st
splitI :: Int -> GmState
splitI n = st
@@ -638,6 +643,7 @@ compiledPrims =
, binop "/#" Div
, binop "==#" Equals
, binop "<#" Lesser
, binop ">=#" GreaterEq
, ("print#", 1, [ Push 0, Eval, Print, Pack tag_Unit_unit 0, Update 1, Pop 1
, Unwind ])
]
@@ -743,14 +749,12 @@ buildInitialHeap (view programScDefs -> ss) = mapAccumL allocateSc mempty compil
mconcat binders <> compileE g' e <> [Slide d]
where
d = length bs
(g',binders) = mapAccumL compileBinder (argOffset d g) addressed
-- kinda gross. revisit this
addressed = bs `zip` reverse [0 .. d-1]
(g',binders) = mapAccumL compileBinder g bs
compileBinder :: Env -> (Binding', Int) -> (Env, Code)
compileBinder m (k := v, a) = (m',c)
compileBinder :: Env -> Binding' -> (Env, Code)
compileBinder m (k := v) = (m',c)
where
m' = (NameKey k, a) : m
m' = (NameKey k, 0) : argOffset 1 m
-- make note that we use m rather than m'!
c = compileC m v
@@ -779,6 +783,7 @@ buildInitialHeap (view programScDefs -> ss) = mapAccumL allocateSc mempty compil
compileE g ("/#" :$ a :$ b) = inlineOp2 g Div a b
compileE g ("==#" :$ a :$ b) = inlineOp2 g Equals a b
compileE g ("<#" :$ a :$ b) = inlineOp2 g Lesser a b
compileE g (">=#" :$ a :$ b) = inlineOp2 g GreaterEq a b
compileE g (Case e as) = compileE g e <> [CaseJump (compileD g as)]

View File

@@ -27,8 +27,7 @@ import Data.Text (Text)
import Data.Text qualified as T
import Data.Word
import Data.Default
import Lens.Micro.Mtl
import Lens.Micro
import Control.Lens
import Debug.Trace
import Rlp.Parse.Types

View File

@@ -13,7 +13,7 @@ import Rlp.Lex
import Rlp.Syntax
import Rlp.Parse.Types
import Rlp.Parse.Associate
import Lens.Micro.Platform
import Control.Lens hiding (snoc, (.>), (<.), (<<~))
import Data.List.Extra
import Data.Fix
import Data.Functor.Const

View File

@@ -11,7 +11,7 @@ import Data.Functor.Const
import Data.Functor
import Data.Text qualified as T
import Text.Printf
import Lens.Micro
import Control.Lens
import Rlp.Parse.Types
import Rlp.Syntax
--------------------------------------------------------------------------------

View File

@@ -44,8 +44,7 @@ import Data.HashMap.Strict qualified as H
import Data.Void
import Data.Word (Word8)
import Data.Text qualified as T
import Lens.Micro.TH
import Lens.Micro
import Control.Lens hiding ((<<~))
import Rlp.Syntax
import Compiler.Types
--------------------------------------------------------------------------------

View File

@@ -57,8 +57,7 @@ import Data.Functor.Identity
import Data.Kind (Type)
import GHC.Generics
import Language.Haskell.TH.Syntax (Lift)
import Lens.Micro.Pro
import Lens.Micro.Pro.TH
import Control.Lens
import Core.Syntax hiding (Lit, Type, Binding, Binding')
import Core (HasRHS(..), HasLHS(..))
----------------------------------------------------------------------------------

View File

@@ -13,8 +13,6 @@ import Control.Monad.Utils
import Control.Arrow
import Control.Applicative
import Control.Comonad
-- import Lens.Micro
-- import Lens.Micro.Internal
import Control.Lens
import Compiler.RLPC
import Data.List (mapAccumL, partition)

View File

@@ -20,8 +20,7 @@ import System.IO (Handle, hPutStr)
import Text.Printf (printf, hPrintf)
import Data.Proxy (Proxy(..))
import Data.Monoid (Endo(..))
import Lens.Micro
import Lens.Micro.TH
import Control.Lens
import Data.Pretty
import Data.Heap
import Core.Examples

View File

@@ -41,6 +41,7 @@ evalArith (a ::* b) = evalArith a * evalArith b
evalArith (a ::- b) = evalArith a - evalArith b
instance Arbitrary ArithExpr where
-- TODO: implement shrink
arbitrary = gen 4
where
gen :: Int -> Gen ArithExpr