calc (empty) → 0.1

raw patch · 7 files changed

+235/−0 lines, 7 filesdep +arraydep +basedep +harpybuild-type:Customsetup-changed

Dependencies added: array, base, harpy, haskell98, mtl

Files

• Asm.hs +56/−0
• Compile.hs +36/−0
• LICENSE +31/−0
• Main.hs +22/−0
• Parser.hs +63/−0
• Setup.lhs +3/−0
• calc.cabal +24/−0

@@ -0,0 +1,56 @@+module Asm where+import Harpy.X86CodeGen+import Harpy.X86Assembler+import Foreign++-- epilogue/prologue stuff+gfunc x = gprologue >> x >> gepilogue++gprologue = do+  push ebp+  mov ebp esp++gepilogue = do+  pop eax+  mov esp ebp+  pop ebp+  ret++-- actual operations to be done++-- because all of these end up+-- pushing the result to the stack+-- at the very end, our gepilogue+-- will pop whatever's there and mov+-- into eax+gadd = do+  pop ebx+  pop eax+  add eax ebx+  push eax++gsub = do+  pop ebx+  pop eax+  sub eax ebx+  push eax++gmul = do+  pop ebx+  pop eax+  imul InPlace eax ebx+  push eax++gdivmod = do+  pop ebx+  pop eax+  mov edx eax+  sar edx (31 :: Word8)+  idiv ebx++gdiv = do+  gdivmod+  push eax++gconst n = do+  push (fromIntegral n :: Word32)

@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -XTemplateHaskell -XPatternGuards #-}+module Compile (compile) where+import Control.Monad.Trans+import Harpy.X86Disassembler+import Harpy.CodeGenMonad+import Harpy.X86Assembler+import Harpy.X86CodeGen+import System.IO+import Foreign+-- our modules+import Parser+import Asm++$(callDecl "callgen" [t|Int|])++compile :: [Exp] -> IO ()+compile i = do+  runCodeGen (compile' i) () ()+  return ()++compile' e = do+  gfunc (mapM_ generate e)+  x   <- callgen+  dis <- disassemble+  io $ putStrLn ("Disassembly:") >> mapM_ (putStrLn . showIntel) dis+  io $ putStr ("Result: ") >> print x+      where +        io  = liftIO+        allocate = ensureBufferSize . (* 16)+        generate x | EInt y   <- x = gconst y+                   | Add      <- x = gadd+                   | Multiply <- x = gmul+                   | Divide   <- x = gdiv+                   | Minus    <- x = gsub+                   | Open     <- x = error "Parsing error, invalid (mismatched) parenthesis"+                   | Close    <- x = error "Parsing error, invalid (mismatched) parenthesis"

@@ -0,0 +1,31 @@+Copyright Author Name 2007++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author Name nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,22 @@+module Main where+import System.Environment+import System.IO+import Compile+import Parser++main = do+  hSetBuffering stdout NoBuffering+  x <- getArgs+  parse (if null x then "-compile" else head x)+      where+        shell = do s <- (putStr "Expression: " >> getLine)+                   if null s then putStrLn "Enter an expression..." >> shell+                    else return s+        parse x | "-rpn"     == x = shell >>= (print   . parser . lexer)+                | "-compile" == x = shell >>= (compile . parser . lexer)+                | "-help"    == x = putStrLn $ unlines [ "options:"+                                                        ,"\t\t-compile -- compile to assembly"+                                                        ,"\t\t-rpn     -- show rpn output of expression"+                                                        ,"\t\t-help    -- this help"+                                                       ]+                | otherwise       = error "Invalid argument, try `-help'"

@@ -0,0 +1,63 @@+module Parser(lexer,parser,Token(..),Exp(..)) where+import Data.Maybe+import Char++data Token = TInt Int+           | TOpenP+           | TCloseP+           | TAdd+           | TMinus+           | TDiv+           | TMul+ deriving (Show,Eq)++data Exp = EInt Int+         | Add+         | Multiply+         | Divide+         | Minus+         | Open+         | Close+ deriving (Show,Eq)++ops :: [(Exp,Int)]+ops = zip [Open,Minus,Add,Divide,Multiply] [0,1,1,2,2]++lexer :: String -> [Token]+lexer []       = []+lexer ('*':xs) = TMul    : lexer xs+lexer ('+':xs) = TAdd    : lexer xs+lexer ('/':xs) = TDiv    : lexer xs+lexer ('-':xs) = TMinus  : lexer xs+lexer ('(':xs) = TOpenP  : lexer xs+lexer (')':xs) = TCloseP : lexer xs+lexer a@(x:xs) +    | isSpace x = lexer xs+    | isDigit x = lexN a++lexN cs = TInt (read n :: Int) : lexer r+    where +      (n,r) = span isDigit cs++parser :: [Token] -> [Exp]+parser = parser' [] []++parser' :: [Exp] -> [Exp] -> [Token] -> [Exp]+parser' output opstack [] = output ++ opstack+parser' output opstack (x:xs)+    | TAdd      == x = addStack Add output opstack+    | TMul      == x = addStack Multiply output opstack+    | TDiv      == x = addStack Divide output opstack+    | TMinus    == x = addStack Minus output opstack+    | TOpenP    == x = parser' output (Open:opstack) xs+    | TCloseP   == x = let (y,z) = span (/=Open) opstack+                           out'  = output ++ y in+                       if null z then error "Mismatched parenthesis"+                        else parser' out' (tail z) xs+    | otherwise      = let (TInt y) = x in parser' (output ++ [EInt y]) opstack xs+      where+        addStack v out opst = let (Just y)     = lookup v ops -- get precedence+                                  (out',opst') = f y out opst +                              in parser' out' (v:opst') xs+        f n o st = let (a,b) = span (\c -> n <= (fromJust $ lookup c ops)) st+                   in (o++a,b)

@@ -0,0 +1,3 @@+#!/usr/bin/env runghc+> import Distribution.Simple+> main = defaultMainWithHooks defaultUserHooks

@@ -0,0 +1,24 @@+name:                  calc+version:               0.1+cabal-version:         >= 1.2+license:               BSD3+license-file:          LICENSE+author:                Austin Seipp+stability:             Provisional+synopsis:              A small compiler for arithmetic expressions.+extra-source-files:    Parser.hs, Compile.hs, Asm.hs++flag debug+  description:         enable debug support+  default:             False++executable calc+  main-is:             Main.hs+  build-depends:       base, harpy, array, mtl, haskell98+  if flag(debug)+     if impl(ghc >= 6.8)+          ghc-options: -fhpc -O0+     else+          ghc-options: -O0 +  else+     ghc-options:      -fvia-C -O2 -optc-O3