Compare commits
12 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1436f1124f | ||
|
|
2e13ec2cf4 | ||
|
|
36a17d092b | ||
|
|
ccc71a751c | ||
|
|
c57da862ae | ||
|
|
4c9ceb74d1 | ||
|
|
8267548fab | ||
|
|
968832bfaf | ||
|
|
81b019e659 | ||
|
|
cd2a283493 | ||
|
|
bb41d3c196 | ||
|
|
de16bf12df |
15
README.md
15
README.md
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
31
examples/rlp/QuickSort.rl
Normal 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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
18
rlp.cabal
18
rlp.cabal
@@ -61,21 +61,15 @@ library
|
||||
, 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
|
||||
, 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
|
||||
, extra >= 1.7.0 && <2
|
||||
, 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,9 +96,9 @@ 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
|
||||
, lens >=5.2.3 && <6.0
|
||||
, text >= 2.0.2 && < 2.1
|
||||
|
||||
hs-source-dirs: app
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
----------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@@ -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
|
||||
----------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@@ -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]) }
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
----------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@@ -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(..))
|
||||
----------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
37
src/GM.hs
37
src/GM.hs
@@ -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,8 +643,9 @@ 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])
|
||||
, Unwind ])
|
||||
]
|
||||
where
|
||||
unop k i = (k, 1, [Push 0, Eval, i, 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)]
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@@ -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
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@@ -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(..))
|
||||
----------------------------------------------------------------------------------
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user