blob: ae80d665643e1827d72a73742079d298dd6512e4 (
plain) (
blame)
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
|
module Fun.Generator where
import Fun.Tree
import Fun.Typer
-- TODO: 'Merge' syntax for danger-asm: _merge (_asm ..) main (_asm ..)
data GenerateError = GenerateError String
-- TODO: There's something about a lifted ++ as alternative here I think
concatEither :: Either GenerateError [String] -> Either GenerateError String
concatEither (Left err ) = Left err
concatEither (Right strs) = Right $ concat strs
generatePattern :: Tree -> FunctionPattern -> Either GenerateError String
generatePattern t (FunctionPattern []) = Right ""
generatePattern t _ = Left $ GenerateError "not implemented"
generateInternalAsmArgs :: [FunctionArgument] -> [Either GenerateError String]
generateInternalAsmArgs [FunctionString x] = [Right x]
generateInternalAsmArgs ((FunctionString x) : xs) =
[Right x] ++ [Right "\n"] ++ (generateInternalAsmArgs xs)
generateInternalAsmArgs _ = [Left $ GenerateError "invalid _asm arguments"]
generateFunctionCall :: Tree -> FunctionBody -> Either GenerateError String
generateFunctionCall t (FunctionBodyCall "_asm" args) =
concatEither $ sequence $ generateInternalAsmArgs args
generateFunctionCall t (FunctionBodyCall name args) =
Left $ GenerateError "not implemented"
generateBody :: Tree -> FunctionBody -> Either GenerateError String
generateBody t c@(FunctionBodyCall _ _) = generateFunctionCall t c
generateBody t (FunctionBodyInfixCall name args) =
Left $ GenerateError "infix function call not implemented"
generateBody t (FunctionBodyValue value) =
Left $ GenerateError "value not implemented"
generateBody t (FunctionBodySub sub) = generateBody t sub
generateDefinition :: Tree -> FunctionDefinition -> Either GenerateError String
generateDefinition t (FunctionDefinition pattern body) =
concatEither $ sequence $ [generatePattern t pattern, generateBody t body]
generateFunction :: Tree -> Block -> Either GenerateError String
generateFunction t (FunctionBlock decl defns) =
let defn = concatEither $ sequence $ map (\d -> generateDefinition t d) defns
in case defn of
Left _ -> defn
Right d -> Right $ (dName decl) ++ ":\n" ++ d
-- TODO: Generate all used functions directly instead
generateAsm :: Tree -> Either GenerateError String
-- generateAsm (Tree t) = Right $ show t
generateAsm t = case getFunction t "_start" [InternalType "_void"] of
Nothing -> Left $ GenerateError "invalid/missing _start function"
Just f -> generateFunction t f
|
