Skip to content

Commit 4628296

Browse files
heinemanheineman
committed
Haskell Grow works up to M3 now.
1 parent a969c17 commit 4628296

17 files changed

Lines changed: 202 additions & 164 deletions

‎src/main/scala/example/expression/haskell/HUnitTestGenerator.scala‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ trait HUnitTestGenerator extends HaskellGenerator {
3131
def actual(test:TestCase):Haskell = dispatch(convert(test.inst), test.op)
3232

3333
/** Return JUnit test case associated with these given test cases. */
34-
def hunitMethod(model:Model, tests:Seq[TestCase]) : Haskell = {
34+
def hunitMethod(tests:Seq[TestCase]) : Haskell = {
3535
val stmts:Seq[Haskell] = tests.zipWithIndex.flatMap(pair => {
3636
val test = pair._1
3737
val idx = pair._2

‎src/main/scala/example/expression/haskell/HaskellGenerator.scala‎

Lines changed: 32 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
package example.expression.haskell /*DI:LD:AI*/
22

3-
import java.nio.file.Paths
3+
import java.io.File
4+
import java.nio.file.{Files, Path, Paths}
5+
import java.util.Scanner
46

57
import example.expression.generator.LanguageIndependentGenerator
68

@@ -11,6 +13,9 @@ import example.expression.generator.LanguageIndependentGenerator
1113
*/
1214
trait HaskellGenerator extends LanguageIndependentGenerator with StandardHaskellBinaryMethod with HaskellBinaryMethod {
1315

16+
/** Specially required files are placed in this area. */
17+
val haskellResources:String = Seq("src", "main", "resources", "haskell-code").mkString(File.separator)
18+
1419
type CompilationUnit = HaskellWithPath
1520
type Type = HaskellType
1621
type Expression = Haskell
@@ -59,7 +64,6 @@ trait HaskellGenerator extends LanguageIndependentGenerator with StandardHaskell
5964
new Haskell(s"$functionName $bars = $defaultExpression")
6065
}
6166

62-
6367
def generateDataTypes(m:domain.Model): HaskellWithPath = {
6468
val allTypes = m.types.map(exp => {
6569
val params:Seq[HaskellType] = exp.attributes.map(att => typeConverter(att.tpe))
@@ -89,4 +93,30 @@ trait HaskellGenerator extends LanguageIndependentGenerator with StandardHaskell
8993
HaskellWithPath(code, Paths.get("DataTypes.hs"))
9094
}
9195

96+
/** Taken from scala meta web page. */
97+
def loadSource(entry:String*) : HaskellWithPath = {
98+
val path:Path = java.nio.file.Paths.get(haskellResources, entry: _*)
99+
val contents = java.nio.file.Files.readAllBytes(path).map(_.toChar).mkString
100+
101+
HaskellWithPath(Haskell(contents), Paths.get(entry.head, entry.tail : _*))
102+
}
103+
104+
/**
105+
* Helpful snippet to get all regular files below a given directory, using
106+
* the specified header as the relative path to those files
107+
*/
108+
def getRecursiveListOfFiles(dir: File, header:String*): Seq[HaskellWithPath] = {
109+
val these:Seq[File] = dir.listFiles
110+
val sources:Seq[HaskellWithPath] = these.filterNot(f => f.isDirectory).map(f => loadSource(header :+ f.getName : _*))
111+
112+
sources ++ these.filter(_.isDirectory).flatMap(f => getRecursiveListOfFiles(f, header :+ f.getName : _*))
113+
}
114+
115+
/**
116+
* Helper artifacts to be loaded for Haskell.
117+
*/
118+
def helperClasses():Seq[HaskellWithPath] = {
119+
getRecursiveListOfFiles(Paths.get(haskellResources).toFile)
120+
}
121+
92122
}

‎src/main/scala/example/expression/haskell/e0.scala‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -67,9 +67,7 @@ trait e0 extends HaskellGenerator with HUnitTestGenerator with M0 {
6767
}
6868

6969
abstract override def testGenerator: Seq[Haskell] = {
70-
val a1 = new BinaryInst(Add, new LitInst(1.0), new LitInst(2.0))
71-
val lit1 = new LitInst(5.0)
7270

73-
super.testGenerator :+ hunitMethod(m0, M0_tests)
71+
super.testGenerator :+ hunitMethod(M0_tests)
7472
}
7573
}

‎src/main/scala/example/expression/haskell/e1.scala‎

Lines changed: 1 addition & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -28,19 +28,6 @@ trait e1 extends Evolution with HaskellGenerator with HUnitTestGenerator with M1
2828
}
2929

3030
abstract override def testGenerator: Seq[Haskell] = {
31-
32-
super.testGenerator :+ hunitMethod(m1, M1_tests)
33-
// val s1 = new domain.BinaryInst(Sub, new LitInst(1.0), new LitInst(2.0))
34-
//
35-
// super.testGenerator :+ new Haskell(
36-
// s"""
37-
// |s1 = ${convert(s1)}
38-
// |-- for some reason, can't type in "-1.0" plain, but must make it an expression...
39-
// |test_e1_1 = TestCase (assertEqual "MinusCheck" (0 -1.0) (${Eval.name} s1))
40-
// |test_e1 = TestList [ TestLabel "1" test_e1_1 ]
41-
// |
42-
// |main :: IO Counts
43-
// |main = runTestTT test_e1
44-
// |""".stripMargin)
31+
super.testGenerator :+ hunitMethod(M1_tests)
4532
}
4633
}

‎src/main/scala/example/expression/haskell/e2.scala‎

Lines changed: 4 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -44,9 +44,9 @@ trait e2 extends Evolution with HaskellGenerator with HUnitTestGenerator with M0
4444
op match {
4545
case PrettyP =>
4646
exp match {
47-
case Lit => Seq(Haskell(s""" show ${atts(litValue)}"""))
48-
case Add => Seq(Haskell(s""" "(" ++ ${dispatch(atts(base.left), op)} ++ "+" ++ ${dispatch(atts(base.right), op)} ++ ")" """))
49-
case Sub => Seq(Haskell(s""" "(" ++ ${dispatch(atts(base.left), op)} ++ "-" ++ ${dispatch(atts(base.right), op)} ++ ")" """))
47+
case Lit => Seq(Haskell(s"""(show ${atts(litValue)})"""))
48+
case Add => Seq(Haskell(s""""(" ++ ${dispatch(atts(base.left), op)} ++ "+" ++ ${dispatch(atts(base.right), op)} ++ ")""""))
49+
case Sub => Seq(Haskell(s""""(" ++ ${dispatch(atts(base.left), op)} ++ "-" ++ ${dispatch(atts(base.right), op)} ++ ")""""))
5050
case _ => super.logic(exp)(op)
5151
}
5252

@@ -55,25 +55,6 @@ trait e2 extends Evolution with HaskellGenerator with HUnitTestGenerator with M0
5555
}
5656

5757
abstract override def testGenerator: Seq[Haskell] = {
58-
59-
super.testGenerator :+ hunitMethod(m2, M2_tests)
60-
// val s1 = new BinaryInst(Sub, new LitInst(1.0), new LitInst(2.0))
61-
// val a1 = new BinaryInst(Add, new LitInst(1.0), new LitInst(2.0))
62-
// val lit1 = new LitInst(5.0)
63-
//
64-
// super.testGenerator :+ new Haskell(
65-
// s"""
66-
// |s1 = ${convert(s1)}
67-
// |a1 = ${convert(a1)}
68-
// |lit1 = ${convert(lit1)}
69-
// |test_e2_1 = TestCase (assertEqual "MinusCheck" "(1.0-2.0)" (${PrettyP.name} s1))
70-
// |test_e2_2 = TestCase (assertEqual "LitCheck" "5.0" (${PrettyP.name} lit1))
71-
// |test_e2_3 = TestCase (assertEqual "PlusCheck" "(1.0+2.0)" (${PrettyP.name} a1))
72-
// |
73-
// |test_e2 = TestList [ TestLabel "1" test_e2_1, TestLabel "2" test_e2_2, TestLabel "3" test_e2_3 ]
74-
// |
75-
// |main :: IO Counts
76-
// |main = runTestTT test_e2
77-
// |""".stripMargin)
58+
super.testGenerator :+ hunitMethod(M2_tests)
7859
}
7960
}

‎src/main/scala/example/expression/haskell/e3.scala‎

Lines changed: 1 addition & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -39,31 +39,7 @@ trait e3 extends Evolution with HaskellGenerator with HUnitTestGenerator with M0
3939
}
4040

4141
abstract override def testGenerator: Seq[Haskell] = {
42-
43-
super.testGenerator :+ hunitMethod(m3, M3_tests)
44-
// // (5/7) / (7-(2*3) --> just (5/7)
45-
// val n1 = new domain.UnaryInst(Neg, new LitInst(5.0))
46-
// val m1 = new domain.BinaryInst(Mult, new LitInst(2.0), new LitInst(3.0))
47-
// val s1 = new domain.UnaryInst(Neg, m1)
48-
// val m2 = new domain.BinaryInst(Mult, new domain.BinaryInst (Divd, new LitInst(5.0), new LitInst(2.0)), new LitInst(4.0))
49-
//
50-
// super.testGenerator :+ new Haskell(
51-
// s"""
52-
// |n1 = ${convert(n1)}
53-
// |m1 = ${convert(m1)}
54-
// |m2 = ${convert(m2)}
55-
// |test_e3_1 = TestCase (assertEqual "NegCheck-Eval" (0-5.0) (${Eval.name} n1))
56-
// |test_e3_2 = TestCase (assertEqual "NegCheck-Print" "-5.0" (${PrettyP.name} n1))
57-
// |test_e3_3 = TestCase (assertEqual "MultCheck-Eval" 6.0 (${Eval.name} m1))
58-
// |test_e3_4 = TestCase (assertEqual "MultCheck-Print" "(2.0*3.0)" (${PrettyP.name} m1))
59-
// |test_e3_5 = TestCase (assertEqual "MultCheck-Eval" 10.0 (${Eval.name} m2))
60-
// |test_e3_6 = TestCase (assertEqual "MultCheck-Print" "((5.0/2.0)*4.0)" (${PrettyP.name} m2))
61-
// |
62-
// |test_e3 = TestList [ TestLabel "1" test_e3_1, TestLabel "2" test_e3_2, TestLabel "3" test_e3_3, TestLabel "4" test_e3_4, TestLabel "5" test_e3_5, TestLabel "6" test_e3_6 ]
63-
// |
64-
// |main :: IO Counts
65-
// |main = runTestTT test_e3
66-
// |""".stripMargin)
42+
super.testGenerator :+ hunitMethod(M3_tests)
6743
}
6844
}
6945

‎src/main/scala/example/expression/haskell/e4.scala‎

Lines changed: 1 addition & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -123,34 +123,7 @@ trait e4 extends Evolution with HaskellGenerator with HUnitTestGenerator with Pr
123123
}
124124

125125
abstract override def testGenerator: Seq[Haskell] = {
126-
127-
super.testGenerator :+ hunitMethod(m4, M4_tests)
128-
129-
// // (5/7) / (7-(2*3) --> just (5/7)
130-
// val n1 = new domain.UnaryInst(Neg, new LitInst(5.0))
131-
// val m1 = new domain.BinaryInst(Mult, new LitInst(2.0), new LitInst(3.0))
132-
// val m2 = new domain.BinaryInst(Mult, new domain.BinaryInst (Divd, new LitInst(5.0), new LitInst(2.0)), new LitInst(4.0))
133-
//
134-
// val d1 = new domain.BinaryInst(Divd, new LitInst(5.0), new LitInst(7.0))
135-
// val s1 = new domain.BinaryInst(Sub, new LitInst(7.0), m1)
136-
// val d2 = new domain.BinaryInst(Divd, d1, s1)
137-
//
138-
// super.testGenerator :+ new Haskell(
139-
// s"""
140-
// |n1 = ${convert(n1)}
141-
// |m2 = ${convert(m2)}
142-
// |d2 = ${convert(d2)}
143-
// |d1 = ${convert(d1)}
144-
// |test_e4_1 = TestCase (assertEqual "NegCheck-Eval" (0-5.0) (${Eval.name} n1))
145-
// |test_e4_2 = TestCase (assertEqual "Simplify-Print" (${PrettyP.name} d1) (${PrettyP.name} d2))
146-
// |-- collect test case
147-
// |test_e4_3 = TestCase (assertEqual "Collect-D1" [5,7,7,2,3] (${Collect.name} d2))
148-
// |
149-
// |test_e4 = TestList [ TestLabel "1" test_e4_1, TestLabel "2" test_e4_2, TestLabel "3" test_e4_3 ]
150-
// |
151-
// |main :: IO Counts
152-
// |main = runTestTT test_e4
153-
// |""".stripMargin)
126+
super.testGenerator :+ hunitMethod(M4_tests)
154127
}
155128

156129
}

‎src/main/scala/example/expression/haskell/grow/GrowGenerator.scala‎

Lines changed: 52 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -15,10 +15,10 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
1515

1616
/** For the processed model, return generated code artifacts for solution. */
1717
def generatedCode():Seq[HaskellWithPath] = {
18-
getModel.inChronologicalOrder.map(m => generateEvolution(m)) :+
19-
generateDataTypes(flat)
20-
}
2118

19+
helperClasses() ++
20+
getModel.inChronologicalOrder.map(m => generateEvolution(m))
21+
}
2222

2323
/** Combined string from the types. */
2424
def extTypeDeclaration(m:Model):String = {
@@ -32,18 +32,11 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
3232
/** Combined string from the types. */
3333
def extDeclaration(m:Model):String = {
3434
"Ext_" + m.name.capitalize
35-
//onlyTypes(m) + "Ext"
3635
}
3736

3837
/** Exp defined solely by types. */
3938
def expDeclaration(m:Model):String = {
40-
4139
domain.baseTypeRep.name + "_" + m.name.capitalize
42-
// if (m.last.isEmpty) {
43-
// domain.baseTypeRep.name
44-
// } else {
45-
// onlyTypes(m) + domain.baseTypeRep.name
46-
// }
4740
}
4841

4942
/**
@@ -55,6 +48,7 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
5548
*/
5649
def generateOp(m:Model, op:Operation) : Haskell = {
5750
val mcaps = m.name.capitalize // haskell needs data to be capitalized!
51+
5852
val baseDomain = domain.baseTypeRep.name
5953
val name = op.name
6054

@@ -67,23 +61,31 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
6761
case u: Unary => s"$name${expDeclaration(m)} helpWith "
6862
case _ => s"$name${expDeclaration(m)} _ "
6963
}
70-
val rest0 = s"(${exp.name.capitalize} ${standardArgs(exp).getCode}) = " + logic(exp)(op).mkString("\n")
71-
72-
// be sure to append "_Mi" to the end of every Exp
73-
val rest = rest0.replace(" helpWith ", s"_$mcaps helpWith ")
7464

75-
val modifiedRest = if (!m.last.isEmpty) {
65+
val modifiedRest = { // if (!m.last.isEmpty)
7666
// must embed 'help' properly, if needed
7767
val code = logic(exp)(op).mkString("\n")
7868
if (code.contains(" helpWith ")) {
79-
s"""(${exp.name.capitalize} ${standardArgs(exp).getCode}) =
80-
# let help = $name${expDeclaration(m)} helpWith in
81-
# ${code.replace(" helpWith ", " help ")}""".stripMargin('#')
69+
val prior = m.last.name.capitalize
70+
71+
// old: let help = $name${expDeclaration(m.last)} ($name${expDeclaration(m)} helpWith) in
72+
73+
74+
if (!m.last.isEmpty) {
75+
val invoke = m.inChronologicalOrder.reverse.tail.foldLeft(s"(${op.name}${expDeclaration(m)} helpWith)")((former,tail) =>
76+
s"(${op.name}${expDeclaration(tail)} $former)")
77+
78+
s"""(${exp.name.capitalize} ${standardArgs(exp).getCode}) =
79+
# let help = $invoke in
80+
# ${code.replace(s"$name${domain.baseTypeRep.name} helpWith ", "help ")}""".stripMargin('#')
81+
} else {
82+
s"""(${exp.name.capitalize} ${standardArgs(exp).getCode}) =
83+
# let help = $name${expDeclaration(m)} helpWith in
84+
# ${code.replace(s"$name${domain.baseTypeRep.name} helpWith ", "help ")}""".stripMargin('#')
85+
}
8286
} else {
83-
rest
87+
s"(${exp.name.capitalize} ${standardArgs(exp).getCode}) = " + logic(exp)(op).mkString("\n")
8488
}
85-
} else {
86-
rest
8789
}
8890
head + modifiedRest
8991
}).mkString("\n")
@@ -106,12 +108,20 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
106108
header
107109
}
108110

109-
// only the evolution that defines this opration needs this declaration
110-
val baseDeclaration = if (m.ops.contains(op)) {
111-
s"$name${domain.baseTypeRep.name} = $name${expDeclaration(m)} -- define for future extensions"
112-
} else {
113-
""
114-
}
111+
// if we define new operations, we must expand as provided
112+
val invocation = { // if (m.ops.nonEmpty) {
113+
// FIX HERE
114+
val invoke = m.inChronologicalOrder.reverse.tail.foldLeft(s"(${op.name}${expDeclaration(m)} helpWith${op.name.capitalize}$mcaps)")((former,tail) =>
115+
s"(${op.name}${expDeclaration(tail)} $former)")
116+
117+
s"""#${op.name}$baseDomain$mcaps :: ${expDeclaration(m.base())} $mcaps -> ${typeConverter(op.returnType.get)}
118+
#${op.name}$baseDomain$mcaps e = $invoke e
119+
#""".stripMargin('#')
120+
} //else {
121+
// s"""#${op.name}$baseDomain$mcaps :: ${expDeclaration(m)} $mcaps -> ${typeConverter(op.returnType.get)}
122+
// #${op.name}$baseDomain$mcaps e = ${op.name}${expDeclaration(m)} helpWith${op.name.capitalize}$mcaps e
123+
// #""".stripMargin('#')
124+
// }
115125

116126
new Haskell(s"""
117127
#-- | Evaluates expression.
@@ -121,19 +131,20 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
121131
# -> ${expDeclaration(m)} f
122132
# -- ^ The expression to evaluate
123133
# -> $returnType
134+
#
124135
#$inner
125136
#$name${expDeclaration(m)} helpWith (${extDeclaration(m)} inner) = helpWith inner
126-
#$baseDeclaration
127-
#-- | Helps with extensions $mcaps
128-
#helpWith${op.name.capitalize}$mcaps :: $previous -> ${typeConverter(op.returnType.get)}
129-
#helpWith${op.name.capitalize}$mcaps = absurd
130137
#
131138
#-- | Evaluates an $mcaps expression
132139
#-- | Calls ${op.name}$baseDomain with the $mcaps helper
133-
#${op.name}$baseDomain$mcaps :: ${expDeclaration(m)} $mcaps -> ${typeConverter(op.returnType.get)}
134-
#${op.name}$baseDomain$mcaps e = ${op.name}${expDeclaration(m)} helpWith${op.name.capitalize}$mcaps e
140+
#$invocation
141+
#
142+
#-- | Helps with extensions $mcaps
143+
#helpWith${op.name.capitalize}$mcaps :: Void -> ${typeConverter(op.returnType.get)}
144+
#helpWith${op.name.capitalize}$mcaps = absurd
145+
#
135146
#""".stripMargin('#'))
136-
}
147+
} // Void had been $previous
137148

138149
def generateData(m:Model):Haskell = {
139150
val mcaps = m.name.capitalize // haskell needs data to be capitalized!
@@ -147,6 +158,11 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
147158
}
148159
).mkString("\n | ")
149160

161+
val priorOps:String = if (m.ops.nonEmpty) {
162+
m.inChronologicalOrder.reverse.tail.reverse.flatMap(priorM => {
163+
m.ops.map(op => s"-- ${priorM.name.capitalize} part for ${op.name}\n" + generateOp(priorM, op) + s"-- DONE ${priorM.name.capitalize} part\n")}).mkString("\n")
164+
} else { "" }
165+
150166
val ops:String = m.ops.map(op => generateOp(m, op)).mkString("\n")
151167

152168
var pastExtensions:String = ""
@@ -179,6 +195,7 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
179195
#-- | of Exp used for this evolution.
180196
#type family ${extTypeDeclaration(m)} f
181197
#
198+
#$priorOps
182199
#$ops
183200
#
184201
#-- Evolution $mcaps
@@ -189,6 +206,7 @@ trait GrowGenerator extends HaskellGenerator with StandardHaskellBinaryMethod wi
189206
#$pastExtensions
190207
#type instance ${extTypeDeclaration(m)} $mcaps = Void
191208
#
209+
#
192210
#$pastOps
193211
#""".stripMargin('#')) // HACK: Issue with "|"
194212
}

0 commit comments

Comments
 (0)