diff options
| -rw-r--r-- | ABC/Assembler.dcl | 4 | ||||
| -rw-r--r-- | ABC/Assembler.icl | 43 |
2 files changed, 47 insertions, 0 deletions
diff --git a/ABC/Assembler.dcl b/ABC/Assembler.dcl index 6b0a585..281190d 100644 --- a/ABC/Assembler.dcl +++ b/ABC/Assembler.dcl @@ -1,5 +1,6 @@ definition module ABC.Assembler +from StdOverloaded import class toString from ABC.Machine.Def import ::Arity, ::Name, ::NrArgs, ::ArgNr, ::Instruction, ::State from ABC.Machine.AStack import ::ASrc, ::ADst from ABC.Machine.BStack import ::BSrc, ::BDst @@ -75,4 +76,7 @@ from ABC.Machine.GraphStore import ::Desc | MulI | SubI +instance toString Assembler +instance toString Statement + assemble :: Assembler -> ([Instruction], [Desc]) diff --git a/ABC/Assembler.icl b/ABC/Assembler.icl index e5e3a9a..656ea1a 100644 --- a/ABC/Assembler.icl +++ b/ABC/Assembler.icl @@ -1,10 +1,53 @@ implementation module ABC.Assembler import StdEnv +import StdGeneric import ABC.Machine import ABC.Misc +instance toString Assembler +where + toString [] = "" + toString [stm=:(Label l):r] = stm <+ "\n" <+ r + toString [stm=:(Descriptor _ _ _ _):r] = toString r + toString [stm :r] = "\t" <+ stm <+ "\n" <+ r + +generic gPrint a :: !a -> [Char] +gPrint{|Int|} x = fromString (toString x) +gPrint{|Bool|} x = map toLower (fromString (toString x)) +gPrint{|String|} x = fromString x +gPrint{|UNIT|} x = [] +gPrint{|EITHER|} fl fr (LEFT x) = fl x +gPrint{|EITHER|} fl fr (RIGHT x) = fr x +gPrint{|PAIR|} fl fr (PAIR x y) = fl x ++ ['\t':fr y] +gPrint{|OBJECT|} fx (OBJECT x) = fx x +gPrint{|CONS of d|} fx (CONS x) = case d.gcd_name of + "Label" = fx x + "Descriptor" = [] + "Dump" = ['dump\t"'] ++ quote (fx x) ++ ['"'] + "Print" = ['print\t"'] ++ quote (fx x) ++ ['"'] + name = tl (cons (fromString name)) ++ ['\t':fx x] +where + cons :: ![Char] -> [Char] + cons [] = [] + cons [c:cs] + | isUpper c = ['_':toLower c:cons cs] + | otherwise = [c :cons cs] + +derive gPrint Statement + +instance toString Statement +where + toString stm = toString (gPrint{|*|} stm) + +quote :: ![Char] -> [Char] +quote [] = [] +quote ['\\':cs] = ['\\':'\\':quote cs] +quote ['\n':cs] = ['\\':'n' :quote cs] +quote ['"' :cs] = ['\\':'"' :quote cs] +quote [c :cs] = [c :quote cs] + assemble :: Assembler -> ([Instruction], [Desc]) assemble stms = (translate stms loc_counter syms, descTable stms syms) where |