diff --git "a/.output/actual/eta/eval/logged/Fast/from-eas/fact0\n.logged" "b/.output/actual/eta/eval/logged/Fast/from-eas/fact0\n.logged"
deleted file mode 100644
index c78338ffd..000000000
--- "a/.output/actual/eta/eval/logged/Fast/from-eas/fact0\n.logged"
+++ /dev/null
@@ -1,712 +0,0 @@
-dump: Memory
- { memoryCM = CM
- { program =
- [ ICF
- ( Mark
- ( MNatural 1 )
- )
- , IAL
- ( SPure
- ( Cons 2 )
- )
- , ICF
- ( Labeled
- ( LImmediate 14 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 2 )
- )
- , IAL
- ( SPure
- ( Cons 3 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 3 )
- )
- , IAL
- ( SPure
- ( Cons 4 )
- )
- , ICF
- ( Labeled
- ( LImmediate 32 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 4 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Labeled
- ( LImmediate 0 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 5 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 6 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 7 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 9 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 8 )
- )
- , ICF
- ( Labeled
- ( LImmediate 13 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 9 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 10 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 11 )
- )
- , IAL
- ( SPure
- ( Cons 12 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 12 )
- )
- , IAL
- ( SPure
- ( Cons 13 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 13 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 14 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 15 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 16 )
- )
- , ICF
- ( Branch
- ( BImmediate 18 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 17 )
- )
- , ICF
- ( Branch
- ( BImmediate 14 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 18 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 19 )
- )
- , IAL
- ( SPure
- ( Cons 16 )
- )
- , ICF
- ( Mark
- ( MNatural 20 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 21 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Cons 22 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 22 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 23 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 24 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 25 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 27 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 26 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 27 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 10 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 29 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 28 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 29 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -1 ) Sub
- )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 19 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 30 )
- )
- , IAL ( SPure Discard )
- , ICF
- ( Mark
- ( MNatural 31 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 32 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 33 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Branch
- ( BImmediate 35 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 34 )
- )
- , IAL
- ( SPure
- ( Cons 48 )
- )
- , IAL ( SIO OutputChar )
- , ICF ( Branch BTop NE )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 35 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 36 )
- )
- , ICF
- ( Branch
- ( BImmediate 38 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 37 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Labeled
- ( LImmediate 42 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 38 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Binaries
- [ Mod
- , Div
- ]
- )
- )
- , ICF
- ( Mark
- ( MArtificial "38" )
- )
- , ICF
- ( Mark
- ( MNatural 39 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -48 ) Sub
- )
- )
- )
- , ICF
- ( Mark
- ( MNatural 40 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 41 )
- )
- , ICF
- ( Labeled
- ( LImmediate 35 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 42 )
- )
- , IAL
- ( SPure
- ( Cons 43 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 43 )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 44 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 45 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , ICF
- ( Mark
- ( MNatural 46 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 47 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 48 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 49 )
- )
- , ICF
- ( Branch
- ( BImmediate 51 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 50 )
- )
- , ICF
- ( Labeled
- ( LImmediate 58 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 51 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 52 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 53 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 3 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 54 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 55 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 56 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 57 )
- )
- , ICF
- ( Labeled
- ( LImmediate 48 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 58 )
- )
- , ICF ( Branch BSwapped NE )
- , ICF
- ( Mark
- ( MNatural 59 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 60 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 61 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 62 )
- )
- , ICF
- ( Branch
- ( BImmediate 64 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 63 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 64 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Mark
- ( MNatural 65 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 66 )
- )
- , ICF
- ( Mark
- ( MNatural 0 )
- )
- , End
- ]
- , programCounter = 169
- , returnStack = IS []
- }
- , memoryStack = fromList
- [ 496
- , 2
- ]
- , memoryRAM = []
- }
diff --git "a/.output/actual/eta/eval/logged/Fast/from-eas/fact1\n.logged" "b/.output/actual/eta/eval/logged/Fast/from-eas/fact1\n.logged"
index a171ba9b9..2daffb9c5 100644
--- "a/.output/actual/eta/eval/logged/Fast/from-eas/fact1\n.logged"
+++ "b/.output/actual/eta/eval/logged/Fast/from-eas/fact1\n.logged"
@@ -204,7 +204,9 @@ dump: Memory
)
, IAL
( SPure
- ( Cons 16 )
+ ( Unary
+ ( UImmediate 48 Sub )
+ )
)
, ICF
( Mark
@@ -704,9 +706,6 @@ dump: Memory
, programCounter = 169
, returnStack = IS []
}
- , memoryStack = fromList
- [ 506
- , 2
- ]
+ , memoryStack = fromList []
, memoryRAM = []
}
diff --git "a/.output/actual/eta/eval/logged/Fast/from-eas/fact10\n.logged" "b/.output/actual/eta/eval/logged/Fast/from-eas/fact10\n.logged"
deleted file mode 100644
index 2c647be5a..000000000
--- "a/.output/actual/eta/eval/logged/Fast/from-eas/fact10\n.logged"
+++ /dev/null
@@ -1,717 +0,0 @@
- [Undefined label 506]
-CPM.labeledIImmediateInstruction
-CPM.labeledITopInstruction
- [i ICF (Labeled LTop Jump)] [Automaton.nextState Memory
- { memoryCM = CM
- { program =
- [ ICF
- ( Mark
- ( MNatural 1 )
- )
- , IAL
- ( SPure
- ( Cons 2 )
- )
- , ICF
- ( Labeled
- ( LImmediate 14 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 2 )
- )
- , IAL
- ( SPure
- ( Cons 3 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 3 )
- )
- , IAL
- ( SPure
- ( Cons 4 )
- )
- , ICF
- ( Labeled
- ( LImmediate 32 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 4 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Labeled
- ( LImmediate 0 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 5 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 6 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 7 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 9 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 8 )
- )
- , ICF
- ( Labeled
- ( LImmediate 13 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 9 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 10 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 11 )
- )
- , IAL
- ( SPure
- ( Cons 12 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 12 )
- )
- , IAL
- ( SPure
- ( Cons 13 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 13 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 14 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 15 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 16 )
- )
- , ICF
- ( Branch
- ( BImmediate 18 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 17 )
- )
- , ICF
- ( Branch
- ( BImmediate 14 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 18 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 19 )
- )
- , IAL
- ( SPure
- ( Cons 16 )
- )
- , ICF
- ( Mark
- ( MNatural 20 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 21 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Cons 22 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 22 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 23 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 24 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 25 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 27 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 26 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 27 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 10 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 29 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 28 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 29 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -1 ) Sub
- )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 19 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 30 )
- )
- , IAL ( SPure Discard )
- , ICF
- ( Mark
- ( MNatural 31 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 32 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 33 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Branch
- ( BImmediate 35 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 34 )
- )
- , IAL
- ( SPure
- ( Cons 48 )
- )
- , IAL ( SIO OutputChar )
- , ICF ( Branch BTop NE )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 35 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 36 )
- )
- , ICF
- ( Branch
- ( BImmediate 38 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 37 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Labeled
- ( LImmediate 42 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 38 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Binaries
- [ Mod
- , Div
- ]
- )
- )
- , ICF
- ( Mark
- ( MArtificial "38" )
- )
- , ICF
- ( Mark
- ( MNatural 39 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -48 ) Sub
- )
- )
- )
- , ICF
- ( Mark
- ( MNatural 40 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 41 )
- )
- , ICF
- ( Labeled
- ( LImmediate 35 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 42 )
- )
- , IAL
- ( SPure
- ( Cons 43 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 43 )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 44 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 45 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , ICF
- ( Mark
- ( MNatural 46 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 47 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 48 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 49 )
- )
- , ICF
- ( Branch
- ( BImmediate 51 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 50 )
- )
- , ICF
- ( Labeled
- ( LImmediate 58 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 51 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 52 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 53 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 3 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 54 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 55 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 56 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 57 )
- )
- , ICF
- ( Labeled
- ( LImmediate 48 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 58 )
- )
- , ICF ( Branch BSwapped NE )
- , ICF
- ( Mark
- ( MNatural 59 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 60 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 61 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 62 )
- )
- , ICF
- ( Branch
- ( BImmediate 64 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 63 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 64 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Mark
- ( MNatural 65 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 66 )
- )
- , ICF
- ( Mark
- ( MNatural 0 )
- )
- , End
- ]
- , programCounter = 83
- , returnStack = IS []
- }
- , memoryStack = fromList
- [ 506
- , 496
- , 0
- , 2
- ]
- , memoryRAM = []
- }]
diff --git "a/.output/actual/eta/eval/logged/Fast/from-eas/fact9\n.logged" "b/.output/actual/eta/eval/logged/Fast/from-eas/fact9\n.logged"
index 80a0b0430..2daffb9c5 100644
--- "a/.output/actual/eta/eval/logged/Fast/from-eas/fact9\n.logged"
+++ "b/.output/actual/eta/eval/logged/Fast/from-eas/fact9\n.logged"
@@ -204,7 +204,9 @@ dump: Memory
)
, IAL
( SPure
- ( Cons 16 )
+ ( Unary
+ ( UImmediate 48 Sub )
+ )
)
, ICF
( Mark
@@ -704,9 +706,6 @@ dump: Memory
, programCounter = 169
, returnStack = IS []
}
- , memoryStack = fromList
- [ 586
- , 2
- ]
+ , memoryStack = fromList []
, memoryRAM = []
}
diff --git "a/.output/actual/eta/eval/output/Fast/from-eas/fact0\n.output" "b/.output/actual/eta/eval/output/Fast/from-eas/fact0\n.output"
deleted file mode 100644
index e69de29bb..000000000
diff --git "a/.output/actual/eta/eval/output/Fast/from-eas/fact1\n.output" "b/.output/actual/eta/eval/output/Fast/from-eas/fact1\n.output"
index e69de29bb..d00491fd7 100644
--- "a/.output/actual/eta/eval/output/Fast/from-eas/fact1\n.output"
+++ "b/.output/actual/eta/eval/output/Fast/from-eas/fact1\n.output"
@@ -0,0 +1 @@
+1
diff --git "a/.output/actual/eta/eval/output/Fast/from-eas/fact10\n.output" "b/.output/actual/eta/eval/output/Fast/from-eas/fact10\n.output"
deleted file mode 100644
index e69de29bb..000000000
diff --git "a/.output/actual/eta/eval/output/Fast/from-eas/fact9\n.output" "b/.output/actual/eta/eval/output/Fast/from-eas/fact9\n.output"
index e69de29bb..9c626aa4f 100644
--- "a/.output/actual/eta/eval/output/Fast/from-eas/fact9\n.output"
+++ "b/.output/actual/eta/eval/output/Fast/from-eas/fact9\n.output"
@@ -0,0 +1 @@
+362880
diff --git a/.output/actual/eta/il/optimized/from-eas/fact.il b/.output/actual/eta/il/optimized/from-eas/fact.il
index 8ce517f12..9d355af84 100644
--- a/.output/actual/eta/il/optimized/from-eas/fact.il
+++ b/.output/actual/eta/il/optimized/from-eas/fact.il
@@ -65,7 +65,7 @@ cons 0
moveI 1
markM 19
-cons 16
+subI 48
markM 20
moveI 1
diff --git a/.output/actual/eta/il/parsed/from-eas/fact.il b/.output/actual/eta/il/parsed/from-eas/fact.il
index 53995b229..7f84dbd15 100644
--- a/.output/actual/eta/il/parsed/from-eas/fact.il
+++ b/.output/actual/eta/il/parsed/from-eas/fact.il
@@ -104,7 +104,6 @@ halibut
markM 19
cons 48
-cons 32
sub
markM 20
diff --git a/.output/actual/eta/minified/from-eas/fact.eta b/.output/actual/eta/minified/from-eas/fact.eta
index 750ab4c5a..b4670f8cf 100644
--- a/.output/actual/eta/minified/from-eas/fact.eta
+++ b/.output/actual/eta/minified/from-eas/fact.eta
@@ -16,7 +16,7 @@ NEHNIIES
ANENTESST
NENTETNAHET
NENTEH
-NSSENIIES
+NSSES
NTEH
NTOEANTENSAET
NENTEH
diff --git "a/.output/golden/eta/eval/logged/Fast/from-eas/fact0\n.logged" "b/.output/golden/eta/eval/logged/Fast/from-eas/fact0\n.logged"
deleted file mode 100644
index c78338ffd..000000000
--- "a/.output/golden/eta/eval/logged/Fast/from-eas/fact0\n.logged"
+++ /dev/null
@@ -1,712 +0,0 @@
-dump: Memory
- { memoryCM = CM
- { program =
- [ ICF
- ( Mark
- ( MNatural 1 )
- )
- , IAL
- ( SPure
- ( Cons 2 )
- )
- , ICF
- ( Labeled
- ( LImmediate 14 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 2 )
- )
- , IAL
- ( SPure
- ( Cons 3 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 3 )
- )
- , IAL
- ( SPure
- ( Cons 4 )
- )
- , ICF
- ( Labeled
- ( LImmediate 32 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 4 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Labeled
- ( LImmediate 0 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 5 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 6 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 7 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 9 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 8 )
- )
- , ICF
- ( Labeled
- ( LImmediate 13 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 9 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 10 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 11 )
- )
- , IAL
- ( SPure
- ( Cons 12 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 12 )
- )
- , IAL
- ( SPure
- ( Cons 13 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 13 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 14 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 15 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 16 )
- )
- , ICF
- ( Branch
- ( BImmediate 18 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 17 )
- )
- , ICF
- ( Branch
- ( BImmediate 14 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 18 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 19 )
- )
- , IAL
- ( SPure
- ( Cons 16 )
- )
- , ICF
- ( Mark
- ( MNatural 20 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 21 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Cons 22 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 22 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 23 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 24 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 25 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 27 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 26 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 27 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 10 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 29 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 28 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 29 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -1 ) Sub
- )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 19 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 30 )
- )
- , IAL ( SPure Discard )
- , ICF
- ( Mark
- ( MNatural 31 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 32 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 33 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Branch
- ( BImmediate 35 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 34 )
- )
- , IAL
- ( SPure
- ( Cons 48 )
- )
- , IAL ( SIO OutputChar )
- , ICF ( Branch BTop NE )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 35 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 36 )
- )
- , ICF
- ( Branch
- ( BImmediate 38 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 37 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Labeled
- ( LImmediate 42 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 38 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Binaries
- [ Mod
- , Div
- ]
- )
- )
- , ICF
- ( Mark
- ( MArtificial "38" )
- )
- , ICF
- ( Mark
- ( MNatural 39 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -48 ) Sub
- )
- )
- )
- , ICF
- ( Mark
- ( MNatural 40 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 41 )
- )
- , ICF
- ( Labeled
- ( LImmediate 35 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 42 )
- )
- , IAL
- ( SPure
- ( Cons 43 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 43 )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 44 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 45 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , ICF
- ( Mark
- ( MNatural 46 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 47 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 48 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 49 )
- )
- , ICF
- ( Branch
- ( BImmediate 51 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 50 )
- )
- , ICF
- ( Labeled
- ( LImmediate 58 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 51 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 52 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 53 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 3 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 54 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 55 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 56 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 57 )
- )
- , ICF
- ( Labeled
- ( LImmediate 48 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 58 )
- )
- , ICF ( Branch BSwapped NE )
- , ICF
- ( Mark
- ( MNatural 59 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 60 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 61 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 62 )
- )
- , ICF
- ( Branch
- ( BImmediate 64 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 63 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 64 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Mark
- ( MNatural 65 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 66 )
- )
- , ICF
- ( Mark
- ( MNatural 0 )
- )
- , End
- ]
- , programCounter = 169
- , returnStack = IS []
- }
- , memoryStack = fromList
- [ 496
- , 2
- ]
- , memoryRAM = []
- }
diff --git "a/.output/golden/eta/eval/logged/Fast/from-eas/fact1\n.logged" "b/.output/golden/eta/eval/logged/Fast/from-eas/fact1\n.logged"
index a171ba9b9..2daffb9c5 100644
--- "a/.output/golden/eta/eval/logged/Fast/from-eas/fact1\n.logged"
+++ "b/.output/golden/eta/eval/logged/Fast/from-eas/fact1\n.logged"
@@ -204,7 +204,9 @@ dump: Memory
)
, IAL
( SPure
- ( Cons 16 )
+ ( Unary
+ ( UImmediate 48 Sub )
+ )
)
, ICF
( Mark
@@ -704,9 +706,6 @@ dump: Memory
, programCounter = 169
, returnStack = IS []
}
- , memoryStack = fromList
- [ 506
- , 2
- ]
+ , memoryStack = fromList []
, memoryRAM = []
}
diff --git "a/.output/golden/eta/eval/logged/Fast/from-eas/fact10\n.logged" "b/.output/golden/eta/eval/logged/Fast/from-eas/fact10\n.logged"
deleted file mode 100644
index 2c647be5a..000000000
--- "a/.output/golden/eta/eval/logged/Fast/from-eas/fact10\n.logged"
+++ /dev/null
@@ -1,717 +0,0 @@
- [Undefined label 506]
-CPM.labeledIImmediateInstruction
-CPM.labeledITopInstruction
- [i ICF (Labeled LTop Jump)] [Automaton.nextState Memory
- { memoryCM = CM
- { program =
- [ ICF
- ( Mark
- ( MNatural 1 )
- )
- , IAL
- ( SPure
- ( Cons 2 )
- )
- , ICF
- ( Labeled
- ( LImmediate 14 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 2 )
- )
- , IAL
- ( SPure
- ( Cons 3 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 3 )
- )
- , IAL
- ( SPure
- ( Cons 4 )
- )
- , ICF
- ( Labeled
- ( LImmediate 32 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 4 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Labeled
- ( LImmediate 0 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 5 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 6 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 7 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 9 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 8 )
- )
- , ICF
- ( Labeled
- ( LImmediate 13 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 9 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 10 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 11 )
- )
- , IAL
- ( SPure
- ( Cons 12 )
- )
- , ICF
- ( Labeled
- ( LImmediate 5 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 12 )
- )
- , IAL
- ( SPure
- ( Cons 13 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 13 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 14 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 15 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 16 )
- )
- , ICF
- ( Branch
- ( BImmediate 18 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 17 )
- )
- , ICF
- ( Branch
- ( BImmediate 14 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 18 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 19 )
- )
- , IAL
- ( SPure
- ( Cons 16 )
- )
- , ICF
- ( Mark
- ( MNatural 20 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 21 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Cons 22 )
- )
- , ICF
- ( Labeled
- ( LImmediate 44 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 22 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 23 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 24 )
- )
- , IAL ( SIO InputChar )
- , ICF
- ( Mark
- ( MNatural 25 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 32 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 27 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 26 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 27 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 10 Sub )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 29 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 28 )
- )
- , ICF
- ( Labeled
- ( LImmediate 30 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 29 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -1 ) Sub
- )
- )
- )
- , ICF
- ( Branch
- ( BImmediate 19 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 30 )
- )
- , IAL ( SPure Discard )
- , ICF
- ( Mark
- ( MNatural 31 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 32 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 33 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Branch
- ( BImmediate 35 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 34 )
- )
- , IAL
- ( SPure
- ( Cons 48 )
- )
- , IAL ( SIO OutputChar )
- , ICF ( Branch BTop NE )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 35 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 36 )
- )
- , ICF
- ( Branch
- ( BImmediate 38 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 37 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Labeled
- ( LImmediate 42 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 38 )
- )
- , IAL
- ( SPure
- ( Cons 10 )
- )
- , IAL
- ( SPure
- ( Binaries
- [ Mod
- , Div
- ]
- )
- )
- , ICF
- ( Mark
- ( MArtificial "38" )
- )
- , ICF
- ( Mark
- ( MNatural 39 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate
- ( -48 ) Sub
- )
- )
- )
- , ICF
- ( Mark
- ( MNatural 40 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 41 )
- )
- , ICF
- ( Labeled
- ( LImmediate 35 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 42 )
- )
- , IAL
- ( SPure
- ( Cons 43 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 43 )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 44 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 45 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , ICF
- ( Mark
- ( MNatural 46 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 47 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 48 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 49 )
- )
- , ICF
- ( Branch
- ( BImmediate 51 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 50 )
- )
- , ICF
- ( Labeled
- ( LImmediate 58 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 51 )
- )
- , IAL
- ( SPure
- ( Unary
- ( UImmediate 1 Sub )
- )
- )
- , ICF
- ( Mark
- ( MNatural 52 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 53 )
- )
- , IAL
- ( SPure
- ( Cons 0 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 3 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 54 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF
- ( Mark
- ( MNatural 55 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 56 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 2 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 57 )
- )
- , ICF
- ( Labeled
- ( LImmediate 48 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 58 )
- )
- , ICF ( Branch BSwapped NE )
- , ICF
- ( Mark
- ( MNatural 59 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 60 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 1 ) Move
- )
- )
- , ICF
- ( Mark
- ( MNatural 61 )
- )
- , IAL
- ( SPure
- ( Indexed
- ( IImmediate 0 ) Copy
- )
- )
- , ICF
- ( Mark
- ( MNatural 62 )
- )
- , ICF
- ( Branch
- ( BImmediate 64 ) NE
- )
- , ICF
- ( Mark
- ( MNatural 63 )
- )
- , IAL
- ( SPure ( Binary Sub ) )
- , ICF ( Labeled LTop Jump )
- , ICF
- ( Mark
- ( MNatural 64 )
- )
- , IAL ( SIO OutputChar )
- , ICF
- ( Mark
- ( MNatural 65 )
- )
- , ICF
- ( Labeled
- ( LImmediate 60 ) Jump
- )
- , ICF
- ( Mark
- ( MNatural 66 )
- )
- , ICF
- ( Mark
- ( MNatural 0 )
- )
- , End
- ]
- , programCounter = 83
- , returnStack = IS []
- }
- , memoryStack = fromList
- [ 506
- , 496
- , 0
- , 2
- ]
- , memoryRAM = []
- }]
diff --git "a/.output/golden/eta/eval/logged/Fast/from-eas/fact9\n.logged" "b/.output/golden/eta/eval/logged/Fast/from-eas/fact9\n.logged"
index 80a0b0430..2daffb9c5 100644
--- "a/.output/golden/eta/eval/logged/Fast/from-eas/fact9\n.logged"
+++ "b/.output/golden/eta/eval/logged/Fast/from-eas/fact9\n.logged"
@@ -204,7 +204,9 @@ dump: Memory
)
, IAL
( SPure
- ( Cons 16 )
+ ( Unary
+ ( UImmediate 48 Sub )
+ )
)
, ICF
( Mark
@@ -704,9 +706,6 @@ dump: Memory
, programCounter = 169
, returnStack = IS []
}
- , memoryStack = fromList
- [ 586
- , 2
- ]
+ , memoryStack = fromList []
, memoryRAM = []
}
diff --git "a/.output/golden/eta/eval/output/Fast/from-eas/fact0\n.output" "b/.output/golden/eta/eval/output/Fast/from-eas/fact0\n.output"
deleted file mode 100644
index e69de29bb..000000000
diff --git "a/.output/golden/eta/eval/output/Fast/from-eas/fact1\n.output" "b/.output/golden/eta/eval/output/Fast/from-eas/fact1\n.output"
index e69de29bb..d00491fd7 100644
--- "a/.output/golden/eta/eval/output/Fast/from-eas/fact1\n.output"
+++ "b/.output/golden/eta/eval/output/Fast/from-eas/fact1\n.output"
@@ -0,0 +1 @@
+1
diff --git "a/.output/golden/eta/eval/output/Fast/from-eas/fact10\n.output" "b/.output/golden/eta/eval/output/Fast/from-eas/fact10\n.output"
deleted file mode 100644
index e69de29bb..000000000
diff --git "a/.output/golden/eta/eval/output/Fast/from-eas/fact9\n.output" "b/.output/golden/eta/eval/output/Fast/from-eas/fact9\n.output"
index e69de29bb..9c626aa4f 100644
--- "a/.output/golden/eta/eval/output/Fast/from-eas/fact9\n.output"
+++ "b/.output/golden/eta/eval/output/Fast/from-eas/fact9\n.output"
@@ -0,0 +1 @@
+362880
diff --git a/.output/golden/eta/il/optimized/from-eas/fact.il b/.output/golden/eta/il/optimized/from-eas/fact.il
index 8ce517f12..9d355af84 100644
--- a/.output/golden/eta/il/optimized/from-eas/fact.il
+++ b/.output/golden/eta/il/optimized/from-eas/fact.il
@@ -65,7 +65,7 @@ cons 0
moveI 1
markM 19
-cons 16
+subI 48
markM 20
moveI 1
diff --git a/.output/golden/eta/il/parsed/from-eas/fact.il b/.output/golden/eta/il/parsed/from-eas/fact.il
index 53995b229..7f84dbd15 100644
--- a/.output/golden/eta/il/parsed/from-eas/fact.il
+++ b/.output/golden/eta/il/parsed/from-eas/fact.il
@@ -104,7 +104,6 @@ halibut
markM 19
cons 48
-cons 32
sub
markM 20
diff --git a/.output/golden/eta/minified/from-eas/fact.eta b/.output/golden/eta/minified/from-eas/fact.eta
index 750ab4c5a..b4670f8cf 100644
--- a/.output/golden/eta/minified/from-eas/fact.eta
+++ b/.output/golden/eta/minified/from-eas/fact.eta
@@ -16,7 +16,7 @@ NEHNIIES
ANENTESST
NENTETNAHET
NENTEH
-NSSENIIES
+NSSES
NTEH
NTOEANTENSAET
NENTEH
diff --git a/docs/developers/CHANGELOG.md b/docs/developers/CHANGELOG.md
index 3ff0cae60..6c1478568 100644
--- a/docs/developers/CHANGELOG.md
+++ b/docs/developers/CHANGELOG.md
@@ -1,5 +1,8 @@
# 📅 Revision history for HelMA
+## 0.8.4.8 -- 2023-04-24
+* HotFix for ETA
+
## 0.8.4.7 -- 2023-04-16
* Add optimize
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.API.BFType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.API.BFType.hs.html
new file mode 100644
index 000000000..c5c5fe35e
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.API.BFType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.API.BFType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultBFType :: BFType
+ 7 defaultBFType = defaultEnum
+ 8
+ 9 bfTypes :: [BFType]
+ 10 bfTypes = generateEnums 3
+ 11
+ 12 -- | Type
+ 13 data BFType = FastType | TreeType | FlatType
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction.hs.html
new file mode 100644
index 000000000..5e949c6e8
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction.hs.html
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction where
+ 2
+ 3 import qualified Text.Read
+ 4 import qualified Text.Show
+ 5
+ 6 charToSimpleInstruction :: Char -> Maybe SimpleInstruction
+ 7 charToSimpleInstruction = readMaybe . one
+ 8
+ 9 simpleInstructions :: [SimpleInstruction]
+ 10 simpleInstructions = [MoveR , MoveL , Inc , Dec , Output , Input]
+ 11
+ 12 data SimpleInstruction =
+ 13 MoveR
+ 14 | MoveL
+ 15 | Inc
+ 16 | Dec
+ 17 | Output
+ 18 | Input
+ 19 deriving stock (Bounded , Enum , Eq)
+ 20
+ 21 instance Show SimpleInstruction where
+ 22 show MoveR = ">"
+ 23 show MoveL = "<"
+ 24 show Inc = "+"
+ 25 show Dec = "-"
+ 26 show Output = "."
+ 27 show Input = ","
+ 28
+ 29 instance Read SimpleInstruction where
+ 30 readsPrec _ ">" = [( MoveR , "")]
+ 31 readsPrec _ "<" = [( MoveL , "")]
+ 32 readsPrec _ "+" = [( Inc , "")]
+ 33 readsPrec _ "-" = [( Dec , "")]
+ 34 readsPrec _ "." = [( Output , "")]
+ 35 readsPrec _ "," = [( Input , "")]
+ 36 readsPrec _ _ = []
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.Symbol.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.Symbol.hs.html
new file mode 100644
index 000000000..4b3e01063
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.Symbol.hs.html
@@ -0,0 +1,123 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Common.Symbol (
+ 2 inc,
+ 3 compare0,
+ 4 def,
+ 5 next,
+ 6 prev,
+ 7 toInteger,
+ 8 fromChar,
+ 9 toChar,
+ 10 Symbol,
+ 11 ) where
+ 12
+ 13 import Data.Default (Default)
+ 14
+ 15 import qualified Data.Default as Default
+ 16 import qualified Relude.Extra as Extra
+ 17
+ 18 inc :: Symbol e => e -> e -> e
+ 19 inc = flip (+)
+ 20
+ 21 compare0 :: Integer -> Ordering
+ 22 compare0 = compare 0
+ 23
+ 24 --
+ 25
+ 26 def :: Symbol e => e
+ 27 def = Default.def
+ 28
+ 29 next :: Symbol e => e -> e
+ 30 next = Extra.next
+ 31
+ 32 prev :: Symbol e => e -> e
+ 33 prev = Extra.prev
+ 34
+ 35 class (Bounded e , Default e , Enum e , Eq e , Integral e , Show e) => Symbol e where
+ 36 -- toInteger :: e -> Integer
+ 37 fromChar :: Char -> e
+ 38 toChar :: e -> Char
+ 39
+ 40 --
+ 41
+ 42 instance Symbol Int where
+ 43 -- toInteger = fromIntegral
+ 44 fromChar = ord
+ 45 toChar = chr
+ 46
+ 47 instance Symbol Word where
+ 48 -- toInteger = fromIntegral
+ 49 fromChar = fromIntegral . ord
+ 50 toChar = chr . fromIntegral
+ 51
+ 52 instance Symbol Int8 where
+ 53 -- toInteger = fromIntegral
+ 54 fromChar = fromIntegral . ord
+ 55 toChar = chr . normalizeMod . fromIntegral
+ 56
+ 57 instance Symbol Word8 where
+ 58 -- toInteger = fromIntegral
+ 59 fromChar = fromIntegral . ord
+ 60 toChar = chr . fromIntegral
+ 61
+ 62 instance Symbol Int16 where
+ 63 -- toInteger = fromIntegral
+ 64 fromChar = fromIntegral . ord
+ 65 toChar = chr . normalizeMod . fromIntegral
+ 66
+ 67 instance Symbol Word16 where
+ 68 -- toInteger = fromIntegral
+ 69 fromChar = fromIntegral . ord
+ 70 toChar = chr . fromIntegral
+ 71
+ 72 instance Symbol Int32 where
+ 73 -- toInteger = fromIntegral
+ 74 fromChar = fromIntegral . ord
+ 75 toChar = chr . normalizeMod . fromIntegral
+ 76
+ 77 instance Symbol Word32 where
+ 78 -- toInteger = fromIntegral
+ 79 fromChar = fromIntegral . ord
+ 80 toChar = chr . fromIntegral
+ 81
+ 82 instance Symbol Int64 where
+ 83 -- toInteger = fromIntegral
+ 84 fromChar = fromIntegral . ord
+ 85 toChar = chr . normalizeMod . fromIntegral
+ 86
+ 87 instance Symbol Word64 where
+ 88 -- toInteger = fromIntegral
+ 89 fromChar = fromIntegral . ord
+ 90 toChar = chr . fromIntegral
+ 91 --
+ 92
+ 93 countSymbols :: (Integral e) => e
+ 94 countSymbols = 256
+ 95
+ 96 modifyMod :: (Integral e) => (e -> e) -> e -> e
+ 97 modifyMod f i = f (i + countSymbols) `mod` countSymbols
+ 98
+ 99 normalizeMod :: (Integral e) => e -> e
+ 100 normalizeMod = modifyMod id
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols.hs.html
new file mode 100644
index 000000000..40258d987
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols.hs.html
@@ -0,0 +1,165 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols (
+ 2 triAndClearSymbol,
+ 3
+ 4 mulDupAndClearSymbol,
+ 5 dupAndClearSymbol,
+ 6
+ 7 mulAddAndClearSymbol,
+ 8 addAndClearSymbol,
+ 9 subAndClearSymbol,
+ 10
+ 11 setSymbol,
+ 12 incSymbol,
+ 13 nextSymbol,
+ 14 prevSymbol,
+ 15 clearSymbol,
+ 16 writeSymbol,
+ 17
+ 18 moveHead,
+ 19 moveHeadRight,
+ 20 moveHeadLeft,
+ 21
+ 22 newTape,
+ 23 FullTape,
+ 24 ) where
+ 25
+ 26 import HelVM.HelMA.Automata.BrainFuck.Common.Symbol
+ 27
+ 28 import Control.Monad.Extra
+ 29
+ 30 -- | Complex instructions
+ 31
+ 32 triAndClearSymbol :: (Symbol e) => Integer -> Integer -> Integer -> FullTapeD e
+ 33 triAndClearSymbol f1 f2 f3 tape = tape & stepSymbol f1 & stepSymbol f2 & stepSymbol f3 & backAndClear back where
+ 34 back = negate (f1 + f2 + f3)
+ 35 stepSymbol = step symbol
+ 36 symbol = readSymbol tape
+ 37
+ 38 mulDupAndClearSymbol :: (Symbol e) => Integer -> Integer -> Integer -> Integer -> FullTapeD e
+ 39 mulDupAndClearSymbol m1 m2 f1 f2 tape = tape & step ms1 f1 & step ms2 f2 & backAndClear back where
+ 40 back = negate (f1 + f2)
+ 41 ms1 = symbol * fromIntegral m1
+ 42 ms2 = symbol * fromIntegral m2
+ 43 symbol = readSymbol tape
+ 44
+ 45 dupAndClearSymbol :: (Symbol e) => Integer -> Integer -> FullTapeD e
+ 46 dupAndClearSymbol f1 f2 tape = tape & stepSymbol f1 & stepSymbol f2 & backAndClear back where
+ 47 back = negate (f1 + f2)
+ 48 stepSymbol = step symbol
+ 49 symbol = readSymbol tape
+ 50
+ 51 mulAddAndClearSymbol :: (Symbol e) => Integer -> Integer -> FullTapeD e
+ 52 mulAddAndClearSymbol mul forward tape = tape & step mulSymbol forward & backAndClear back where
+ 53 back = negate forward
+ 54 mulSymbol = symbol * fromIntegral mul
+ 55 symbol = readSymbol tape
+ 56
+ 57 addAndClearSymbol :: (Symbol e) => Integer -> FullTapeD e
+ 58 addAndClearSymbol = changeAndClearSymbol id
+ 59
+ 60 subAndClearSymbol :: (Symbol e) => Integer -> FullTapeD e
+ 61 subAndClearSymbol = changeAndClearSymbol negate
+ 62
+ 63 changeAndClearSymbol :: (Symbol e) => (e -> e) -> Integer -> FullTapeD e
+ 64 changeAndClearSymbol f forward tape = tape & step symbol forward & backAndClear back where
+ 65 back = negate forward
+ 66 symbol = f $ readSymbol tape
+ 67
+ 68 step :: (Symbol e) => e -> Integer -> FullTapeD e
+ 69 step symbol forward = addSymbol symbol . moveHead forward
+ 70
+ 71 backAndClear :: (Symbol e) => Integer -> FullTapeD e
+ 72 backAndClear back = clearSymbol . moveHead back
+ 73
+ 74 -- | Change symbols
+ 75
+ 76 setSymbol :: (Symbol e) => Integer -> FullTapeD e
+ 77 setSymbol i = modifyCell $ const $ fromIntegral i
+ 78
+ 79 incSymbol :: (Symbol e) => Integer -> FullTapeD e
+ 80 incSymbol i = addSymbol $ fromIntegral i
+ 81
+ 82 addSymbol :: (Symbol e) => e -> FullTapeD e
+ 83 addSymbol e = modifyCell $ inc e
+ 84
+ 85 clearSymbol :: (Symbol e) => FullTapeD e
+ 86 clearSymbol = modifyCell $ const def
+ 87
+ 88 nextSymbol :: (Symbol e) => FullTapeD e
+ 89 nextSymbol = modifyCell next
+ 90
+ 91 prevSymbol :: (Symbol e) => FullTapeD e
+ 92 prevSymbol = modifyCell prev
+ 93
+ 94 writeSymbol :: (Symbol e) => Char -> FullTapeD e
+ 95 writeSymbol symbol = modifyCell (const $ fromChar symbol)
+ 96
+ 97 modifyCell :: D e -> FullTapeD e
+ 98 modifyCell f (left , cell : right) = (left , f cell : right)
+ 99 modifyCell _ (_ , []) = error "End of the Tape"
+ 100
+ 101 readSymbol :: FullTape e -> e
+ 102 readSymbol (_ , cell : _) = cell
+ 103 readSymbol (_ , []) = error "End of the Tape"
+ 104
+ 105 -- | Moves
+ 106
+ 107 moveHead :: (Symbol e) => Integer -> FullTapeD e
+ 108 moveHead = changeTape moveHeadRight moveHeadLeft
+ 109
+ 110 changeTape :: FullTapeD e -> FullTapeD e -> Integer -> FullTapeD e
+ 111 changeTape lf gf i t = loop atc (i , t) where
+ 112 atc (i' , t') = (check . compare0) i' where
+ 113 check LT = Left (i' - 1 , lf t')
+ 114 check GT = Left (i' + 1 , gf t')
+ 115 check EQ = Right t'
+ 116
+ 117 moveHeadRight :: (Symbol e) => FullTapeD e
+ 118 moveHeadRight (cell : left , right) = pad (left , cell : right)
+ 119 moveHeadRight ([] , _) = error "End of the Tape"
+ 120
+ 121 moveHeadLeft :: (Symbol e) => FullTapeD e
+ 122 moveHeadLeft (left , cell : right) = pad (cell : left , right)
+ 123 moveHeadLeft (_ , []) = error "End of the Tape"
+ 124
+ 125 pad :: (Symbol e) => FullTapeD e
+ 126 pad ([] , []) = newTape
+ 127 pad ([] , right) = ([def] , right)
+ 128 pad (left , []) = (left , [def])
+ 129 pad tape = tape
+ 130
+ 131 -- | Constructors
+ 132
+ 133 newTape :: (Symbol e) => FullTape e
+ 134 newTape = ([def] , [def])
+ 135
+ 136 -- | Types
+ 137
+ 138 type D a = a -> a
+ 139 type FullTape e = (HalfTape e , HalfTape e)
+ 140 type FullTapeD e = D (FullTape e)
+ 141
+ 142 type HalfTape e = [e]
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Evaluator.hs.html
new file mode 100644
index 000000000..50e369f91
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Evaluator.hs.html
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Evaluator where
+ 2
+ 3 import qualified HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Evaluator as Fast
+ 4 import qualified HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Evaluator as Flat
+ 5 import qualified HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Evaluator as Tree
+ 6
+ 7 import HelVM.HelMA.Automata.BrainFuck.API.BFType
+ 8
+ 9 import HelVM.HelMA.Automata.BrainFuck.Common.Symbol
+ 10 import HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols
+ 11
+ 12 import HelVM.HelMA.Automaton.API.EvalParams
+ 13 import HelVM.HelMA.Automaton.API.IOTypes
+ 14
+ 15 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 16
+ 17 import HelVM.HelMA.Automaton.Types.CellType
+ 18 import HelVM.HelMA.Automaton.Types.DumpType
+ 19
+ 20 simpleEval :: BIO m => (BFType , Source , CellType) -> m ()
+ 21 simpleEval (c , s , t) = eval c s t Pretty --TODO Add MaybeLimit and use Loop
+ 22
+ 23 ----
+ 24
+ 25 evalParams :: BIO m => BFType -> EvalParams -> m ()
+ 26 evalParams b p = eval b (source p) (cellAutoOptions p) (dumpAutoOptions p)
+ 27
+ 28 eval :: BIO m => BFType -> Source -> CellType -> DumpType -> m ()
+ 29 eval c s Int8Type = evalSource c s (newTape :: FullTape Int8)
+ 30 eval c s Word8Type = evalSource c s (newTape :: FullTape Word8)
+ 31 eval c s Int16Type = evalSource c s (newTape :: FullTape Int16)
+ 32 eval c s Word16Type = evalSource c s (newTape :: FullTape Word16)
+ 33 eval c s Int32Type = evalSource c s (newTape :: FullTape Int32)
+ 34 eval c s Word32Type = evalSource c s (newTape :: FullTape Word32)
+ 35 eval c s Int64Type = evalSource c s (newTape :: FullTape Int64)
+ 36 eval c s Word64Type = evalSource c s (newTape :: FullTape Word64)
+ 37
+ 38 evalSource :: (BIO m , Symbol e) => BFType -> Source -> FullTape e -> DumpType -> m ()
+ 39 evalSource FastType = Fast.evalSource
+ 40 evalSource TreeType = Tree.evalSource
+ 41 evalSource FlatType = Flat.evalSource
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Evaluator.hs.html
new file mode 100644
index 000000000..6426f60db
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Evaluator.hs.html
@@ -0,0 +1,98 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Evaluator (
+ 2 evalSource,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction
+ 6
+ 7 import HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Parser
+ 8
+ 9 import HelVM.HelMA.Automata.BrainFuck.Common.Symbol
+ 10 import HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols
+ 11
+ 12 import HelVM.HelMA.Automaton.API.IOTypes
+ 13 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 14 import HelVM.HelMA.Automaton.Types.DumpType
+ 15
+ 16 import HelVM.HelIO.Containers.LLIndexSafe
+ 17
+ 18 import Control.Type.Operator
+ 19
+ 20 evalSource :: (BIO m , Symbol e) => Source -> FullTape e -> DumpType -> m ()
+ 21 evalSource source tape dt = logDump dt =<< flip runList tape =<< parseWithOptimize source
+ 22
+ 23 runList :: (BIO m , Symbol e) => FastInstructionList -> FullTape e -> m $ Memory e
+ 24 runList il = nextStep (IM il 0)
+ 25
+ 26 nextStep :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
+ 27 nextStep (IM iv ic) = doInstruction (iv `indexMaybe` ic) (IM iv $ ic + 1)
+ 28
+ 29 doInstruction :: (BIO m , Symbol e) => Maybe FastInstruction -> InstructionMemory -> FullTape e -> m $ Memory e
+ 30 doInstruction (Just (Move i )) table tape = nextStep table (moveHead i tape)
+ 31 doInstruction (Just (Inc i )) table tape = nextStep table (incSymbol i tape)
+ 32 doInstruction (Just Output ) table tape = doOutputChar table tape
+ 33 doInstruction (Just Input ) table tape = doInputChar table tape
+ 34 doInstruction (Just (While iv )) table tape = doWhile iv table tape
+ 35 doInstruction (Just (Set i )) table tape = nextStep table (setSymbol i tape)
+ 36
+ 37 doInstruction (Just (SubClr f )) table tape = nextStep table (subAndClearSymbol f tape)
+ 38 doInstruction (Just (AddClr f )) table tape = nextStep table (addAndClearSymbol f tape)
+ 39 doInstruction (Just (MulAddClr m f )) table tape = nextStep table (mulAddAndClearSymbol m f tape)
+ 40
+ 41 doInstruction (Just (DupClr f1 f2)) table tape = nextStep table (dupAndClearSymbol f1 f2 tape)
+ 42 doInstruction (Just (MulDupClr m1 m2 f1 f2)) table tape = nextStep table (mulDupAndClearSymbol m1 m2 f1 f2 tape)
+ 43
+ 44 doInstruction (Just (TriClr i1 i2 i3)) table tape = nextStep table (triAndClearSymbol i1 i2 i3 tape)
+ 45 doInstruction Nothing table tape = doEnd table tape
+ 46
+ 47 doWhile :: (BIO m , Symbol e) => FastInstructionList -> InstructionMemory -> FullTape e -> m $ Memory e
+ 48 doWhile _ table tape@(_ , 0:_) = nextStep table tape
+ 49 doWhile iv table tape = doWhileWithTape =<< runList iv tape where
+ 50 doWhileWithTape :: (BIO m , Symbol e) => Memory e -> m $ Memory e
+ 51 doWhileWithTape = doWhile iv table . memoryTape
+ 52
+ 53 -- | IO instructions
+ 54 doOutputChar :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
+ 55 doOutputChar _ (_ , []) = error "Illegal State"
+ 56 doOutputChar table tape@(_ , e:_) = wPutChar (toChar e) *> nextStep table tape
+ 57
+ 58 doInputChar :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
+ 59 doInputChar table tape = (nextStep table . flip writeSymbol tape) =<< wGetChar
+ 60
+ 61 -- | Terminate instruction
+ 62 doEnd :: BIO m => InstructionMemory -> FullTape e -> m $ Memory e
+ 63 doEnd iu tape = pure $ Memory iu tape
+ 64
+ 65 -- | Types
+ 66 data Memory e = Memory
+ 67 { memoryIM :: InstructionMemory
+ 68 , memoryTape :: FullTape e
+ 69 }
+ 70 deriving stock (Eq , Show)
+ 71
+ 72 data InstructionMemory = IM !FastInstructionList !InstructionCounter
+ 73 deriving stock (Eq , Show)
+ 74
+ 75 type InstructionCounter = Int
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction.hs.html
new file mode 100644
index 000000000..b73adc623
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction.hs.html
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction where
+ 2
+ 3 data FastInstruction =
+ 4 Move Integer
+ 5 | Inc Integer
+ 6 | Output
+ 7 | Input
+ 8 | While FastInstructionList
+ 9 | Set Integer
+ 10 | SubClr Integer
+ 11 | AddClr Integer
+ 12 | MulAddClr Integer Integer
+ 13 | DupClr Integer Integer
+ 14 | MulDupClr Integer Integer Integer Integer
+ 15 | TriClr Integer Integer Integer
+ 16 deriving stock (Eq , Read , Show)
+ 17
+ 18 type FastInstructionList = [FastInstruction]
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Optimizer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Optimizer.hs.html
new file mode 100644
index 000000000..90d386727
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Optimizer.hs.html
@@ -0,0 +1,71 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Optimizer (
+ 2 optimize,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction
+ 6
+ 7 optimize :: FastInstructionList -> FastInstructionList
+ 8 optimize (Move s1 : Move s2 : il) = optimize (Move (s1 + s2) : il)
+ 9 optimize (Inc s1 : Inc s2 : il) = optimize (Inc (s1 + s2) : il)
+ 10 optimize ((While [Inc (-1)]) : il) = buildClear il
+ 11 optimize ((While [Inc 1 ]) : il) = buildClear il
+ 12 optimize ((While il') : il) = buildWhile (optimize il') : optimize il
+ 13 optimize (i : il) = i : optimize il
+ 14 optimize [] = []
+ 15
+ 16 buildClear :: FastInstructionList -> FastInstructionList
+ 17 buildClear = optimizeSet . optimize
+ 18
+ 19 optimizeSet :: FastInstructionList -> FastInstructionList
+ 20 optimizeSet (Inc s : il) = Set s : il
+ 21 optimizeSet il = Set 0 : il
+ 22
+ 23 buildWhile :: FastInstructionList -> FastInstruction
+ 24 buildWhile [Move forward , Inc mul , Move back , Inc (-1)] = buildAdd back forward mul
+ 25 buildWhile [Inc (-1) , Move forward , Inc mul , Move back] = buildAdd back forward mul
+ 26 buildWhile [Move f1 , Inc m1 , Move f2 , Inc m2 , Move back , Inc (-1)] = buildDup back f1 f2 m1 m2
+ 27 buildWhile [Inc (-1) , Move f1 , Inc m1 , Move f2 , Inc m2 , Move back] = buildDup back f1 f2 m1 m2
+ 28 buildWhile [Move f1 , Inc 1 , Move f2 , Inc 1 , Move f3 , Inc 1 , Move back , Inc (-1)] = buildTri back f1 f2 f3
+ 29 buildWhile [Inc (-1) , Move f1 , Inc 1 , Move f2 , Inc 1 , Move f3 , Inc 1 , Move back] = buildTri back f1 f2 f3
+ 30 buildWhile il = While il
+ 31
+ 32 buildAdd :: Integer -> Integer -> Integer -> FastInstruction
+ 33 buildAdd back forward = build (negate back == forward) where
+ 34 build True (-1) = SubClr forward
+ 35 build True 1 = AddClr forward
+ 36 build True mul = MulAddClr mul forward
+ 37 build False mul = While [Move forward , Inc mul , Move back , Inc (-1)]
+ 38
+ 39 buildDup :: Integer -> Integer -> Integer -> Integer -> Integer -> FastInstruction
+ 40 buildDup back f1 f2 = build (negate back == f1 + f2) where
+ 41 build True 1 1 = DupClr f1 f2
+ 42 build True m1 m2 = MulDupClr m1 m2 f1 f2
+ 43 build False m1 m2 = While [Move f1 , Inc m1 , Move f2 , Inc m2 , Move back , Inc (-1)]
+ 44
+ 45 buildTri :: Integer -> Integer -> Integer -> Integer -> FastInstruction
+ 46 buildTri back f1 f2 f3
+ 47 | f1 + f2 + f3 == negate back = TriClr f1 f2 f3
+ 48 | otherwise = While [Move f1 , Inc 1 , Move f2 , Inc 1 , Move f3 , Inc 1 , Move back , Inc (-1)]
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Parser.hs.html
new file mode 100644
index 000000000..c5a9e4017
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Parser.hs.html
@@ -0,0 +1,105 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Parser (
+ 2 parseWithOptimizeSafe,
+ 3 parseAsListSafe,
+ 4 parseWithOptimize,
+ 5 parseAsList,
+ 6 ) where
+ 7
+ 8 import HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction
+ 9 import HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Optimizer
+ 10
+ 11 import qualified HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction as Simple
+ 12
+ 13 import HelVM.HelMA.Automaton.API.IOTypes
+ 14 import HelVM.HelMA.Automaton.ReadPExtra
+ 15
+ 16 import HelVM.HelIO.Control.Safe
+ 17
+ 18 import Control.Applicative.Tools
+ 19
+ 20 import qualified Data.Text as Text
+ 21
+ 22 import Text.ParserCombinators.ReadP hiding (many)
+ 23
+ 24 parseWithOptimizeSafe :: Source -> Safe FastInstructionList
+ 25 parseWithOptimizeSafe = parseWithOptimize
+ 26
+ 27 parseAsListSafe :: Source -> Safe FastInstructionList
+ 28 parseAsListSafe = parseAsList
+ 29
+ 30 parseWithOptimize :: MonadSafe m => Source -> m FastInstructionList
+ 31 parseWithOptimize = optimize <.> parseAsList
+ 32
+ 33 parseAsList :: MonadSafe m => Source -> m FastInstructionList
+ 34 parseAsList = runParser parameterizedInstructionsParser . filterComments
+ 35
+ 36 parameterizedInstructionsParser :: ReadP FastInstructionList
+ 37 parameterizedInstructionsParser = many1 parameterizedInstructionParser
+ 38
+ 39 parameterizedInstructionParser :: ReadP FastInstruction
+ 40 parameterizedInstructionParser =
+ 41 moveRParser <|> moveLParser
+ 42 <|> incParser <|> decParser
+ 43 <|> outParser <|> inParser
+ 44 <|> whileParser
+ 45
+ 46 moveRParser :: ReadP FastInstruction
+ 47 moveRParser = Move 1 <$ char '>'
+ 48
+ 49 moveLParser :: ReadP FastInstruction
+ 50 moveLParser = Move negate1 <$ char '<'
+ 51
+ 52 incParser :: ReadP FastInstruction
+ 53 incParser = Inc 1 <$ char '+'
+ 54
+ 55 decParser :: ReadP FastInstruction
+ 56 decParser = Inc negate1 <$ char '-'
+ 57
+ 58 outParser :: ReadP FastInstruction
+ 59 outParser = Output <$ char '.'
+ 60
+ 61 inParser :: ReadP FastInstruction
+ 62 inParser = Input <$ char ','
+ 63
+ 64 whileParser :: ReadP FastInstruction
+ 65 whileParser = While <$> (char '[' *> parameterizedInstructionsParser <* char ']')
+ 66
+ 67 filterComments :: Source -> Source
+ 68 filterComments = Text.filter isNotComment
+ 69
+ 70 isNotComment :: Char -> Bool
+ 71 isNotComment c = c `elem` allInstructionChars
+ 72
+ 73 allInstructionChars :: String
+ 74 allInstructionChars = "[]" <> simpleInstructionChars
+ 75
+ 76 simpleInstructionChars :: String
+ 77 simpleInstructionChars = show =<< Simple.simpleInstructions
+ 78
+ 79 --
+ 80
+ 81 negate1 :: Integer
+ 82 negate1 = negate 1
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Evaluator.hs.html
new file mode 100644
index 000000000..9da8b9429
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Evaluator.hs.html
@@ -0,0 +1,81 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Evaluator(
+ 2 evalSource,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction
+ 6 import HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Parser
+ 7 import HelVM.HelMA.Automata.BrainFuck.Impl.Flat.TableOfInstructions
+ 8
+ 9 import HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
+ 10 import HelVM.HelMA.Automata.BrainFuck.Common.Symbol
+ 11 import HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols
+ 12
+ 13 import HelVM.HelMA.Automaton.API.IOTypes
+ 14 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 15 import HelVM.HelMA.Automaton.Types.DumpType
+ 16
+ 17 import Control.Type.Operator
+ 18
+ 19 evalSource :: (BIO m , Symbol e) => Source -> FullTape e -> DumpType -> m ()
+ 20 evalSource source tape dt = logDump dt =<< doInstruction ([] , tokenize source) tape
+ 21
+ 22 doInstruction :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
+ 23 doInstruction table@(_ , Simple MoveR : _) tape = doInstruction (nextInst table) (moveHeadRight tape)
+ 24 doInstruction table@(_ , Simple MoveL : _) tape = doInstruction (nextInst table) (moveHeadLeft tape)
+ 25 doInstruction table@(_ , Simple Inc : _) tape = doInstruction (nextInst table) (nextSymbol tape)
+ 26 doInstruction table@(_ , Simple Dec : _) tape = doInstruction (nextInst table) (prevSymbol tape)
+ 27 doInstruction table@(_ , Simple Output : _) tape = doOutputChar table tape
+ 28 doInstruction table@(_ , Simple Input : _) tape = doInputChar table tape
+ 29 doInstruction table@(_ , JmpPast : _) tape = doJmpPast table tape
+ 30 doInstruction table@(_ , JmpBack : _) tape = doJmpBack table tape
+ 31 doInstruction table@(_ , [] ) tape = doEnd table tape
+ 32
+ 33 doJmpPast :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
+ 34 doJmpPast table tape@(_ , 0 : _) = doInstruction (jumpPast table) tape
+ 35 doJmpPast table tape = doInstruction (nextInst table) tape
+ 36
+ 37 doJmpBack :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
+ 38 doJmpBack table tape@(_ , 0 : _) = doInstruction (nextInst table) tape
+ 39 doJmpBack table tape = doInstruction (jumpBack table) tape
+ 40
+ 41 -- | IO instructions
+ 42 doOutputChar :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
+ 43 doOutputChar _ (_ , []) = error "Illegal State"
+ 44 doOutputChar table tape@(_ , e : _) = wPutChar (toChar e) *> doInstruction (nextInst table) tape
+ 45
+ 46 doInputChar :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
+ 47 doInputChar table tape = (doInstruction (nextInst table) . flip writeSymbol tape) =<< wGetChar
+ 48
+ 49 -- | Terminate instruction
+ 50 doEnd :: BIO m => Table -> FullTape e -> m $ Memory e
+ 51 doEnd table tape = pure $ Memory table tape
+ 52
+ 53 -- | Types
+ 54 data Memory e = Memory
+ 55 { memoryTable :: Table
+ 56 , memoryTape :: FullTape e
+ 57 }
+ 58 deriving stock (Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction.hs.html
new file mode 100644
index 000000000..5f38cc523
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction.hs.html
@@ -0,0 +1,54 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction where
+ 2
+ 3 import HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
+ 4
+ 5 import Text.Read
+ 6
+ 7 import qualified Text.Show
+ 8
+ 9 data FlatInstruction =
+ 10 Simple SimpleInstruction
+ 11 | JmpPast
+ 12 | JmpBack
+ 13 deriving stock (Eq)
+ 14
+ 15 type FlatTreeInstructionList = [FlatInstruction]
+ 16
+ 17 instance Show FlatInstruction where
+ 18 show (Simple i) = show i
+ 19 show JmpPast = "["
+ 20 show JmpBack = "]"
+ 21
+ 22 instance Read FlatInstruction where
+ 23 readsPrec _ ">" = [( Simple MoveR , "")]
+ 24 readsPrec _ "<" = [( Simple MoveL , "")]
+ 25 readsPrec _ "+" = [( Simple Inc , "")]
+ 26 readsPrec _ "-" = [( Simple Dec , "")]
+ 27 readsPrec _ "." = [( Simple Output , "")]
+ 28 readsPrec _ "," = [( Simple Input , "")]
+ 29 readsPrec _ "[" = [( JmpPast , "")]
+ 30 readsPrec _ "]" = [( JmpBack , "")]
+ 31 readsPrec _ _ = []
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Parser.hs.html
new file mode 100644
index 000000000..9d9760fb2
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Parser.hs.html
@@ -0,0 +1,40 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Parser where
+ 2
+ 3 import HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction
+ 4
+ 5 import HelVM.HelMA.Automaton.API.IOTypes
+ 6 import HelVM.HelMA.Automaton.WrapTokenList
+ 7
+ 8 import HelVM.HelIO.ReadText
+ 9
+ 10 -- | Parser
+ 11 tokenize :: Source -> FlatTreeInstructionList
+ 12 tokenize = unWrapTokenList . readTokens
+ 13
+ 14 readTokens :: Source -> Tokens
+ 15 readTokens source = readTextUnsafe source :: Tokens
+ 16
+ 17 type Tokens = WrapTokenList FlatTreeInstructionList
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.TableOfInstructions.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.TableOfInstructions.hs.html
new file mode 100644
index 000000000..51d637bfe
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Flat.TableOfInstructions.hs.html
@@ -0,0 +1,58 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Flat.TableOfInstructions where
+ 2
+ 3 import HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction
+ 4
+ 5 type HalfTable = FlatTreeInstructionList
+ 6 type Table = (HalfTable , HalfTable)
+ 7 type TableD = Table -> Table
+ 8
+ 9 currentInstruction :: ([a], [a]) -> Maybe a
+ 10 currentInstruction (_ , i : _) = Just i
+ 11 currentInstruction (_ , []) = Nothing
+ 12
+ 13 prevInst :: TableD
+ 14 prevInst (inst : prev , next) = (prev , inst : next)
+ 15 prevInst ([] , _) = error "End of the table"
+ 16
+ 17 nextInst :: TableD
+ 18 nextInst (prev , inst : next) = (inst : prev , next)
+ 19 nextInst (_ , []) = error "End of the table"
+ 20
+ 21 matchPrevJmp :: TableD
+ 22 matchPrevJmp table@(JmpPast : _ , _) = table
+ 23 matchPrevJmp table@(JmpBack : _ , _) = (matchPrevJmp . prevInst . jumpBack) table
+ 24 matchPrevJmp table = jumpBack table
+ 25
+ 26 matchNextJmp :: TableD
+ 27 matchNextJmp table@(_ , JmpBack : _) = nextInst table
+ 28 matchNextJmp table@(_ , JmpPast : _) = (matchNextJmp . jumpPast) table
+ 29 matchNextJmp table = jumpPast table
+ 30
+ 31 jumpPast :: TableD
+ 32 jumpPast = matchNextJmp . nextInst
+ 33
+ 34 jumpBack :: TableD
+ 35 jumpBack = matchPrevJmp . prevInst
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Evaluator.hs.html
new file mode 100644
index 000000000..13fbbae98
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Evaluator.hs.html
@@ -0,0 +1,90 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Evaluator (
+ 2 evalSource,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction
+ 6 import HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser
+ 7
+ 8 import HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
+ 9 import HelVM.HelMA.Automata.BrainFuck.Common.Symbol
+ 10 import HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols
+ 11
+ 12 import HelVM.HelMA.Automaton.API.IOTypes
+ 13 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 14 import HelVM.HelMA.Automaton.Types.DumpType
+ 15
+ 16 import HelVM.HelIO.Containers.LLIndexSafe
+ 17
+ 18 import Control.Type.Operator
+ 19
+ 20 evalSource :: (BIO m , Symbol e) => Source -> FullTape e -> DumpType -> m ()
+ 21 evalSource source tape dt = logDump dt =<< flip runVector tape =<< parseAsVector source
+ 22
+ 23 runVector :: (BIO m , Symbol e) => TreeInstructionVector -> FullTape e -> m $ Memory e
+ 24 runVector iv = nextStep (IM iv 0)
+ 25
+ 26 nextStep :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
+ 27 nextStep (IM iv ic) = doInstruction (iv `indexMaybe` ic) (IM iv $ ic + 1)
+ 28
+ 29 doInstruction :: (BIO m , Symbol e) => Maybe TreeInstruction -> InstructionMemory -> FullTape e -> m $ Memory e
+ 30 doInstruction (Just (Simple MoveR )) table tape = nextStep table (moveHeadRight tape)
+ 31 doInstruction (Just (Simple MoveL )) table tape = nextStep table (moveHeadLeft tape)
+ 32 doInstruction (Just (Simple Inc )) table tape = nextStep table (nextSymbol tape)
+ 33 doInstruction (Just (Simple Dec )) table tape = nextStep table (prevSymbol tape)
+ 34 doInstruction (Just (Simple Output )) table tape = doOutputChar table tape
+ 35 doInstruction (Just (Simple Input )) table tape = doInputChar table tape
+ 36 doInstruction (Just (While iv )) table tape = doWhile iv table tape
+ 37 doInstruction Nothing table tape = doEnd table tape
+ 38
+ 39 doWhile :: (BIO m , Symbol e) => TreeInstructionVector -> InstructionMemory -> FullTape e -> m $ Memory e
+ 40 doWhile _ table tape@(_ , 0:_) = nextStep table tape
+ 41 doWhile iv table tape = doWhileWithTape =<< runVector iv tape where
+ 42 doWhileWithTape :: (BIO m , Symbol e) => Memory e -> m $ Memory e
+ 43 doWhileWithTape = doWhile iv table . memoryTape
+ 44
+ 45 -- | IO instructions
+ 46 doOutputChar :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
+ 47 doOutputChar _ (_ , []) = error "Illegal State"
+ 48 doOutputChar table tape@(_ , e:_) = wPutChar (toChar e) *> nextStep table tape
+ 49
+ 50 doInputChar :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
+ 51 doInputChar table tape = (nextStep table . flip writeSymbol tape) =<< wGetChar
+ 52
+ 53 -- | Terminate instruction
+ 54 doEnd :: BIO m => InstructionMemory -> FullTape e -> m $ Memory e
+ 55 doEnd im tape = pure $ Memory im tape
+ 56
+ 57 -- | Types
+ 58 data Memory e = Memory
+ 59 { memoryIM :: InstructionMemory
+ 60 , memoryTape :: FullTape e
+ 61 }
+ 62 deriving stock (Eq , Show)
+ 63
+ 64 data InstructionMemory = IM !TreeInstructionVector !InstructionCounter
+ 65 deriving stock (Eq , Show)
+ 66
+ 67 type InstructionCounter = Int
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction.hs.html
new file mode 100644
index 000000000..f1c147c8e
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction.hs.html
@@ -0,0 +1,38 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction where
+ 2
+ 3 import HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
+ 4
+ 5 import Data.DList
+ 6 import Data.Vector
+ 7
+ 8 data TreeInstruction =
+ 9 Simple SimpleInstruction
+ 10 | While !TreeInstructionVector
+ 11 deriving stock (Eq , Read , Show)
+ 12
+ 13 type TreeInstructionList = [TreeInstruction]
+ 14 type TreeInstructionDList = DList TreeInstruction
+ 15 type TreeInstructionVector = Vector TreeInstruction
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser.hs.html
new file mode 100644
index 000000000..cbff8d65a
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser.hs.html
@@ -0,0 +1,72 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser (
+ 2 parseAsVectorSafe,
+ 3 parseAsVector,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction as Tree
+ 7
+ 8 import HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
+ 9
+ 10 import HelVM.HelMA.Automaton.API.IOTypes
+ 11 import HelVM.HelMA.Automaton.ReadPExtra
+ 12
+ 13 import HelVM.HelIO.Control.Safe
+ 14 import HelVM.HelIO.Extra hiding (runParser)
+ 15
+ 16 import qualified Data.Text as Text
+ 17 import qualified Data.Vector as Vector
+ 18
+ 19 import Text.ParserCombinators.ReadP hiding (many)
+ 20
+ 21 parseAsVectorSafe :: Source -> Safe TreeInstructionVector
+ 22 parseAsVectorSafe = parseAsVector
+ 23
+ 24 parseAsVector :: MonadSafe m => Source -> m TreeInstructionVector
+ 25 parseAsVector = runParser treeInstructionsParser . filterComments
+ 26
+ 27 treeInstructionsParser :: ReadP TreeInstructionVector
+ 28 treeInstructionsParser = Vector.fromList <$> many treeInstructionParser
+ 29
+ 30 treeInstructionParser :: ReadP TreeInstruction
+ 31 treeInstructionParser = simpleParser <|> whileParser
+ 32
+ 33 whileParser :: ReadP TreeInstruction
+ 34 whileParser = Tree.While <$> (char '[' *> treeInstructionsParser <* char ']')
+ 35
+ 36 simpleParser :: ReadP TreeInstruction
+ 37 simpleParser = Simple . fromJustWithText "imposible" . charToSimpleInstruction <$> oneOf simpleInstructionChars
+ 38
+ 39 filterComments :: Source -> Source
+ 40 filterComments = Text.filter isNotComment
+ 41
+ 42 isNotComment :: Char -> Bool
+ 43 isNotComment c = c `elem` allInstructionChars
+ 44
+ 45 allInstructionChars :: String
+ 46 allInstructionChars = "[]" <> simpleInstructionChars
+ 47
+ 48 simpleInstructionChars :: String
+ 49 simpleInstructionChars = show =<< simpleInstructions
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Cat.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Cat.Evaluator.hs.html
new file mode 100644
index 000000000..3bb70e191
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Cat.Evaluator.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.Cat.Evaluator (
+ 2 evalParams,
+ 3 eval
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automaton.API.EvalParams
+ 7 import HelVM.HelMA.Automaton.API.IOTypes
+ 8 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 9
+ 10 evalParams :: BIO m => EvalParams -> m ()
+ 11 evalParams = eval . source
+ 12
+ 13 eval :: BusinessIO m => Source -> m ()
+ 14 eval = wPutStr
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.API.ETAImplType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.API.ETAImplType.hs.html
new file mode 100644
index 000000000..3bebcfe93
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.API.ETAImplType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.API.ETAImplType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultETAImplType :: ETAImplType
+ 7 defaultETAImplType = defaultEnum
+ 8
+ 9 etaImplTypes:: [ETAImplType]
+ 10 etaImplTypes = generateEnums 2
+ 11
+ 12 -- | Type
+ 13 data ETAImplType = Fast | Original
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Addressing.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Addressing.hs.html
new file mode 100644
index 000000000..17e805bdf
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Addressing.hs.html
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.Addressing (
+ 2 genericFindAddress,
+ 3 findAddress,
+ 4 genericNextLabel,
+ 5 nextLabel
+ 6 ) where
+ 7
+ 8 import HelVM.HelMA.Automata.ETA.Symbol
+ 9 import HelVM.HelMA.Automata.ETA.Token
+ 10
+ 11 import HelVM.HelIO.Containers.LLIndexSafe
+ 12
+ 13 import HelVM.HelIO.Control.Safe
+ 14
+ 15 import Data.ListLike hiding (show)
+ 16
+ 17 import Prelude hiding (length, splitAt)
+ 18
+ 19 import qualified Data.Vector as Vector
+ 20
+ 21 ----
+ 22
+ 23 genericFindAddress :: (MonadSafe m , Integral cell) => Vector.Vector Token -> cell -> m InstructionAddress
+ 24 genericFindAddress il = findAddress il . fromIntegral
+ 25
+ 26 findAddress :: MonadSafe m => Vector.Vector Token -> Int -> m InstructionAddress
+ 27 findAddress _ 1 = pure 0
+ 28 findAddress il address = appendErrorTupleList [("il" , show il) , ("address" , show address)] ((+1) <$> indexSafe (Vector.elemIndices R il) (address-2))
+ 29
+ 30 ----
+ 31
+ 32 genericNextLabel :: Integral cell => Vector.Vector Token -> InstructionAddress -> cell
+ 33 genericNextLabel il = fromIntegral . nextLabel il
+ 34
+ 35 nextLabel :: Vector.Vector Token -> InstructionAddress -> Int
+ 36 nextLabel il ic = length (Vector.elemIndices R il') + 2 where (il' , _) = splitAt ic il
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Automaton.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Automaton.hs.html
new file mode 100644
index 000000000..5918360b1
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Automaton.hs.html
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.Automaton (
+ 2 run,
+ 3 newMemory,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automata.ETA.Addressing
+ 7 import HelVM.HelMA.Automata.ETA.OperandParsers
+ 8 import HelVM.HelMA.Automata.ETA.Token
+ 9
+ 10 import HelVM.HelMA.Automaton.Loop
+ 11
+ 12 import HelVM.HelMA.Automaton.IO.AutomatonIO
+ 13
+ 14 import HelVM.HelMA.Automaton.Combiner.ALU as Stack
+ 15
+ 16 import Control.Monad.Extra
+ 17 import Control.Type.Operator
+ 18 import HelVM.HelMA.Automata.ETA.Symbol
+ 19
+ 20 import qualified Data.Vector as Vector
+ 21
+ 22 import Prelude hiding (divMod)
+ 23
+ 24 run :: (SAutomatonIO e s m) => Maybe Natural -> Memory s -> m $ Memory s
+ 25 run = loopMWithLimit nextState
+ 26
+ 27 nextState :: (SAutomatonIO e s m) => Memory s -> m $ MemorySame s
+ 28 nextState (Memory iu s) = build =<< nextIM iu where build (t , iu') = doInstruction t (Memory iu' s)
+ 29
+ 30 doInstruction :: (SAutomatonIO e s m) => Maybe Token -> Memory s -> m $ MemorySame s
+ 31 -- | IO instructions
+ 32 doInstruction (Just O) u = Left . updateStack u <$> doOutputChar2 (memoryStack u)
+ 33 doInstruction (Just I) u = Left . updateStack u <$> doInputChar2 (memoryStack u)
+ 34
+ 35 -- | Stack instructions
+ 36 doInstruction (Just N) (Memory iu s) = build <$> parseNumber iu where build (symbol , iu') = Left (Memory iu' (push1 symbol s))
+ 37 doInstruction (Just H) u = Left . updateStack u <$> halibut (memoryStack u)
+ 38
+ 39 -- | Arithmetic
+ 40 doInstruction (Just S) u = Left . updateStack u <$> sub (memoryStack u)
+ 41 doInstruction (Just E) u = Left . updateStack u <$> divMod (memoryStack u)
+ 42
+ 43 -- | Control
+ 44 doInstruction (Just R) u = pure $ Left u
+ 45 doInstruction (Just A) (Memory iu@(IM il ic) s) = pure $ Left ((Memory iu . flipPush1 s . genericNextLabel il) ic)
+ 46 doInstruction (Just T) u = transfer u
+ 47 doInstruction Nothing u = end u
+ 48
+ 49 transfer :: (SAutomatonIO e s m) => Memory s -> m $ MemorySame s
+ 50 transfer = branch <=< pop2ForStack where
+ 51 branch (_ , 0 , u) = pure $ Left u
+ 52 branch (0 , _ , u) = end u
+ 53 branch (l , _ , u) = Left . updateAddress u <$> genericFindAddress (memoryProgram u) l
+ 54
+ 55 pop2ForStack :: (SAutomatonIO e s m) => Memory s -> m (e , e , Memory s)
+ 56 pop2ForStack u = build <$> pop2 (memoryStack u) where
+ 57 build (s1 , s2 , s') = (s1 , s2 , updateStack u s')
+ 58
+ 59 -- | Terminate instruction
+ 60 end :: (SAutomatonIO e s m) => Memory s -> m $ MemorySame s
+ 61 end = pure . Right
+ 62
+ 63 -- | Memory methods
+ 64
+ 65 newMemory :: TokenList -> s -> Memory s
+ 66 newMemory tl = Memory (IM (Vector.fromList tl) 0)
+ 67
+ 68 updateStack :: Memory s -> s -> Memory s
+ 69 updateStack u s = u {memoryStack = s}
+ 70
+ 71 updateAddress :: Memory s -> InstructionCounter -> Memory s
+ 72 updateAddress u a = u {memoryIM = updatePC (memoryIM u) a}
+ 73
+ 74 memoryProgram :: Memory s -> TokenVector
+ 75 memoryProgram = program . memoryIM
+ 76
+ 77 -- | Types
+ 78
+ 79 type MemorySame s = Same (Memory s)
+ 80
+ 81 data Memory s = Memory
+ 82 { memoryIM :: !InstructionMemory
+ 83 , memoryStack :: s
+ 84 }
+ 85 deriving stock (Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Evaluator.hs.html
new file mode 100644
index 000000000..38572f10d
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Evaluator.hs.html
@@ -0,0 +1,81 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.Evaluator (
+ 2 simpleEval,
+ 3 evalParams,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automata.ETA.API.ETAImplType
+ 7
+ 8 import HelVM.HelMA.Automata.ETA.Automaton
+ 9 import HelVM.HelMA.Automata.ETA.Lexer
+ 10 import HelVM.HelMA.Automata.ETA.Optimizer
+ 11 import qualified HelVM.HelMA.Automata.ETA.SimpleParams as S
+ 12 import HelVM.HelMA.Automata.ETA.Symbol
+ 13 import HelVM.HelMA.Automata.ETA.Token
+ 14
+ 15 import HelVM.HelMA.Automaton.API.AutoOptions
+ 16 import qualified HelVM.HelMA.Automaton.API.AutomatonOptions as Automaton
+ 17 import HelVM.HelMA.Automaton.API.EvalParams
+ 18 import HelVM.HelMA.Automaton.API.IOTypes
+ 19
+ 20 import qualified HelVM.HelMA.Automaton.Automaton as Automaton
+ 21
+ 22 import HelVM.HelMA.Automaton.IO.AutomatonIO
+ 23 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 24
+ 25 import HelVM.HelMA.Automaton.Types.DumpType
+ 26 import HelVM.HelMA.Automaton.Types.StackType
+ 27
+ 28 import HelVM.HelIO.Collections.SList as SList
+ 29
+ 30 import qualified Data.Sequence as Seq
+ 31
+ 32 import Prelude hiding (divMod)
+ 33
+ 34 simpleEval :: BIO m => S.SimpleParams -> m ()
+ 35 simpleEval p = evalSource (S.implType p) (S.source p) (S.stackType p) (S.autoOptions p)
+ 36
+ 37 ----
+ 38
+ 39 evalParams :: BIO m => ETAImplType -> EvalParams -> m ()
+ 40 evalParams e p = evalSource e (source p) (stackAutoOptions p) (autoOptions p)
+ 41
+ 42 evalSource :: (AutomatonIO Symbol m) => ETAImplType -> Source -> StackType -> AutoOptions -> m ()
+ 43 evalSource etaImplType source = evalTL etaImplType (tokenize source)
+ 44
+ 45 evalTL :: (AutomatonIO Symbol m) => ETAImplType -> TokenList -> StackType -> AutoOptions -> m ()
+ 46 evalTL Fast = fastEval
+ 47 evalTL Original = originalEval
+ 48
+ 49 fastEval :: (AutomatonIO Symbol m) => TokenList -> StackType -> AutoOptions -> m ()
+ 50 fastEval tl s a = flip Automaton.start (Automaton.withDefaultRam s a) =<< optimize tl
+ 51
+ 52 originalEval :: (AutomatonIO Symbol m) => TokenList -> StackType -> AutoOptions -> m ()
+ 53 originalEval tl ListStackType = eval tl []
+ 54 originalEval tl SeqStackType = eval tl Seq.empty
+ 55 originalEval tl SListStackType = eval tl SList.sListEmpty
+ 56
+ 57 eval :: (SAutomatonIO Symbol s m) => TokenList -> s -> AutoOptions -> m ()
+ 58 eval tl s (AutoOptions _ limit dt) = logDump dt =<< run limit (newMemory tl s)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Lexer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Lexer.hs.html
new file mode 100644
index 000000000..db051c6fc
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Lexer.hs.html
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.Lexer where
+ 2
+ 3 import HelVM.HelMA.Automata.ETA.Token
+ 4
+ 5 import HelVM.HelIO.Extra
+ 6 import HelVM.HelIO.ReadText
+ 7 import HelVM.HelMA.Automaton.API.IOTypes
+ 8 import HelVM.HelMA.Automaton.WrapTokenList
+ 9
+ 10 -- | Lexer
+ 11 tokenize :: Source -> TokenList
+ 12 tokenize = whiteTokenListToTokenList . unWrapTokenList . readTokens
+ 13
+ 14 readTokens :: Source -> WhiteTokens
+ 15 readTokens source = (readTextUnsafe . toUppers) source :: WhiteTokens
+ 16
+ 17 -- | Types
+ 18 type WhiteTokens = WrapTokenList WhiteTokenList
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.OperandParsers.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.OperandParsers.hs.html
new file mode 100644
index 000000000..9181df955
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.OperandParsers.hs.html
@@ -0,0 +1,76 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.OperandParsers where
+ 2
+ 3 import HelVM.HelMA.Automata.ETA.Symbol
+ 4 import HelVM.HelMA.Automata.ETA.Token
+ 5
+ 6 import HelVM.HelIO.Containers.LLIndexSafe
+ 7 import HelVM.HelIO.Control.Safe
+ 8 import HelVM.HelIO.Digit.ToDigit
+ 9
+ 10 import Control.Monad.Extra
+ 11
+ 12 import qualified Data.Vector as Vector
+ 13
+ 14 parseNumberFromTLL :: (MonadSafe m , Integral a) => (TokenList, [TokenList]) -> m (a , (TokenList, [TokenList]))
+ 15 parseNumberFromTLL a = loop act ([] , a) where
+ 16 act (acc , (E : tl , tll)) = Right $ ( , (tl , tll)) <$> makeIntegral7FromList acc
+ 17 act (acc , (R : tl , tll)) = Left ( acc , (tl , tll))
+ 18 act (acc , (t : tl , tll)) = Left (t : acc , (tl , tll))
+ 19 act (acc , ([] , tl : tll)) = Left ( acc , (tl , tll))
+ 20 act (acc , ([] , [])) = Right $ ( , ([] , [])) <$> makeIntegral7FromList acc
+ 21
+ 22 parseNumberFromTL :: (MonadSafe m , Integral a) => OperandParser m a
+ 23 parseNumberFromTL a = loop act ([] , a) where
+ 24 act (acc , E : tl) = Right $ ( , tl) <$> makeIntegral7FromList acc
+ 25 act (acc , R : tl) = Left ( acc , tl)
+ 26 act (acc , t : tl) = Left (t : acc , tl)
+ 27 act (acc , []) = Right (liftError $ show acc)
+ 28
+ 29 parseNumber :: (MonadSafe m , Integral a) => OperandIMParser m a
+ 30 parseNumber iu = loopM act =<< (([] , ) <$> nextIM iu) where
+ 31 act (acc , (Nothing , iu')) = Right . ( , iu') <$> makeIntegral7FromList acc
+ 32 act (acc , (Just E , iu')) = Right . ( , iu') <$> makeIntegral7FromList acc
+ 33 act (acc , (Just R , iu')) = Left . ( acc , ) <$> nextIM iu'
+ 34 act (acc , (Just t , iu')) = Left . (t : acc , ) <$> nextIM iu'
+ 35
+ 36 nextIM :: MonadSafe m => OperandIMParser m (Maybe Token)
+ 37 nextIM iu@(IM il ic)
+ 38 | ic < Vector.length il = wrap <$> indexSafe il ic
+ 39 | otherwise = pure (Nothing , iu)
+ 40 where wrap i = (Just i, IM il (ic+1))
+ 41
+ 42 updatePC :: InstructionMemory -> InstructionCounter -> InstructionMemory
+ 43 updatePC iu a = iu { programCounter = a }
+ 44
+ 45 -- | Types
+ 46 type OperandParser m a = TokenList -> m (a , TokenList)
+ 47
+ 48 data InstructionMemory = IM
+ 49 { program :: !TokenVector
+ 50 , programCounter :: !InstructionCounter
+ 51 } deriving stock (Eq , Read , Show)
+ 52
+ 53 type OperandIMParser m a = InstructionMemory -> m (a , InstructionMemory)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Optimizer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Optimizer.hs.html
new file mode 100644
index 000000000..598931dcb
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Optimizer.hs.html
@@ -0,0 +1,136 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.Optimizer (
+ 2 optimize,
+ 3 )
+ 4 where
+ 5
+ 6 import HelVM.HelMA.Automata.ETA.OperandParsers
+ 7 import HelVM.HelMA.Automata.ETA.Token
+ 8
+ 9 import HelVM.HelMA.Automaton.Instruction
+ 10 import HelVM.HelMA.Automaton.Instruction.Extras.Constructors
+ 11
+ 12 import HelVM.HelIO.Control.Safe
+ 13
+ 14 import Control.Applicative.Tools
+ 15
+ 16 import Data.List.Extra
+ 17 import qualified Data.List.Index as List
+ 18
+ 19 import qualified Data.ListLike as LL
+ 20
+ 21 optimize :: MonadSafe m => TokenList -> m InstructionList
+ 22 optimize = appendEnd <.> join <.> optimizeLines
+ 23
+ 24 appendEnd :: InstructionList -> InstructionList
+ 25 appendEnd l = l <> [markNI 0 , End]
+ 26
+ 27 optimizeLines :: MonadSafe m => TokenList -> m [InstructionList]
+ 28 optimizeLines = sequence . optimizeLineInit <.> lineFromTuple2 <.> splitOnRAndIndex2
+ 29
+ 30 splitOnRAndIndex2 :: TokenList -> [(Natural, [TokenList])]
+ 31 splitOnRAndIndex2 = indexedByNaturalWithOffset 1 <.> List.indexed . filterNull . tails . splitOn [R]
+ 32
+ 33 indexedByNaturalWithOffset :: Int -> (Int , a) -> (Natural , a)
+ 34 indexedByNaturalWithOffset offset (i , a) = (fromIntegral (i + offset) , a)
+ 35
+ 36 optimizeLineInit :: MonadSafe m => Line -> m InstructionList
+ 37 optimizeLineInit line = (markNI (currentAddress line) : ) <$> optimizeLineTail line
+ 38
+ 39 optimizeLineTail:: MonadSafe m => Line -> m InstructionList
+ 40 optimizeLineTail line = check (currentTL line) where
+ 41 check (t : tl) = optimizeLineForToken t $ line { currentTL = tl }
+ 42 check [] = pure []
+ 43
+ 44 optimizeLineForToken :: MonadSafe m => Token -> Line -> m InstructionList
+ 45 optimizeLineForToken O = (sOutputI : ) <.> optimizeLineTail
+ 46 optimizeLineForToken I = (sInputI : ) <.> optimizeLineTail
+ 47
+ 48 optimizeLineForToken S = (subI : ) <.> optimizeLineTail
+ 49 optimizeLineForToken E = prependDivMod
+ 50
+ 51 optimizeLineForToken H = (halibutI : ) <.> optimizeLineTail
+ 52 optimizeLineForToken T = (bNeTI : ) <.> optimizeLineTail
+ 53
+ 54 optimizeLineForToken A = prependAddress
+ 55 optimizeLineForToken N = prependNumber
+ 56
+ 57 optimizeLineForToken R = optimizeLineTail
+ 58
+ 59 prependDivMod :: MonadSafe m => Line -> m InstructionList
+ 60 prependDivMod line = check $ numberFlag line where
+ 61 check False = prependDivModSimple line
+ 62 check True = prependStaticMakr line <.> optimizeLineTail $ line {numberFlag = False}
+ 63
+ 64 prependStaticMakr :: Line -> InstructionList -> InstructionList
+ 65 prependStaticMakr line il = divModI : markSI (show $ currentAddress line) : il
+ 66
+ 67 prependDivModSimple :: MonadSafe m => Line -> m InstructionList
+ 68 prependDivModSimple = (divModI : ) <.> optimizeLineTail
+ 69
+ 70 prependAddress :: MonadSafe m => Line -> m InstructionList
+ 71 prependAddress line = ((consI $ fromIntegral $ nextAddress line) : ) <$> optimizeLineTail line
+ 72
+ 73 prependNumber :: MonadSafe m => Line -> m InstructionList
+ 74 prependNumber line = flip buildNumber line =<< parseNumberFromTLL (currentTL line , nextTLL line)
+ 75
+ 76 buildNumber :: MonadSafe m => (Integer , (TokenList , [TokenList])) -> Line -> m InstructionList
+ 77 buildNumber (n , (tl , ttl) ) line = build (LL.length (nextTLL line) - LL.length ttl) where
+ 78 build 0 = (consI n :) <$> optimizeLineTail (line {currentTL = tl})
+ 79 build offset = pure [consI n , jumpSI $ show $ currentAddress line + fromIntegral offset]
+ 80
+ 81 -- | Accessors
+ 82
+ 83 nextAddress :: Line -> Natural
+ 84 nextAddress line = currentAddress line + 1
+ 85
+ 86 -- | Constructors
+ 87
+ 88 lineFromTuple2 :: (Natural, [TokenList]) -> Line
+ 89 lineFromTuple2 (a, []) = Line
+ 90 { currentAddress = a
+ 91 , currentTL = []
+ 92 , nextTLL = []
+ 93 , numberFlag = True
+ 94 }
+ 95 lineFromTuple2 (a, l : ls) = Line
+ 96 { currentAddress = a
+ 97 , currentTL = l
+ 98 , nextTLL = ls
+ 99 , numberFlag = True
+ 100 }
+ 101
+ 102 data Line = Line
+ 103 { currentTL :: TokenList
+ 104 , currentAddress :: Natural
+ 105 , numberFlag :: Bool
+ 106 , nextTLL :: [TokenList]
+ 107 }
+ 108
+ 109 --consM :: Functor f => a -> f [a] -> f [a]
+ 110 --consM a l = (a : ) <$> l
+ 111
+ 112 filterNull :: [[a]] -> [[a]]
+ 113 filterNull = filter notNull
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Parser.hs.html
new file mode 100644
index 000000000..1c766fb19
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Parser.hs.html
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.Parser (
+ 2 parseSafe,
+ 3 parse,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automata.ETA.Lexer
+ 7 import HelVM.HelMA.Automata.ETA.Optimizer
+ 8
+ 9 import HelVM.HelMA.Automaton.API.IOTypes
+ 10 import HelVM.HelMA.Automaton.Instruction
+ 11
+ 12 import HelVM.HelIO.Control.Safe
+ 13
+ 14 parseSafe :: Source -> Safe InstructionList
+ 15 parseSafe = parse
+ 16
+ 17 parse :: MonadSafe m => Source -> m InstructionList
+ 18 parse = optimize . tokenize
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.SimpleParams.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.SimpleParams.hs.html
new file mode 100644
index 000000000..3df324016
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.SimpleParams.hs.html
@@ -0,0 +1,47 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.SimpleParams where
+ 2
+ 3 import HelVM.HelMA.Automata.ETA.API.ETAImplType
+ 4
+ 5 import HelVM.HelMA.Automaton.API.AutoOptions
+ 6 import HelVM.HelMA.Automaton.API.IOTypes
+ 7
+ 8 import HelVM.HelMA.Automaton.Types.StackType
+ 9
+ 10 simpleParams :: ETAImplType -> StackType-> Source -> SimpleParams
+ 11 simpleParams it st s = SimpleParams
+ 12 { implType = it
+ 13 , source = s
+ 14 , stackType = st
+ 15 , autoOptions = simpleAutoParams
+ 16 }
+ 17
+ 18 -- | Type
+ 19 data SimpleParams = SimpleParams
+ 20 { implType :: !ETAImplType
+ 21 , source :: !Source
+ 22 , stackType :: !StackType
+ 23 , autoOptions :: !AutoOptions
+ 24 }
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Token.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Token.hs.html
new file mode 100644
index 000000000..b73b3b4c0
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.ETA.Token.hs.html
@@ -0,0 +1,78 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.ETA.Token where
+ 2
+ 3 import HelVM.HelIO.Control.Safe
+ 4 import HelVM.HelIO.Digit.ToDigit
+ 5
+ 6 import Data.Vector as Vector
+ 7
+ 8 import qualified Text.Read
+ 9 import qualified Text.Show
+ 10
+ 11 data Token = E | T | A | O | I | N | S | H | R
+ 12 deriving stock (Bounded , Enum , Eq , Read , Show)
+ 13
+ 14 type TokenList = [Token]
+ 15 type TokenVector = Vector Token
+ 16
+ 17 instance ToDigit Token where
+ 18 toDigit H = pure 0
+ 19 toDigit T = pure 1
+ 20 toDigit A = pure 2
+ 21 toDigit O = pure 3
+ 22 toDigit I = pure 4
+ 23 toDigit N = pure 5
+ 24 toDigit S = pure 6
+ 25 toDigit t = liftErrorWithPrefix "Wrong token" $ show t
+ 26
+ 27 ----
+ 28
+ 29 newtype WhiteToken = WhiteToken { unWhiteToken :: Token}
+ 30 deriving stock (Eq)
+ 31
+ 32 type WhiteTokenList = [WhiteToken]
+ 33
+ 34 instance Show WhiteToken where
+ 35 show (WhiteToken R) = "\n"
+ 36 show (WhiteToken t) = show t
+ 37
+ 38 -- | Scanner
+ 39 instance Read WhiteToken where
+ 40 readsPrec _ "\n" = [( WhiteToken R , "")]
+ 41 readsPrec _ "E" = [( WhiteToken E , "")]
+ 42 readsPrec _ "T" = [( WhiteToken T , "")]
+ 43 readsPrec _ "A" = [( WhiteToken A , "")]
+ 44 readsPrec _ "O" = [( WhiteToken O , "")]
+ 45 readsPrec _ "I" = [( WhiteToken I , "")]
+ 46 readsPrec _ "N" = [( WhiteToken N , "")]
+ 47 readsPrec _ "S" = [( WhiteToken S , "")]
+ 48 readsPrec _ "H" = [( WhiteToken H , "")]
+ 49 readsPrec _ _ = []
+ 50
+ 51 tokenToWhiteTokenPair :: Token -> (WhiteToken , String)
+ 52 tokenToWhiteTokenPair t = (WhiteToken t , "")
+ 53
+ 54 whiteTokenListToTokenList :: WhiteTokenList -> TokenList
+ 55 whiteTokenListToTokenList = fmap unWhiteToken
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.FALSE.Expression.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.FALSE.Expression.hs.html
new file mode 100644
index 000000000..ec5ab4012
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.FALSE.Expression.hs.html
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.FALSE.Expression where
+ 2
+ 3 import HelVM.HelMA.Automaton.Instruction
+ 4
+ 5 type ExpressionList = [Expression]
+ 6 data Expression =
+ 7 Inst Instruction
+ 8 | Lambda ExpressionList
+ 9 | Exec
+ 10 | Cond
+ 11 | While
+ 12 | Ref Natural
+ 13 | Store
+ 14 | Fetch
+ 15 | Str String
+ 16 | Comment String
+ 17 | Flush
+ 18 deriving stock (Eq , Show , Read)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.FALSE.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.FALSE.Parser.hs.html
new file mode 100644
index 000000000..14f7521d8
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.FALSE.Parser.hs.html
@@ -0,0 +1,136 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.FALSE.Parser (
+ 2 parseSafe,
+ 3 parse,
+ 4 charToSimpleInstruction,
+ 5 ) where
+ 6
+ 7 import HelVM.HelMA.Automata.FALSE.Expression
+ 8
+ 9 import HelVM.HelMA.Automaton.API.IOTypes
+ 10 import HelVM.HelMA.Automaton.Instruction
+ 11 import HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
+ 12 import HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
+ 13 import HelVM.HelMA.Automaton.ReadPExtra
+ 14
+ 15 import HelVM.HelMA.Automaton.Instruction.Extras.Constructors
+ 16
+ 17 import HelVM.HelIO.Control.Safe
+ 18 import HelVM.HelIO.Extra hiding (runParser)
+ 19 import HelVM.HelIO.ReadText
+ 20
+ 21 import Data.Char
+ 22
+ 23 import Text.ParserCombinators.ReadP hiding (many)
+ 24
+ 25 parseSafe :: Source -> Safe ExpressionList
+ 26 parseSafe = parse
+ 27
+ 28 parse :: MonadSafe m => Source -> m ExpressionList
+ 29 parse = runParser vlParser
+ 30
+ 31 vlParser :: ReadP ExpressionList
+ 32 vlParser = many (skipSpaces *> valueParser) <* skipSpaces
+ 33
+ 34 valueParser :: ReadP Expression
+ 35 valueParser = lambdaParser <|> commentParser <|> writeStringParser <|> constParser <|> refParser <|> simpleParser
+ 36
+ 37 lambdaParser :: ReadP Expression
+ 38 lambdaParser = Lambda <$> (char '[' *> vlParser <* char ']')
+ 39
+ 40 commentParser :: ReadP Expression
+ 41 commentParser = Comment <$> (char '{' *> many (notChar '}') <* char '}')
+ 42
+ 43 writeStringParser :: ReadP Expression
+ 44 writeStringParser = Str <$> stringParser
+ 45
+ 46 constParser :: ReadP Expression
+ 47 constParser = Inst . consI . fromIntegral <$> naturalParser
+ 48
+ 49 refParser :: ReadP Expression
+ 50 refParser = refFromChar <$> letterAscii
+ 51
+ 52 simpleParser :: ReadP Expression
+ 53 simpleParser = fromJustWithText "imposible" . charToSimpleInstruction <$> oneOf simpleInstructionChars
+ 54
+ 55 simpleInstructionChars :: String
+ 56 simpleInstructionChars = "$%\\@`+-*/_&|~<=!?#:;^,.ß"
+ 57
+ 58 charToSimpleInstruction :: Char -> Maybe Expression
+ 59 charToSimpleInstruction '$' = inst dupI
+ 60 charToSimpleInstruction '%' = inst discardI
+ 61 charToSimpleInstruction '\\' = inst swapI
+ 62 charToSimpleInstruction '@' = inst rotI
+ 63 charToSimpleInstruction '`' = inst copyTI
+ 64
+ 65 charToSimpleInstruction '+' = inst addI
+ 66 charToSimpleInstruction '-' = inst subI
+ 67 charToSimpleInstruction '*' = inst mulI
+ 68 charToSimpleInstruction '/' = inst divI
+ 69 charToSimpleInstruction '_' = inst negI
+ 70
+ 71 charToSimpleInstruction '&' = inst $ binary BAnd
+ 72 charToSimpleInstruction '|' = inst $ binary BOr
+ 73 charToSimpleInstruction '~' = inst $ unary BNot
+ 74
+ 75 charToSimpleInstruction '<' = inst $ binary LGT
+ 76 charToSimpleInstruction '=' = inst $ binary LEQ
+ 77
+ 78 charToSimpleInstruction '!' = pure Exec
+ 79 charToSimpleInstruction '?' = pure Cond
+ 80 charToSimpleInstruction '#' = pure While
+ 81
+ 82 charToSimpleInstruction ':' = pure Store
+ 83 charToSimpleInstruction ';' = pure Fetch
+ 84
+ 85 charToSimpleInstruction '^' = inst $ sio InputChar
+ 86 charToSimpleInstruction ',' = inst $ sio OutputChar
+ 87 charToSimpleInstruction '.' = inst $ sio OutputDec
+ 88 charToSimpleInstruction 'ß' = pure Flush
+ 89
+ 90 charToSimpleInstruction _ = Nothing
+ 91
+ 92 inst :: Instruction -> Maybe Expression
+ 93 inst = pure . Inst
+ 94
+ 95 -- | Extra
+ 96
+ 97 refFromChar :: Char -> Expression
+ 98 refFromChar c = Ref $ fromIntegral $ ord (toLower c) - ord 'a'
+ 99
+ 100 naturalParser :: ReadP Natural
+ 101 naturalParser = naturalLiteralParser <|> ordCharLiteralParser
+ 102
+ 103 naturalLiteralParser :: ReadP Natural
+ 104 naturalLiteralParser = readUnsafe <$> many1 digit
+ 105
+ 106 ordCharLiteralParser :: Integral a => ReadP a
+ 107 ordCharLiteralParser = fromIntegral . ord <$> (skipSpacesAndChar '\'' *> anyChar)
+ 108
+ 109 stringParser :: ReadP String
+ 110 stringParser = skipSpacesAndChar '"' *> many (notChar '"') <* char '"'
+ 111
+ 112 skipSpacesAndChar :: Char -> ReadP Char
+ 113 skipSpacesAndChar c = skipSpaces *> char c
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Automaton.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Automaton.hs.html
new file mode 100644
index 000000000..aab062ba0
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Automaton.hs.html
@@ -0,0 +1,62 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.Automaton (
+ 2 run,
+ 3 runWithTerminator,
+ 4 realize,
+ 5 realizeWithTrue,
+ 6 ) where
+ 7
+ 8 import HelVM.HelMA.Automata.LazyK.Constants
+ 9 import HelVM.HelMA.Automata.LazyK.Lambda
+ 10 import HelVM.HelMA.Automata.LazyK.Reducer
+ 11
+ 12 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 13
+ 14 import HelVM.HelIO.Control.Safe
+ 15
+ 16 run :: BIO m => Lambda -> m ()
+ 17 run = runWithTerminator false
+ 18
+ 19 runWithTerminator :: BIO m => Lambda -> Lambda -> m ()
+ 20 runWithTerminator terminator lambda = output terminator lambda =<< realizeWithTrue lambda
+ 21
+ 22 realizeWithTrue :: MonadSafe m => Lambda -> m Natural
+ 23 realizeWithTrue = realize . flippedApply true
+ 24
+ 25 realize :: MonadSafe m => Lambda -> m Natural
+ 26 realize = naturalSafe . flippedApply number0 . flippedApply Succ
+ 27
+ 28 number0 :: Lambda
+ 29 number0 = Number 0
+ 30
+ 31 naturalSafe :: MonadSafe m => Lambda -> m Natural
+ 32 naturalSafe (Number x) = pure x
+ 33 naturalSafe x = liftErrorWithPrefix "Invalid output format. Output should be the list of Church numerals. " $ show x
+ 34
+ 35 output :: BIO m => Lambda -> Lambda -> Natural -> m ()
+ 36 output terminator lambda number = check $ compare 256 number where
+ 37 check GT = wPutAsChar number *> runWithTerminator terminator (apply lambda terminator)
+ 38 check EQ = pass
+ 39 check LT = wLogStr (show number) *> wLogStr (show lambda)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Constants.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Constants.hs.html
new file mode 100644
index 000000000..f50d577ca
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Constants.hs.html
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.Constants where
+ 2
+ 3 import HelVM.HelMA.Automata.LazyK.Lambda
+ 4
+ 5 bCombinator :: Lambda
+ 6 bCombinator = app3 S appKS K
+ 7
+ 8 appSelfApp :: Lambda -> Lambda
+ 9 appSelfApp = app4 S I I
+ 10
+ 11 selfApp :: Lambda
+ 12 selfApp = app3 S I I
+ 13
+ 14 app3SI :: Lambda -> Lambda
+ 15 app3SI = app3 S I
+ 16
+ 17 appKS :: Lambda
+ 18 appKS = App K S
+ 19
+ 20 appK :: Lambda -> Lambda
+ 21 appK = App K
+ 22
+ 23 false :: Lambda
+ 24 false = App K I
+ 25
+ 26 true :: Lambda
+ 27 true = K
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Evaluator.hs.html
new file mode 100644
index 000000000..09b52e1e0
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Evaluator.hs.html
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.Evaluator (
+ 2 evalParams,
+ 3 evalSource,
+ 4 reduceSource,
+ 5 ) where
+ 6
+ 7 import HelVM.HelMA.Automata.LazyK.Automaton
+ 8 import HelVM.HelMA.Automata.LazyK.InputEncoder
+ 9 import HelVM.HelMA.Automata.LazyK.Lambda
+ 10 import HelVM.HelMA.Automata.LazyK.Parser
+ 11
+ 12 import HelVM.HelMA.Automata.LazyK.Reducer
+ 13
+ 14 import HelVM.HelMA.Automaton.API.EvalParams
+ 15 import HelVM.HelMA.Automaton.API.IOTypes
+ 16
+ 17 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 18
+ 19 evalParams :: BIO m => EvalParams -> m ()
+ 20 evalParams = evalSource . source
+ 21
+ 22 evalSource :: BIO m => Source -> m ()
+ 23 evalSource = evalLambda <=< parse
+ 24
+ 25 evalLambda :: BIO m => Lambda -> m ()
+ 26 evalLambda lambda = (run . reduce . App lambda . readInput) =<< wGetContentsBS
+ 27
+ 28 reduceSource :: BIO m => Source -> m Source
+ 29 reduceSource s = show . reduce <$> parse s
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.InputEncoder.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.InputEncoder.hs.html
new file mode 100644
index 000000000..70cf3f904
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.InputEncoder.hs.html
@@ -0,0 +1,67 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.InputEncoder where
+ 2
+ 3 import HelVM.HelMA.Automata.LazyK.Constants
+ 4 import HelVM.HelMA.Automata.LazyK.Lambda
+ 5
+ 6 import qualified Data.ByteString.Lazy as LBS
+ 7
+ 8 -- | Constructors
+ 9 readInput :: LBS.ByteString -> Lambda
+ 10 readInput = encodeInput . fmap fromIntegral . LBS.unpack
+ 11
+ 12 encodeInput :: [Natural] -> Lambda
+ 13 encodeInput = foldr (cons . church) end
+ 14
+ 15 -- | Other
+ 16 end :: Lambda
+ 17 end = cons (church 256) false
+ 18
+ 19 cons :: Lambda -> Lambda -> Lambda
+ 20 cons a b = app3 S (app3SI (appK a)) (appK b)
+ 21
+ 22 church :: Natural -> Lambda
+ 23 church 0 = false
+ 24 church 1 = I
+ 25 church 4 = appSelfApp $ church 2
+ 26 church 8 = church 3 `App` church 2
+ 27 church 9 = church 2 `App` church 3
+ 28 church 16 = church 2 `App` church 4
+ 29 church 25 = church 2 `App` church 5
+ 30 church 27 = appSelfApp $ church 3
+ 31 church 36 = church 2 `App` church 6
+ 32 church 64 = church 3 `App` church 4
+ 33 church 81 = church 4 `App` church 3
+ 34 church 100 = church 2 `App` church 10
+ 35 church 121 = church 2 `App` church 11
+ 36 church 125 = church 3 `App` church 5
+ 37 church 256 = appSelfApp $ church 4
+ 38 church n = succChurch $ n - 1
+ 39
+ 40 succChurch :: Natural -> Lambda
+ 41 succChurch = successor . church
+ 42
+ 43 successor :: Lambda -> Lambda
+ 44 successor = app3 S bCombinator
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Lambda.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Lambda.hs.html
new file mode 100644
index 000000000..d1b79f18f
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Lambda.hs.html
@@ -0,0 +1,45 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.Lambda where
+ 2
+ 3 import Relude.Extra
+ 4
+ 5 app4 :: Lambda -> Lambda -> Lambda -> Lambda -> Lambda
+ 6 app4 l1 l2 l3 l4 = l1 `App` l2 `App` l3 `App` l4
+ 7
+ 8 app3 :: Lambda -> Lambda -> Lambda -> Lambda
+ 9 app3 l1 l2 l3 = l1 `App` l2 `App` l3
+ 10
+ 11 foldlLambda :: NonEmpty Lambda -> Lambda
+ 12 foldlLambda = foldl1' App
+ 13
+ 14 data Lambda =
+ 15 S
+ 16 | K
+ 17 | I
+ 18 | App Lambda Lambda
+ 19 | Succ
+ 20 | Number !Natural
+ 21 | Var Text
+ 22 deriving stock (Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Lexer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Lexer.hs.html
new file mode 100644
index 000000000..60322b677
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Lexer.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.Lexer where
+ 2
+ 3 import HelVM.HelMA.Automaton.API.IOTypes
+ 4
+ 5 import qualified Data.Text as Text
+ 6
+ 7 filterComments :: Source -> Source
+ 8 filterComments source = mconcat $ removeComment <$> lines source
+ 9
+ 10 removeComment :: Source -> Source
+ 11 removeComment = fst . Text.break isHash
+ 12
+ 13 isHash :: Char -> Bool
+ 14 isHash c = '#' == c
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Parser.hs.html
new file mode 100644
index 000000000..e21ed74b4
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Parser.hs.html
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.Parser (
+ 2 parse,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automata.LazyK.Lambda
+ 6 import HelVM.HelMA.Automata.LazyK.Lexer
+ 7
+ 8 import HelVM.HelMA.Automaton.API.IOTypes
+ 9 import HelVM.HelMA.Automaton.ReadPExtra
+ 10
+ 11 import HelVM.HelIO.Control.Safe
+ 12
+ 13 import Text.ParserCombinators.ReadP hiding (many)
+ 14
+ 15 parse :: MonadSafe m => Source -> m Lambda
+ 16 parse = parseCode . filterComments
+ 17
+ 18 parseCode :: MonadSafe m => Source -> m Lambda
+ 19 parseCode = runParser appParser
+ 20
+ 21 appParser :: ReadP Lambda
+ 22 appParser = foldlLambda <$> manyNonEmpty lambdaParser
+ 23
+ 24 lambdaParser :: ReadP Lambda
+ 25 lambdaParser =
+ 26 S <$ oneOf "sS"
+ 27 <|> K <$ oneOf "kK"
+ 28 <|> I <$ oneOf "iI"
+ 29 <|> App <$ char '`' <*> lambdaParser <*> lambdaParser
+ 30 <|> char '(' *> appParser <* char ')'
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Reducer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Reducer.hs.html
new file mode 100644
index 000000000..b39a65dc8
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.LazyK.Reducer.hs.html
@@ -0,0 +1,45 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.LazyK.Reducer (
+ 2 reduce,
+ 3 flippedApply,
+ 4 apply,
+ 5 ) where
+ 6
+ 7 import HelVM.HelMA.Automata.LazyK.Lambda
+ 8
+ 9 reduce :: Lambda -> Lambda
+ 10 reduce (App x y) = reduce x `apply` reduce y
+ 11 reduce x = x
+ 12
+ 13 flippedApply :: Lambda -> Lambda -> Lambda
+ 14 flippedApply = flip apply
+ 15
+ 16 apply :: Lambda -> Lambda -> Lambda
+ 17 apply (S `App` x `App` y) z = apply x z `apply` apply y z
+ 18 apply (App K x) _ = x
+ 19 apply I x = x
+ 20 apply Succ (Number x) = Number $! x + 1
+ 21 apply Succ x = error $ "attempted to apply inc to a non-number " <> show x
+ 22 apply f x = App f x
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Rev.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Rev.Evaluator.hs.html
new file mode 100644
index 000000000..43ff16dd5
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Rev.Evaluator.hs.html
@@ -0,0 +1,45 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.Rev.Evaluator (
+ 2 evalParams,
+ 3 eval,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automaton.API.EvalParams
+ 7 import HelVM.HelMA.Automaton.API.IOTypes
+ 8 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 9
+ 10 import qualified Data.Text as Text
+ 11
+ 12 evalParams :: BIO m => EvalParams -> m ()
+ 13 evalParams = eval . source
+ 14
+ 15 eval :: BusinessIO m => Source -> m ()
+ 16 eval = evalLines . lines
+ 17
+ 18 evalLines :: BusinessIO m => [Source] -> m ()
+ 19 evalLines ll = doOutput $ unlines $ Text.reverse <$> ll
+ 20
+ 21 doOutput :: BusinessIO m => Source -> m ()
+ 22 doOutput = wPutStr
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Automaton.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Automaton.hs.html
new file mode 100644
index 000000000..6981d5220
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Automaton.hs.html
@@ -0,0 +1,83 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.SubLeq.Automaton (
+ 2 newMemory,
+ 3 run,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automaton.IO.AutomatonIO
+ 7 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 8
+ 9 import HelVM.HelMA.Automaton.Loop as Loop
+ 10
+ 11 import HelVM.HelMA.Automaton.Combiner.RAM as RAM
+ 12
+ 13 import Control.Type.Operator
+ 14
+ 15 run :: (RAutomatonIO e r m) => Maybe Natural -> Automaton e r -> m $ Automaton e r
+ 16 run = loopMWithLimit nextState
+ 17
+ 18 nextState :: RAutomatonIO e r m => Automaton e r -> m $ AutomatonSame e r
+ 19 nextState a@(Automaton ic ram)
+ 20 | ic < 0 = doEnd a
+ 21 | src < 0 = doInputChar dst a
+ 22 | dst < 0 = doOutputChar src a
+ 23 | otherwise = doInstruction src dst a
+ 24 where
+ 25 src = genericLoad ram ic
+ 26 dst = genericLoad ram $ ic + 1
+ 27
+ 28 -- | IO instructions
+ 29 doOutputChar :: RAutomatonIO e r m => e -> Automaton e r -> m $ AutomatonSame e r
+ 30 doOutputChar address (Automaton ic ram) = wPutAsChar (genericLoad ram address) $> Loop.continue (next3Automaton ic ram)
+ 31
+ 32 doInputChar :: RAutomatonIO e r m => e -> Automaton e r -> m $ AutomatonSame e r
+ 33 doInputChar address (Automaton ic ram) = Loop.continue . next3Automaton ic . flippedStoreChar address ram <$> wGetChar
+ 34
+ 35 -- | Terminate instruction
+ 36 doEnd :: RAutomatonIO e r m => Automaton e r -> m $ AutomatonSame e r
+ 37 doEnd = pure . Loop.break
+ 38
+ 39 doInstruction :: RAutomatonIO e r m => e -> e -> Automaton e r -> m $ AutomatonSame e r
+ 40 doInstruction src dst (Automaton ic ram) = pure $ Loop.continue $ Automaton ic' $ store dst diff ram where
+ 41 diff = genericLoad ram dst - genericLoad ram src
+ 42 ic'
+ 43 | diff <= 0 = genericLoad ram $ ic + 2
+ 44 | otherwise = ic + 3
+ 45
+ 46 next3Automaton :: Num e => e -> ram -> Automaton e ram
+ 47 next3Automaton ic = Automaton (ic + 3)
+ 48
+ 49 newMemory :: Num e => ram -> Automaton e ram
+ 50 newMemory = Automaton 0
+ 51
+ 52 -- | Types
+ 53
+ 54 type AutomatonSame ic ram = Same (Automaton ic ram)
+ 55
+ 56 data Automaton ic ram = Automaton
+ 57 { memoryIC :: ic
+ 58 , memoryRAM :: ram
+ 59 }
+ 60 deriving stock (Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Evaluator.hs.html
new file mode 100644
index 000000000..64bac6e26
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Evaluator.hs.html
@@ -0,0 +1,69 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.SubLeq.Evaluator (
+ 2 simpleEval,
+ 3 evalParams,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automata.SubLeq.Automaton
+ 7 import HelVM.HelMA.Automata.SubLeq.Lexer
+ 8
+ 9 import HelVM.HelMA.Automaton.API.EvalParams
+ 10 import HelVM.HelMA.Automaton.API.IOTypes
+ 11
+ 12 import HelVM.HelMA.Automaton.IO.AutomatonIO
+ 13 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 14
+ 15 import HelVM.HelMA.Automaton.Loop
+ 16
+ 17 import HelVM.HelMA.Automaton.Types.DumpType
+ 18 import HelVM.HelMA.Automaton.Types.RAMType
+ 19
+ 20 import qualified HelVM.HelIO.Collections.MapList as MapList
+ 21 import qualified HelVM.HelIO.Collections.SList as SList
+ 22
+ 23 import qualified Data.Sequence as Seq
+ 24
+ 25 simpleEval :: BIO m => RAMType -> Source -> m ()
+ 26 simpleEval rt s = evalSource s rt testMaybeLimit Pretty
+ 27
+ 28 ----
+ 29
+ 30 evalParams :: BIO m => EvalParams -> m ()
+ 31 evalParams p = evalSource (source p) (ramAutoOptions p) Nothing (dumpAutoOptions p)
+ 32
+ 33 evalSource :: BIO m => Source -> RAMType -> LimitMaybe -> DumpType -> m ()
+ 34 evalSource source = evalIL $ tokenize source
+ 35
+ 36 evalIL :: AutomatonIO e m => [e] -> RAMType -> LimitMaybe -> DumpType -> m ()
+ 37 evalIL = flip evalIL'
+ 38
+ 39 evalIL' :: AutomatonIO e m => RAMType -> [e] -> LimitMaybe -> DumpType -> m ()
+ 40 evalIL' ListRAMType = start
+ 41 evalIL' SeqRAMType = start . Seq.fromList
+ 42 evalIL' SListRAMType = start . SList.sListFromList
+ 43 evalIL' MapListRAMType = start . MapList.mapListFromList
+ 44
+ 45 start :: RAutomatonIO e r m => r -> LimitMaybe -> DumpType -> m ()
+ 46 start r limit dt = logDump dt =<< run limit (newMemory r)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Lexer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Lexer.hs.html
new file mode 100644
index 000000000..f8c24b181
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.SubLeq.Lexer.hs.html
@@ -0,0 +1,54 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.SubLeq.Lexer where
+ 2
+ 3 import HelVM.HelMA.Automata.SubLeq.Symbol
+ 4
+ 5 import HelVM.HelIO.Extra
+ 6 import HelVM.HelIO.ReadText
+ 7 import HelVM.HelMA.Automaton.API.IOTypes
+ 8
+ 9 import qualified Text.Read as Read
+ 10 import qualified Text.Show as Show
+ 11
+ 12 tokenize :: Source -> SymbolList
+ 13 tokenize source = (maybeToList . readTextMaybe) =<< splitOneOf " \t\n" source
+ 14
+ 15 readSymbols :: Source -> Symbols
+ 16 readSymbols source = readTextUnsafe source :: Symbols
+ 17
+ 18 ----
+ 19
+ 20 newtype Symbols = Symbols SymbolList
+ 21
+ 22 instance Show Symbols where
+ 23 show (Symbols symbols) = toString $ unwords $ shows symbols
+ 24
+ 25 instance Read Symbols where
+ 26 readsPrec _ source = [( Symbols $ tokenize $ toText source , "")]
+ 27
+ 28 ----
+ 29
+ 30 shows :: SymbolList -> [Text]
+ 31 shows symbols = show <$> symbols
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Evaluator.hs.html
new file mode 100644
index 000000000..62f072364
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Evaluator.hs.html
@@ -0,0 +1,62 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.WhiteSpace.Evaluator (
+ 2 simpleEval,
+ 3 evalParams,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automata.WhiteSpace.Lexer
+ 7 import HelVM.HelMA.Automata.WhiteSpace.Parser
+ 8 import qualified HelVM.HelMA.Automata.WhiteSpace.SimpleParams as S
+ 9 import HelVM.HelMA.Automata.WhiteSpace.Token
+ 10
+ 11 import qualified HelVM.HelMA.Automaton.API.AutomatonOptions as Automaton
+ 12 import HelVM.HelMA.Automaton.API.EvalParams
+ 13 import HelVM.HelMA.Automaton.API.IOTypes
+ 14
+ 15 import HelVM.HelMA.Automaton.Automaton
+ 16
+ 17 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 18
+ 19 import HelVM.HelMA.Automaton.Types.FormatType
+ 20 import HelVM.HelMA.Automaton.Types.TokenType
+ 21
+ 22 import HelVM.HelIO.Control.Safe
+ 23
+ 24 import Prelude hiding (swap)
+ 25
+ 26
+ 27 simpleEval :: BIO m => S.SimpleParams -> m ()
+ 28 simpleEval p = eval (S.tokenType p) (S.source p) (S.formatType p) $ S.automatonOptions p
+ 29
+ 30 ----
+ 31
+ 32 evalParams :: BIO m => TokenType -> EvalParams -> m ()
+ 33 evalParams tokenType p = eval tokenType (source p) (formatType p) $ automatonOptions p
+ 34
+ 35 eval :: BIO m => TokenType -> Source -> FormatType -> Automaton.AutomatonOptions -> m ()
+ 36 eval tokenType source = evalTL $ tokenize tokenType source
+ 37
+ 38 evalTL :: BIO m => TokenList -> FormatType -> Automaton.AutomatonOptions -> m ()
+ 39 evalTL tl ascii ao = flip start ao =<< liftSafe (parseFromTL ascii tl)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Lexer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Lexer.hs.html
new file mode 100644
index 000000000..ac7fd28f0
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Lexer.hs.html
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.WhiteSpace.Lexer where
+ 2
+ 3 import HelVM.HelMA.Automata.WhiteSpace.Token
+ 4
+ 5 import HelVM.HelIO.ReadText
+ 6 import HelVM.HelMA.Automaton.API.IOTypes
+ 7 import HelVM.HelMA.Automaton.Types.TokenType
+ 8 import HelVM.HelMA.Automaton.WrapTokenList
+ 9
+ 10 -- | Lexer
+ 11
+ 12 tokenize :: TokenType -> Source -> TokenList
+ 13 tokenize VisibleTokenType = tokenizeVisible
+ 14 tokenize _ = tokenizeWhite
+ 15
+ 16 tokenizeVisible :: Source -> TokenList
+ 17 tokenizeVisible = unWrapTokenList . readVisibleTokens
+ 18
+ 19 tokenizeWhite :: Source -> TokenList
+ 20 tokenizeWhite = whiteTokenListToTokenList . unWrapTokenList . readWhiteTokens
+ 21
+ 22 readVisibleTokens :: Source -> VisibleTokens
+ 23 readVisibleTokens source = readTextUnsafe source :: VisibleTokens
+ 24
+ 25 readWhiteTokens :: Source -> WhiteTokens
+ 26 readWhiteTokens source = readTextUnsafe source :: WhiteTokens
+ 27
+ 28 type VisibleTokens = WrapTokenList TokenList
+ 29
+ 30 type WhiteTokens = WrapTokenList WhiteTokenList
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.OperandParsers.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.OperandParsers.hs.html
new file mode 100644
index 000000000..2c0438b86
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.OperandParsers.hs.html
@@ -0,0 +1,95 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.WhiteSpace.OperandParsers where
+ 2
+ 3 import HelVM.HelMA.Automata.WhiteSpace.Token
+ 4 import HelVM.HelMA.Automaton.Symbol
+ 5
+ 6 import HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
+ 7
+ 8 import HelVM.HelMA.Automaton.Types.FormatType
+ 9
+ 10 import HelVM.HelIO.Collections.SList
+ 11 import HelVM.HelIO.Control.Safe
+ 12 import HelVM.HelIO.Digit.ToDigit
+ 13
+ 14 import Control.Monad.Extra
+ 15
+ 16 parseIndex :: MonadSafe m => ParserFromTokenList m Index
+ 17 parseIndex = parseInt
+ 18
+ 19 parseSymbol :: MonadSafe m => ParserFromTokenList m Symbol
+ 20 parseSymbol = parseInteger
+ 21
+ 22 parseLabel :: MonadSafe m => FormatType -> ParserFromTokenList m Label
+ 23 parseLabel BinaryLabel = parseDigitString
+ 24 parseLabel TextLabel = parseAsciiString
+ 25
+ 26 ----
+ 27
+ 28 parseInt :: MonadSafe m => ParserFromTokenList m Int
+ 29 parseInt tl = parseInt' <$> parseInteger tl where
+ 30 parseInt' (integer , tl') = (fromIntegral integer , tl')
+ 31
+ 32 parseInteger :: MonadSafe m => ParserFromTokenList m Integer
+ 33 parseInteger [] = liftError "EOL"
+ 34 parseInteger (S : tl) = parseExtra makeIntegral2FromList tl
+ 35 parseInteger (T : tl) = negationIntegral <$> parseExtra makeIntegral2FromList tl
+ 36 parseInteger (N : tl) = pure (0 , tl)
+ 37
+ 38 negationIntegral :: (Integer , TokenList) -> (Integer , TokenList)
+ 39 negationIntegral (i , l) = (-i , l)
+ 40
+ 41 parseNatural :: MonadSafe m => ParserFromTokenList m Natural
+ 42 parseNatural = parseExtra makeIntegral2FromList
+ 43
+ 44 parseExtra :: MonadSafe m => (TokenList -> m a) -> ParserFromTokenList m a
+ 45 parseExtra maker = loop act . ([] , ) where
+ 46 act (acc , []) = Right $ liftError $ show acc
+ 47 act (acc , N : tl) = Right $ moveSafe (maker acc , tl)
+ 48 act (acc , t : tl) = Left (t : acc , tl)
+ 49
+ 50 parseDigitString :: MonadSafe m => ParserFromTokenList m SString
+ 51 parseDigitString tl = moveSafe =<< parseString' makeDigitStringFromList tl
+ 52
+ 53 parseAsciiString :: MonadSafe m => ParserFromTokenList m SString
+ 54 parseAsciiString tl = moveSafe =<< parseString' makeAsciiString28FromList tl
+ 55
+ 56 moveSafe :: MonadSafe m => (m a , TokenList) -> m (a , TokenList)
+ 57 moveSafe (a , tl) = appendErrorTuple ("TokenList" , show tl) $ ( , tl) <$> a
+ 58
+ 59 parseString' :: MonadSafe m => (TokenList -> a) -> ParserFromTokenList m a
+ 60 parseString' maker tl = parseString'' <$> splitByN tl where
+ 61 parseString'' (acc , tl') = (maker acc , tl')
+ 62
+ 63 splitByN :: MonadSafe m => ParserFromTokenList m TokenList
+ 64 splitByN [] = liftError "Empty list"
+ 65 splitByN (N : tl) = pure ([] , tl)
+ 66 splitByN (t : tl) = splitByN' <$> splitByN tl where
+ 67 splitByN' (acc , tl') = (t:acc , tl')
+ 68
+ 69 -- | Types
+ 70 type ParserFromTokenList m a = Parser TokenList m a
+ 71
+ 72 type Parser b m a = b -> m (a , b)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Parser.hs.html
new file mode 100644
index 000000000..26fd2781c
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Parser.hs.html
@@ -0,0 +1,117 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.WhiteSpace.Parser (
+ 2 flipParseVisible,
+ 3 flipParseWhite,
+ 4 parseVisible,
+ 5 parseWhite,
+ 6 parse,
+ 7 parseFromTL
+ 8 ) where
+ 9
+ 10 import HelVM.HelMA.Automata.WhiteSpace.Lexer
+ 11 import HelVM.HelMA.Automata.WhiteSpace.OperandParsers
+ 12 import HelVM.HelMA.Automata.WhiteSpace.Token
+ 13
+ 14 import HelVM.HelMA.Automaton.API.IOTypes
+ 15
+ 16 import HelVM.HelMA.Automaton.Instruction
+ 17 import HelVM.HelMA.Automaton.Instruction.Extras.Constructors
+ 18
+ 19 import HelVM.HelMA.Automaton.Types.FormatType
+ 20 import HelVM.HelMA.Automaton.Types.TokenType
+ 21
+ 22 import HelVM.HelIO.Control.Safe
+ 23 import HelVM.HelIO.Extra
+ 24
+ 25 -- FIXME
+ 26 flipParseVisible :: FormatType -> Source -> Safe InstructionList
+ 27 flipParseVisible = flip parseVisible
+ 28
+ 29 flipParseWhite :: FormatType -> Source -> Safe InstructionList
+ 30 flipParseWhite = flip parseWhite
+ 31
+ 32 parseVisible :: Source -> FormatType -> Safe InstructionList
+ 33 parseVisible = parse VisibleTokenType
+ 34
+ 35 parseWhite :: Source -> FormatType -> Safe InstructionList
+ 36 parseWhite = parse WhiteTokenType
+ 37
+ 38 parse :: MonadSafe m => TokenType -> Source -> FormatType -> m InstructionList
+ 39 parse tokenType = flip parseFromTL . tokenize tokenType
+ 40
+ 41 parseFromTL :: MonadSafe m => FormatType -> TokenList -> m InstructionList
+ 42 parseFromTL ascii = repeatedlyM (parseInstruction ascii)
+ 43
+ 44 parseInstruction :: MonadSafe m => FormatType -> InstructionParser m
+ 45 parseInstruction _ (S : tl) = parseInstructionStackManipulation tl
+ 46 parseInstruction _ (T : S : tl) = parseInstructionArithmetic tl
+ 47 parseInstruction _ (T : T : tl) = parseInstructionHeadAccess tl
+ 48 parseInstruction ascii (N : tl) = parseInstructionFlowControl ascii tl
+ 49 parseInstruction _ (T : N : tl) = parseInstructionIO tl
+ 50 parseInstruction _ tl = unrecognisedTokensIn "parseInstruction" tl
+ 51
+ 52 parseInstructionStackManipulation :: MonadSafe m => InstructionParser m
+ 53 parseInstructionStackManipulation (S : tl) = build <$> parseSymbol tl where build (symbol , tl') = (consI symbol , tl')
+ 54 parseInstructionStackManipulation (T : S : tl) = build <$> parseIndex tl where build (index , tl') = (copyII index , tl')
+ 55 parseInstructionStackManipulation (T : N : tl) = build <$> parseIndex tl where build (index , tl') = (slideII index , tl')
+ 56 parseInstructionStackManipulation (N : S : tl) = pure (dupI , tl)
+ 57 parseInstructionStackManipulation (N : T : tl) = pure (swapI , tl)
+ 58 parseInstructionStackManipulation (N : N : tl) = pure (discardI , tl)
+ 59 parseInstructionStackManipulation tl = unrecognisedTokensIn "parseInstructionStackManipulation" tl
+ 60
+ 61 parseInstructionArithmetic :: MonadSafe m => InstructionParser m
+ 62 parseInstructionArithmetic (S : S : tl) = pure (addI , tl)
+ 63 parseInstructionArithmetic (S : T : tl) = pure (subI , tl)
+ 64 parseInstructionArithmetic (S : N : tl) = pure (mulI , tl)
+ 65 parseInstructionArithmetic (T : S : tl) = pure (divI , tl)
+ 66 parseInstructionArithmetic (T : T : tl) = pure (modI , tl)
+ 67 parseInstructionArithmetic tl = unrecognisedTokensIn "parseInstructionArithmetic" tl
+ 68
+ 69 parseInstructionHeadAccess :: MonadSafe m => InstructionParser m
+ 70 parseInstructionHeadAccess (S : tl) = pure (storeI , tl)
+ 71 parseInstructionHeadAccess (T : tl) = pure (loadI , tl)
+ 72 parseInstructionHeadAccess tl = unrecognisedTokensIn "parseInstructionHeadAccess" tl
+ 73
+ 74 parseInstructionFlowControl :: MonadSafe m => FormatType -> InstructionParser m
+ 75 parseInstructionFlowControl ascii (S : S : tl) = build <$> parseLabel ascii tl where build (label , tl') = (markSI label , tl')
+ 76 parseInstructionFlowControl ascii (S : T : tl) = build <$> parseLabel ascii tl where build (label , tl') = (callSI label , tl')
+ 77 parseInstructionFlowControl ascii (S : N : tl) = build <$> parseLabel ascii tl where build (label , tl') = (jumpSI label , tl')
+ 78 parseInstructionFlowControl ascii (T : S : tl) = build <$> parseLabel ascii tl where build (label , tl') = (bEzSI label , tl')
+ 79 parseInstructionFlowControl ascii (T : T : tl) = build <$> parseLabel ascii tl where build (label , tl') = (bLtzSI label , tl')
+ 80 parseInstructionFlowControl _ (T : N : tl) = pure (returnI , tl)
+ 81 parseInstructionFlowControl _ (N : N : tl) = pure (End , tl)
+ 82 parseInstructionFlowControl _ tl = unrecognisedTokensIn "parseInstructionFlowControl" tl
+ 83
+ 84 parseInstructionIO :: MonadSafe m => InstructionParser m
+ 85 parseInstructionIO (S : S : tl) = pure (sOutputI , tl)
+ 86 parseInstructionIO (S : T : tl) = pure (sOutputDecI , tl)
+ 87 parseInstructionIO (T : S : tl) = pure (mInputI , tl)
+ 88 parseInstructionIO (T : T : tl) = pure (mInputDecI , tl)
+ 89 parseInstructionIO tl = unrecognisedTokensIn "parseInstructionIO" tl
+ 90
+ 91 unrecognisedTokensIn :: MonadSafe m => Text -> TokenList -> m a
+ 92 unrecognisedTokensIn name tl = liftErrorTupleList [("Unrecognised tokens in" , name) , ("Rest tokens" , show tl)]
+ 93
+ 94 type InstructionParser m = ParserFromTokenList m Instruction
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.SimpleParams.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.SimpleParams.hs.html
new file mode 100644
index 000000000..b48ae1fc6
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.SimpleParams.hs.html
@@ -0,0 +1,73 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.WhiteSpace.SimpleParams where
+ 2
+ 3 import HelVM.HelMA.Automaton.API.AutoOptions
+ 4 import qualified HelVM.HelMA.Automaton.API.AutomatonOptions as Automaton
+ 5 import HelVM.HelMA.Automaton.API.IOTypes
+ 6
+ 7 import HelVM.HelMA.Automaton.Types.FormatType
+ 8 import HelVM.HelMA.Automaton.Types.RAMType
+ 9 import HelVM.HelMA.Automaton.Types.StackType
+ 10 import HelVM.HelMA.Automaton.Types.TokenType
+ 11
+ 12 -- | Construction for tests
+ 13 simpleParamsWithDefaultsAndWhiteTokenType :: FormatType -> Source -> SimpleParams
+ 14 simpleParamsWithDefaultsAndWhiteTokenType = simpleParamsWithDefaults WhiteTokenType
+ 15
+ 16 simpleParamsWithDefaultsAndVisibleTokenType :: FormatType -> Source -> SimpleParams
+ 17 simpleParamsWithDefaultsAndVisibleTokenType = simpleParamsWithDefaults VisibleTokenType
+ 18
+ 19 simpleParamsWithDefaults :: TokenType -> FormatType -> Source -> SimpleParams
+ 20 simpleParamsWithDefaults tt = simpleParams tt (defaultStackType , defaultRAMType)
+ 21
+ 22 -- | Construction for benchmark
+ 23 simpleParamsWithWhiteTokenType :: (StackType, RAMType) -> FormatType -> Source -> SimpleParams
+ 24 simpleParamsWithWhiteTokenType = simpleParams WhiteTokenType
+ 25
+ 26 simpleParamsWithVisibleTokenType :: (StackType, RAMType) -> FormatType -> Source -> SimpleParams
+ 27 simpleParamsWithVisibleTokenType = simpleParams VisibleTokenType
+ 28
+ 29 automatonOptions :: SimpleParams -> Automaton.AutomatonOptions
+ 30 automatonOptions p = Automaton.AutomatonOptions (stackType p) (ramType p) (autoOptions p)
+ 31
+ 32 simpleParams :: TokenType -> (StackType, RAMType) -> FormatType -> Source -> SimpleParams
+ 33 simpleParams tt (st , rt) al s = SimpleParams
+ 34 { tokenType = tt
+ 35 , source = s
+ 36 , formatType = al
+ 37 , stackType = st
+ 38 , ramType = rt
+ 39 , autoOptions = simpleAutoParams
+ 40 }
+ 41
+ 42 -- | Type
+ 43 data SimpleParams = SimpleParams
+ 44 { tokenType :: !TokenType
+ 45 , source :: !Source
+ 46 , formatType :: !FormatType
+ 47 , stackType :: !StackType
+ 48 , ramType :: !RAMType
+ 49 , autoOptions :: !AutoOptions
+ 50 }
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Token.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Token.hs.html
new file mode 100644
index 000000000..6cb7c3008
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.WhiteSpace.Token.hs.html
@@ -0,0 +1,66 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.WhiteSpace.Token where
+ 2
+ 3 import HelVM.HelIO.Collections.SList
+ 4 import HelVM.HelIO.Control.Safe
+ 5 import HelVM.HelIO.Digit.ToDigit
+ 6
+ 7 import Text.Read
+ 8
+ 9 import qualified Text.Show
+ 10
+ 11 data Token = S | T | N
+ 12 deriving stock (Bounded , Enum , Eq , Read , Show)
+ 13
+ 14 type TokenList = [Token]
+ 15 type TokenSList = SList Token
+ 16
+ 17 instance ToDigit Token where
+ 18 toDigit S = pure 0
+ 19 toDigit T = pure 1
+ 20 toDigit t = liftErrorWithPrefix "Wrong token" $ show t
+ 21
+ 22 ----
+ 23
+ 24 newtype WhiteToken = WhiteToken { unWhiteToken :: Token}
+ 25 deriving stock (Eq)
+ 26
+ 27 instance Show WhiteToken where
+ 28 show (WhiteToken S) = " "
+ 29 show (WhiteToken T) = "\t"
+ 30 show (WhiteToken N) = "\n"
+ 31
+ 32 -- | Scanner
+ 33 instance Read WhiteToken where
+ 34 readsPrec _ " " = [( WhiteToken S , "")]
+ 35 readsPrec _ "\t" = [( WhiteToken T , "")]
+ 36 readsPrec _ "\n" = [( WhiteToken N , "")]
+ 37 readsPrec _ _ = []
+ 38
+ 39 type WhiteTokenList = [WhiteToken]
+ 40
+ 41 whiteTokenListToTokenList :: WhiteTokenList -> TokenList
+ 42 whiteTokenListToTokenList = fmap unWhiteToken
+ 43
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Automaton.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Automaton.hs.html
new file mode 100644
index 000000000..cb2d7bf2d
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Automaton.hs.html
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.Zot.Automaton (
+ 2 evalParams,
+ 3 evalWithFormat,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automata.Zot.Evaluator
+ 7 import HelVM.HelMA.Automata.Zot.Expression
+ 8 import HelVM.HelMA.Automata.Zot.Parser
+ 9
+ 10 import HelVM.HelMA.Automaton.API.EvalParams
+ 11 import HelVM.HelMA.Automaton.API.IOTypes
+ 12
+ 13 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 14
+ 15 import HelVM.HelMA.Automaton.Types.FormatType
+ 16
+ 17 import HelVM.HelIO.Containers.Extra
+ 18 import HelVM.HelIO.Control.Safe
+ 19
+ 20 import HelVM.HelIO.Digit.Digitable
+ 21 import HelVM.HelIO.Digit.ToDigit
+ 22
+ 23 import HelVM.HelIO.ListLikeExtra
+ 24
+ 25 import Control.Monad.Writer.Lazy
+ 26
+ 27 import qualified Data.Text.Lazy as LT
+ 28
+ 29 evalParams :: BIO m => EvalParams -> m ()
+ 30 evalParams p = wPutStr =<< evalWithFormat (formatType p) (source p) =<< wGetContentsText
+ 31
+ 32 evalWithFormat :: MonadSafe m => FormatType -> Source -> LT.Text -> m Output
+ 33 evalWithFormat BinaryLabel source input = pure $ showFoldable $ evalInternal source input
+ 34 evalWithFormat TextLabel source input = (makeAsciiText28 . convert . evalInternal source) . showExpressionList =<< stringToDL (toString input)
+ 35
+ 36 evalInternal :: Source -> LT.Text -> ExpressionDList
+ 37 evalInternal source input = eval $ fromStrict source <> input
+ 38
+ 39 eval :: LT.Text -> ExpressionDList
+ 40 eval = execWriter . runExpressionList . parse
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Evaluator.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Evaluator.hs.html
new file mode 100644
index 000000000..7fbaabb92
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Evaluator.hs.html
@@ -0,0 +1,96 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.Zot.Evaluator (
+ 2 runExpressionList,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automata.Zot.Expression
+ 6
+ 7 import Control.Monad.Writer.Lazy
+ 8
+ 9 import qualified Data.ListLike as LL
+ 10
+ 11 -- | High-level Expressions
+ 12 runExpressionList :: ExpressionList -> Out Expression
+ 13 runExpressionList el = foldExpression el >><< outputExpression >>< printExpression
+ 14
+ 15 foldExpression :: ExpressionList -> Out Expression
+ 16 foldExpression = foldM (><) emptyExpression
+ 17
+ 18 emptyExpression :: Expression
+ 19 emptyExpression = contExpression iExpression
+ 20
+ 21 outputExpression :: Out Expression
+ 22 outputExpression = kExpression ><< kExpression ><< kExpression ><< kExpression ><< kExpression ><< kExpression >< iExpression
+ 23
+ 24 printExpression :: Expression
+ 25 printExpression = Expression innerPrintExpression
+ 26
+ 27 innerPrintExpression :: Expression -> Out Expression
+ 28 innerPrintExpression f = interrogateExpression f >>< Zero >>< One >>= tell . LL.singleton >> pure printExpression
+ 29
+ 30 interrogateExpression :: Expression -> Out Expression
+ 31 interrogateExpression f = f >< iExpression >>< iExpression >>< iExpression >>< kExpression
+ 32
+ 33 -- | Operators
+ 34 infixl 9 ><
+ 35 (><) :: Expression -> Expression -> Out Expression
+ 36 (><) Zero = (zeroExpression ><)
+ 37 (><) One = (oneExpression ><)
+ 38 (><) (Expression f) = f
+ 39
+ 40 infixl 6 >><
+ 41 (>><) :: Out Expression -> Expression -> Out Expression
+ 42 f >>< a = f >>= (>< a)
+ 43
+ 44 infixr 8 ><<
+ 45 (><<) :: Expression -> Out Expression -> Out Expression
+ 46 f ><< a = (f ><) =<< a
+ 47
+ 48 infixl 7 >><<
+ 49 (>><<) :: Out Expression -> Out Expression -> Out Expression
+ 50 f >><< a = f >>= (><< a)
+ 51
+ 52
+ 53 -- | Low-level Expressions
+ 54 zeroExpression :: Expression
+ 55 zeroExpression = contExpression $ Expression $ \ f -> f >< sExpression >>< kExpression
+ 56
+ 57 oneExpression :: Expression
+ 58 oneExpression = makeExpression $ \c -> contExpression $ makeExpression $ \l -> contExpression $ Expression $ \r -> c ><< l >< r
+ 59
+ 60 contExpression :: Expression -> Expression
+ 61 contExpression = Expression . flip (><)
+ 62
+ 63 sExpression :: Expression
+ 64 sExpression = makeExpression $ \x -> makeExpression $ \y -> Expression $ \z -> x >< z >><< y >< z
+ 65
+ 66 kExpression :: Expression
+ 67 kExpression = makeExpression $ makeExpression . const
+ 68
+ 69 iExpression :: Expression
+ 70 iExpression = makeExpression id
+ 71
+ 72 makeExpression :: (Expression -> Expression) -> Expression
+ 73 makeExpression f = Expression $ pure . f
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Expression.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Expression.hs.html
new file mode 100644
index 000000000..c593bd870
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Expression.hs.html
@@ -0,0 +1,87 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.Zot.Expression where
+ 2
+ 3 import HelVM.HelIO.Control.Safe
+ 4
+ 5 import HelVM.HelIO.Containers.Extra
+ 6 import HelVM.HelIO.Digit.Digitable
+ 7 import HelVM.HelIO.Digit.ToDigit
+ 8
+ 9 import Control.Monad.Writer.Lazy
+ 10
+ 11 import qualified Data.DList as D
+ 12 import qualified Data.Text.Lazy as LT
+ 13 import Text.Read
+ 14 import qualified Text.Show
+ 15
+ 16 showExpressionList :: ExpressionList -> LT.Text
+ 17 showExpressionList f = fmconcat $ show <$> f
+ 18
+ 19 readExpressionList :: LT.Text -> ExpressionList
+ 20 readExpressionList = stringToExpressionList . toString
+ 21
+ 22 stringToExpressionList :: String -> ExpressionList
+ 23 stringToExpressionList s = charToExpressionList =<< s
+ 24
+ 25 charToExpressionList :: Char -> ExpressionList
+ 26 charToExpressionList = maybeToList . rightToMaybe . charToExpressionSafe
+ 27
+ 28 charToExpression :: Char -> Expression
+ 29 charToExpression = unsafe . charToExpressionSafe
+ 30
+ 31 charToExpressionSafe :: MonadSafe m => Char -> m Expression
+ 32 charToExpressionSafe '0' = pure Zero
+ 33 charToExpressionSafe '1' = pure One
+ 34 charToExpressionSafe c = liftErrorWithPrefix "charToExpression" $ one c
+ 35
+ 36 -- | Types
+ 37 type ExpressionDList = D.DList Expression
+ 38
+ 39 type ExpressionList = [Expression]
+ 40
+ 41 data Expression = Zero | One | Expression (Expression -> Out Expression)
+ 42
+ 43 type Out = Writer ExpressionDList
+ 44
+ 45 instance Read Expression where
+ 46 readsPrec _ [] = []
+ 47 readsPrec _ (c : s) = [(charToExpression c , s)]
+ 48 readList s = [(stringToExpressionList s , "")]
+ 49
+ 50 instance Show Expression where
+ 51 show Zero = "0"
+ 52 show One = "1"
+ 53 show (Expression _) = "function"
+ 54 showList fs = (concatMap show fs <>)
+ 55
+ 56 instance Digitable Expression where
+ 57 fromDigit 0 = pure Zero
+ 58 fromDigit 1 = pure One
+ 59 fromDigit t = wrongToken t
+ 60
+ 61 instance ToDigit Expression where
+ 62 toDigit Zero = pure 0
+ 63 toDigit One = pure 1
+ 64 toDigit t = wrongToken t
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Parser.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Parser.hs.html
new file mode 100644
index 000000000..a4e439887
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automata.Zot.Parser.hs.html
@@ -0,0 +1,42 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automata.Zot.Parser (
+ 2 parse,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automata.Zot.Expression
+ 6
+ 7 import qualified Data.Text.Lazy as LT
+ 8
+ 9 parse :: LT.Text -> ExpressionList
+ 10 parse = concatMap parseLine . LT.lines
+ 11
+ 12 parseLine :: LT.Text -> ExpressionList
+ 13 parseLine = readExpressionList . filter01 . LT.takeWhile (/= '#')
+ 14
+ 15 filter01 :: LT.Text -> LT.Text
+ 16 filter01 = LT.filter is01
+ 17
+ 18 is01 :: Char -> Bool
+ 19 is01 c = c == '0' || c == '1'
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.AutoOptions.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.AutoOptions.hs.html
new file mode 100644
index 000000000..b98ec6c21
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.AutoOptions.hs.html
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.API.AutoOptions where
+ 2
+ 3 import HelVM.HelMA.Automaton.API.OptimizationLevel
+ 4 import HelVM.HelMA.Automaton.Loop
+ 5 import HelVM.HelMA.Automaton.Types.DumpType
+ 6
+ 7 simpleAutoParams :: AutoOptions
+ 8 simpleAutoParams = AutoOptions
+ 9 { optLevel = AllOptimizations
+ 10 , limit = testMaybeLimit
+ 11 , dumpType = Pretty
+ 12 }
+ 13
+ 14 data AutoOptions = AutoOptions
+ 15 { optLevel :: OptimizationLevel
+ 16 , limit :: LimitMaybe
+ 17 , dumpType :: DumpType
+ 18 }
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.AutomatonOptions.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.AutomatonOptions.hs.html
new file mode 100644
index 000000000..bee737adb
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.AutomatonOptions.hs.html
@@ -0,0 +1,45 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.API.AutomatonOptions where
+ 2
+ 3 import HelVM.HelMA.Automaton.API.AutoOptions
+ 4 import HelVM.HelMA.Automaton.API.OptimizationLevel
+ 5 import HelVM.HelMA.Automaton.Types.RAMType
+ 6 import HelVM.HelMA.Automaton.Types.StackType
+ 7
+ 8 optLevelAutoOptions :: AutomatonOptions -> OptimizationLevel
+ 9 optLevelAutoOptions = optLevel . autoOptions
+ 10
+ 11 withDefaultRam :: StackType -> AutoOptions -> AutomatonOptions
+ 12 withDefaultRam s ao = AutomatonOptions
+ 13 { ramType = defaultRAMType
+ 14 , stackType = s
+ 15 , autoOptions = ao
+ 16 }
+ 17
+ 18 data AutomatonOptions = AutomatonOptions
+ 19 { stackType :: StackType
+ 20 , ramType :: RAMType
+ 21 , autoOptions :: AutoOptions
+ 22 }
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.EvalParams.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.EvalParams.hs.html
new file mode 100644
index 000000000..303cf1b4f
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.EvalParams.hs.html
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.API.EvalParams where
+ 2
+ 3 import HelVM.HelMA.Automaton.API.AutoOptions
+ 4 import qualified HelVM.HelMA.Automaton.API.AutomatonOptions as Automaton
+ 5 import HelVM.HelMA.Automaton.API.IOTypes
+ 6 import HelVM.HelMA.Automaton.API.MemoryOptions
+ 7
+ 8 import HelVM.HelMA.Automaton.Types.CellType
+ 9 import HelVM.HelMA.Automaton.Types.DumpType
+ 10 import HelVM.HelMA.Automaton.Types.FormatType
+ 11 import HelVM.HelMA.Automaton.Types.IntCellType
+ 12 import HelVM.HelMA.Automaton.Types.RAMType
+ 13 import HelVM.HelMA.Automaton.Types.StackType
+ 14
+ 15 -- | Accessors
+ 16 ramAutoOptions :: EvalParams -> RAMType
+ 17 ramAutoOptions = ram . memoryOptions
+ 18
+ 19 stackAutoOptions :: EvalParams -> StackType
+ 20 stackAutoOptions = stack . memoryOptions
+ 21
+ 22 cellAutoOptions :: EvalParams -> CellType
+ 23 cellAutoOptions = cell . memoryOptions
+ 24
+ 25 intCellAutoOptions :: EvalParams -> IntCellType
+ 26 intCellAutoOptions = intCell . memoryOptions
+ 27
+ 28 dumpAutoOptions :: EvalParams -> DumpType
+ 29 dumpAutoOptions = dumpType . autoOptions
+ 30
+ 31 automatonOptions :: EvalParams -> Automaton.AutomatonOptions
+ 32 automatonOptions p = Automaton.AutomatonOptions (stackAutoOptions p) (ramAutoOptions p) (autoOptions p)
+ 33
+ 34 -- | Type
+ 35 data EvalParams = EvalParams
+ 36 { formatType :: !FormatType
+ 37 , source :: !Source
+ 38 , memoryOptions :: !MemoryOptions
+ 39 , autoOptions :: !AutoOptions
+ 40 }
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.MemoryOptions.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.MemoryOptions.hs.html
new file mode 100644
index 000000000..fee9a0b3e
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.MemoryOptions.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.API.MemoryOptions where
+ 2
+ 3 import HelVM.HelMA.Automaton.Types.CellType
+ 4 import HelVM.HelMA.Automaton.Types.IntCellType
+ 5 import HelVM.HelMA.Automaton.Types.RAMType
+ 6 import HelVM.HelMA.Automaton.Types.StackType
+ 7
+ 8 -- | Types
+ 9 data MemoryOptions = MemoryOptions
+ 10 { ram :: !RAMType
+ 11 , stack :: !StackType
+ 12 , cell :: !CellType
+ 13 , intCell :: !IntCellType
+ 14 }
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.OptimizationLevel.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.OptimizationLevel.hs.html
new file mode 100644
index 000000000..96e2b9243
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.API.OptimizationLevel.hs.html
@@ -0,0 +1,54 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.API.OptimizationLevel where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 import HelVM.HelIO.Containers.LLIndexSafe
+ 6
+ 7 -- | Constructors
+ 8
+ 9 implementedOptimizationLevels :: [OptimizationLevel]
+ 10 implementedOptimizationLevels = [NoOptimizations , BasicOptimizations]
+ 11
+ 12 fromBool :: Bool -> OptimizationLevel
+ 13 fromBool = enumFromBool
+ 14
+ 15 fromNatural :: Natural -> OptimizationLevel
+ 16 fromNatural = fromMaybe AllOptimizations . indexMaybe optimizationLevels . fromIntegral
+ 17
+ 18 defaultOptimizationLevel :: OptimizationLevel
+ 19 defaultOptimizationLevel = defaultEnum
+ 20
+ 21 optimizationLevels :: [OptimizationLevel]
+ 22 optimizationLevels = generateEnums 4
+ 23
+ 24 -- | Types
+ 25
+ 26 data OptimizationLevel =
+ 27 NoOptimizations
+ 28 | BasicOptimizations
+ 29 | SomeOptimizations
+ 30 | AllOptimizations
+ 31 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Automaton.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Automaton.hs.html
new file mode 100644
index 000000000..3d41e424c
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Automaton.hs.html
@@ -0,0 +1,87 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Automaton (
+ 2 start,
+ 3 runAndDumpLogs,
+ 4 run,
+ 5 ) where
+ 6
+ 7 import HelVM.HelMA.Automaton.API.AutoOptions
+ 8 import HelVM.HelMA.Automaton.API.AutomatonOptions
+ 9
+ 10 import HelVM.HelMA.Automaton.Instruction
+ 11
+ 12 import HelVM.HelMA.Automaton.IO.AutomatonIO
+ 13 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 14
+ 15 import HelVM.HelMA.Automaton.Loop as Loop
+ 16 import HelVM.HelMA.Automaton.Optimizer
+ 17 import HelVM.HelMA.Automaton.Symbol
+ 18
+ 19 import HelVM.HelMA.Automaton.Types.DumpType
+ 20 import HelVM.HelMA.Automaton.Types.RAMType
+ 21 import HelVM.HelMA.Automaton.Types.StackType
+ 22
+ 23 import HelVM.HelMA.Automaton.Combiner
+ 24 import HelVM.HelMA.Automaton.Combiner.CPU as CPU
+ 25
+ 26 import qualified HelVM.HelIO.Collections.MapList as MapList
+ 27 import qualified HelVM.HelIO.Collections.SList as SList
+ 28
+ 29 import HelVM.HelIO.Control.Safe
+ 30
+ 31 import HelVM.HelIO.Extra
+ 32
+ 33 import Control.Monad.Extra
+ 34
+ 35 import qualified Data.Sequence as Seq
+ 36
+ 37 import Prelude hiding (swap)
+ 38
+ 39 start :: BIO m => InstructionList -> AutomatonOptions -> m ()
+ 40 start il ao = start' (flip optimize il $ optLevelAutoOptions ao) (stackType ao) (ramType ao) (autoOptions ao)
+ 41
+ 42 start' :: BIO m => InstructionList -> StackType -> RAMType -> AutoOptions -> m ()
+ 43 start' il s ListRAMType = start'' il s []
+ 44 start' il s SeqRAMType = start'' il s Seq.empty
+ 45 start' il s SListRAMType = start'' il s SList.sListEmpty
+ 46 start' il s MapListRAMType = start'' il s MapList.mapListEmpty
+ 47
+ 48 start'' :: (RAutomatonIO Symbol r m) => InstructionList -> StackType -> r -> AutoOptions -> m ()
+ 49 start'' il ListStackType = start''' il []
+ 50 start'' il SeqStackType = start''' il Seq.empty
+ 51 start'' il SListStackType = start''' il SList.sListEmpty
+ 52
+ 53 start''' :: (SRAutomatonIO Symbol s r m) => InstructionList -> s -> r -> AutoOptions -> m ()
+ 54 start''' il s r p = runAndDumpLogs p (newMemory il s r)
+ 55
+ 56 runAndDumpLogs :: (SRAutomatonIO Symbol s r m) => AutoOptions -> Memory s r -> m ()
+ 57 runAndDumpLogs p = logDump (dumpType p) <=< run (limit p)
+ 58
+ 59 run :: (SRAutomatonIO Symbol s r m) => LimitMaybe -> F s r m
+ 60 run = loopMWithLimit nextState
+ 61
+ 62 nextState :: (SRAutomatonIO Symbol s r m) => SF s r m
+ 63 nextState a = nextStateForInstruction =<< currentInstruction (memoryCM a) where
+ 64 nextStateForInstruction i = appendErrorTupleList [("i" , show i ) , ("Automaton.nextState" , showP a)] $ runInstruction i $ incrementIC a
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.ALU.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.ALU.hs.html
new file mode 100644
index 000000000..64160e044
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.ALU.hs.html
@@ -0,0 +1,212 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Combiner.ALU (
+ 2 runALI,
+ 3 runSAL,
+ 4
+ 5 doOutputChar2,
+ 6 doInputChar2,
+ 7 doInputDec2,
+ 8 divMod,
+ 9 sub,
+ 10 binaryInstruction,
+ 11 binaryInstructions,
+ 12 halibut,
+ 13 move,
+ 14 discard,
+ 15 slide,
+ 16 copy,
+ 17 flipPush1,
+ 18 charPush1,
+ 19 genericPush1,
+ 20 pop1,
+ 21 pop2,
+ 22 push1,
+ 23 push2,
+ 24 splitAt,
+ 25 drop,
+ 26 ALU,
+ 27 SafeStack,
+ 28 Stack,
+ 29 ) where
+ 30
+ 31 import HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
+ 32 import HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
+ 33
+ 34 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 35
+ 36 import HelVM.HelIO.Control.Safe
+ 37
+ 38 import HelVM.HelIO.Containers.LLIndexSafe
+ 39
+ 40 import HelVM.HelIO.ListLikeExtra
+ 41
+ 42 import Control.Applicative.Tools
+ 43 import Data.ListLike hiding (show)
+ 44 import Prelude hiding (divMod, drop, fromList, length, splitAt, swap)
+ 45
+ 46
+ 47 runALI :: ALU m ll element => SMInstruction -> ll -> m ll
+ 48 runALI (SPure ali) = runSAL ali
+ 49 runALI (SIO ioi) = runSIO ioi
+ 50
+ 51 runSIO :: ALU m ll element => IOInstruction -> ll -> m ll
+ 52 runSIO OutputChar = doOutputChar2
+ 53 runSIO OutputDec = doOutputDec2
+ 54 runSIO InputChar = doInputChar2
+ 55 runSIO InputDec = doInputDec2
+ 56
+ 57 runSAL :: SafeStack m ll element => SPureInstruction -> ll -> m ll
+ 58 runSAL (Cons i ) = push i
+ 59 runSAL (Unary op ) = unaryInstruction op
+ 60 runSAL (Binary op ) = binaryInstruction op
+ 61 runSAL (Binaries ops ) = binaryInstructions ops
+ 62 runSAL (Indexed t op) = indexedInstruction op t
+ 63 runSAL Halibut = halibut
+ 64 runSAL Pick = pick
+ 65 runSAL Discard = discard
+ 66
+ 67 -- | Arithmetic instructions
+ 68 unaryInstruction :: SafeStack m ll element => UnaryOperation -> ll -> m ll
+ 69 unaryInstruction (UImmediate i op) = build <.> pop1 where
+ 70 build (e , l) = push1 (calculateOp (fromInteger i) e op) l
+ 71 unaryInstruction op = error $ show op
+ 72
+ 73 divMod :: SafeStack m ll element => ll -> m ll
+ 74 divMod = binaryInstructions [Mod , Div]
+ 75
+ 76 sub :: SafeStack m ll element => ll -> m ll
+ 77 sub = binaryInstruction Sub
+ 78
+ 79 binaryInstruction :: SafeStack m ll element => BinaryOperation -> ll -> m ll
+ 80 binaryInstruction i = binaryInstructions [i]
+ 81
+ 82 binaryInstructions :: SafeStack m ll element => [BinaryOperation] -> ll -> m ll
+ 83 binaryInstructions il = build <.> pop2 where
+ 84 build (e , e', l) = pushList (calculateOps e e' il) l
+ 85
+ 86 -- | IO instructions
+ 87 doOutputChar2 :: ALU m ll element => ll -> m ll
+ 88 doOutputChar2 = appendError "ALU.doOutputChar2" . build <=< pop1 where
+ 89 build (e , l) = wPutAsChar e $> l
+ 90
+ 91 doOutputDec2 :: ALU m ll element => ll -> m ll
+ 92 doOutputDec2 = appendError "ALU.doOutputDec2" . build <=< pop1 where
+ 93 build (e , l) = wPutAsDec e $> l
+ 94
+ 95 doInputChar2 :: ALU m ll element => ll -> m ll
+ 96 doInputChar2 l = appendError "ALU.doOutputDec2" $ build <$> wGetCharAs where
+ 97 build e = push1 e l
+ 98
+ 99 doInputDec2 :: ALU m ll element => ll -> m ll
+ 100 doInputDec2 l = build <$> wGetCharAs where
+ 101 build e = push1 e l
+ 102
+ 103 indexedInstruction :: SafeStack m ll element => IndexedOperation -> IndexOperand -> ll -> m ll
+ 104 indexedInstruction i ITop = indexedInstructionTop i
+ 105 indexedInstruction i (IImmediate n) = indexedInstructionImmediate i n
+ 106
+ 107 -- | Indexed instructions
+ 108 indexedInstructionTop :: SafeStack m ll element => IndexedOperation -> ll -> m ll
+ 109 indexedInstructionTop op = appendError "ALU.indexedInstructionTop" . build <=< unconsSafe where
+ 110 build (e , l) = indexedInstructionImmediate op (fromIntegral e) l
+ 111
+ 112 indexedInstructionImmediate :: SafeStack m ll element => IndexedOperation -> Index -> ll -> m ll
+ 113 indexedInstructionImmediate Copy = copy
+ 114 indexedInstructionImmediate Move = move
+ 115 indexedInstructionImmediate Slide = slide
+ 116
+ 117 -- | Halibut and Pick instructions
+ 118 halibut :: SafeStack m ll element => ll -> m ll
+ 119 halibut = appendError "ALU.halibut" . build <=< pop1 where
+ 120 build (e , l)
+ 121 | 0 < i = move i l
+ 122 | otherwise = copy (negate i) l
+ 123 where i = fromIntegral e
+ 124
+ 125 pick :: SafeStack m ll element => ll -> m ll
+ 126 pick = appendError "ALU.pick" . build <=< pop1 where
+ 127 build (e , l)
+ 128 | 0 <= i = copy i l
+ 129 | otherwise = move (negate i) l
+ 130 where i = fromIntegral e
+ 131
+ 132 -- | Slide instructions
+ 133 slide :: SafeStack m ll element => Index -> ll -> m ll
+ 134 slide i = appendError "ALU.pop2" . build <.> pop1 where
+ 135 build (e , l) = push1 e $ drop i l
+ 136
+ 137 -- | Move instructions
+ 138 move :: SafeStack m ll element => Index -> ll -> m ll
+ 139 move i l = build $ length l where
+ 140 build ll
+ 141 | ll <= i = liftErrorWithTupleList "ALU.move index must be less then lenght" [("i" , show i) , ("ll" , show ll)]
+ 142 | otherwise = pure $ l1 <> l2 <> l3 where
+ 143 (l1 , l3) = splitAt 1 l'
+ 144 (l2 , l') = splitAt i l
+ 145
+ 146 -- | Copy instructions
+ 147 copy :: SafeStack m ll element => Index -> ll -> m ll
+ 148 copy i = teeMap flipPush1 (findSafe i)
+ 149
+ 150 -- | Pop instructions
+ 151 pop1 :: SafeStack m ll element => ll -> m (element , ll)
+ 152 pop1 = appendError "ALU.pop1" . unconsSafe
+ 153
+ 154 pop2 :: SafeStack m ll element => ll -> m (element , element , ll)
+ 155 pop2 = appendError "ALU.pop2" . uncons2Safe
+ 156
+ 157 -- | Push instructions
+ 158 push :: SafeStack m ll element => Integer -> ll -> m ll
+ 159 push i = pure . genericPush1 i
+ 160
+ 161 flipPush1 :: Stack ll element => ll -> element -> ll
+ 162 flipPush1 = flip push1
+ 163
+ 164 charPush1 :: (Num element , Stack ll element) => Char -> ll -> ll
+ 165 charPush1 = genericPush1 . ord
+ 166
+ 167 genericPush1 :: (Integral v , Num element , Stack ll element) => v -> ll -> ll
+ 168 genericPush1 = push1 . fromIntegral
+ 169
+ 170 push1 :: Stack ll element => element -> ll -> ll
+ 171 push1 e = pushList [e]
+ 172
+ 173 push2 :: Stack ll element => element -> element -> ll -> ll
+ 174 push2 e e' = pushList [e , e']
+ 175
+ 176 pushList :: Stack ll element => [element] -> ll -> ll
+ 177 pushList es l = fromList es <> l
+ 178
+ 179 teeMap :: Functor f => (t -> a -> b) -> (t -> f a) -> t -> f b
+ 180 teeMap f2 f1 x = f2 x <$> f1 x
+ 181
+ 182 -- | Types
+ 183 type ALU m ll element = (BIO m , SafeStack m ll element)
+ 184
+ 185 type SafeStack m ll element = (MonadSafe m , IntegralStack ll element)
+ 186
+ 187 type IntegralStack ll element = (Stack ll element , Integral element)
+ 188
+ 189 type Stack ll element = (Show ll , ListLike ll element , IndexSafe ll element)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.CPU.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.CPU.hs.html
new file mode 100644
index 000000000..a1b19fb28
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.CPU.hs.html
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Combiner.CPU where
+ 2
+ 3 import HelVM.HelMA.Automaton.Combiner.ALU
+ 4
+ 5 import HelVM.HelMA.Automaton.Instruction
+ 6 import HelVM.HelMA.Automaton.Instruction.Extras.Patterns
+ 7 import HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
+ 8
+ 9 import HelVM.HelIO.Containers.LLIndexSafe
+ 10 import HelVM.HelIO.Control.Safe
+ 11
+ 12 import Control.Type.Operator
+ 13
+ 14 import Data.ListLike hiding (show)
+ 15 import qualified Data.Vector as Vector
+ 16
+ 17 runCFI :: (ALU m ll element , Show element) => CFInstruction -> CentralProcessingStep ll m
+ 18 runCFI (Mark _) = pure
+ 19 runCFI (Branch o t) = branchInstruction t o
+ 20 runCFI (Labeled o i) = labeledInstruction i o
+ 21 runCFI Return = popAddress
+ 22
+ 23 popAddress :: ALU m ll element => CentralProcessingMemory ll -> m $ CentralProcessingMemory ll
+ 24 popAddress (CPM (CM il _ (IS (a : is))) s) = pure $ CPM (CM il a $ IS is) s
+ 25 popAddress (CPM (CM il _ (IS [] )) _) = liftErrorWithTupleList "Empty Return Stack" [("il" , show il)]
+ 26
+ 27 --
+ 28
+ 29 branchInstruction :: (ALU m ll element , Show element) => BranchTest -> BranchOperand -> CentralProcessingStep ll m
+ 30 branchInstruction t BSwapped = branchSwappedInstruction t
+ 31 branchInstruction t BTop = branchTopInstruction t
+ 32 branchInstruction t (BImmediate l) = branchImmediateInstruction t l
+ 33 branchInstruction t (BArtificial l) = branchArtificialInstruction t l
+ 34
+ 35 branchSwappedInstruction :: (ALU m ll element , Show element) => BranchTest -> CentralProcessingStep ll m
+ 36 branchSwappedInstruction t cpm = appendError "CPM.branchSwappedInstruction" $ build =<< cpmPop2 cpm where
+ 37 build (e , l , cpm') = branch t e (findAddressForNaturalLabel l (cpmProgram cpm')) cpm'
+ 38
+ 39 branchTopInstruction :: (ALU m ll element , Show element) => BranchTest -> CentralProcessingStep ll m
+ 40 branchTopInstruction t cpm = appendError "CPM.branchTopInstruction" $ build =<< cpmPop2 cpm where
+ 41 build (l , e , cpm') = branch t e (findAddressForNaturalLabel l (cpmProgram cpm')) cpm'
+ 42
+ 43 branchImmediateInstruction :: (ALU m ll element , DynamicLabel l) => BranchTest -> l -> CentralProcessingStep ll m
+ 44 branchImmediateInstruction t l cpm = appendError "CPM.branchImmediateInstruction" $ build =<< cpmPop1 cpm where
+ 45 build (e , cpm') = branch t e (findAddressForNaturalLabel l (cpmProgram cpm')) cpm'
+ 46
+ 47 branchArtificialInstruction :: (ALU m ll element) => BranchTest -> Label -> CentralProcessingStep ll m
+ 48 branchArtificialInstruction t l cpm = appendError "CPM.branchArtificialInstruction" $ build =<< cpmPop1 cpm where
+ 49 build (e , cpm') = branch t e (findAddressForArtificialLabel l (cpmProgram cpm')) cpm'
+ 50
+ 51 branch :: (ALU m ll element) => BranchTest -> element -> m InstructionCounter -> CentralProcessingStep ll m
+ 52 branch t e icM cpm
+ 53 | isJump t e = flip jump cpm <$> icM
+ 54 | otherwise = pure cpm
+ 55
+ 56 --
+ 57
+ 58 labeledInstruction :: (ALU m ll element , Show element) => LabelOperation -> LabelOperand -> CentralProcessingStep ll m
+ 59 labeledInstruction i LTop = labeledTopInstruction i
+ 60 labeledInstruction i (LImmediate l) = labeledImmediateInstruction i l
+ 61 labeledInstruction i (LArtificial l) = labeledArtificialInstruction i l
+ 62
+ 63 labeledTopInstruction :: (ALU m ll element , Show element) => LabelOperation -> CentralProcessingStep ll m
+ 64 labeledTopInstruction i cpm = appendError "CPM.labeledTopInstruction" $ uncurry (labeledImmediateInstruction i) =<< cpmPop1 cpm
+ 65
+ 66 labeledImmediateInstruction :: (ALU m ll element, DynamicLabel l) => LabelOperation -> l -> CentralProcessingStep ll m
+ 67 labeledImmediateInstruction i l cpm = appendError "CPM.labeledImmediateInstruction" $ flip (labeled i) cpm <$> findAddressForNaturalLabel l (cpmProgram cpm)
+ 68
+ 69 labeledArtificialInstruction :: ALU m ll element => LabelOperation -> Label -> CentralProcessingStep ll m
+ 70 labeledArtificialInstruction i l cpm = appendError "CPM.labeledArtificialInstruction" $ flip (labeled i) cpm <$> findAddressForArtificialLabel l (cpmProgram cpm)
+ 71
+ 72 --
+ 73
+ 74 findAddressForNaturalLabel :: (MonadSafe m , DynamicLabel n) => n -> InstructionVector -> m InstructionAddress --FIXME
+ 75 findAddressForNaturalLabel n il
+ 76 | n < 0 = liftError $ show n
+ 77 | otherwise = liftMaybeOrErrorTuple ("Undefined label", show n) $ findIndex (checkNaturalMark $ fromIntegral n) il
+ 78
+ 79 findAddressForArtificialLabel :: MonadSafe m => Label -> InstructionVector -> m InstructionAddress
+ 80 findAddressForArtificialLabel l = liftMaybeOrErrorTuple ("Undefined label", show l) . findIndex (checkArtificialMark l)
+ 81
+ 82 --
+ 83
+ 84 labeled :: LabelOperation -> InstructionCounter -> CentralProcessingMemory ll -> CentralProcessingMemory ll
+ 85 labeled Jump = jump
+ 86 labeled Call = call
+ 87
+ 88 jump :: InstructionCounter -> CentralProcessingMemory ll -> CentralProcessingMemory ll
+ 89 jump a (CPM (CM il _ is) s) = CPM (CM il a is) s
+ 90
+ 91 call :: InstructionCounter -> CentralProcessingMemory ll -> CentralProcessingMemory ll
+ 92 call a (CPM (CM il ic (IS is)) s) = CPM (CM il a (IS (ic : is))) s
+ 93
+ 94 -- | ControlMemory methods
+ 95
+ 96 newCM :: InstructionList -> ControlMemory
+ 97 newCM il = CM (Vector.fromList il) 0 (IS [])
+ 98
+ 99 currentInstruction :: MonadSafe m => ControlMemory -> m Instruction
+ 100 currentInstruction (CM il ic _) = indexSafe il ic
+ 101
+ 102 incrementPC :: ControlMemory -> ControlMemory
+ 103 incrementPC cu = cu { programCounter = 1 + programCounter cu }
+ 104
+ 105 cpmProgram :: CentralProcessingMemory al -> InstructionVector
+ 106 cpmProgram = program . controlMemory
+ 107
+ 108 cpmPop1 :: ALU m ll element => CentralProcessingMemory ll -> m (element , CentralProcessingMemory ll)
+ 109 cpmPop1 (CPM cm s) = build <$> pop1 s where
+ 110 build (l , s') = (l , CPM cm s')
+ 111
+ 112 cpmPop2 :: ALU m ll element => CentralProcessingMemory ll -> m (element , element , CentralProcessingMemory ll)
+ 113 cpmPop2 (CPM cm s) = build <$> pop2 s where
+ 114 build (l1 , l2 , s') = (l1 , l2 , CPM cm s')
+ 115
+ 116 -- | Types
+ 117 type DynamicLabel l = (Integral l , Show l)
+ 118
+ 119 type CentralProcessingStep ll m = CentralProcessingMemory ll -> m $ CentralProcessingMemory ll
+ 120
+ 121 data CentralProcessingMemory ll = CPM
+ 122 { controlMemory :: ControlMemory
+ 123 , alm :: ll
+ 124 }
+ 125 deriving stock (Show)
+ 126
+ 127 data ControlMemory = CM
+ 128 { program :: InstructionVector
+ 129 , programCounter :: InstructionCounter
+ 130 , returnStack :: InstructionStack
+ 131 }
+ 132 deriving stock (Show)
+ 133
+ 134 newtype InstructionStack = IS [InstructionAddress]
+ 135 deriving stock (Show)
+ 136
+ 137 type InstructionCounter = InstructionAddress
+ 138
+ 139 type InstructionAddress = Int
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.LSU.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.LSU.hs.html
new file mode 100644
index 000000000..366c33b84
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.LSU.hs.html
@@ -0,0 +1,76 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Combiner.LSU where
+ 2
+ 3 import HelVM.HelMA.Automaton.Combiner.ALU
+ 4 import qualified HelVM.HelMA.Automaton.Combiner.RAM as RAM
+ 5
+ 6 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 7
+ 8 import HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
+ 9 import HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction
+ 10
+ 11 import HelVM.HelIO.Control.Safe
+ 12
+ 13 import Control.Type.Operator
+ 14
+ 15 runSLI :: (LSU m s r element) => LSInstruction -> LoadStoreMemory s r -> m $ LoadStoreMemory s r
+ 16 runSLI Load = load
+ 17 runSLI Store = store
+ 18 runSLI (MIO OutputChar) = loadOutputChar
+ 19 runSLI (MIO OutputDec) = loadOutputDec
+ 20 runSLI (MIO InputChar) = storeInputChar
+ 21 runSLI (MIO InputDec) = storeInputDec
+ 22
+ 23 load :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
+ 24 load (LSM s r) = appendError "LSM.load" $ build <$> pop1 s where
+ 25 build (address , s') = LSM (push1 (RAM.genericLoad r address) s') r
+ 26
+ 27 store :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
+ 28 store (LSM s r) = appendError "LSM.store" $ build <$> pop2 s where
+ 29 build (value , address , s') = LSM s' $ RAM.store address value r
+ 30
+ 31 loadOutputChar :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
+ 32 loadOutputChar (LSM s r) = appendError "LSM.loadOutputChar" $ build =<< pop1 s where
+ 33 build (address , s') = LSM s' r <$ wPutAsChar (RAM.genericLoad r address)
+ 34
+ 35 loadOutputDec :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
+ 36 loadOutputDec (LSM s r) = appendError "LSM.loadOutputDec" $ build =<< pop1 s where
+ 37 build (address , s') = LSM s' r <$ wPutAsDec (RAM.genericLoad r address)
+ 38
+ 39 storeInputChar :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
+ 40 storeInputChar (LSM s r) = appendError "LSM.storeInputChar" $ build =<< pop1 s where
+ 41 build (address , s') = LSM s' . flip (RAM.store address) r <$> wGetCharAs
+ 42
+ 43 storeInputDec :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
+ 44 storeInputDec (LSM s r) = appendError "LSM.storeInputDec" $ build =<< pop1 s where
+ 45 build (address , s') = LSM s' . flip (RAM.store address) r <$> wGetDecAs
+ 46
+ 47 -- | Types
+ 48 type LSU m s r element = (ALU m s element , RAM.RAM r element)
+ 49
+ 50 data LoadStoreMemory s r = LSM
+ 51 { stack :: s
+ 52 , ram :: r
+ 53 }
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.RAM.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.RAM.hs.html
new file mode 100644
index 000000000..428fcd692
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.RAM.hs.html
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Combiner.RAM (
+ 2 genericLoad,
+ 3 load,
+ 4 flippedStoreChar,
+ 5 storeChar,
+ 6 genericStore,
+ 7 store,
+ 8 fromList,
+ 9 RAM,
+ 10 ) where
+ 11
+ 12 import HelVM.HelIO.Containers.LLIndexSafe
+ 13 import HelVM.HelIO.Containers.LLInsertDef
+ 14
+ 15 import Data.Default
+ 16 import Prelude hiding (divMod, drop, splitAt, swap)
+ 17
+ 18 genericLoad :: (Integral i , RAM ll element) => ll -> i -> element
+ 19 genericLoad l = load l . fromIntegral
+ 20
+ 21 load :: (RAM ll element) => ll -> Address -> element
+ 22 load l i = indexMaybe l i ?: def
+ 23
+ 24 flippedStoreChar :: (Num element , Integral address , RAM ll element) => address -> ll -> Char -> ll
+ 25 flippedStoreChar a = flip (storeChar a)
+ 26
+ 27 storeChar :: (Num element , Integral address , RAM ll element) => address -> Char -> ll -> ll
+ 28 storeChar a char = genericStore a $ ord char
+ 29
+ 30 genericStore :: (Integral value , Num element , Integral address , RAM ll element) => address -> value -> ll -> ll
+ 31 genericStore a v = store a $ fromIntegral v
+ 32
+ 33 store :: (Integral a , RAM ll element) => a -> element -> ll -> ll
+ 34 store = insertDef . fromIntegral
+ 35
+ 36 -- | Types
+ 37 type RAM ll element = (Show ll , Default element , II ll element)
+ 38
+ 39 type II ll element = (InsertDef ll element , IndexSafe ll element)
+ 40
+ 41 type Address = Int
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.hs.html
new file mode 100644
index 000000000..62dadbee7
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Combiner.hs.html
@@ -0,0 +1,110 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Combiner where
+ 2
+ 3 import HelVM.HelMA.Automaton.IO.AutomatonIO
+ 4
+ 5 import HelVM.HelMA.Automaton.Instruction
+ 6
+ 7 import HelVM.HelMA.Automaton.Loop as Loop
+ 8
+ 9 import HelVM.HelMA.Automaton.Symbol
+ 10
+ 11 import HelVM.HelMA.Automaton.Combiner.ALU as ALU
+ 12 import HelVM.HelMA.Automaton.Combiner.CPU as CPU
+ 13 import HelVM.HelMA.Automaton.Combiner.LSU as LSU
+ 14
+ 15 import Control.Type.Operator
+ 16
+ 17 import Prelude hiding (swap)
+ 18
+ 19 -- | Core of Combiner
+ 20
+ 21 runInstruction :: (SRAutomatonIO Symbol s r m) => Instruction -> SF s r m
+ 22 runInstruction (IAL i) a = Loop.continue . updateStack a <$> runALI i (memoryStack a)
+ 23 runInstruction (ILS i) a = Loop.continue . updateFromLSM a <$> runSLI i (toLSM a)
+ 24 runInstruction (ICF i) a = Loop.continue . updateFromCPM a <$> runCFI i (toCPM a)
+ 25 runInstruction End a = end a
+ 26
+ 27 pop2ForStack :: (SRAutomatonIO Symbol s r m) => Memory s r -> m (Symbol , Symbol , Memory s r)
+ 28 pop2ForStack a = build <$> pop2 (memoryStack a) where
+ 29 build (s1 , s2 , s') = (s1 , s2 , updateStack a s')
+ 30
+ 31 push1ForStack :: Stack s Symbol => Symbol -> Memory s r -> Memory s r
+ 32 push1ForStack e a = a { memoryStack = push1 e (memoryStack a) }
+ 33
+ 34 end :: (SRAutomatonIO Symbol s r m) => SF s r m
+ 35 end = pure . Loop.break
+ 36
+ 37 -- | Constructors
+ 38
+ 39 flippedNewMemory :: (s , r) -> InstructionList -> Memory s r
+ 40 flippedNewMemory = flip (uncurry . newMemory)
+ 41
+ 42 newMemory :: InstructionList -> s -> r -> Memory s r
+ 43 newMemory il = Memory (newCM il)
+ 44
+ 45 -- | Updaters
+ 46
+ 47 incrementIC :: Memory s r -> Memory s r
+ 48 incrementIC m = m { memoryCM = incrementPC $ memoryCM m}
+ 49
+ 50 updateStack :: Memory s r -> s -> Memory s r
+ 51 updateStack m s = m {memoryStack = s}
+ 52
+ 53 updateFromCPM :: Memory s r -> CentralProcessingMemory s -> Memory s r
+ 54 updateFromCPM m cpm = m { memoryCM = controlMemory cpm, memoryStack = alm cpm}
+ 55
+ 56 updateFromLSM :: Memory s r -> LoadStoreMemory s r -> Memory s r
+ 57 updateFromLSM m lsu = m {memoryStack = stack lsu , memoryRAM = ram lsu}
+ 58
+ 59 -- | Accessors
+ 60
+ 61 memoryProgram :: Memory s r -> InstructionVector
+ 62 memoryProgram = program . memoryCM
+ 63
+ 64 memoryProgramCounter :: Memory s r -> InstructionCounter
+ 65 memoryProgramCounter = programCounter . memoryCM
+ 66
+ 67 toCPM :: Memory s r -> CentralProcessingMemory s
+ 68 toCPM a = CPM { controlMemory = memoryCM a , alm = memoryStack a }
+ 69
+ 70 toLSM :: Memory s r -> LoadStoreMemory s r
+ 71 toLSM a = LSM { stack = memoryStack a, ram = memoryRAM a }
+ 72
+ 73 -- | Types
+ 74
+ 75 type SF s r m = Memory s r -> m $ MemorySame s r
+ 76
+ 77 type F s r m = Memory s r -> m $ Memory s r
+ 78
+ 79 type MemorySame s r = Same (Memory s r)
+ 80
+ 81 -- | Data types
+ 82 data Memory s r = Memory
+ 83 { memoryCM :: ControlMemory
+ 84 , memoryStack :: s
+ 85 , memoryRAM :: r
+ 86 }
+ 87 deriving stock (Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.BusinessIO.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.BusinessIO.hs.html
new file mode 100644
index 000000000..8ba820942
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.BusinessIO.hs.html
@@ -0,0 +1,170 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.IO.BusinessIO (
+ 2
+ 3 Element,
+ 4 BIO,
+ 5 BusinessIO,
+ 6
+ 7 wPutAsChar,
+ 8 wPutAsDec,
+ 9 wGetCharAs,
+ 10 wGetDecAs,
+ 11
+ 12 -- wPutIntAsChar,
+ 13 -- wPutIntAsDec,
+ 14 -- wGetCharAsInt,
+ 15 -- wGetDecAsInt,
+ 16
+ 17 wGetContentsBS,
+ 18 wGetContentsText,
+ 19 wGetContents,
+ 20 wGetChar,
+ 21 wPutChar,
+ 22 wGetLine,
+ 23 wPutStr,
+ 24 wPutStrLn,
+ 25 wFlush,
+ 26 wLogStr,
+ 27 wLogStrLn,
+ 28 wLogShow,
+ 29
+ 30 logStr,
+ 31 flush,
+ 32 ) where
+ 33
+ 34 import HelVM.HelIO.Control.Control
+ 35 import HelVM.HelIO.Control.Safe
+ 36
+ 37 import HelVM.HelIO.ReadText
+ 38
+ 39 import qualified Data.ByteString.Lazy as LBS
+ 40 import Data.Default as Default
+ 41 import qualified Data.Text.Lazy as LT
+ 42 import qualified Data.Text.Lazy.IO as LT
+ 43
+ 44 import System.IO hiding (getLine, hFlush, stderr, stdout)
+ 45
+ 46 type Element e = (ReadShow e , Integral e , Default e)
+ 47 type ReadShow e = (Read e , Show e)
+ 48 type BIO m = (MonadControl m , BusinessIO m)
+ 49
+ 50 class Monad m => BusinessIO m where
+ 51
+ 52 wPutAsChar :: Integral v => v -> m ()
+ 53 wPutAsDec :: Integral v => v -> m ()
+ 54 wGetCharAs :: Integral v => m v
+ 55 wGetDecAs :: Integral v => m v
+ 56
+ 57 wPutIntAsChar :: Int -> m ()
+ 58 wPutIntAsDec :: Int -> m ()
+ 59 wGetCharAsInt :: m Int
+ 60 wGetDecAsInt :: m Int
+ 61
+ 62 wGetContentsBS :: m LBS.ByteString
+ 63 wGetContentsText :: m LT.Text
+ 64 wGetContents :: m String
+ 65 wGetChar :: m Char
+ 66 wGetLine :: m Text
+ 67 wPutChar :: Char -> m ()
+ 68 wPutStr :: Text -> m ()
+ 69 wPutStrLn :: Text -> m ()
+ 70 wLogStr :: Text -> m ()
+ 71 wLogStrLn :: Text -> m ()
+ 72 wLogShow :: Show s => s -> m ()
+ 73 wFlush :: m ()
+ 74
+ 75 wPutAsChar = wPutIntAsChar . fromIntegral
+ 76 wPutAsDec = wPutIntAsDec . fromIntegral
+ 77 wGetCharAs = fromIntegral <$> wGetCharAsInt
+ 78 wGetDecAs = fromIntegral <$> wGetDecAsInt
+ 79
+ 80 wPutIntAsChar = wPutChar . chr
+ 81 wPutIntAsDec = wPutStr . show
+ 82 wGetCharAsInt = ord <$> wGetChar
+ 83 wGetDecAsInt = readTextUnsafe <$> wGetLine
+ 84
+ 85 wPutStrLn s = wPutStr $ s <> "\n"
+ 86 wLogStrLn s = wLogStr $ s <> "\n"
+ 87 wLogShow = wLogStrLn . show
+ 88 wFlush = pass
+ 89
+ 90 logStr :: Text -> IO ()
+ 91 logStr = hPutStrLn stderr . toString
+ 92
+ 93 flush :: IO ()
+ 94 flush = hFlush stdout
+ 95
+ 96 instance BusinessIO IO where
+ 97 wGetContentsBS = LBS.getContents
+ 98 wGetContentsText = LT.getContents
+ 99 wGetContents = getContents
+ 100 wGetChar = getChar
+ 101 wGetLine = getLine
+ 102 wPutChar = putChar
+ 103 wPutStr = putText
+ 104 wPutStrLn = putTextLn
+ 105 wLogStr = logStr
+ 106 wFlush = flush
+ 107
+ 108 type ExceptTLegacy = ExceptT String
+ 109
+ 110 exceptTLegacy :: Monad m => m a -> ExceptTLegacy m a
+ 111 exceptTLegacy a = ExceptT $ pure <$> a
+ 112
+ 113 instance BusinessIO (ExceptT String IO) where --FIXXME
+ 114 wGetContentsBS = exceptTLegacy LBS.getContents
+ 115 wGetContentsText = exceptTLegacy LT.getContents
+ 116 wGetContents = exceptTLegacy getContents
+ 117 wGetChar = exceptTLegacy getChar
+ 118 wGetLine = exceptTLegacy getLine
+ 119 wPutChar = exceptTLegacy . putChar
+ 120 wPutStr = exceptTLegacy . putText
+ 121 wPutStrLn = exceptTLegacy . putTextLn
+ 122 wLogStr = exceptTLegacy . logStr
+ 123 wFlush = exceptTLegacy flush
+ 124
+ 125 instance BusinessIO (SafeT IO) where
+ 126 wGetContentsBS = safeT LBS.getContents
+ 127 wGetContentsText = safeT LT.getContents
+ 128 wGetContents = safeT getContents
+ 129 wGetChar = safeT getChar
+ 130 wGetLine = safeT getLine
+ 131 wPutChar = safeT . putChar
+ 132 wPutStr = safeT . putText
+ 133 wPutStrLn = safeT . putTextLn
+ 134 wLogStr = safeT . logStr
+ 135 wFlush = safeT flush
+ 136
+ 137 instance BusinessIO (ControlT IO) where
+ 138 wGetContentsBS = controlT LBS.getContents
+ 139 wGetContentsText = controlT LT.getContents
+ 140 wGetContents = controlT getContents
+ 141 wGetChar = controlT getChar
+ 142 wGetLine = controlT getLine
+ 143 wPutChar = controlT . putChar
+ 144 wPutStr = controlT . putText
+ 145 wPutStrLn = controlT . putTextLn
+ 146 wLogStr = controlT . logStr
+ 147 wFlush = controlT flush
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.FreeIO.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.FreeIO.hs.html
new file mode 100644
index 000000000..7f99ab6cc
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.FreeIO.hs.html
@@ -0,0 +1,169 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE DeriveFunctor #-}
+ 2 module HelVM.HelMA.Automaton.IO.FreeIO (
+ 3 interpretFreeIOToBusinessIO,
+ 4 logInput,
+ 5 logOutput,
+ 6 FreeIO,
+ 7 ) where
+ 8
+ 9 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 10
+ 11 import HelVM.HelIO.Control.Control
+ 12 import HelVM.HelIO.Control.Safe
+ 13
+ 14 import Control.Monad.Free
+ 15 import Control.Natural
+ 16
+ 17 import qualified Data.ByteString.Lazy as LBS
+ 18
+ 19 import qualified Data.Text.Lazy as LT
+ 20
+ 21 interpretFreeIOToBusinessIO :: BusinessIO m => FreeIO a -> m a
+ 22 interpretFreeIOToBusinessIO = foldFree interpretFreeIOFToBusinessIO
+ 23
+ 24 logInput :: FreeIO ~> FreeIO
+ 25 logInput = foldFree logInputF
+ 26
+ 27 logOutput :: FreeIO ~> FreeIO
+ 28 logOutput = foldFree logOutputF
+ 29
+ 30 ----
+ 31
+ 32 interpretFreeIOFToBusinessIO :: BusinessIO m => FreeIOF a -> m a
+ 33 interpretFreeIOFToBusinessIO (GetContentsBS cd) = cd <$> wGetContentsBS
+ 34 interpretFreeIOFToBusinessIO (GetContentsText cd) = cd <$> wGetContentsText
+ 35 interpretFreeIOFToBusinessIO (GetContents cd) = cd <$> wGetContents
+ 36 interpretFreeIOFToBusinessIO (GetChar cd) = cd <$> wGetChar
+ 37 interpretFreeIOFToBusinessIO (GetLine cd) = cd <$> wGetLine
+ 38 interpretFreeIOFToBusinessIO (PutChar c v) = wPutChar c $> v
+ 39 interpretFreeIOFToBusinessIO (PutStr s v) = wPutStr s $> v
+ 40 interpretFreeIOFToBusinessIO (PutStrLn s v) = wPutStrLn s $> v
+ 41 interpretFreeIOFToBusinessIO (LogStr s v) = wLogStr s $> v
+ 42 interpretFreeIOFToBusinessIO (LogStrLn s v) = wLogStrLn s $> v
+ 43 interpretFreeIOFToBusinessIO (Flush v) = wFlush $> v
+ 44
+ 45 ----
+ 46
+ 47 logInputF :: FreeIOF a -> FreeIO a
+ 48 logInputF (GetChar cd) = freeGetChar >>= (\c -> liftF $ LogStr (one c) (cd c))
+ 49 logInputF (GetLine cd) = freeGetLine >>= (\l -> liftF $ LogStr l (cd l))
+ 50 logInputF f = liftF f
+ 51
+ 52 logOutputF :: FreeIOF a -> FreeIO a
+ 53 logOutputF f@(PutChar c v) = liftF (LogStr (one c) v) *> liftF f
+ 54 logOutputF f@(PutStr s v) = liftF (LogStr s v) *> liftF f
+ 55 logOutputF f = liftF f
+ 56
+ 57 -- | Instances
+ 58 instance BusinessIO FreeIO where
+ 59 wGetContentsBS = freeGetContentsBS
+ 60 wGetContentsText = freeGetContentsText
+ 61 wGetContents = freeGetContents
+ 62 wGetChar = freeGetChar
+ 63 wGetLine = freeGetLine
+ 64 wPutChar = freePutChar
+ 65 wPutStr = freePutStr
+ 66 wPutStrLn = freePutStrLn
+ 67 wLogStr = freeLogStr
+ 68 wLogStrLn = freeLogStrLn
+ 69 wFlush = freeFlush
+ 70
+ 71 instance BusinessIO (SafeT FreeIO) where
+ 72 wGetContentsBS = safeT freeGetContentsBS
+ 73 wGetContentsText = safeT freeGetContentsText
+ 74 wGetContents = safeT freeGetContents
+ 75 wGetChar = safeT freeGetChar
+ 76 wGetLine = safeT freeGetLine
+ 77 wPutChar = safeT . freePutChar
+ 78 wPutStr = safeT . freePutStr
+ 79 wPutStrLn = safeT . freePutStrLn
+ 80 wLogStr = safeT . freeLogStr
+ 81 wLogStrLn = safeT . freeLogStrLn
+ 82 wFlush = safeT freeFlush
+ 83
+ 84 instance BusinessIO (ControlT FreeIO) where
+ 85 wGetContentsBS = controlT freeGetContentsBS
+ 86 wGetContentsText = controlT freeGetContentsText
+ 87 wGetContents = controlT freeGetContents
+ 88 wGetChar = controlT freeGetChar
+ 89 wGetLine = controlT freeGetLine
+ 90 wPutChar = controlT . freePutChar
+ 91 wPutStr = controlT . freePutStr
+ 92 wPutStrLn = controlT . freePutStrLn
+ 93 wLogStr = controlT . freeLogStr
+ 94 wLogStrLn = controlT . freeLogStrLn
+ 95 wFlush = controlT freeFlush
+ 96
+ 97 -- | Low level functions
+ 98 freeGetContentsBS :: FreeIO LBS.ByteString
+ 99 freeGetContentsBS = liftF $ GetContentsBS id
+ 100
+ 101 freeGetContentsText :: FreeIO LT.Text
+ 102 freeGetContentsText = liftF $ GetContentsText id
+ 103
+ 104 freeGetContents :: FreeIO String
+ 105 freeGetContents = liftF $ GetContents id
+ 106
+ 107 freeGetChar :: FreeIO Char
+ 108 freeGetChar = liftF $ GetChar id
+ 109
+ 110 freeGetLine :: FreeIO Text
+ 111 freeGetLine = liftF $ GetLine id
+ 112
+ 113 freePutChar :: Char -> FreeIO ()
+ 114 freePutChar = liftF . flip PutChar ()
+ 115
+ 116 freePutStr :: Text -> FreeIO ()
+ 117 freePutStr = liftF . flip PutStr ()
+ 118
+ 119 freePutStrLn :: Text -> FreeIO ()
+ 120 freePutStrLn = liftF . flip PutStrLn ()
+ 121
+ 122 freeLogStr :: Text -> FreeIO ()
+ 123 freeLogStr = liftF . flip LogStr ()
+ 124
+ 125 freeLogStrLn :: Text -> FreeIO ()
+ 126 freeLogStrLn = liftF . flip LogStrLn ()
+ 127
+ 128 freeFlush :: FreeIO ()
+ 129 freeFlush = liftF $ Flush ()
+ 130
+ 131 -- | Types
+ 132 type FreeIO = Free FreeIOF
+ 133
+ 134 data FreeIOF a
+ 135 = GetContentsBS (LBS.ByteString -> a)
+ 136 | GetContentsText (LT.Text -> a)
+ 137 | GetContents (String -> a)
+ 138 | GetChar (Char -> a)
+ 139 | GetLine (Text -> a)
+ 140 | PutChar Char a
+ 141 | PutStr Text a
+ 142 | PutStrLn Text a
+ 143 | LogStr Text a
+ 144 | LogStrLn Text a
+ 145 | Flush a
+ 146 deriving stock (Functor)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.MockIO.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.MockIO.hs.html
new file mode 100644
index 000000000..c6a861b49
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.IO.MockIO.hs.html
@@ -0,0 +1,202 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.IO.MockIO (
+ 2 ioExecMockIOBatch,
+ 3 ioExecMockIOWithInput,
+ 4
+ 5 safeExecMockIOBatch,
+ 6 safeExecMockIOWithInput,
+ 7
+ 8 execMockIOBatch,
+ 9 execMockIOWithInput,
+ 10
+ 11 runMockIO,
+ 12 createMockIO,
+ 13 calculateOutput,
+ 14 calculateLogged,
+ 15
+ 16 MockIO,
+ 17 MockIOData,
+ 18 ) where
+ 19
+ 20 import HelVM.HelMA.Automaton.API.IOTypes
+ 21 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 22
+ 23 import HelVM.HelIO.Control.Control
+ 24 import HelVM.HelIO.Control.Safe
+ 25
+ 26 import HelVM.HelIO.ListLikeExtra
+ 27
+ 28 import qualified Data.ByteString.Lazy as LBS
+ 29
+ 30 import Data.Text as Text
+ 31 import qualified Data.Text.Lazy as LT
+ 32
+ 33 ioExecMockIOBatch :: ControlT MockIO () -> IO MockIOData
+ 34 ioExecMockIOBatch = ioExecMockIOWithInput ""
+ 35
+ 36 ioExecMockIOWithInput :: Input -> ControlT MockIO () -> IO MockIOData
+ 37 ioExecMockIOWithInput i = safeToIO . safeExecMockIOWithInput i
+ 38
+ 39 safeExecMockIOBatch :: ControlT MockIO () -> Safe MockIOData
+ 40 safeExecMockIOBatch = safeExecMockIOWithInput ""
+ 41
+ 42 safeExecMockIOWithInput :: Input -> ControlT MockIO () -> Safe MockIOData
+ 43 safeExecMockIOWithInput i = pure . runMockIO i . runControlT
+ 44
+ 45 execMockIOBatch :: MockIO () -> MockIOData
+ 46 execMockIOBatch = execMockIOWithInput ""
+ 47
+ 48 execMockIOWithInput :: Input -> MockIO () -> MockIOData
+ 49 execMockIOWithInput i a = runMockIO i $ safeWithMessages <$> a
+ 50
+ 51 ----
+ 52
+ 53 runMockIO :: Input -> MockIO UnitSafeWithMessages -> MockIOData
+ 54 runMockIO i mockIO = flip mockDataLogStr mockIOData $ safeWithMessagesToText s
+ 55 where (s , mockIOData) = runState mockIO $ createMockIO i
+ 56
+ 57 createMockIO :: Input -> MockIOData
+ 58 createMockIO i = MockIOData (toString i) "" ""
+ 59
+ 60 calculateOutput :: MockIOData -> Output
+ 61 calculateOutput = calculateText . output
+ 62
+ 63 calculateLogged :: MockIOData -> Output
+ 64 calculateLogged = calculateText . logged
+ 65
+ 66 ----
+ 67
+ 68 instance BusinessIO MockIO where
+ 69 wGetContentsBS = mockGetContentsBS
+ 70 wGetContentsText = mockGetContentsText
+ 71 wGetContents = mockGetContents
+ 72 wGetChar = mockGetChar
+ 73 wGetLine = mockGetLine
+ 74 wPutChar = mockPutChar
+ 75 wPutStr = mockPutStr
+ 76 wLogStr = mockLogStr
+ 77
+ 78 instance BusinessIO (SafeT MockIO) where
+ 79 wGetContentsBS = safeT mockGetContentsBS
+ 80 wGetContentsText = safeT mockGetContentsText
+ 81 wGetContents = safeT mockGetContents
+ 82 wGetChar = safeT mockGetChar
+ 83 wGetLine = safeT mockGetLine
+ 84 wPutChar = safeT . mockPutChar
+ 85 wPutStr = safeT . mockPutStr
+ 86 wLogStr = safeT . mockLogStr
+ 87
+ 88 instance BusinessIO (ControlT MockIO) where
+ 89 wGetContentsBS = controlT mockGetContentsBS
+ 90 wGetContentsText = controlT mockGetContentsText
+ 91 wGetContents = controlT mockGetContents
+ 92 wGetChar = mockGetCharSafe
+ 93 wGetLine = mockGetLineSafe
+ 94 wPutChar = controlT . mockPutChar
+ 95 wPutStr = controlT . mockPutStr
+ 96 wLogStr = controlT . mockLogStr
+ 97
+ 98 ----
+ 99
+ 100 mockGetContentsBS :: MonadMockIO m => m LBS.ByteString
+ 101 mockGetContentsBS = fromStrict . encodeUtf8 <$> mockGetContentsText
+ 102
+ 103 mockGetContentsText :: MonadMockIO m => m LT.Text
+ 104 mockGetContentsText = fromStrict . toText <$> mockGetContents
+ 105
+ 106 mockGetContents :: MonadMockIO m => m String
+ 107 mockGetContents = mockGetContents' =<< get where
+ 108 mockGetContents' :: MonadMockIO m => MockIOData -> m String
+ 109 mockGetContents' mockIO = content <$ put mockIO { input = "" } where content = input mockIO
+ 110
+ 111 mockGetChar :: MonadMockIO m => m Char
+ 112 mockGetChar = mockGetChar' =<< get where
+ 113 mockGetChar' :: MonadMockIO m => MockIOData -> m Char
+ 114 mockGetChar' mockIO = orErrorTuple ("mockGetChar" , show mockIO) (top (input mockIO)) <$ put mockIO { input = orErrorTuple ("mockGetChar" , show mockIO) $ discard $ input mockIO }
+ 115
+ 116 mockGetLine :: MonadMockIO m => m Text
+ 117 mockGetLine = mockGetLine' =<< get where
+ 118 mockGetLine' :: MonadMockIO m => MockIOData -> m Text
+ 119 mockGetLine' mockIO = toText line <$ put mockIO { input = input' } where (line , input') = splitStringByLn $ input mockIO
+ 120
+ 121 mockGetCharSafe :: MonadControlMockIO m => m Char
+ 122 mockGetCharSafe = mockGetChar' =<< get where
+ 123 mockGetChar' :: MonadControlMockIO m => MockIOData -> m Char
+ 124 mockGetChar' mockIO = appendErrorTuple ("mockGetCharSafe" , show mockIO) $ mockGetChar'' =<< unconsSafe (input mockIO) where
+ 125 mockGetChar'' (c, input') = put mockIO { input = input' } $> c
+ 126
+ 127 mockGetLineSafe :: MonadControlMockIO m => m Text
+ 128 mockGetLineSafe = mockGetLine' =<< get where
+ 129 mockGetLine' :: MonadControlMockIO m => MockIOData -> m Text
+ 130 mockGetLine' mockIO = toText line <$ put mockIO { input = input' } where (line , input') = splitStringByLn $ input mockIO
+ 131
+ 132
+ 133 mockPutChar :: Char -> MockIO ()
+ 134 mockPutChar = modify . mockDataPutChar
+ 135
+ 136 mockPutStr :: Text -> MockIO ()
+ 137 mockPutStr = modify . mockDataPutStr
+ 138
+ 139 mockLogStr :: Text -> MockIO ()
+ 140 mockLogStr = modify . mockDataLogStr
+ 141
+ 142 ----
+ 143
+ 144 mockDataPutChar :: Char -> MockIOData -> MockIOData
+ 145 mockDataPutChar char mockIO = mockIO { output = char : output mockIO }
+ 146
+ 147 mockDataPutStr :: Text -> MockIOData -> MockIOData
+ 148 mockDataPutStr text mockIO = mockIO { output = calculateString text <> output mockIO }
+ 149
+ 150 mockDataLogStr :: Text -> MockIOData -> MockIOData
+ 151 mockDataLogStr text mockIO = mockIO { logged = calculateString text <> logged mockIO }
+ 152
+ 153 ----
+ 154
+ 155 type MonadControlMockIO m = (MonadMockIO m , MonadControl m)--FIXME
+ 156
+ 157 --type MonadSafeMockIO m = (MonadMockIO m , MonadSafe m) --FIXME
+ 158
+ 159 type MonadMockIO m = MonadState MockIOData m
+ 160
+ 161 type MockIO = State MockIOData
+ 162
+ 163 calculateText :: String -> Output
+ 164 calculateText = Text.reverse . toText
+ 165
+ 166 calculateString :: Output -> String
+ 167 calculateString = toString . Text.reverse
+ 168
+ 169 data MockIOData = MockIOData
+ 170 { input :: !String
+ 171 , output :: !String
+ 172 , logged :: !String
+ 173 }
+ 174 deriving stock (Eq , Read , Show)
+ 175
+ 176 ----
+ 177
+ 178 splitStringByLn :: String -> (String , String)
+ 179 splitStringByLn = splitBy '\n'
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.Constructors.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.Constructors.hs.html
new file mode 100644
index 000000000..47657b48c
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.Constructors.hs.html
@@ -0,0 +1,149 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Instruction.Extras.Constructors where
+ 2
+ 3 import HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
+ 4 import HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
+ 5 import HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction
+ 6 import HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
+ 7
+ 8 import HelVM.HelMA.Automaton.Instruction
+ 9
+ 10 immediateBinaryI :: Integer -> BinaryOperation -> Instruction
+ 11 immediateBinaryI i = IAL . SPure . Unary . UImmediate i
+ 12
+ 13 consI :: Integer -> Instruction
+ 14 consI = sal . Cons
+ 15
+ 16 addI , subI , mulI , divI , modI :: Instruction
+ 17 addI = binary Add
+ 18 subI = binary Sub
+ 19 mulI = binary Mul
+ 20 divI = binary Div
+ 21 modI = binary Mod
+ 22
+ 23 divModI , negI , halibutI :: Instruction
+ 24 divModI = binaries [Mod, Div]
+ 25 negI = unary Neg
+ 26 halibutI = sal Halibut
+ 27
+ 28 dupI , swapI , rotI , copyTI , discardI :: Instruction
+ 29 dupI = copyII 0
+ 30 swapI = moveII 1
+ 31 rotI = moveII 2
+ 32 copyTI = sal $ Indexed ITop Copy
+ 33 discardI = sal Discard
+ 34
+ 35 copyII :: Index -> Instruction
+ 36 copyII = manipulationII Copy
+ 37
+ 38 moveII :: Index -> Instruction
+ 39 moveII = manipulationII Move
+ 40
+ 41 slideII :: Index -> Instruction
+ 42 slideII = manipulationII Slide
+ 43
+ 44 manipulationII :: IndexedOperation -> Index -> Instruction
+ 45 manipulationII op i = sal $ Indexed (IImmediate i) op
+ 46
+ 47 sInputI , sOutputI , sOutputDecI :: Instruction
+ 48 sInputI = sio InputChar
+ 49 sOutputI = sio OutputChar
+ 50 sOutputDecI = sio OutputDec
+ 51
+ 52 binaries :: [BinaryOperation] -> Instruction
+ 53 binaries = sal . Binaries
+ 54
+ 55 binary :: BinaryOperation -> Instruction
+ 56 binary = sal . Binary
+ 57
+ 58 unary :: UnaryOperation -> Instruction
+ 59 unary = sal . Unary
+ 60
+ 61 sal :: SPureInstruction -> Instruction
+ 62 sal = IAL . SPure
+ 63
+ 64 sio :: IOInstruction -> Instruction
+ 65 sio = IAL . SIO
+ 66
+ 67 markNI :: Natural -> Instruction
+ 68 markNI = ICF . Mark . MNatural
+ 69
+ 70 markSI :: Label -> Instruction
+ 71 markSI = ICF . Mark . MArtificial
+ 72
+ 73 jumpTI :: Instruction
+ 74 jumpTI = labeledT Jump
+ 75
+ 76 jumpII :: Natural -> Instruction
+ 77 jumpII = labeledI Jump
+ 78
+ 79 callSI , jumpSI :: Label -> Instruction
+ 80 callSI = labeledA Call
+ 81 jumpSI = labeledA Jump
+ 82
+ 83 branchSwapI :: BranchTest -> Instruction
+ 84 branchSwapI = ICF . Branch BSwapped
+ 85
+ 86 bNeTI :: Instruction
+ 87 bNeTI = branchT NE
+ 88
+ 89 bNeII :: Natural -> Instruction
+ 90 bNeII = branchI NE
+ 91
+ 92 bEzSI , bLtzSI :: Label -> Instruction
+ 93 bEzSI = branchA EZ
+ 94 bLtzSI = branchA LTZ
+ 95
+ 96 branchT :: BranchTest -> Instruction
+ 97 branchT = ICF . Branch BTop
+ 98
+ 99 branchI :: BranchTest -> Natural -> Instruction
+ 100 branchI op n = ICF $ Branch (BImmediate n) op
+ 101
+ 102 branchA :: BranchTest -> Label -> Instruction
+ 103 branchA op l = ICF $ Branch (BArtificial l) op
+ 104
+ 105 labeledT :: LabelOperation -> Instruction
+ 106 labeledT = ICF . Labeled LTop
+ 107
+ 108 labeledI :: LabelOperation -> Natural -> Instruction
+ 109 labeledI op n = ICF $ Labeled (LImmediate n) op
+ 110
+ 111 labeledA :: LabelOperation -> Label -> Instruction
+ 112 labeledA op l = ICF $ Labeled (LArtificial l) op
+ 113
+ 114 returnI :: Instruction
+ 115 returnI = ICF Return
+ 116
+ 117 storeI , loadI :: Instruction
+ 118 storeI = ILS Store
+ 119 loadI = ILS Load
+ 120
+ 121 mInputI , mInputDecI :: Instruction
+ 122 mInputI = mio InputChar
+ 123 mInputDecI = mio InputDec
+ 124
+ 125 mio :: IOInstruction -> Instruction
+ 126 mio = ILS . MIO
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.Patterns.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.Patterns.hs.html
new file mode 100644
index 000000000..aa6522379
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.Patterns.hs.html
@@ -0,0 +1,82 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE PatternSynonyms #-}
+ 2 module HelVM.HelMA.Automaton.Instruction.Extras.Patterns where
+ 3
+ 4 import HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
+ 5 import HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
+ 6
+ 7 import HelVM.HelMA.Automaton.Instruction
+ 8
+ 9 -- | Getters
+ 10
+ 11 isICF :: Instruction -> Bool
+ 12 isICF (ICF _) = True
+ 13 isICF _ = False
+ 14
+ 15 isMark :: Instruction -> Bool
+ 16 isMark (MarkP _) = True
+ 17 isMark _ = False
+ 18
+ 19 checkNaturalMark :: Natural -> Instruction -> Bool
+ 20 checkNaturalMark n (MNaturalP n') = n == n'
+ 21 checkNaturalMark _ _ = False
+ 22
+ 23 checkArtificialMark :: Label -> Instruction -> Bool
+ 24 checkArtificialMark l (MArtificialP l') = l == l'
+ 25 checkArtificialMark _ _ = False
+ 26
+ 27 -- | Patterns
+ 28 pattern JumpP :: LabelOperand -> Instruction
+ 29 pattern JumpP o = ICF (Labeled o Jump)
+ 30
+ 31 pattern MarkP :: Mark -> Instruction
+ 32 pattern MarkP m = (ICF (Mark m))
+ 33
+ 34 pattern HalibutP :: Instruction
+ 35 pattern HalibutP = IAL (SPure Halibut)
+ 36
+ 37 pattern PickP :: Instruction
+ 38 pattern PickP = IAL (SPure Pick)
+ 39
+ 40 pattern MNaturalP :: Natural -> Instruction
+ 41 pattern MNaturalP n = (ICF (Mark (MNatural n)))
+ 42
+ 43 pattern MArtificialP :: Label -> Instruction
+ 44 pattern MArtificialP l = (ICF (Mark (MArtificial l)))
+ 45
+ 46 pattern ConsP :: Integer -> Instruction
+ 47 pattern ConsP c = IAL (SPure (Cons c))
+ 48
+ 49 pattern MoveIP :: Index -> Instruction
+ 50 pattern MoveIP i = IAL (SPure (Indexed (IImmediate i) Move))
+ 51
+ 52 pattern BranchTP :: BranchTest -> Instruction
+ 53 pattern BranchTP t = ICF (Branch BTop t)
+ 54
+ 55 pattern BinaryP :: BinaryOperation -> Instruction
+ 56 pattern BinaryP op = IAL (SPure (Binary op))
+ 57
+ 58 pattern SPureP :: SPureInstruction -> Instruction
+ 59 pattern SPureP i = IAL (SPure i)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.TextExtra.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.TextExtra.hs.html
new file mode 100644
index 000000000..44db4ad47
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Extras.TextExtra.hs.html
@@ -0,0 +1,29 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Instruction.Extras.TextExtra where
+ 2
+ 3 import qualified Data.Text as Text
+ 4
+ 5 toLowerShow :: Show i => i -> Text
+ 6 toLowerShow = Text.toLower . show
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction.hs.html
new file mode 100644
index 000000000..27ab194b8
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction.hs.html
@@ -0,0 +1,90 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction where
+ 2
+ 3 import HelVM.HelMA.Automaton.Instruction.Extras.TextExtra
+ 4
+ 5 import HelVM.HelIO.Collections.SList
+ 6
+ 7 -- | Others
+ 8
+ 9 isNotJump :: Integral e => BranchTest -> e -> Bool
+ 10 isNotJump t = not . isJump t
+ 11
+ 12 isJump :: Integral e => BranchTest -> e -> Bool
+ 13 isJump NE e = e /= 0
+ 14 isJump EZ e = e == 0
+ 15 isJump LTZ e = e < 0
+ 16 isJump GTZ e = e > 0
+ 17
+ 18 -- | Types
+ 19 data CFInstruction =
+ 20 Mark !Mark
+ 21 | Branch !BranchOperand !BranchTest
+ 22 | Labeled !LabelOperand !LabelOperation
+ 23 | Return
+ 24 deriving stock (Eq , Read , Show)
+ 25
+ 26 data Mark = MNatural Natural | MArtificial Label
+ 27 deriving stock (Eq , Read , Show)
+ 28
+ 29 data LabelOperand = LTop | LImmediate !Natural | LArtificial Label
+ 30 deriving stock (Eq , Read , Show)
+ 31
+ 32 data BranchOperand = BSwapped | BTop | BImmediate !Natural | BArtificial Label
+ 33 deriving stock (Eq , Read , Show)
+ 34
+ 35 type Label = SString --FIXME Artificial
+ 36
+ 37 data LabelOperation = Call | Jump
+ 38 deriving stock (Eq , Read , Show)
+ 39
+ 40 data BranchTest = EZ | LTZ | GTZ | NE
+ 41 deriving stock (Eq , Read , Show)
+ 42
+ 43 -- | Internal
+ 44
+ 45 printCF :: CFInstruction -> Text
+ 46 printCF (Mark i ) = "\nmark" <> printMark i
+ 47 printCF (Branch i t) = printBranchTest t <> printBranchOperand i
+ 48 printCF (Labeled i o) = toLowerShow o <> printLabelOperand i
+ 49 printCF i = toLowerShow i
+ 50
+ 51 printMark :: Mark -> Text
+ 52 printMark (MNatural i) = "M " <> show i
+ 53 printMark (MArtificial i) = "A " <> show i
+ 54
+ 55 printBranchTest :: BranchTest -> Text
+ 56 printBranchTest t = "b" <> show t
+ 57
+ 58 printBranchOperand :: BranchOperand -> Text
+ 59 printBranchOperand BTop = ""
+ 60 printBranchOperand BSwapped = "S"
+ 61 printBranchOperand (BImmediate i) = "I " <> show i
+ 62 printBranchOperand (BArtificial i) = "A " <> show i
+ 63
+ 64 printLabelOperand :: LabelOperand -> Text
+ 65 printLabelOperand LTop = ""
+ 66 printLabelOperand (LImmediate i) = "I " <> show i
+ 67 printLabelOperand (LArtificial i) = "A " <> show i
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction.hs.html
new file mode 100644
index 000000000..822f5abbd
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction.hs.html
@@ -0,0 +1,49 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction where
+ 2
+ 3 import HelVM.HelMA.Automaton.Instruction.Extras.PrintAsm
+ 4 -- | Types
+ 5
+ 6 -- TODO convert to (Output/Input) (Char/Dec)
+ 7
+ 8 data IOInstruction =
+ 9 OutputChar
+ 10 | OutputDec
+ 11 | InputChar
+ 12 | InputDec
+ 13 deriving stock (Eq , Read , Show)
+ 14
+ 15 -- | Type Classes
+ 16
+ 17 instance PrintAsm IOInstruction where
+ 18 printAsm = printIO
+ 19
+ 20 -- | Internal
+ 21
+ 22 printIO :: IOInstruction -> Text
+ 23 printIO OutputChar = "outputC"
+ 24 printIO OutputDec = "outputD"
+ 25 printIO InputChar = "inputC"
+ 26 printIO InputDec = "inputD"
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction.hs.html
new file mode 100644
index 000000000..6e6014ea3
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction.hs.html
@@ -0,0 +1,34 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction where
+ 2
+ 3 import HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
+ 4
+ 5 -- | Types
+ 6
+ 7 data LSInstruction =
+ 8 Load --Restore --Fetch
+ 9 | Store --Save
+ 10 | MIO !IOInstruction
+ 11 deriving stock (Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction.hs.html
new file mode 100644
index 000000000..75792dd0f
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction.hs.html
@@ -0,0 +1,127 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction where
+ 2
+ 3 import HelVM.HelMA.Automaton.Instruction.Extras.TextExtra
+ 4 import HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
+ 5
+ 6 import HelVM.HelIO.Containers.Extra
+ 7
+ 8 -- | Constructors
+ 9
+ 10 blAnd :: OperatorType -> BinaryOperation
+ 11 blAnd Bitwise = BAnd
+ 12 blAnd Logical = LAnd
+ 13
+ 14 blOr :: OperatorType -> BinaryOperation
+ 15 blOr Bitwise = BOr
+ 16 blOr Logical = LOr
+ 17
+ 18 blXor :: OperatorType -> BinaryOperation
+ 19 blXor Bitwise = BXor
+ 20 blXor Logical = LXor
+ 21
+ 22 blEQ :: OperatorType -> BinaryOperation
+ 23 blEQ Bitwise = BEQ
+ 24 blEQ Logical = LEQ
+ 25
+ 26 blGT :: OperatorType -> BinaryOperation
+ 27 blGT Bitwise = BGT
+ 28 blGT Logical = LGT
+ 29
+ 30 -- | Other functions
+ 31
+ 32 calculateOps :: Integral a => a -> a -> [BinaryOperation] -> [a]
+ 33 calculateOps operand operand' = map (calculateOp operand operand')
+ 34
+ 35 calculateOp :: Integral a => a -> a -> BinaryOperation -> a
+ 36 calculateOp operand operand' operation = doBinary operation operand' operand
+ 37
+ 38 doBinary :: Integral a => BinaryOperation -> a -> a -> a
+ 39 doBinary Add = (+)
+ 40 doBinary Sub = (-)
+ 41 doBinary Mul = (*)
+ 42 doBinary Div = div
+ 43 doBinary Mod = mod
+ 44 doBinary o = error $ show o
+ 45
+ 46 -- | Types
+ 47 data SMInstruction =
+ 48 SPure !SPureInstruction
+ 49 | SIO !IOInstruction
+ 50 deriving stock (Eq , Read , Show)
+ 51
+ 52 data SPureInstruction =
+ 53 Cons !Integer
+ 54 | Unary !UnaryOperation
+ 55 | Binary !BinaryOperation
+ 56 | Binaries [BinaryOperation]
+ 57 | Indexed !IndexOperand !IndexedOperation
+ 58 | Halibut
+ 59 | Pick
+ 60 | Discard
+ 61 deriving stock (Eq , Read , Show)
+ 62
+ 63 data IndexOperand = ITop | IImmediate !Index
+ 64 deriving stock (Eq , Read , Show)
+ 65
+ 66 data UnaryOperation = Neg | BNot | LNot | UImmediate Integer BinaryOperation
+ 67 deriving stock (Eq , Read , Show)
+ 68
+ 69 data BinaryOperation =
+ 70 Add | Sub | Mul | Div | Mod
+ 71 | BAnd | BOr | BXor | BEQ | BGT
+ 72 | LAnd | LOr | LXor | LEQ | LGT
+ 73 deriving stock (Eq , Read , Show)
+ 74
+ 75 data IndexedOperation = Copy | Move | Slide
+ 76 deriving stock (Eq , Read , Show)
+ 77
+ 78 type Index = Int
+ 79
+ 80 data OperatorType = Bitwise | Logical
+ 81
+ 82 -- | Internal
+ 83
+ 84 printSM :: SMInstruction -> Text
+ 85 printSM (SPure i) = printSPure i
+ 86 printSM (SIO i) = printIO i <> "S"
+ 87
+ 88 printSPure :: SPureInstruction -> Text
+ 89 printSPure (Unary i ) = printUnary i
+ 90 printSPure (Indexed i o) = toLowerShow o <> printIndexOperand i
+ 91 printSPure (Binary i ) = toLowerShow i
+ 92 printSPure (Binaries i ) = printBinaries i
+ 93 printSPure i = toLowerShow i
+ 94
+ 95 printBinaries :: (Foldable c, Functor c, Show i) => c i -> Text
+ 96 printBinaries il = fmconcat $ toLowerShow <$> il
+ 97
+ 98 printUnary :: UnaryOperation -> Text
+ 99 printUnary (UImmediate i o) = toLowerShow o <> "I " <> show i
+ 100 printUnary i = toLowerShow i
+ 101
+ 102 printIndexOperand :: IndexOperand -> Text
+ 103 printIndexOperand ITop = ""
+ 104 printIndexOperand (IImmediate i) = "I " <> show i
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.hs.html
new file mode 100644
index 000000000..2af60b155
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Instruction.hs.html
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Instruction where
+ 2
+ 3 import HelVM.HelMA.Automaton.Instruction.Extras.TextExtra
+ 4
+ 5 import HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
+ 6 import HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction
+ 7 import HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
+ 8
+ 9 import Data.Vector as Vector
+ 10
+ 11 -- | Types
+ 12
+ 13 data Instruction =
+ 14 IAL !SMInstruction
+ 15 | ILS !LSInstruction
+ 16 | ICF !CFInstruction
+ 17 | End
+ 18 deriving stock (Eq , Read , Show)
+ 19
+ 20 type InstructionList = [Instruction]
+ 21 type InstructionVector = Vector Instruction
+ 22
+ 23 -- | Internal
+ 24
+ 25 printIL :: InstructionList -> Text
+ 26 printIL il = unlines $ printI <$> il
+ 27
+ 28 printI :: Instruction -> Text
+ 29 printI (IAL i) = printSM i
+ 30 printI (ICF i) = printCF i
+ 31 printI (ILS i) = toLowerShow i
+ 32 printI End = toLowerShow End
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Loop.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Loop.hs.html
new file mode 100644
index 000000000..2518f315b
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Loop.hs.html
@@ -0,0 +1,60 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Loop where
+ 2
+ 3 import Control.Monad.Extra
+ 4 import Control.Type.Operator
+ 5
+ 6 import Data.Either.Extra
+ 7
+ 8 import Prelude hiding (break)
+ 9
+ 10 testMaybeLimit :: LimitMaybe
+ 11 testMaybeLimit = Just $ fromIntegral (maxBound :: Int)
+ 12
+ 13 loopMWithLimit :: Monad m => (a -> m $ Same a) -> LimitMaybe -> a -> m a
+ 14 loopMWithLimit f Nothing x = loopM f x
+ 15 loopMWithLimit f (Just n) x = loopM (actMWithLimit f) (n , x)
+ 16
+ 17 actMWithLimit :: Monad m => (a -> m $ Same a) -> WithLimit a -> m $ EitherWithLimit a
+ 18 actMWithLimit f (n , x) = checkN n where
+ 19 checkN 0 = pure $ break x
+ 20 checkN _ = next n <$> f x
+ 21
+ 22 next :: Natural -> Same a -> EitherWithLimit a
+ 23 next n = mapLeft (n - 1 , )
+ 24
+ 25 continue :: a -> Either a b
+ 26 continue = Left
+ 27
+ 28 break :: b -> Either a b
+ 29 break = Right
+ 30
+ 31 type LimitMaybe = Maybe Natural
+ 32
+ 33 type EitherWithLimit a = Either (WithLimit a) a
+ 34
+ 35 type WithLimit a = (Natural , a)
+ 36
+ 37 type Same a = Either a a
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.ConstantFoldingOptimizer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.ConstantFoldingOptimizer.hs.html
new file mode 100644
index 000000000..ff4ae104a
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.ConstantFoldingOptimizer.hs.html
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Optimizer.ConstantFoldingOptimizer (
+ 2 constantFolding,
+ 3 ) where
+ 4
+ 5 import HelVM.HelMA.Automaton.Combiner.ALU
+ 6
+ 7 import HelVM.HelMA.Automaton.Instruction
+ 8
+ 9 import HelVM.HelMA.Automaton.Instruction.Extras.Constructors
+ 10 import HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
+ 11
+ 12 import qualified Data.ListLike as LL
+ 13
+ 14 constantFolding :: InstructionList -> InstructionList
+ 15 constantFolding = constantFoldingWithAcc []
+ 16
+ 17 constantFoldingWithAcc :: [Integer] -> InstructionList -> InstructionList
+ 18 constantFoldingWithAcc acc (i : il) = constantFoldingForI acc il i
+ 19 constantFoldingWithAcc acc [] = generateIL acc
+ 20
+ 21 constantFoldingForI :: [Integer] -> InstructionList -> Instruction -> InstructionList
+ 22 constantFoldingForI acc il i@(IAL (SPure i')) = constantFoldingForResult il i acc $ runSAL i' acc
+ 23 constantFoldingForI acc il i = generateIL acc <> (i : constantFolding il)
+ 24
+ 25 constantFoldingForResult :: InstructionList -> Instruction -> [Integer] -> Either a [Integer] -> InstructionList
+ 26 constantFoldingForResult il _ _ (Right acc) = constantFoldingWithAcc acc il
+ 27 constantFoldingForResult il i acc (Left _ ) = generateIL acc <> (i : constantFolding il)
+ 28
+ 29 generateIL :: [Integer] -> InstructionList
+ 30 generateIL acc = consI <$> LL.reverse acc
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.PeepholeOptimizer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.PeepholeOptimizer.hs.html
new file mode 100644
index 000000000..4950f680d
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.PeepholeOptimizer.hs.html
@@ -0,0 +1,92 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Optimizer.PeepholeOptimizer (
+ 2 peepholeOptimize1,
+ 3 peepholeOptimize2,
+ 4 peepholeOptimize3,
+ 5 ) where
+ 6
+ 7 import HelVM.HelMA.Automaton.Instruction
+ 8
+ 9 import HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
+ 10 import HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
+ 11
+ 12 import HelVM.HelMA.Automaton.Instruction.Extras.Constructors
+ 13 import HelVM.HelMA.Automaton.Instruction.Extras.Patterns
+ 14
+ 15 peepholeOptimize1 :: InstructionList -> InstructionList
+ 16 peepholeOptimize1 = fix optimize where
+ 17 optimize :: (InstructionList -> InstructionList) -> InstructionList -> InstructionList
+ 18 optimize f (ConsP i : BinaryP op : il) = immediateBinaryI i op : f il
+ 19 optimize f (ConsP i : HalibutP : il) = optimizeHalibut i : f il
+ 20 optimize f (ConsP i : PickP : il) = optimizePick i : f il
+ 21 optimize f (ConsP c : ConsP a : BranchTP t : il) = optimizeBranch t c a <> f il
+ 22 optimize f (ConsP a : BranchTP t : il) = optimizeBranchLabel t a <> f il
+ 23 optimize f (i : il) = i : f il
+ 24 optimize _ [] = []
+ 25
+ 26 peepholeOptimize2 :: InstructionList -> InstructionList
+ 27 peepholeOptimize2 = fix optimize where
+ 28 optimize :: (InstructionList -> InstructionList) -> InstructionList -> InstructionList
+ 29 optimize f (ConsP c : MoveIP i : BranchTP t : il) = optimizeBranchCondition i t c <> f il
+ 30 optimize f (MoveIP 1 : BranchTP t : il) = branchSwapI t : f il
+ 31 optimize f (i : il) = i : f il
+ 32 optimize _ [] = []
+ 33
+ 34 peepholeOptimize3 :: InstructionList -> InstructionList
+ 35 peepholeOptimize3 = fix optimize where
+ 36 optimize :: (InstructionList -> InstructionList) -> InstructionList -> InstructionList
+ 37 optimize f (j@(JumpP _) : il) = j : f (dropWhile (not . isMark) il)
+ 38 optimize f (i : il) = i : f il
+ 39 optimize _ [] = []
+ 40
+ 41 optimizeHalibut :: Integer -> Instruction
+ 42 optimizeHalibut i
+ 43 | 0 < i = moveII $ fromIntegral i
+ 44 | otherwise = copyII $ fromIntegral $ negate i
+ 45
+ 46 optimizePick :: Integer -> Instruction
+ 47 optimizePick i
+ 48 | 0 <= i = copyII $ fromIntegral i
+ 49 | otherwise = moveII $ fromIntegral $ negate i
+ 50
+ 51 optimizeBranch :: BranchTest -> Integer -> Integer -> InstructionList
+ 52 optimizeBranch t c a = check $ isJump t c where
+ 53 check True = [jumpII $ fromIntegral a]
+ 54 check _ = []
+ 55
+ 56 optimizeBranchLabel :: BranchTest -> Integer -> InstructionList
+ 57 optimizeBranchLabel t a = [branchI t $ fromIntegral a]
+ 58
+ 59 optimizeBranchCondition :: Index -> BranchTest -> Integer -> InstructionList
+ 60 optimizeBranchCondition 1 t c = optimizeBranchCondition1 t c
+ 61 optimizeBranchCondition i t c = check $ isJump t c where
+ 62 check True = [moveII1 , jumpTI]
+ 63 check _ = [moveII1 , discardI]
+ 64 moveII1 = moveII (i - 1)
+ 65
+ 66 optimizeBranchCondition1 :: BranchTest -> Integer -> InstructionList
+ 67 optimizeBranchCondition1 t c = check $ isJump t c where
+ 68 check True = [jumpTI]
+ 69 check _ = [discardI]
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.hs.html
new file mode 100644
index 000000000..7c49aa50b
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Optimizer.hs.html
@@ -0,0 +1,40 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Optimizer (
+ 2 optimize,
+ 3 constantFolding,
+ 4 ) where
+ 5
+ 6 import HelVM.HelMA.Automaton.API.OptimizationLevel
+ 7
+ 8 import HelVM.HelMA.Automaton.Instruction
+ 9
+ 10 import HelVM.HelMA.Automaton.Optimizer.ConstantFoldingOptimizer
+ 11 import HelVM.HelMA.Automaton.Optimizer.PeepholeOptimizer
+ 12
+ 13 optimize :: OptimizationLevel -> InstructionList -> InstructionList
+ 14 optimize NoOptimizations = id
+ 15 optimize BasicOptimizations = constantFolding
+ 16 optimize SomeOptimizations = peepholeOptimize1 . constantFolding
+ 17 optimize AllOptimizations = peepholeOptimize3 . peepholeOptimize2 . peepholeOptimize1 . constantFolding
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.ReadPExtra.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.ReadPExtra.hs.html
new file mode 100644
index 000000000..d4c90e469
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.ReadPExtra.hs.html
@@ -0,0 +1,68 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.ReadPExtra where
+ 2
+ 3 import HelVM.HelMA.Automaton.API.IOTypes
+ 4
+ 5 import HelVM.HelIO.Control.Safe
+ 6
+ 7 import Control.Type.Operator
+ 8
+ 9 import Data.Char
+ 10
+ 11 import Text.ParserCombinators.ReadP hiding (many)
+ 12
+ 13 runParser :: MonadSafe m => ReadP a -> Source -> m a
+ 14 runParser parser source = fst . last <$> nonEmptyRunParser parser source
+ 15
+ 16 nonEmptyRunParser :: MonadSafe m => ReadP a -> Source -> m $ NonEmpty (a , String)
+ 17 nonEmptyRunParser parser source = nonEmptyFromList ("Cannot parse source\n" <> source) $ listRunParser parser source
+ 18
+ 19 listRunParser :: ReadP a -> Source -> [(a , String)]
+ 20 listRunParser parser = readP_to_S parser . toString
+ 21
+ 22 -- | Parsers
+ 23
+ 24 oneOf :: String -> ReadP Char
+ 25 oneOf cs = satisfy (`elem` cs)
+ 26
+ 27 notChar :: Char -> ReadP Char
+ 28 notChar c = satisfy (/= c)
+ 29
+ 30 anyChar :: ReadP Char
+ 31 anyChar = satisfy $ const True
+ 32
+ 33 digit :: ReadP Char
+ 34 digit = satisfy isDigit
+ 35
+ 36 letterAscii :: ReadP Char
+ 37 letterAscii = satisfy isAlphaAscii
+ 38
+ 39 -- | Extra
+ 40
+ 41 isAlphaAscii :: Char -> Bool
+ 42 isAlphaAscii c = isAsciiLower c || isAsciiUpper c
+ 43
+ 44 manyNonEmpty :: Alternative f => f a -> f $ NonEmpty a
+ 45 manyNonEmpty p = liftA2 (:|) p (many p)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.CellType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.CellType.hs.html
new file mode 100644
index 000000000..002b3d218
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.CellType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Types.CellType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultCellType :: CellType
+ 7 defaultCellType = defaultEnum
+ 8
+ 9 cellTypes :: [CellType]
+ 10 cellTypes = generateEnums 8
+ 11
+ 12 -- | Types
+ 13 data CellType = Int8Type | Word8Type | Int16Type | Word16Type | Int32Type | Word32Type | Int64Type | Word64Type
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.DumpType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.DumpType.hs.html
new file mode 100644
index 000000000..e6e0c3e6f
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.DumpType.hs.html
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Types.DumpType where
+ 2
+ 3 import HelVM.HelMA.Automaton.IO.BusinessIO
+ 4
+ 5 import HelVM.HelIO.Control.Logger
+ 6
+ 7 import HelVM.HelIO.Extra
+ 8 import HelVM.HelIO.SwitchEnum
+ 9
+ 10 logDump :: (BIO m , Show d) => DumpType -> d -> m ()
+ 11 logDump dt d = logDump' $ dump dt d where
+ 12 logDump' Nothing = pass
+ 13 logDump' (Just t) = logMessageTuple ("dump" , t)
+ 14
+ 15 dump :: Show a => DumpType -> a -> Maybe Text
+ 16 dump No _ = Nothing
+ 17 dump Ugly a = Just $ show a
+ 18 dump Pretty a = Just $ showP a
+ 19
+ 20 -- | Constructors
+ 21 defaultDumpType :: DumpType
+ 22 defaultDumpType = defaultEnum
+ 23
+ 24 dumpTypes :: [DumpType]
+ 25 dumpTypes = generateEnums 3
+ 26
+ 27 -- | Types
+ 28 data DumpType = No | Ugly | Pretty
+ 29 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.FormatType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.FormatType.hs.html
new file mode 100644
index 000000000..96a182cbe
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.FormatType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Types.FormatType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultFormatType :: FormatType
+ 7 defaultFormatType = defaultEnum
+ 8
+ 9 formatTypes :: [FormatType]
+ 10 formatTypes = bothEnums
+ 11
+ 12 -- | Types
+ 13 data FormatType = BinaryLabel | TextLabel
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.IntCellType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.IntCellType.hs.html
new file mode 100644
index 000000000..550234485
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.IntCellType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Types.IntCellType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultIntCellType :: IntCellType
+ 7 defaultIntCellType = defaultEnum
+ 8
+ 9 intCellTypes :: [IntCellType]
+ 10 intCellTypes = generateEnums 5
+ 11
+ 12 -- | Types
+ 13 data IntCellType = IntegerType | Int8Type | Int16Type | Int32Type | Int64Type
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.RAMType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.RAMType.hs.html
new file mode 100644
index 000000000..c76725fb7
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.RAMType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Types.RAMType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultRAMType :: RAMType
+ 7 defaultRAMType = defaultEnum
+ 8
+ 9 ramTypes :: [RAMType]
+ 10 ramTypes = generateEnums 4
+ 11
+ 12 -- | Types
+ 13 data RAMType = MapListRAMType | SListRAMType | SeqRAMType | ListRAMType
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.StackType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.StackType.hs.html
new file mode 100644
index 000000000..3d02d8a43
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.StackType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Types.StackType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultStackType :: StackType
+ 7 defaultStackType = defaultEnum
+ 8
+ 9 stackTypes :: [StackType]
+ 10 stackTypes = generateEnums 3
+ 11
+ 12 -- | Types
+ 13 data StackType = SeqStackType | SListStackType | ListStackType
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.TokenType.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.TokenType.hs.html
new file mode 100644
index 000000000..1f07b3bf4
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.Types.TokenType.hs.html
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.Types.TokenType where
+ 2
+ 3 import HelVM.HelIO.SwitchEnum
+ 4
+ 5 -- | Constructors
+ 6 defaultTokenType :: TokenType
+ 7 defaultTokenType = defaultEnum
+ 8
+ 9 tokenTypes :: [TokenType]
+ 10 tokenTypes = bothEnums
+ 11
+ 12 -- | Types
+ 13 data TokenType = WhiteTokenType | VisibleTokenType
+ 14 deriving stock (Bounded , Enum , Eq , Read , Show)
+
+
+
+
diff --git a/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.WrapTokenList.hs.html b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.WrapTokenList.hs.html
new file mode 100644
index 000000000..41a99454c
--- /dev/null
+++ b/docs/reports/helma-test/helma-0.8.4.8-inplace/HelVM.HelMA.Automaton.WrapTokenList.hs.html
@@ -0,0 +1,38 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module HelVM.HelMA.Automaton.WrapTokenList where
+ 2
+ 3 import qualified Text.Read
+ 4 import qualified Text.Show
+ 5
+ 6 newtype WrapTokenList a = WrapTokenList { unWrapTokenList :: a }
+ 7 deriving stock (Eq)
+ 8
+ 9 ----
+ 10
+ 11 instance Show a => Show (WrapTokenList [a]) where
+ 12 show (WrapTokenList tokens) = show =<< tokens
+ 13
+ 14 instance Read a => Read (WrapTokenList [a]) where
+ 15 readsPrec _ source = [( WrapTokenList $ maybeToList . readMaybe . one =<< source , "")]
+
+
+
+
diff --git a/docs/reports/helma-test/hpc_index.html b/docs/reports/helma-test/hpc_index.html
index 47cfbeb8c..c2b129d07 100644
--- a/docs/reports/helma-test/hpc_index.html
+++ b/docs/reports/helma-test/hpc_index.html
@@ -7,264 +7,264 @@