ref: b171546e714116a788e15ced71be7073b7a24fc3
parent: a68b34972f7d52204231aa35ef9ddc7315d17a66
parent: 250f9d8992890fb0a98363897ae022aac58cb6d3
author: Lennart Augustsson <lennart@augustsson.net>
date: Mon Sep 25 12:14:49 EDT 2023
Merge pull request #1 from Rewbert/master Basic, primitive support for doubles
--- a/Makefile
+++ b/Makefile
@@ -46,10 +46,12 @@
$(GHCB) -c ghc/Primitives.hs
$(GHCB) -c ghc/Data/Bool_Type.hs
$(GHCB) -c ghc/Data/Ordering_Type.hs
+ $(GHCB) -c ghc/Data/Double.hs
$(GHCB) -c src/PrimTable.hs
$(GHCC) -c lib/Control/Error.hs
$(GHCC) -c lib/Data/Bool.hs
$(GHCC) -c lib/Data/Int.hs
+ $(GHCC) -c lib/Data/Double.hs
$(GHCC) -c lib/Data/Char.hs
$(GHCC) -c lib/Data/Either.hs
$(GHCC) -c lib/Data/Tuple.hs
--- a/README.md
+++ b/README.md
@@ -31,14 +31,15 @@
* application
* lambda
* integer literals
+* double literals (no exponents)
* character literals
* string (list of characters) literals
* case expressions
* let expressions
* tuples
-* list syntax
+* list syntax (for stuff like `[x..y]` you unfortunately need to write `[x .. y]`, as the parsers support for `Double` literals is simple)
* list comprehensions
-* arithmetic and comparison operators, but only for `Int`
+* arithmetic and comparison operators, the prelude exports the ones for `Int`, but for the other types you need to do a qulified import (e.g for `Double` and for `Word`).
* qualified `do` notation, e.g., `IO.do`
* data (and newtype) type declarations
* type synonyms
@@ -81,8 +82,7 @@
But in general, the `Prelude` contains much, much less.
## Types
-There are two primitive data types `Int` and `Handle`. These are known by the runtime system
-and various primitive operations work on them. The function type, `->`, is (of course) also built in.
+There are some primitive data types, e.g `Int`, `Handle`, and `Double`. These are known by the runtime system and various primitive operations work on them. The function type, `->`, is (of course) also built in. The support for rendering (printing) `Double`s is a bit primitive, and only at most 6 decimal places will be shown. The actual value can contain more precise values, however.
All other types are defined with the language. They are converted to lambda terms using
the Scott encoding. The runtime system knows how lists are encoded and booleans are encoded.
@@ -214,14 +214,14 @@
*
* Q: When will it get _insert feature_?
* A: Maybe some time, maybe never.
-*
+*
* Q: Why are the error messages so bad?
* A: Error messages are boring.
-*
+*
* Q: Why is the so much source code?
* A: I wonder this myself. Over 5000 lines of Haskell seems excessive.
2000 lines of C is also more than I'd like for such a simple system.
-*
+*
* Q: Why are the binaries so big?
* A: The combinator file is rather verbose. The combinator file
for the compiler shrinks from 170kB to 30kB when compressed.
--- a/TODO
+++ b/TODO
@@ -9,6 +9,5 @@
- Use filename as the cache lookup key and SHA for validation
* make the runtime system catch ^C and stop execution
* use pointer stack during GC instead of recursion.
-* add Double primitive type
* implement Data.Integer
* add pretty printing library
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.5
-887
-(($A :0 _773) (($A :1 (($B _819) _0)) (($A :2 ((($S' _819) _0) $I)) (($A :3 _743) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _772) (($C _49) _5))) (($A :7 ((($C' _6) (_790 _46)) ((_49 _788) _45))) (($A :8 (($B (($S _819) _788)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_49 _160)) _10)) (($A :12 (($B ($B (_48 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_48 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_48 _9)) $P)) (($A :15 (($B ($B (_48 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_48 _9)) ($B ($P _713)))) (($A :18 (($B (_48 _9)) ($BK ($P _713)))) (($A :19 ((_48 _9) (($S $P) $I))) (($A :20 (($B (_48 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _89)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _90)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _713)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _713))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _748) (($A :34 _749) (($A :35 ((($S' _26) (_740 97)) (($C _740) 122))) (($A :36 ((($S' _26) (_740 65)) (($C _740) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_740 48)) (($C _740) 57))) (($A :39 ((($S' _26) (_740 32)) (($C _740) 126))) (($A :40 _737) (($A :41 _738) (($A :42 _740) (($A :43 _739) (($A :44 ((($S' _25) (($C _40) 32)) ((($S' _25) (($C _40) 9)) (($C _40) 10)))) (($A :45 (($B $BK) $T)) (($A :46 ($BK $T)) (($A :47 $P) (($A :48 $I) (($A :49 $B) (($A :50 $I) (($A :51 $K) (($A :52 $C) (($A :53 _744) (($A :54 (($C (($C $S') _160)) _161)) (($A :55 ((($C' ($S' ($C' $B))) $B) $I)) (($A :56 _714) (($A :57 _715) (($A :58 _716) (($A :59 _717) (($A :60 _718) (($A :61 _719) (($A :62 (_57 0)) (($A :63 _725) (($A :64 _726) (($A :65 _727) (($A :66 _728) (($A :67 _729) (($A :68 _730) (($A :69 _63) (($A :70 ($BK $K)) (($A :71 (($B $BK) (($B ($B $BK)) $P))) (($A :72 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :73 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_66 0))) (_63 0)))) (($B ($B (($C' $P) (_61 1)))) _56))) ($C $P))) _59)) _60)) (($A :74 _70) (($A :75 ((($S' $C) (($B ($P _149)) ((($C' ($C' $B)) ((($C' $C) _63) _149)) _150))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_63 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_63 1)))) (($B (($C' $C) (($B (($C' $S') (_63 2))) ($C _75)))) ($C _75))))) ($C _75))))) ($C _75)))) ($T $K))) ($T $A)))) (($C _73) 4)))) (($A :76 (_82 _51)) (($A :77 ((_97 (_54 _76)) _74)) (($A :78 (($C ((($C' $B) (($P _89) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _79)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _79))) ((($S' ($C' $B)) (($B ($B _79)) ((($C' $B) (($B _95) ($T 0))) _78))) ((($C' $B) (($B _95) ($T 1))) _78)))) ((($C' $B) (($B _95) ($T 2))) _78)))) ((($C' $B) (($B _95) ($T 3))) _78)))) (($B $T) (($B ($B $P)) (($C' _56) (_58 4)))))) (($A :79 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _65)))) (($B (($C' $B) _90)) _79)))))) (($B (($C' $B) _90)) ($C _79)))))))))) (((_712 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :80 ((_49 (_95 _160)) _78)) (($A :81 ((($C' $C) ((($C' $C) ($C _75)) (_3 "Data.IntMap.!"))) $I)) (($A :82 (($B (($C' $B) $T)) (($B ($B $Y)) ((($C' ($C' ($S' ($S' $C)))) (($B (($S' $B) (($B ($S' $P)) ($C _71)))) (($B ($B (($C' ($S' $C)) (($B (($S' ($S' $S')) _63)) ((($C' ($C' $B)) (($B $B') ($B _48))) ((($C' ($C' _48)) _76) ((((_72 _70) _70) _70) _70))))))) ($B (($C' $B) _71))))) ((($C' $B) (($B ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C'
\ No newline at end of file
+925
+(($A :0 _810) (($A :1 (($B _856) _0)) (($A :2 ((($S' _856) _0) $I)) (($A :3 _780) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _809) (($C _71) _5))) (($A :7 ((($C' _6) (_827 _68)) ((_71 _825) _67))) (($A :8 (($B (($S _856) _825)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_71 _183)) _10)) (($A :12 (($B ($B (_70 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_70 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_70 _9)) $P)) (($A :15 (($B ($B (_70 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_70 _9)) ($B ($P _738)))) (($A :18 (($B (_70 _9)) ($BK ($P _738)))) (($A :19 ((_70 _9) (($S $P) $I))) (($A :20 (($B (_70 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _111)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _112)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _738)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _738))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _785) (($A :34 _786) (($A :35 ((($S' _26) (_777 97)) (($C _777) 122))) (($A :36 ((($S' _26) (_777 65)) (($C _777) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_777 48)) (($C _777) 57))) (($A :39 ((($S' _26) (_777 32)) (($C _777) 126))) (($A :40 _774) (($A :41 _775) (($A :42 _777) (($A :43 _776) (($A :44 ((($S' _25) (($C _40) 32)) ((($S' _25) (($C _40) 9)) (($C _40) 10)))) (($A :45 _745) (($A :46 _746) (($A :47 _747) (($A :48 _748) (($A :49 (_46 %0.0)) (($A :50 _45) (($A :51 _46) (($A :52 _47) (($A :53 _48) (($A :54 _749) (($A :55 _750) (($A :56 _54) (($A :57 _55) (($A :58 _751) (($A :59 _752) (($A :60 _753) (($A :61 _754) (($A :62 _58) (($A :63 _59) (($A :64 _60) (($A :65 _61) (($A :66 _755) (($A :67 (($B $BK) $T)) (($A :68 ($BK $T)) (($A :69 $P) (($A :70 $I) (($A :71 $B) (($A :72 $I) (($A :73 $K) (($A :74 $C) (($A :75 _781) (($A :76 (($C (($C $S') _183)) _184)) (($A :77 ((($C' ($S' ($C' $B))) $B) $I)) (($A :78 _739) (($A :79 _740) (($A :80 _741) (($A :81 _742) (($A :82 _743) (($A :83 _744) (($A :84 (_79 0)) (($A :85 _762) (($A :86 _763) (($A :87 _764) (($A :88 _765) (($A :89 _766) (($A :90 _767) (($A :91 _85) (($A :92 ($BK $K)) (($A :93 (($B $BK) (($B ($B $BK)) $P))) (($A :94 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :95 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_88 0))) (_85 0)))) (($B ($B (($C' $P) (_83 1)))) _78))) ($C $P))) _81)) _82)) (($A :96 _92) (($A :97 ((($S' $C) (($B ($P _172)) ((($C' ($C' $B)) ((($C' $C) _85) _172)) _173))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_85 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_85 1)))) (($B (($C' $C) (($B (($C' $S') (_85 2))) ($C _97)))) ($C _97))))) ($C _97))))) ($C _97)))) ($T $K))) ($T $A)))) (($C _95) 4)))) (($A :98 (_104 _73)) (($A :99 ((_119 (_76 _98)) _96)) (($A :100 (($C ((($C' $B) (($P _111) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _101)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _101))) ((($S' ($C' $B)) (($B ($B _101)) ((($C' $B) (($B _117) ($T 0))) _100))) ((($C' $B) (($B _117) ($T 1))) _100)))) ((($C' $B) (($B _117) ($T 2))) _100)))) ((($C' $B) (($B _117) ($T 3))) _100)))) (($B $T) (($B ($B $P)) (($C' _78) (_80 4)))))) (($A :101 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _87)))) (($B (($C' $B) _112)) _101)))))) (($B (($C' $B) _112)) ($C _101)))))))))) (((_737 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :102 ((_71 (_117 _183)) _100)) (($A :103 ((($C' $C) ((($C' $C) ($C _97)) (_3 "Data.IntMap.!"))) $I)) (($A :104 (($B ((
\ No newline at end of file
--- /dev/null
+++ b/ghc/Data/Double.hs
@@ -1,0 +1,4 @@
+module Data.Double(Double, showDouble) where
+
+showDouble :: Double -> [Char]
+showDouble = show
\ No newline at end of file
--- a/ghc/Primitives.hs
+++ b/ghc/Primitives.hs
@@ -4,6 +4,7 @@
Char,
Handle,
Int,
+ Double,
IO,
Word,
NFData(..),
@@ -126,6 +127,42 @@
primWordGE :: Word -> Word -> Bool
primWordGE = (>=)
+
+primDoubleAdd :: Double -> Double -> Double
+primDoubleAdd = (+)
+
+primDoubleSub :: Double -> Double -> Double
+primDoubleSub = (-)
+
+primDoubleMul :: Double -> Double -> Double
+primDoubleMul = (*)
+
+primDoubleDiv :: Double -> Double -> Double
+primDoubleDiv = (/)
+
+primDoubleEQ :: Double -> Double -> Bool
+primDoubleEQ = (==)
+
+primDoubleNE :: Double -> Double -> Bool
+primDoubleNE = (/=)
+
+primDoubleLT :: Double -> Double -> Bool
+primDoubleLT = (<)
+
+primDoubleLE :: Double -> Double -> Bool
+primDoubleLE = (<=)
+
+primDoubleGT :: Double -> Double -> Bool
+primDoubleGT = (>)
+
+primDoubleGE :: Double -> Double -> Bool
+primDoubleGE = (>=)
+
+primDoubleShow :: Double -> [Char]
+primDoubleShow = show
+
+primDoubleRead :: [Char] -> Double
+primDoubleRead = read
------
--- /dev/null
+++ b/lib/Data/Double.hs
@@ -1,0 +1,74 @@
+-- Copyright 2023 Lennart Augustsson
+-- See LICENSE file for full license.
+module Data.Double(module Data.Double, Double) where
+import Primitives
+import Data.Bool_Type
+
+infixl 6 +,-
+infixl 7 *
+
+-- Arithmetic
+(+) :: Double -> Double -> Double
+(+) = primDoubleAdd
+(-) :: Double -> Double -> Double
+(-) = primDoubleSub
+(*) :: Double -> Double -> Double
+(*) = primDoubleMul
+(/) :: Double -> Double -> Double
+(/) = primDoubleDiv
+
+negate :: Double -> Double
+negate x = 0.0 - x
+
+addDouble :: Double -> Double -> Double
+addDouble = (+)
+subDouble :: Double -> Double -> Double
+subDouble = (-)
+mulDouble :: Double -> Double -> Double
+mulDouble = (*)
+divDouble :: Double -> Double -> Double
+divDouble = (/)
+
+--------------------------------
+
+infix 4 ==,/=,<,<=,>,>=
+
+-- Comparison
+(==) :: Double -> Double -> Bool
+(==) = primDoubleEQ
+(/=) :: Double -> Double -> Bool
+(/=) = primDoubleNE
+
+eqDouble :: Double -> Double -> Bool
+eqDouble = (==)
+neqDouble :: Double -> Double -> Bool
+neqDouble = (/=)
+
+(<) :: Double -> Double -> Bool
+(<) = primDoubleLT
+(<=) :: Double -> Double -> Bool
+(<=) = primDoubleLE
+(>) :: Double -> Double -> Bool
+(>) = primDoubleGT
+(>=) :: Double -> Double -> Bool
+(>=) = primDoubleGE
+
+ltDouble :: Double -> Double -> Bool
+ltDouble = (<)
+
+leDouble :: Double -> Double -> Bool
+leDouble = (<=)
+
+gtDouble :: Double -> Double -> Bool
+gtDouble = (>)
+
+geDouble :: Double -> Double -> Bool
+geDouble = (>=)
+
+-- | this primitive will print doubles with up to 6 decimal points
+-- it turns out that doubles are extremely tricky, and just printing them is a
+-- herculean task of its own...
+showDouble :: Double -> [Char]
+showDouble = primDoubleShow
+
+--------------------------------
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -10,6 +10,7 @@
data Char
data Handle
data Int
+data Double
data IO a
data Word
@@ -27,6 +28,31 @@
primIntRem = primitive "rem"
primIntSubR :: Int -> Int -> Int
primIntSubR = primitive "subtract"
+
+primDoubleAdd :: Double -> Double -> Double
+primDoubleAdd = primitive "fadd"
+primDoubleSub :: Double -> Double -> Double
+primDoubleSub = primitive "fsub"
+primDoubleMul :: Double -> Double -> Double
+primDoubleMul = primitive "fmul"
+primDoubleDiv :: Double -> Double -> Double
+primDoubleDiv = primitive "fdiv"
+primDoubleEQ :: Double -> Double -> Bool
+primDoubleEQ = primitive "feq"
+primDoubleNE :: Double -> Double -> Bool
+primDoubleNE = primitive "fne"
+primDoubleLT :: Double -> Double -> Bool
+primDoubleLT = primitive "flt"
+primDoubleLE :: Double -> Double -> Bool
+primDoubleLE = primitive "fle"
+primDoubleGT :: Double -> Double -> Bool
+primDoubleGT = primitive "fgt"
+primDoubleGE :: Double -> Double -> Bool
+primDoubleGE = primitive "fge"
+primDoubleShow :: Double -> [Char]
+primDoubleShow = primitive "fshow"
+primDoubleRead :: [Char] -> Double
+primDoubleRead = primitive "fread"
primWordAdd :: Word -> Word -> Word
primWordAdd = primitive "+"
--- a/lib/Text/String.hs
+++ b/lib/Text/String.hs
@@ -7,6 +7,7 @@
import Data.Either
import Data.Function
import Data.Int
+import qualified Data.Double as DD
import Data.List
import Data.Maybe
import Data.Ord
@@ -50,6 +51,9 @@
let
rd = foldl (\ a c -> a * 10 + ord c - ord '0') 0
in if eqChar (head cs) '-' then 0 - rd (tail cs) else rd cs
+
+readDouble :: String -> Double
+readDouble = primDoubleRead
showBool :: Bool -> String
showBool arg =
--- a/src/Compat.hs
+++ b/src/Compat.hs
@@ -32,8 +32,14 @@
readInt :: String -> Int
readInt = read
+readDouble :: String -> Double
+readDouble = read
+
showInt :: Int -> String
showInt = show
+
+showDouble :: Double -> String
+showDouble = show
showChar :: Char -> String
showChar = show
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -120,7 +120,8 @@
fn = map (\ c -> if eqChar c '.' then '/' else c) (unIdent nm) ++ ".hs"
(pathfn, file) <- liftIO (readFilePath (paths flags) fn)
let mdl@(EModule nmn _ defs) = parseDie pTop pathfn file
- --liftIO $ putStrLn $ showEModule mdl
+ -- liftIO $ putStrLn $ showEModule mdl
+ -- liftIO $ putStrLn $ showEDefs defs
S.when (not (eqIdent nm nmn)) $
error $ "module name does not agree with file name: " ++ showIdent nm ++ " " ++ showIdent nmn
let
--- a/src/MicroHs/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -154,7 +154,7 @@
n = length is
ev = Var v
one m i = letE i (mkTupleSel m n ev)
- bnds = foldr (.) id $ zipWith one [0..] is
+ bnds = foldr (.) id $ zipWith one [0 .. ] is
in letRecE v (bnds $ mkTuple es) $
bnds body
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -34,6 +34,7 @@
import Data.List
import Data.Maybe
import MicroHs.Ident
+import qualified Data.Double as D
--Ximport Compat
--Ximport GHC.Stack
--Ximport Control.DeepSeq
@@ -131,12 +132,13 @@
data Lit
= LInt Int
+ | LDouble D.Double
| LChar Char
| LStr String
| LPrim String
| LForImp String
--Xderiving (Show, Eq)
---Winstance NFData Lit where rnf (LInt i) = rnf i; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
+--Winstance NFData Lit where rnf (LInt i) = rnf i; rnf (LDouble d) = rnf d; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
eqLit :: Lit -> Lit -> Bool
eqLit (LInt x) (LInt y) = x == y
@@ -433,6 +435,7 @@
showLit l =
case l of
LInt i -> showInt i
+ LDouble d -> '%' : D.showDouble d
LChar c -> showChar c
LStr s -> showString s
LPrim s -> '$' : s
--- a/src/MicroHs/Graph.hs
+++ b/src/MicroHs/Graph.hs
@@ -103,7 +103,7 @@
max_v = length edges0 - 1
sorted_edges = sortLE lek edges0
- edges1 = zip [0..] sorted_edges
+ edges1 = zip [0 .. ] sorted_edges
key_map = IM.fromList [(v, k) | (v, (_, k, _ )) <- edges1]
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -5,6 +5,7 @@
import Prelude --Xhiding(lex, showChar, showString)
import Data.Char
import Data.List
+import qualified Data.Double as D
--Ximport Compat
import MicroHs.Ident
@@ -13,6 +14,7 @@
| TString Loc String
| TChar Loc Char
| TInt Loc Int
+ | TDouble Loc D.Double
| TSpec Loc Char
| TError Loc String
| TBrace Loc
@@ -24,6 +26,7 @@
showToken (TString _ s) = showString s
showToken (TChar _ c) = showChar c
showToken (TInt _ i) = showInt i
+showToken (TDouble _ d) = D.showDouble d
showToken (TSpec _ c) = [c]
showToken (TError _ s) = "ERROR " ++ s
showToken (TBrace _) = "TBrace"
@@ -70,6 +73,7 @@
lexTop = layout [] .
lex (mkLoc 1 1)
+-- | Take a location and string and produce a list of tokens
lex :: Loc -> String -> [Token]
lex loc (' ':cs) = lex (addCol loc 1) cs lex loc ('\n':cs) = tIndent (lex (incrLine loc) cs)@@ -86,10 +90,14 @@
lex loc cs@(d:_) | isUpper d = upperIdent loc loc [] cs
lex loc ('-':d:cs) | isDigit d =case span isDigit cs of
- (ds, rs) -> TInt loc (readInt ('-':d:ds)) : lex (addCol loc $ 2 + length ds) rs+ (ds, rs) | null rs || not (eqChar (head rs) '.') -> TInt loc (readInt ('-':d:ds)) : lex (addCol loc $ 2 + length ds) rs+ | otherwise -> case span isDigit (tail rs) of
+ (ns, rs') -> TDouble loc (readDouble (('-':d:ds) ++ ('.':ns))) : lex (addCol loc $ 3 + length ds + length ns) rs'lex loc (d:cs) | isDigit d =
case span isDigit cs of
- (ds, rs) -> TInt loc (readInt (d:ds)) : lex (addCol loc $ 1 + length ds) rs
+ (ds, rs) | null rs || not (eqChar (head rs) '.') -> TInt loc (readInt (d:ds)) : lex (addCol loc $ 1 + length ds) rs
+ | otherwise -> case span isDigit (tail rs) of
+ (ns, rs') -> TDouble loc (readDouble ((d:ds) ++ ('.':ns))) : lex (addCol loc $ 2 + length ds + length ns) rs' lex loc (d:cs) | isOperChar d =
case span isOperChar cs of
(ds, rs) -> TIdent loc [] (d:ds) : lex (addCol loc $ 1 + length ds) rs
@@ -121,6 +129,9 @@
skipLine loc (_:cs) = skipLine loc cs
skipLine _ [] = []
+-- | Takes a list of tokens and produces a list of tokens. If the first token in
+-- the input list is a TIndent, the input is returned unaltered. Otherwise, a
+-- TIndent is prepended to the input list
tIndent :: [Token] -> [Token]
tIndent ts@(TIndent _ : _) = ts
tIndent ts = TIndent (tokensLoc ts) : ts
@@ -178,6 +189,7 @@
tokensLoc (TString loc _ :_) = loc
tokensLoc (TChar loc _ :_) = loc
tokensLoc (TInt loc _ :_) = loc
+tokensLoc (TDouble loc _ : _) = loc
tokensLoc (TSpec loc _ :_) = loc
tokensLoc (TError loc _ :_) = loc
tokensLoc (TBrace loc :_) = loc
@@ -184,6 +196,7 @@
tokensLoc (TIndent loc :_) = loc
tokensLoc [] = mkLoc 0 1
+-- | This appears to be the magical layout resolver, I wondered where it was...
layout :: [Int] -> [Token] -> [Token]
layout mms@(m : ms) tts@(TIndent x : ts) | n == m = TSpec (tokensLoc ts) ';' : layout mms ts
| n < m = TSpec (tokensLoc ts) '}' : layout ms tts where {n = getCol x}--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -212,6 +212,7 @@
is (TString (l, c) s) = Just (ELit (SLoc fn l c) (LStr s))
is (TChar (l, c) a) = Just (ELit (SLoc fn l c) (LChar a))
is (TInt (l, c) i) = Just (ELit (SLoc fn l c) (LInt i))
+ is (TDouble (l, c) d) = Just (ELit (SLoc fn l c) (LDouble d))
is _ = Nothing
satisfyM "literal" is
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -889,6 +889,7 @@
let { lit t = T.do { munify loc mt t; T.return (ELit loc l, t) } } incase l of
LInt _ -> lit (tConI loc "Primitives.Int")
+ LDouble _ -> lit (tConI loc "Primitives.Double")
LChar _ -> lit (tConI loc "Primitives.Char")
LStr _ -> lit (tApp (tConI loc "Data.List.[]") (tConI loc "Primitives.Char"))
LPrim _ -> T.do
--- a/src/PrimTable.hs
+++ b/src/PrimTable.hs
@@ -33,6 +33,16 @@
, arith "quot" quot
, arith "rem" rem
, arith "subtract" subtract
+ , farith "fadd" (+)
+ , farith "fsub" (-)
+ , farith "fmul" (*)
+ , cmp "feq" (==)
+ , cmp "fne" (/=)
+ , cmp "flt" (<)
+ , cmp "fle" (<=)
+ , cmp "fgt" (>)
+ , cmp "fge" (>=)
+ , comb "fshow" (show :: Double -> String)
, cmp "==" (==)
, cmp "/=" (/=)
, cmp "<" (<)
@@ -55,6 +65,8 @@
comb n f = (n, unsafeCoerce f)
arith :: String -> (Int -> Int -> Int) -> (String, Any)
arith = comb
+ farith :: String -> (Double -> Double -> Double) -> (String, Any)
+ farith = comb
cmp :: String -> (Int -> Int -> Bool) -> (String, Any)
cmp n f = comb n (\ x y -> if f x y then cTrue else cFalse)
cTrue _x y = y
--- a/src/Text/ParserComb.hs
+++ b/src/Text/ParserComb.hs
@@ -48,6 +48,7 @@
data Res s t a = Many [(a, ([t], s))] (LastFail t)
--deriving (Show)
+-- |
data Prsr s t a = P (([t], s) -> Res s t a)
--instance Show (Prsr s t a) where show _ = "<<Prsr>>"
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -146,9 +146,11 @@
#define ERR(s) do { fprintf(stderr, "ERR: %s\n", s); exit(1); } while(0)-enum node_tag { T_FREE, T_IND, T_AP, T_INT, T_HDL, T_S, T_K, T_I, T_B, T_C,+enum node_tag { T_FREE, T_IND, T_AP, T_INT, T_DOUBLE, T_HDL, T_S, T_K, T_I, T_B, T_C,T_A, T_Y, T_SS, T_BB, T_CC, T_P, T_O, T_T, T_BK, T_ADD, T_SUB, T_MUL,
T_QUOT, T_REM, T_SUBR, T_UQUOT, T_UREM,
+ T_FADD, T_FSUB, T_FMUL, T_FDIV,
+ T_FEQ, T_FNE, T_FLT, T_FLE, T_FGT, T_FGE, T_FSHOW, T_FREAD,
T_EQ, T_NE, T_LT, T_LE, T_GT, T_GE, T_ULT, T_ULE, T_UGT, T_UGE,
T_ERROR, T_SEQ, T_EQUAL, T_COMPARE, T_RNF,
T_IO_BIND, T_IO_THEN, T_IO_RETURN, T_IO_GETCHAR, T_IO_PUTCHAR,
@@ -169,6 +171,7 @@
enum node_tag tag;
union {value_t value;
+ double doublevalue;
FILE *file;
const char *string;
struct {@@ -184,7 +187,11 @@
#define GETTAG(p) (p)->tag
#define SETTAG(p, t) do { (p)->tag = (t); } while(0)#define GETVALUE(p) (p)->u.value
+// to squeeze a double into value_t we must exactly copy and read the bits
+// this is a stm, and not an exp
+#define GETDOUBLEVALUE(p) (p)->u.doublevalue
#define SETVALUE(p,v) (p)->u.value = v
+#define SETDOUBLEVALUE(p,v) (p)->u.doublevalue = v
#define FUN(p) (p)->u.s.fun
#define ARG(p) (p)->u.s.arg
#define NEXT(p) FUN(p)
@@ -205,6 +212,7 @@
union {struct node *uuarg;
value_t uuvalue;
+ double uudoublevalue;
FILE *uufile;
const char *uustring;
} uarg;
@@ -215,7 +223,9 @@
#define GETTAG(p) ((p)->ufun.uutag & 1 ? (int)((p)->ufun.uutag >> 1) : T_AP)
#define SETTAG(p,t) do { if (t != T_AP) (p)->ufun.uutag = ((t) << 1) + 1; } while(0)#define GETVALUE(p) (p)->uarg.uuvalue
+#define GETDOUBLEVALUE(p) (p)->uarg.uudoublevalue
#define SETVALUE(p,v) (p)->uarg.uuvalue = v
+#define SETDOUBLEVALUE(p,v) (p)->uarg.uudoublevalue = v
#define FUN(p) (p)->ufun.uufun
#define ARG(p) (p)->uarg.uuarg
#define STR(p) (p)->uarg.uustring
@@ -434,6 +444,18 @@
{ "uquot", T_UQUOT }, { "urem", T_UREM }, { "subtract", T_SUBR },+ { "fadd" , T_FADD},+ { "fsub" , T_FSUB},+ { "fmul" , T_FMUL},+ { "fdiv", T_FDIV},+ { "feq", T_FEQ},+ { "fne", T_FNE},+ { "flt", T_FLT},+ { "fle", T_FLE},+ { "fgt", T_FGT},+ { "fge", T_FGE},+ { "fshow", T_FSHOW},+ { "fread", T_FREAD}, { "==", T_EQ }, { "/=", T_NE }, { "<", T_LT },@@ -762,6 +784,29 @@
return i;
}
+double
+parse_double(BFILE *f)
+{+ // apparently longest float, when rendered, takes up 24 characters. We add one more for a potential
+ // minus sign, and another one for the final null terminator.
+ // https://stackoverflow.com/questions/1701055/what-is-the-maximum-length-in-chars-needed-to-represent-any-double-value
+ // I expect Lennart will hate this...
+ char floatstr[26];
+ int i = 0;
+ for(;;) {+ int c = getb(f);
+ if ((c != '-' && c != '.') && (c < '0' || c > '9')) {+ ungetb(c, f);
+ break;
+ }
+ floatstr[i++] = c;
+ }
+
+ floatstr[i++] = '\0';
+ double d = strtod(floatstr, NULL);
+ return d;
+}
+
NODEPTR
mkStrNode(const char *str)
{@@ -771,6 +816,7 @@
}
NODEPTR mkInt(value_t i);
+NODEPTR mkDouble(double d);
/* Table of labelled nodes for sharing during parsing. */
struct shared_entry {@@ -807,6 +853,7 @@
NODEPTR *nodep;
heapoffs_t l;
value_t i;
+ double d;
value_t neg;
int c;
char buf[80]; /* store names of primitives. */
@@ -824,12 +871,16 @@
return r;
case '-':
c = getb(f);
+ neg = -1;
if ('0' <= c && c <= '9') {- neg = -1;
goto number;
} else { ERR("got -");}
+ case '%':
+ d = parse_double(f);
+ r = mkDouble(d);
+ return r;
case '0':case '1':case '2':case '3':case '4':case '5':case '6':case '7':case '8':case '9':
/* integer [0-9]+*/
neg = 1;
@@ -1088,6 +1139,7 @@
fputc(')', f);break;
case T_INT: fprintf(f, "%"PRIvalue, GETVALUE(n)); break;
+ case T_DOUBLE: fprintf(f, "%f", GETDOUBLEVALUE(n)); break;
case T_STR:
{const char *p = STR(n);
@@ -1135,6 +1187,18 @@
case T_UQUOT: fprintf(f, "$uquot"); break;
case T_UREM: fprintf(f, "$urem"); break;
case T_SUBR: fprintf(f, "$subtract"); break;
+ case T_FADD: fprintf(f, "$fadd"); break;
+ case T_FSUB: fprintf(f, "$fsub"); break;
+ case T_FMUL: fprintf(f, "$fmul"); break;
+ case T_FDIV: fprintf(f, "$fdiv"); break;
+ case T_FEQ: fprintf(f, "$feq"); break;
+ case T_FNE: fprintf(f, "$fne"); break;
+ case T_FLT: fprintf(f, "$flt"); break;
+ case T_FLE: fprintf(f, "$fle"); break;
+ case T_FGT: fprintf(f, "$fgt"); break;
+ case T_FGE: fprintf(f, "$fge"); break;
+ case T_FSHOW: fprintf(f, "$fshow"); break;
+ case T_FREAD: fprintf(f, "$fread"); break;
case T_EQ: fprintf(f, "$=="); break;
case T_NE: fprintf(f, "$/="); break;
case T_LT: fprintf(f, "$<"); break;
@@ -1217,6 +1281,15 @@
return n;
}
+NODEPTR
+mkDouble(double d)
+{+ NODEPTR n;
+ n = alloc_node(T_DOUBLE);
+ SETDOUBLEVALUE(n, d);
+ return n;
+}
+
static inline NODEPTR
mkNil(void)
{@@ -1298,6 +1371,20 @@
return GETVALUE(n);
}
+/* Evaluate to a Double */
+static inline double
+evaldouble(NODEPTR n)
+{+ n = evali(n);
+ #if SANITY
+ if (GETTAG(n) != T_DOUBLE) {+ fprintf(stderr, "bad tag %d\n", GETTAG(n));
+ ERR("evaldouble");+ }
+ #endif
+ return GETDOUBLEVALUE(n);
+}
+
/* Evaluate to a T_HDL */
FILE *
evalhandleN(NODEPTR n)
@@ -1446,7 +1533,9 @@
stackptr_t stk = stack_ptr;
NODEPTR x, y, z, w;
value_t xi, yi;
+ double xd, yd;
value_t r;
+ double rd;
FILE *hdl;
char *msg;
heapoffs_t l;
@@ -1475,12 +1564,16 @@
/* Alloc a possible GC action, e, between setting x and popping */
#define CHKARGEV1(e) do { CHECK(1); x = ARG(TOP(0)); e; POP(1); n = TOP(-1); } while(0)-#define SETINT(n,r) do { SETTAG((n), T_INT); SETVALUE((n), (r)); } while(0)-#define OPINT2(e) do { CHECK(2); xi = evalint(ARG(TOP(0))); yi = evalint(ARG(TOP(1))); e; POP(2); n = TOP(-1); } while(0);-#define ARITHBIN(op) do { OPINT2(r = xi op yi); SETINT(n, r); RET; } while(0)-#define ARITHBINU(op) do { OPINT2(r = (value_t)((uvalue_t)xi op (uvalue_t)yi)); SETINT(n, r); RET; } while(0)-#define CMP(op) do { OPINT2(r = xi op yi); GOIND(r ? combTrue : combFalse); } while(0)-#define CMPU(op) do { OPINT2(r = (uvalue_t)xi op (uvalue_t)yi); GOIND(r ? combTrue : combFalse); } while(0)+#define SETINT(n,r) do { SETTAG((n), T_INT); SETVALUE((n), (r)); } while(0)+#define SETDOUBLE(n,d) do { SETTAG((n), T_DOUBLE); SETDOUBLEVALUE((n), (d)); } while(0)+#define OPINT2(e) do { CHECK(2); xi = evalint(ARG(TOP(0))); yi = evalint(ARG(TOP(1))); e; POP(2); n = TOP(-1); } while(0);+#define OPDOUBLE2(e) do { CHECK(2); xd = evaldouble(ARG(TOP(0))); yd = evaldouble(ARG(TOP(1))); e; POP(2); n = TOP(-1); } while(0);+#define ARITHBIN(op) do { OPINT2(r = xi op yi); SETINT(n, r); RET; } while(0)+#define ARITHBINU(op) do { OPINT2(r = (value_t)((uvalue_t)xi op (uvalue_t)yi)); SETINT(n, r); RET; } while(0)+#define FARITHBIN(op) do { OPDOUBLE2(rd = xd op yd); SETDOUBLE(n, rd); RET; } while(0) // TODO FIXME+#define CMP(op) do { OPINT2(r = xi op yi); GOIND(r ? combTrue : combFalse); } while(0)+#define CMPF(op) do { OPDOUBLE2(r = xd op yd); GOIND(r ? combTrue : combFalse); } while(0)+#define CMPU(op) do { OPINT2(r = (uvalue_t)xi op (uvalue_t)yi); GOIND(r ? combTrue : combFalse); } while(0) for(;;) {num_reductions++;
@@ -1509,6 +1602,7 @@
case T_STR: GCCHECK(strNodes(strlen(STR(n)))); GOIND(mkStringC(STR(n)));
case T_INT: RET;
+ case T_DOUBLE: RET;
case T_HDL: RET;
case T_S: GCCHECK(2); CHKARG3; GOAP(new_ap(x, z), new_ap(y, z)); /* S x y z = x z (y z) */
@@ -1532,6 +1626,60 @@
case T_QUOT: ARITHBIN(/);
case T_REM: ARITHBIN(%);
case T_SUBR: OPINT2(r = yi - xi); SETINT(n, r); RET;
+ case T_FADD: FARITHBIN(+);
+ case T_FSUB: FARITHBIN(-);
+ case T_FMUL: FARITHBIN(*);
+ case T_FDIV: FARITHBIN(/);
+ case T_FEQ: CMPF(==);
+ case T_FNE: CMPF(!=);
+ case T_FLT: CMPF(<);
+ case T_FLE: CMPF(<=);
+ case T_FGT: CMPF(>);
+ case T_FGE: CMPF(>=);
+ case T_FREAD:
+ CHECK(1);
+ msg = evalstring(ARG(TOP(0)));
+ xd = strtod(msg, NULL);
+ free(msg);
+
+ POP(1);
+ n = TOP(-1);
+
+ GOIND(mkDouble(xd));
+
+ case T_FSHOW:
+ // check that the double exists
+ CHECK(1);
+
+ // evaluate it
+ xd = evaldouble(ARG(TOP(0)));
+
+ // turn it into a string
+ char str[25];
+ int idx = snprintf(str, 25, "%f", xd);
+
+ /* C will render floats with potentially many training zeros, shave the
+ off by moving the NULL terminator */
+ for(int i = idx - 1; i >= 0; i--) {+ if(str[i] == '.') {+ str[i+2] = '\0'; // number is x.0, create {x, '.', '0', '\0'}+ break;
+ }
+ if(str[i] != '0') {+ str[i+1] = '\0';
+ break;
+ }
+ }
+
+ // turn it into a mhs string
+ NODEPTR s = mkStringC(str);
+
+ // remove the double from the stack
+ POP(1);
+ n = TOP(-1);
+
+ // update n to be s
+ GOIND(s);
case T_UQUOT: ARITHBINU(/);
case T_UREM: ARITHBINU(%);
--- /dev/null
+++ b/tests/FArith.hs
@@ -1,0 +1,22 @@
+module FArith(module FArith) where
+
+import Prelude
+import Primitives
+import qualified Data.Double as D
+import Text.String
+
+list1 :: [Double]
+list1 = [-100.343241, -53.3248973, -0.0, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999]
+
+list2 :: [Double]
+list2 = [-100.343241, -53.3248973, -0.0, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999]
+
+main :: IO ()
+main = do
+ putStrLn $ showList D.showDouble [ op x y | x <- list1, y <- list2, op <- [D.addDouble, D.subDouble, D.mulDouble] ]
+ putStrLn $ showList showBool [ op x y | x <- list1, y <- list2, op <- [D.eqDouble, D.neqDouble, D.ltDouble, D.leDouble, D.gtDouble, D.geDouble] ]
+ putStrLn $ showList D.showDouble [ D.divDouble x y | x <- [2.234983, 1.232, 23.0], y <- [1.0, 5.0, 10.0, 100.0]]
+ putStrLn $ showList D.showDouble [ D.divDouble x y | x <- [-2.234983, -1.232, -23.0], y <- [1.0, -5.0, 10.0, -100.0]]
+ let str = readDouble "1.576"
+ putStrLn $ D.showDouble str
+ putStrLn $ D.showDouble $ D.addDouble 1.0 $ readDouble "2.5"
\ No newline at end of file
--- /dev/null
+++ b/tests/FArith.ref
@@ -1,0 +1,6 @@
+[-200.686482,0.0,10068.766014,-153.668138,-47.018344,5350.793021,-100.343241,-100.343241,0.0,-100.343241,-100.343241,-0.0,-99.343241,-101.343241,-100.343241,-99.108706,-101.577776,-123.877266,3243434.002099,-3243634.688581,-325466748.506229,899.655759,-1100.342241,-100343.140657,-153.668138,47.018344,5350.793021,-106.649795,0.0,2843.544672,-53.324897,-53.324897,0.0,-53.324897,-53.324897,-0.0,-52.324897,-54.324897,-53.324897,-52.090362,-54.559433,-65.831464,3243481.020443,-3243587.670237,-172961135.854278,946.674103,-1053.323897,-53324.843975,-100.343241,100.343241,0.0,-53.324897,53.324897,0.0,-0.0,0.0,0.0,0.0,-0.0,-0.0,1.0,-1.0,-0.0,1.234535,-1.234535,-0.0,3243534.34534,-3243534.34534,-0.0,999.999,-999.999,-0.0,-100.343241,100.343241,-0.0,-53.324897,53.324897,-0.0,0.0,0.0,-0.0,0.0,0.0,0.0,1.0,-1.0,0.0,1.234535,-1.234535,0.0,3243534.34534,-3243534.34534,0.0,999.999,-999.999,0.0,-99.343241,101.343241,-100.343241,-52.324897,54.324897,-53.324897,1.0,1.0,-0.0,1.0,1.0,0.0,2.0,0.0,1.0,2.234535,-0.234535,1.234535,3243535.34534,-3243533.34534,3243534.34534,1000.999,-998.999,999.999,-99.108706,101.577776,-123.877266,-52.090362,54.559433,-65.831464,1.234535,1.234535,-0.0,1.234535,1.234535,0.0,2.234535,0.234535,1.234535,2.46907,0.0,1.524077,3243535.579875,-3243533.110805,4004257.419037,1001.233535,-998.764465,1234.533995,3243434.002099,3243634.688581,-325466748.506229,3243481.020443,3243587.670237,-172961135.854278,3243534.34534,3243534.34534,-0.0,3243534.34534,3243534.34534,0.0,3243535.34534,3243533.34534,3243534.34534,3243535.579875,3243533.110805,4004257.419037,6487068.69068,0.0,10520515049400.181641,3244534.34434,3242534.34634,3243531101.805655,899.655759,1100.342241,-100343.140657,946.674103,1053.323897,-53324.843975,999.999,999.999,-0.0,999.999,999.999,0.0,1000.999,998.999,999.999,1001.233535,998.764465,1234.533995,3244534.34434,-3242534.34634,3243531101.805655,1999.998,0.0,999998.000001]
+[True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,True,True,False,False,True,False,False,True,False,True]
+[2.234983,0.446997,0.223498,0.02235,1.232,0.2464,0.1232,0.01232,23.0,4.6,2.3,0.23]
+[-2.234983,0.446997,-0.223498,0.02235,-1.232,0.2464,-0.1232,0.01232,-23.0,4.6,-2.3,0.23]
+1.576
+3.5
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -20,6 +20,7 @@
$(MHS) LocalPoly && $(EVAL) > LocalPoly.out && diff LocalPoly.ref LocalPoly.out
$(MHS) Rank2 && $(EVAL) > Rank2.out && diff Rank2.ref Rank2.out
$(MHS) Catch && $(EVAL) > Catch.out && diff Catch.ref Catch.out
+ $(MHS) FArith && $(EVAL) > FArith.out && diff FArith.ref FArith.out
time:
@echo Expect about 10s runtime
--- a/tests/MutRec.hs
+++ b/tests/MutRec.hs
@@ -5,4 +5,4 @@
main = do
let even i = if i == 0 then True else odd (i - 1)
odd i = if i == 0 then False else even (i - 1)
- putStrLn $ showList showBool $ map even [1..5] ++ map odd [1..5]
+ putStrLn $ showList showBool $ map even [1 .. 5] ++ map odd [1 .. 5]
--
⑨