forked from glen/fostr
100 lines
3.4 KiB
Plaintext
100 lines
3.4 KiB
Plaintext
module haskell
|
|
imports libstrategolib signatures/- signature/TYPE util analysis
|
|
rules
|
|
/* Approach:
|
|
A) We will define a local transformation taking a term with value strings
|
|
at each child to a value string for the node.
|
|
B) We will append IO actions needed to set up for the value progressively
|
|
to a Preactions rule (mapping () to the list of actions). There will
|
|
be a utility `add-preaction` to append a new clause to value of this
|
|
rule.
|
|
C) We will use bottomup-para to traverse the full AST with the
|
|
transformation from A so that we have access to the original expression
|
|
(and can get the Statix-associated type when we need to).
|
|
Hence the transformation in (A) must actually take a pair of
|
|
an (original) term and a term with value strings at each child,
|
|
and be certain to return a value string.
|
|
|
|
Finally, at the toplevel we emit the result of <Preactions>() before
|
|
returning the final value.
|
|
*/
|
|
|
|
hs: (_, TopLevel(val)) -> $[-- Preamble from fostr
|
|
import System.IO
|
|
data IOStream = StdIO
|
|
|
|
-- Danger: These currently assume the stream is StdIO
|
|
gets :: Show b => a -> b -> IO a
|
|
gets s d = do
|
|
putStr(show d)
|
|
return s
|
|
|
|
getsStr :: a -> String -> IO a
|
|
getsStr s d = do
|
|
putStr(d)
|
|
return s
|
|
|
|
emit s = getLine
|
|
|
|
main = do
|
|
[<Preactions>()]return [val]]
|
|
|
|
hs: (_, Stream()) -> "StdIO"
|
|
hs: (_, Int(x)) -> x
|
|
hs: (_, LitString(x)) -> <haskLitString>x
|
|
hs: (_, EscString(x)) -> x
|
|
hs: (_, Sum(x, y)) -> $[([x] + [y])]
|
|
hs: (_, Concat(x, y)) -> $[([x] ++ [y])]
|
|
|
|
hs: (Gets(_, xn), Gets(s, x)) -> v
|
|
with v := <newname>"_fostr_get"
|
|
; <add-preactions>[$[[v] <- [<hs_gets>(s, xn, x)]]]
|
|
hs: (To(xn, _), To(x, s)) -> v
|
|
with v := <newname>"_fostr_to"
|
|
; <add-preactions>[$[let [v] = [x]], <hs_gets>(s, xn, v)]
|
|
|
|
hs_gets: (s, xn, x ) -> $[[s] [<hs_getOp>xn] [x]]
|
|
hs_getOp = get-type; (?STRING() < !"`getsStr`" + !"`gets`")
|
|
|
|
hs: (_, Emits(s)) -> v
|
|
with v := <newname>"_fostr_emitted"
|
|
; <add-preactions>[$[[v] <- emit [s]]]
|
|
|
|
hs: (_, Terminate(x)) -> $[[x];;]
|
|
hs: (_, Sequence(l)) -> <last>l
|
|
/* One drawback of using paramorphism is we have to handle lists
|
|
explicitly:
|
|
*/
|
|
hs: (_, []) -> []
|
|
hs: (_, [x | xs]) -> [x | xs]
|
|
|
|
/* Another drawback of using paramorphism is at the very leaves we have
|
|
to undouble the tuple:
|
|
*/
|
|
hs: (x, x) -> x where <is-string>x
|
|
|
|
/* Characters we need to escape in Haskell string constants */
|
|
Hascape: ['\t' | cs ] -> ['\', 't' | cs ]
|
|
/* I think I can just use ASCII constants for characters... */
|
|
Hascape: [ 0 | cs ] -> ['\', '0' | cs ]
|
|
Hascape: [ 7 | cs ] -> ['\', 'a' | cs ] // Alert
|
|
Hascape: [ 8 | cs ] -> ['\', 'b' | cs ] // Backspace
|
|
Hascape: [ 11 | cs ] -> ['\', 'v' | cs ] // Vertical tab
|
|
Hascape: [ 12 | cs ] -> ['\', 'f' | cs ] // Form feed
|
|
|
|
strategies
|
|
haskLitString = un-single-quote
|
|
; string-as-chars(escape-chars(Escape <+ Hascape))
|
|
; double-quote
|
|
|
|
haskell = rules(Preactions: () -> ""); bottomup-para(try(hs))
|
|
|
|
/* See "Approach" at top of file */
|
|
add-preactions = newp := <conc-strings>(<Preactions>(), <lines>)
|
|
; rules(Preactions: () -> newp)
|
|
|
|
// Interface haskell code generation with editor services and file system
|
|
to-haskell: (selected, _, _, path, project-path) -> (filename, result)
|
|
with filename := <guarantee-extension(|"hs")> path
|
|
; result := <haskell> selected
|