multiquine

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
import Data.Char

data Language = C | Haskell | Python | Perl
  deriving Show

join sep xs = if null xs then [] else foldr1 (\x j -> x ++ sep ++ j) xs

--

-- Program initialization
progInit C = join "" [
  "#include <stdio.h>\n",
  "#include <string.h>\n",
  "int main(int argc, char **argv) {\n",
  "  char *c;\n"
  ]
progInit Haskell = join "" [
  "import Char\n",
  "import System\n",
  "join sep xs = if null xs then [] else foldr1 (\\x j -> x ++ sep ++ j) xs\n",
  "unquote s = join \"\" (map ((:[]).chr) s)\n"
  ]
progInit Python = join "" [
  "import sys\n"
  ]
progInit Perl = ""

-- Start
progStart C = "";
progStart Haskell = "main = do\n";
progStart Python = "";
progStart Perl = "";

-- End
progEnd C = join "" [
  "  return 0;\n",
  "}\n"
  ]
progEnd Haskell = ""
progEnd Python = ""
progEnd Perl = ""

-- aux
quoteBraceDelimited s = (\s-> "{" ++ s ++ "0}") . join "" . map ((++","). show . ord) $ s
quoteBracketDelimited s = (\s-> "[" ++ s ++ "]") . join "," . map (show . ord) $ s

-- Returns a quoted version of the string in the language.
-- The string can be stored in any representation.
quotedString C s = quoteBraceDelimited s
quotedString Haskell s = quoteBracketDelimited s
quotedString Python s = quoteBracketDelimited s
quotedString Perl s = quoteBracketDelimited s

-- aux
printBraceDelimited C varname = join "" [
  "  printf(\"{\");\n",
  "  for (c = " ++ varname ++ "; *c; c++) { printf(\"%i,\", *c); }\n",
  "  printf(\"0}\");\n"
  ]
printBraceDelimited Haskell varname = join "" [
  "  putStr $ \"{\" ++ (join \",\" (map show " ++ varname ++ ")) ++ \",0}\"\n"
  ]
printBraceDelimited Python varname = join "" [
  "  sys.stdout.write('{' + ''.join(map(lambda x: str(x) + ','," ++ varname ++ ")) + '0}')\n"
  ]
printBraceDelimited Perl varname = join "" [
  "print '{';\n",
  "foreach (@$" ++ varname ++ ") { print \"$_,\"}\n",
  "print ',0}';\n"
  ]

printBracketDelimited C varname = join "" [
  "  printf(\"[\");\n",
  "  for (c = " ++ varname ++ "; *c;) { printf(\"%i\", *c); c++; if (*c) { printf(\",\"); } }\n",
  "  printf(\"]\");\n"
  ]
printBracketDelimited Haskell varname = join "" [
  "  putStr $ show " ++ varname ++ "\n"
  ]
printBracketDelimited Python varname = join "" [
  "  sys.stdout.write('[' + ','.join(map(str," ++ varname ++ ")) + ']')\n"
  ]
printBracketDelimited Perl varname = join "" [
  "print '[';\n",
  "$i = 0;\n",
  "foreach (@$" ++ varname ++ ") { if ($i != 0) { print \",\"; } $i++; print $_; }\n",
  "print ']';\n"
  ]

-- Returns a piece of code in the first language that prints a
-- quoted version of the string (stored in `varname`)
-- in the second language.

printQuotedStrVarFromTo source C varname = printBraceDelimited source varname
printQuotedStrVarFromTo source Haskell varname = printBracketDelimited source varname
printQuotedStrVarFromTo source Python varname = printBracketDelimited source varname
printQuotedStrVarFromTo source Perl varname = printBracketDelimited source varname

printQuotedStrVar lang = printQuotedStrVarFromTo lang lang

-- Returns a piece of code in the language that prints
-- the string stored in `varname`.
printUnquotedStrVar C varname = "  printf(\"%s\", " ++ varname ++ ");\n";
printUnquotedStrVar Haskell varname = "  putStr $ unquote " ++ varname ++ "\n"
printUnquotedStrVar Python varname = "  sys.stdout.write(''.join(map(chr," ++ varname ++ ")))\n"
printUnquotedStrVar Perl varname = "  foreach (@$" ++ varname ++ ") { print chr($_); }\n"

-- Returns a piece of code in the language that prints
-- the given string.
printString C s = "  {\n  " ++ defStrVar C "tmp" s ++ "  " ++ printUnquotedStrVar C "tmp" ++ "  }\n"
printString Haskell s = "  putStr $ unquote " ++ quotedString Haskell s ++ "\n"
printString Python s = "  sys.stdout.write(''.join(map(chr," ++ quotedString Python s ++ ")))\n"
printString Perl s = join "" [
  "  $tmp = " ++ quotedString Perl s ++ ";\n",
  "  foreach (@$tmp) { print chr($_); }\n"
  ]

-- Returns a piece of code in the language that should
-- appear before the definition of a string variable
startDefStrVar C varname = "  char " ++ varname ++ "[] = "
startDefStrVar Haskell varname = varname ++ ":: [Int]" ++ "\n" ++ varname ++ " = "
startDefStrVar Python varname = varname ++ " = "
startDefStrVar Perl varname = "$" ++ varname ++ " = "

-- Returns a piece of code in the language that should
-- appear after
endDefStrVar C = ";\n"
endDefStrVar Haskell = "\n"
endDefStrVar Python = "\n"
endDefStrVar Perl = ";\n"

-- Define a quoted string
defStrVar lang varname s = startDefStrVar lang varname ++ quotedString lang s ++ endDefStrVar lang

-- Analyze the program arguments
switchArgs :: Language -> [(Language, String)] -> String
switchArgs C cases = join "" [
  "if (argc < 2) {\n",
  "  fprintf(stderr, \"Usage: %s [language]\\n\", argv[0]);\n",
  join "" . map (\(tgtLang, thn) -> "} else if (!strcmp(argv[1],\"" ++ show tgtLang ++ "\")) {\n" ++ thn) $ cases,
  "} else {\n",
  "  fprintf(stderr, \"Unrecognized language: %s\\n\", argv[1]);\n",
  "}\n"
  ]
switchArgs Haskell cases = join "" [
  "  args <- getArgs\n",
  "  mq args\n",
  "\n",
  join "" . map (\(tgtLang, thn) -> "mq [\"" ++ show tgtLang ++ "\"] = do\n" ++ thn) $ cases,
  "mq x = do putStr (\"Unrecognized language: \" ++ show x ++ \"\\n\")\n"
  ]
switchArgs Python cases = join "" [
  "if len(sys.argv) < 2:\n",
  "  sys.stderr.write('Usage: %s [language]\\n' % (sys.argv[0],))\n",
  join "" . map (\(tgtLang, thn) -> "elif sys.argv[1] == \"" ++ show tgtLang ++ "\":\n" ++ thn) $ cases,
  "else:\n",
  "  sys.stderr.write('Unrecognized language: %s\\n' % (sys.argv,))\n"
  ]
switchArgs Perl cases = join "" [
  "if ($#ARGV == -1) {\n",
  "  die \"Usage self [language]\\n\"\n",
  join "" . map (\(tgtLang, thn) -> "} elsif ($ARGV[0] eq \"" ++ show tgtLang ++ "\") {\n" ++ thn) $ cases,
  "} else {\n",
  "  die \"Unrecognized language: $ARGV[0]\\n\"\n",
  "}\n"
  ]

selfVar lang = "self" ++ show lang

languageList = [C, Haskell, Python, Perl]

defineAllStrVars srcLang = join "" . map (\tgtLang -> defStrVar srcLang (selfVar tgtLang) $ multiquineMiddle tgtLang) $ languageList

printDefineAllStrVars srcLang tgtLang1 = join "" . map (\tgtLang2 ->
  join "" [
    printString             srcLang (startDefStrVar tgtLang1 (selfVar tgtLang2)),
    printQuotedStrVarFromTo srcLang tgtLang1 (selfVar tgtLang2),
    printString             srcLang (endDefStrVar tgtLang1)
    ]) $ languageList

multiquine srcLang = join "" [
  progInit srcLang,
  defineAllStrVars srcLang,
  progStart srcLang,
  multiquineMiddle srcLang,
  progEnd srcLang
  ]
multiquineMiddle srcLang = switchArgs srcLang (map (\tgtLang -> (tgtLang, multiquineMiddleFromTo srcLang tgtLang)) languageList)

multiquineMiddleFromTo srcLang tgtLang = join "" [
  printString           srcLang (progInit tgtLang),
  printDefineAllStrVars srcLang tgtLang,
  printString           srcLang (progStart tgtLang),
  printUnquotedStrVar   srcLang (selfVar tgtLang),
  printString           srcLang (progEnd tgtLang)
  ]

--
main = putStr (multiquine C)