ref: 14fa45dfbac11b88b9abc8524eb1c642207a2602
parent: 1ddb87f544900f59d70e538d2ab0aa9fa7a65512
author: Lennart Augustsson <lennart@augustsson.net>
date: Mon Nov 13 07:32:46 EST 2023
Start of new Makefile
--- /dev/null
+++ b/Makefile.old
@@ -1,0 +1,136 @@
+# installtion prefix
+PREFIX=/usr/local
+BIN=bin
+BOOTDIR=ghc-boot
+OUTDIR=ghc-out
+TOOLS=Tools
+PROF= -prof -fprof-late #-prof -fprof-auto
+EXTS= -XScopedTypeVariables -XTupleSections
+GHCB=ghc $(PROF) -outputdir $(BOOTDIR)
+GHCFLAGS=-i -ighc -ilib -i$(BOOTDIR) -hide-all-packages -XNoImplicitPrelude -XRebindableSyntax $(EXTS) -F -pgmF $(TOOLS)/convertY.sh
+GHCC=$(GHCB) $(GHCFLAGS)
+GHC=ghc
+# $(CURDIR) might not be quite right
+GHCE=$(GHC) $(EXTS) -package mtl -package pretty -F -pgmF Tools/convertX.sh -outputdir $(OUTDIR)
+GCC=gcc
+UPX=upx
+ALLSRC=src/*/*.hs lib/*.hs lib/*/*.hs ghc/*.hs ghc/*/*.hs
+MHS=mhs
+COMB=comb/
+EVAL=$(BIN)/mhseval
+.PHONY: all alltest everytest runtest bootcombtest $(MHS)test test alltest time example bootstraptest
+
+all: $(EVAL) $(BIN)/$(MHS)
+
+everytest: runtest example examplecomb bootcombtest
+
+###
+### Build evaluator (runtime system)
+###
+# On MINGW you might need the additional flags -Wl,--stack,50000000 to increase stack space.
+$(EVAL): src/runtime/eval.c
+ @mkdir -p bin
+ $(GCC) -Wall -Wno-deprecated-declarations -O3 src/runtime/eval.c -lm -o $(EVAL)
+
+###
+### Build the compiler with ghc, using standard libraries (Prelude, Data.List, etc)
+###
+$(BIN)/$(MHS): src/*/*.hs $(TOOLS)/convertX.sh
+ $(GHCE) -ighc -isrc -Wall -Wno-unrecognised-warning-flags -Wno-x-partial -O src/MicroHs/Main.hs -main-is MicroHs.Main -o $(BIN)/$(MHS)
+
+# Self compile using comb/mhs.comb
+$(COMB)$(MHS)-new.comb: $(EVAL)
+ $(EVAL) +RTS -r$(COMB)$(MHS).comb -RTS -ilib -isrc -o$(COMB)$(MHS)-new.comb MicroHs.Main
+
+# Compare version compiled with GHC, and bootstrapped combinator version
+bootcombtest: $(BIN)/$(MHS) $(EVAL) $(COMB)$(MHS).comb
+ $(BIN)/$(MHS) -ilib -isrc -omain-$(MHS).comb MicroHs.Main
+ $(EVAL) +RTS -v -r$(COMB)$(MHS).comb -RTS -ilib -isrc -omain-comb.comb MicroHs.Main
+ cmp main-$(MHS).comb main-comb.comb
+
+###
+### Run test examples with ghc-compiled compiler
+###
+runtest: $(EVAL) $(BIN)/$(MHS) tests/*.hs
+ cd tests; make alltest
+
+###
+### Run test examples with MicroHs compiler
+###
+runtestcomb: $(EVAL) $(COMB)$(MHS).comb
+ cd tests; make MHS='../$(EVAL) +RTS -r../$(COMB)$(MHS).comb -RTS -i../lib'
+
+###
+### Build combinator file for the compiler, using ghc-compiled compiler
+###
+$(COMB)$(MHS).comb: $(BIN)/$(MHS) $(ALLSRC)
+ $(BIN)/$(MHS) -ilib -isrc -o$(COMB)$(MHS).comb MicroHs.Main
+
+time: $(EVAL) $(BIN)/$(MHS) tests/*.hs
+ cd tests; make time
+
+example: $(EVAL) $(BIN)/$(MHS) Example.hs
+ $(BIN)/$(MHS) -ilib Example && $(EVAL)
+
+# does not work
+exampleboot: $(BIN)/boot$(MHS) Example.hs
+ $(BIN)/boot$(MHS) -r -ilib Example && $(EVAL)
+
+examplecomb: $(EVAL) $(COMB)$(MHS).comb Example.hs
+ $(EVAL) +RTS -r$(COMB)$(MHS).comb -RTS -r -ilib Example
+
+clean:
+ rm -rf src/*/*.hi src/*/*.o eval Main *.comb *.tmp *~ $(BIN)/* a.out $(BOOTDIR) $(OUTDIR) tmp/eval.c Tools/*.o Tools/*.hi dist-newstyle
+ cd tests; make clean
+
+###
+### Make an eval.c that contains the combinator code.
+###
+tmp/eval.c: src/runtime/eval.c $(EVAL) $(COMB)$(MHS).comb
+ @mkdir -p tmp
+ cp src/runtime/eval.c tmp/eval.c
+ $(EVAL) +RTS -r$(COMB)$(MHS).comb -o$(COMB)$(MHS)-gc.comb -RTS
+ $(EVAL) +RTS -K10M -r$(COMB)$(MHS).comb -RTS -ilib -iTools -r Compress < $(COMB)$(MHS)-gc.comb | \
+ $(EVAL) +RTS -K10M -r$(COMB)$(MHS).comb -RTS -ilib -iTools -r Addcombs >> tmp/eval.c
+
+###
+### Make an executable that contains the combinator code.
+###
+$(BIN)/cmhs: tmp/eval.c
+ $(GCC) -Wall -O3 tmp/eval.c -o $(BIN)/cmhs
+ strip $(BIN)/cmhs
+
+###
+### Compress the binary (broken on MacOS)
+###
+$(BIN)/umhs: $(BIN)/cmhs
+ rm -f $(BIN)/umhs
+ $(UPX) -q -q -o$(BIN)/umhs $(BIN)/cmhs
+###
+### Test that the compiler can bootstrap
+###
+bootstraptest: $(EVAL)
+ @mkdir -p tmp
+ @echo Build stage 1 with distribution combinator file
+ $(EVAL) +RTS -rcomb/mhs.comb -RTS -ilib -isrc -otmp/mhs.comb.1 MicroHs.Main
+ @echo Build stage 2 with output from stage 1
+ $(EVAL) +RTS -rtmp/mhs.comb.1 -RTS -ilib -isrc -otmp/mhs.comb.2 MicroHs.Main
+ cmp tmp/mhs.comb.1 tmp/mhs.comb.2 && echo Success
+
+# installs linraries the the following binaries:
+# bin/mhseval - the evaluator that can read a combinator file and run it
+# bin/mhsc - a compiler that produces a proper binary
+# bin/mhs - a compiler/repl that can compile to combinators
+install: $(EVAL)
+ mkdir -p $(PREFIX)/bin
+ cp $(EVAL) $(PREFIX)/bin
+ (echo "prefix=$(PREFIX)"; cat Tools/mhsc.sh) > $(PREFIX)/bin/mhsc
+ chmod +x $(PREFIX)/bin/mhsc
+ mkdir -p $(PREFIX)/lib/mhs/Tools
+ mkdir -p $(PREFIX)/lib/mhs/comb
+ mkdir -p $(PREFIX)/lib/mhs/src/runtime
+ cp Tools/* $(PREFIX)/lib/mhs/Tools
+ cp comb/mhs.comb $(PREFIX)/lib/mhs/comb
+ cp src/runtime/eval.c $(PREFIX)/lib/mhs/src/runtime
+ cp -r lib $(PREFIX)/lib/mhs
+ $(PREFIX)/bin/mhsc -isrc -o$(PREFIX)/bin/mhs MicroHs.Main
--- /dev/null
+++ b/ghc/Data/Double.hs
@@ -1,0 +1,1 @@
+module Data.Double(Double) where
--- /dev/null
+++ b/ghc/System/Console/SimpleReadline.hs
@@ -1,0 +1,10 @@
+module System.Console.SimpleReadline(
+ getInputLine,
+ getInputLineHist
+ ) where
+
+getInputLine :: String -> IO (Maybe String)
+getInputLine _ = error "No getInputLine for ghc"
+
+getInputLineHist :: FilePath -> String -> IO (Maybe String)
+getInputLineHist _ _ = error "No getInputLineHist for ghc"
--- /dev/null
+++ b/lib/System/Console/SimpleReadline.hs
@@ -1,0 +1,174 @@
+-- Copyright 2023 Lennart Augustsson
+-- See LICENSE file for full license.
+--
+-- Simple readline with line editing and history.
+-- Only assumes the terminal is capable of (sane) backspace.
+module System.Console.SimpleReadline(
+ getInputLine,
+ getInputLineHist
+ ) where
+import Prelude
+import Control.Monad
+import Data.Char
+import System.IO
+--Ximport Compat
+
+foreign import ccall "getRaw" c_getRaw :: IO Int
+
+
+-- Get an input line with editing.
+-- Return Nothing if the input is ^D, otherwise the typed string.
+getInputLine :: String -> IO (Maybe String)
+getInputLine prompt = do
+ (_, r) <- loop ([],[]) "" ""
+ return r
+
+
+-- Get an input line with editing.
+-- Return Nothing if the input is ^D, otherwise the typed string.
+-- The FilePath gives the name of a file that stores the history.
+getInputLineHist :: FilePath -> String -> IO (Maybe String)
+getInputLineHist hfn prompt = do
+ mhdl <- openFileM hfn ReadMode
+ hist <-
+ case mhdl of
+ Nothing -> return []
+ Just hdl -> do
+ file <- hGetContents hdl
+ let h = lines file
+ seq (length h) (return h) -- force file to be read
+ putStr prompt
+ (hist', r) <- loop (reverse hist, []) "" ""
+-- putStrLn $ "done: " ++ hfn ++ "\n" ++ unlines hist'
+ writeFile hfn $ unlines hist'
+ return r -- XXX no type error
+
+getRaw :: IO Int
+getRaw = do
+ i <- c_getRaw
+ when (i < 0) $
+ error "getRaw failed"
+ return i
+
+type Hist = ([String], [String])
+
+loop :: Hist -> String -> String -> IO ([String], Maybe String)
+loop hist before after = do
+ hFlush stdout
+ i <- getRaw
+ let
+ cur = reverse before ++ after
+ back n = putStr (replicate n '\b')
+
+ add c = do
+ putChar c
+ putStr after
+ back (length after)
+ loop hist (c:before) after
+ backward =
+ case before of
+ [] -> noop
+ c:cs -> do
+ back 1
+ loop hist cs (c:after)
+ forward =
+ case after of
+ [] -> noop
+ c:cs -> do
+ putChar c
+ loop hist (c:before) cs
+ bol = do
+ back (length before)
+ loop hist "" (reverse before ++ after)
+ eol = do
+ putStr after
+ loop hist (reverse after ++ before) ""
+ bs = do
+ case before of
+ [] -> noop
+ _:cs -> do
+ back 1
+ putStr after
+ putChar ' '
+ back (length after + 1)
+ loop hist cs after
+ del = do
+ case after of
+ [] -> noop
+ _:cs -> do
+ putStr cs
+ putChar ' '
+ back (length cs + 1)
+ loop hist before cs
+ send =
+ ret (Just cur)
+ ret ms = do
+ putChar '\n'
+ hFlush stdout
+ let
+ o = reverse (fst hist) ++ snd hist
+ l =
+ case ms of
+ Nothing -> []
+ Just "" -> []
+ Just s | not (null o) && s == last o -> []
+ | otherwise -> [s]
+ h = o ++ l
+ return (h, ms)
+ erase = do
+ eraseLine
+ loop hist "" ""
+ noop = loop hist before after
+ kill = do
+ putStr after
+ putStr $ concat $ replicate (length after) "\b \b"
+ loop hist before ""
+
+ next =
+ case hist of
+ (_, []) -> noop
+ (p, l:n) -> setLine (l:p, n) l
+ previous =
+ case hist of
+ ([], _) -> noop
+ (l:p, n) -> setLine (p, l:n) l
+ setLine h s = do
+ eraseLine
+ putStr s
+ loop h (reverse s) ""
+
+ eraseLine = do
+ putStr after
+ putStr $ concat $ replicate (length before + length after) "\b \b"
+
+ case i of
+ 4 -> -- CTL-D, EOF
+ if null before && null after then
+ ret Nothing
+ else
+ del
+ 2 -> backward -- CTL-B, backwards
+ 6 -> forward -- CTL-F, forwards
+ 1 -> bol -- CTL-A, beginning of line
+ 5 -> eol -- CTL-E, end of line
+ 8 -> bs -- BS, backspace
+ 127 -> bs -- DEL, backspace
+ 13 -> send -- CR, return
+ 10 -> send -- LF, return
+ 14 -> next -- CTL-N, next line
+ 15 -> previous -- CTL-P, previous line
+ 21 -> erase -- CTL-U, erase line
+ 11 -> kill -- CTL-K, kill to eol
+ 27 -> do -- ESC
+ b <- getRaw
+ if b /= ord '[' then
+ noop
+ else do
+ c <- getRaw
+ case chr c of
+ 'A' -> previous
+ 'B' -> next
+ 'C' -> forward
+ 'D' -> backward
+ _ -> noop
+ _ -> if i >= 32 && i < 127 then add (chr i) else noop
--- a/src/System/Console/SimpleReadline.hs
+++ /dev/null
@@ -1,175 +1,0 @@
--- Copyright 2023 Lennart Augustsson
--- See LICENSE file for full license.
--- Simple readline with line editing and history.
--- Only assumes the terminal is capable of (sane) backspace.
-module System.Console.SimpleReadline(
- getInputLine,
- getInputLineHist
- ) where
-import Prelude
-import Control.Monad
-import Data.Char
-import System.IO
---Ximport Compat
-
-foreign import ccall "getRaw" c_getRaw :: IO Int
-
-
--- Get an input line with editing.
--- Return Nothing if the input is ^D, otherwise the typed string.
-getInputLine :: String -> IO (Maybe String)
-getInputLine prompt = do
- putStr prompt
- (_, r) <- loop ([],[]) "" ""
- return r
-
-
--- Get an input line with editing.
--- Return Nothing if the input is ^D, otherwise the typed string.
--- The FilePath gives the name of a file that stores the history.
-getInputLineHist :: FilePath -> String -> IO (Maybe String)
-getInputLineHist hfn prompt = do
- mhdl <- openFileM hfn ReadMode
- hist <-
- case mhdl of
- Nothing -> return []
- Just hdl -> do
- file <- hGetContents hdl
- let h = lines file
- seq (length h) (return h) -- force file to be read
- putStr prompt
- (hist', r) <- loop (reverse hist, []) "" ""
--- putStrLn $ "done: " ++ hfn ++ "\n" ++ unlines hist'
- writeFile hfn $ unlines hist'
- return r -- XXX no type error
-
-getRaw :: IO Int
-getRaw = do
- i <- c_getRaw
- when (i < 0) $
- error "getRaw failed"
- return i
-
-type Hist = ([String], [String])
-
-loop :: Hist -> String -> String -> IO ([String], Maybe String)
-loop hist before after = do
- hFlush stdout
- i <- getRaw
- let
- cur = reverse before ++ after
- back n = putStr (replicate n '\b')
-
- add c = do
- putChar c
- putStr after
- back (length after)
- loop hist (c:before) after
- backward =
- case before of
- [] -> noop
- c:cs -> do
- back 1
- loop hist cs (c:after)
- forward =
- case after of
- [] -> noop
- c:cs -> do
- putChar c
- loop hist (c:before) cs
- bol = do
- back (length before)
- loop hist "" (reverse before ++ after)
- eol = do
- putStr after
- loop hist (reverse after ++ before) ""
- bs = do
- case before of
- [] -> noop
- _:cs -> do
- back 1
- putStr after
- putChar ' '
- back (length after + 1)
- loop hist cs after
- del = do
- case after of
- [] -> noop
- _:cs -> do
- putStr cs
- putChar ' '
- back (length cs + 1)
- loop hist before cs
- send =
- ret (Just cur)
- ret ms = do
- putChar '\n'
- hFlush stdout
- let
- o = reverse (fst hist) ++ snd hist
- l =
- case ms of
- Nothing -> []
- Just "" -> []
- Just s | not (null o) && s == last o -> []
- | otherwise -> [s]
- h = o ++ l
- return (h, ms)
- erase = do
- eraseLine
- loop hist "" ""
- noop = loop hist before after
- kill = do
- putStr after
- putStr $ concat $ replicate (length after) "\b \b"
- loop hist before ""
-
- next =
- case hist of
- (_, []) -> noop
- (p, l:n) -> setLine (l:p, n) l
- previous =
- case hist of
- ([], _) -> noop
- (l:p, n) -> setLine (p, l:n) l
- setLine h s = do
- eraseLine
- putStr s
- loop h (reverse s) ""
-
- eraseLine = do
- putStr after
- putStr $ concat $ replicate (length before + length after) "\b \b"
-
- case i of
- 4 -> -- CTL-D, EOF
- if null before && null after then
- ret Nothing
- else
- del
- 2 -> backward -- CTL-B, backwards
- 6 -> forward -- CTL-F, forwards
- 1 -> bol -- CTL-A, beginning of line
- 5 -> eol -- CTL-E, end of line
- 8 -> bs -- BS, backspace
- 127 -> bs -- DEL, backspace
- 13 -> send -- CR, return
- 10 -> send -- LF, return
- 14 -> next -- CTL-N, next line
- 15 -> previous -- CTL-P, previous line
- 21 -> erase -- CTL-U, erase line
- 11 -> kill -- CTL-K, kill to eol
- 27 -> do -- ESC
- b <- getRaw
- if b /= ord '[' then
- noop
- else do
- c <- getRaw
- case chr c of
- 'A' -> previous
- 'B' -> next
- 'C' -> forward
- 'D' -> backward
- _ -> noop
- _ -> if i >= 32 && i < 127 then add (chr i) else noop
--
⑨