Split code into modules

Also did some work on laws
This commit is contained in:
Pranshu Sharma 2025-05-21 16:29:43 +10:00
parent 953c0d2298
commit 5113241a63
4 changed files with 88 additions and 43 deletions

22
Calculator.hs Normal file
View file

@ -0,0 +1,22 @@
module Calculator where
import Utils
import Expr
import Parser
data Law = Law LawName Equation
deriving Show
type LawName = String
type Equation = (Expr,Expr)
law :: Parser Law
law = do name <- upto ':'
eqn <- equation
return (Law name eqn)
equation :: Parser Equation
equation = do lh <- expr
symbol "="
rh <- expr
return (lh, rh)

47
Expr.hs Normal file
View file

@ -0,0 +1,47 @@
{-# LANGUAGE LambdaCase #-}
module Expr where
import Data.Char
import Utils
newtype Expr = Compose [Atom]
deriving Eq
data Atom = Var VarName | Con ConName [Expr]
deriving Eq
type VarName = String
type ConName = String
instance Show Expr where
showsPrec p (Compose []) = showString "id"
showsPrec p (Compose [a]) = showsPrec p a
showsPrec p (Compose as)
= showParen (p>0) (showSep " . " (showsPrec 1) as)
compose :: [ShowS] -> ShowS
compose = foldr (.) id
showSep :: String -> (a -> ShowS) -> [a] -> ShowS
showSep sep f
= compose . intersperse (showString sep) . map f
instance Show Atom where
showsPrec p (Var v) = showString v
showsPrec p (Con f []) = showString f
showsPrec p (Con f [l,r])
| isOp f = showParen (p>0) (showsPrec 1 l . showSpace
. showString f . showSpace . showsPrec 1 r)
showsPrec p (Con f es)
= showParen (p>1) (showString f . showSpace . showSep " " (showsPrec 2) es)
showSpace = showChar ' '
isOp f = all symbolic f
intersperse :: a -> [a] -> [a]
intersperse _ [x] = [x]
intersperse s (x : xs)
= x : s : intersperse s xs

View file

@ -1,5 +1,9 @@
{-# LANGUAGE LambdaCase #-}
module Parser where
import Expr
import Utils
import Data.Char
---------------- Parser declerations ---------------------------
@ -113,17 +117,19 @@ nat = do ds <- some digit
return (foldl1 shiftl ds)
where shiftl m n = 10*m+n
upto :: Char -> Parser String
upto c = P (\s -> let (xs, ys) = break (==c) s in
if null ys then []
else [(xs, tail ys)])
-- TODO look into why this didn't work
-- upto x = do c <- (sat (/= x))
-- cs <- upto x
-- return (c:cs)
----------------- Calculator -----------------------------------
newtype Expr = Compose [Atom]
deriving Eq
data Atom = Var VarName | Con ConName [Expr]
deriving Eq
type VarName = String
type ConName = String
-- Main parsing
{-
@ -145,9 +151,6 @@ operator = do op <- token (some (sat symbolic))
guard (op /= "." && op /= "=")
return op
symbolic = (`elem` symbolic_ops)
symbolic_ops = "!@#$%^&*+./<=>?\\^|:-~"
simple :: Parser Expr
simple = do es <- somewith (symbol ".") term
return (Compose (concatMap deCompose es))
@ -174,36 +177,4 @@ isVar [x] = True
isVar [x,d] = isDigit d
isVar _ = False
-- Showing
instance Show Expr where
showsPrec p (Compose []) = showString "id"
showsPrec p (Compose [a]) = showsPrec p a
showsPrec p (Compose as)
= showParen (p>0) (showSep " . " (showsPrec 1) as)
compose :: [ShowS] -> ShowS
compose = foldr (.) id
showSep :: String -> (a -> ShowS) -> [a] -> ShowS
showSep sep f
= compose . intersperse (showString sep) . map f
instance Show Atom where
showsPrec p (Var v) = showString v
showsPrec p (Con f []) = showString f
showsPrec p (Con f [l,r])
| isOp f = showParen (p>0) (showsPrec 1 l . showSpace
. showString f . showSpace . showsPrec 1 r)
showsPrec p (Con f es)
= showParen (p>1) (showString f . showSpace . showSep " " (showsPrec 2) es)
showSpace = showChar ' '
isOp f = all symbolic f
intersperse :: a -> [a] -> [a]
intersperse _ [x] = [x]
intersperse s (x : xs)
= x : s : intersperse s xs

5
Utils.hs Normal file
View file

@ -0,0 +1,5 @@
module Utils where
symbolic = (`elem` symbolic_ops)
symbolic_ops = "!@#$%^&*+./<=>?\\^|:-~"