shithub: MicroHs

Download patch

ref: db48432f3e0de3f17fbd65ac3798fbe9d01d035b
parent: 82e418f7109536c49e8020386ce56330a3166845
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Sun Aug 20 14:07:10 EDT 2023

Various changes so we can have a cabal file.

--- a/LICENSE
+++ b/LICENSE
@@ -4,7 +4,7 @@
 you may not use this file except in compliance with the License.
 You may obtain a copy of the License at
 
-    http://www.apache.org/licenses/LICENSE-2.0
+     http://www.apache.org/licenses/LICENSE-2.0
 
 Unless required by applicable law or agreed to in writing, software
 distributed under the License is distributed on an "AS IS" BASIS,
--- a/Makefile
+++ b/Makefile
@@ -4,11 +4,11 @@
 PROF= #-prof -fprof-auto
 EXTS= -XScopedTypeVariables -XQualifiedDo
 GHCB=ghc $(PROF) -outputdir $(BOOTDIR)
-GHCFLAGS=-i -ighc -ilib -i$(BOOTDIR) -hide-all-packages -XNoImplicitPrelude $(EXTS) -F -pgmF $(CURDIR)/convertY.sh 
+GHCFLAGS=-i -ighc -ilib -i$(BOOTDIR) -hide-all-packages -XNoImplicitPrelude $(EXTS) -F -pgmF ./convertY.sh 
 GHCC=$(GHCB) $(GHCFLAGS)
 GHC=ghc
 # $(CURDIR) might not be quite right
-GHCE=$(GHC) $(EXTS) -package mtl -F -pgmF $(CURDIR)/convertX.sh -outputdir $(OUTDIR)
+GHCE=$(GHC) $(EXTS) -package mtl -F -pgmF ./convertX.sh -outputdir $(OUTDIR)
 GCC=gcc
 ALLSRC=src/*/*.hs lib/*.hs lib/*/*.hs ghc/*.hs ghc/*/*.hs
 MHS=mhs
--- /dev/null
+++ b/MicroHs.cabal
@@ -1,0 +1,61 @@
+cabal-version:       3.6
+name:                MicroHs
+version:             0.1
+synopsis:            A compiler for a small subset of Haskell
+license:             Apache-2.0
+license-file:        LICENSE
+copyright:           2023 Lennart Augustsson
+category:            language
+author:              lennart@augustsson.net
+maintainer:          lennart@augustsson.net
+stability:           experimental
+description:         A compiler for a small subset of Haskell.
+                     The compiler translates to combinators and can compile itself.
+build-type:          Simple
+
+extra-source-files:
+      LICENSE
+      Example.hs
+      Makefile
+      README.md
+      convertX.sh
+      convertY.sh
+      comb/*.comb
+      ghc/Primitives.hs
+      ghc/Data/Bool_Type.hs
+      lib/**/*.hs
+      src/runtime/eval.c
+      tests/Makefile
+      tests/*.hs
+      tests/*.ref
+
+source-repository head
+    type:     git
+    location: https://github.com/augustss/MicroHs
+
+executable mhs
+  default-language:    Haskell98
+  hs-source-dirs:      src
+  ghc-options:         -Wall -F -pgmF ./convertX.sh -main-is MicroHs.Main
+  main-is:             MicroHs/Main.hs
+  default-extensions:  ScopedTypeVariables QualifiedDo
+  other-modules:       MicroHs.Compile
+                       MicroHs.Desugar
+                       MicroHs.Exp
+                       MicroHs.Parse
+                       MicroHs.StateIO
+                       MicroHs.StringMap
+                       MicroHs.StringMapFast
+                       MicroHs.TCMonad
+                       MicroHs.Translate
+                       MicroHs.TypeCheck
+                       PreludeNoIO
+                       Text.ParserComb
+                       Compat
+                       CompatIO
+                       PrimTable
+  build-depends:       base         >= 4.10 && < 4.20,
+                       containers   >= 0.5 && < 0.8,
+                       ghc-prim     >= 0.5 && < 0.11,
+                       mtl          >= 2.0 && < 2.4,
+                       time         >= 1.1 && < 1.15
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v2.2
-648
-(($A :0 ((_476 _430) ((($S' ($C ((($C' ($S' _476)) ($C _2)) (($B ($B (_476 _504))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _477)) ((($C' $B) (($B _561) (($B _494) ((($C' _598) _8) 0)))) (($B (_561 _497)) (($B (_508 (($O 116) (($O 111) (($O 112) (($O 32) (($O 108) (($O 101) (($O 118) (($O 101) (($O 108) (($O 32) (($O 100) (($O 101) (($O 102) (($O 110) (($O 115) (($O 58) (($O 32) $K))))))))))))))))))) _458)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _477)) ((($C' $B) (($B _561) (($B _494) ((($C' _598) _8) 1)))) (_493 ($T (($B ($B (_561 _497))) ((($C' $B) _508) (($B (_508 (($O 32) (($O 61) (($O 32) $K))))) _224))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _477))) ((($C' $B) (($B $B) (($B _561) (($B _499) _11)))) (($B ($B (_508 _1))) (($B (($C' _508) _458)) (_508 (($O 10) $K))))))) (($B ($B (_476 _504))) ((($C' $B) (($B $B) (($B _561) (($B _494) ((($C' _598) _8) 0))))) (($B ($B (_561 _497))) (($B ($B (_508 (($O 102) (($O 105) (($O 110) (($O 97) (($O 108) (($O 32) (($O 112) (($O 97) (($O 115) (($O 115) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) $K))))))))))))))))))))))))) ((($C' ($C' _508)) (($B ($B (_471 6))) (($B ($B _458)) _592))) (($O 109) (($O 115) $K)))))))))) _3)))) _455))) (($B (($C' $C) (($B ($C _513)) _224))) (($C _526) (_541 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B ($B $K))) (($B ($B ($B ($B (_508 (($O 40) (($O 40) (($O 36) (($O 65) (($O 32) (($O 58) $K))))))))))) (($B ($B (($C' $B) (($B _508) _458)))) (($B ($B ($B (_508 (($O 32) $K))))) ((($C' $B) (($B ($C' _508)) ($B _224))) (($B (_508 (($O 41) (($O 32) $K)))) (($C _508) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _204)) $I))) (($B $K) $K))) $K)) $K))))) $T)) (($B (($S' _561) (($B _558) (($B (_561 _606)) (($B (_508 (($O 109) (($O 97) (($O 105) (($O 110) (($O 58) (($O 32) (($O 102) (($O 105) (($O 110) (($O 100) (($O 73) (($O 100) (($O 101) (($O 110) (($O 116) (($O 58) (($O 32) $K))))))))))))))))))) _292))))) ($C _448)))) (($B ($B _452)) (($B (($C' _510) (($B $T) (($B ($C $B)) (($B ($B ($B $K))) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _526) (_541 0)))))) (($B (_561 _203)) (($B (_508 (($O 95) $K))) _458))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _525) (_512 (_469 (($O 45) (($O 118) $K)))))) ((_540 _469) (($O 45) (($O 114) $K))))) (($B (_506 (($O 46) $K))) (($B _560) (_511 ((_530 _583) (($O 45) (($O 105) $K)))))))) (($B (_561 _535)) ((($C' _508) (($B _560) (_511 ((_530 _583) (($O 45) (($O 111) $K)))))) (($O (($O 111) (($O 117) (($O 116) (($O 46) (($O 99) (($O 111) (($O 109) (($O 98) $K))))))))) $K))))) (($B (($S (($C ((($C' _594) _525) 1)) (_606 (($O 85) (($O 115) (($O 97) (($O 103) (($O 101) (($O 58) (($O 32) (($O 117) (($O 104) (($O 115) (($O 32) (($O 91) (($O 45) (($O 118) (($O 93) (($O 32) (($O 91) (($O 45) (($O 114) (($O 93) (($O 32) (($O 91) (($O 45) (($O 105) (($O 80) (($O 65) (($O 84) (($O 72) (($O 93) (($O 32) (($O 91) (($O 45) (($O 111) (($O 70) (($O 73) (($O 76) (($O 69) (($O 93) (($O 32) (($O 77) (($O 111) (($O 100) (($O 117) (($O 108) (($O 101) (($O 78) (($O 97) (($O 109) (($O 101) $K)))))))))))))))))))))))))))))))))))))))))))))))))))) _535)) (_512 ((_562 _603) ((_562 (_469 (($O 45) $K))) (_523 1)))))))) (($A :1 (($O 118) (($O 50) (($O 46) (($O 50) (($O 10) $K)))))) (($A :2 ((($S' ($S' _476)) _16) (($B ($B ($B (_476 _504)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _477) (($B (_561 _495)) (($B (_561 (_524 1000000))) _38)))))) (($B ($B ($B ($B (_476 _504))))) ((($C' $B) (($B ($C' $B)) (($B
\ No newline at end of file
+649
+(($A :0 ((_477 _431) ((($S' ($C ((($C' ($S' _477)) ($C _2)) (($B ($B (_477 _505))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _478)) ((($C' $B) (($B _562) (($B _495) ((($C' _599) _8) 0)))) (($B (_562 _498)) (($B (_509 (($O 116) (($O 111) (($O 112) (($O 32) (($O 108) (($O 101) (($O 118) (($O 101) (($O 108) (($O 32) (($O 100) (($O 101) (($O 102) (($O 110) (($O 115) (($O 58) (($O 32) $K))))))))))))))))))) _459)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _478)) ((($C' $B) (($B _562) (($B _495) ((($C' _599) _8) 1)))) (_494 ($T (($B ($B (_562 _498))) ((($C' $B) _509) (($B (_509 (($O 32) (($O 61) (($O 32) $K))))) _225))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _478))) ((($C' $B) (($B $B) (($B _562) (($B _500) _11)))) (($B ($B (_509 _1))) (($B (($C' _509) _459)) (_509 (($O 10) $K))))))) (($B ($B (_477 _505))) ((($C' $B) (($B $B) (($B _562) (($B _495) ((($C' _599) _8) 0))))) (($B ($B (_562 _498))) (($B ($B (_509 (($O 102) (($O 105) (($O 110) (($O 97) (($O 108) (($O 32) (($O 112) (($O 97) (($O 115) (($O 115) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) (($O 32) $K))))))))))))))))))))))))) ((($C' ($C' _509)) (($B ($B (_472 6))) (($B ($B _459)) _593))) (($O 109) (($O 115) $K)))))))))) _3)))) _456))) (($B (($C' $C) (($B ($C _514)) _225))) (($C _527) (_542 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B ($B $K))) (($B ($B ($B ($B (_509 (($O 40) (($O 40) (($O 36) (($O 65) (($O 32) (($O 58) $K))))))))))) (($B ($B (($C' $B) (($B _509) _459)))) (($B ($B ($B (_509 (($O 32) $K))))) ((($C' $B) (($B ($C' _509)) ($B _225))) (($B (_509 (($O 41) (($O 32) $K)))) (($C _509) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _205)) $I))) (($B $K) $K))) $K)) $K))))) $T)) (($B (($S' _562) (($B _559) (($B (_562 _607)) (($B (_509 (($O 109) (($O 97) (($O 105) (($O 110) (($O 58) (($O 32) (($O 102) (($O 105) (($O 110) (($O 100) (($O 73) (($O 100) (($O 101) (($O 110) (($O 116) (($O 58) (($O 32) $K))))))))))))))))))) _293))))) ($C _449)))) (($B ($B _453)) (($B (($C' _511) (($B $T) (($B ($C $B)) (($B ($B ($B $K))) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _527) (_542 0)))))) (($B (_562 _204)) (($B (_509 (($O 95) $K))) _459))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _526) (_513 (_470 (($O 45) (($O 118) $K)))))) ((_541 _470) (($O 45) (($O 114) $K))))) (($B (_507 (($O 46) $K))) (($B _561) (_512 ((_531 _584) (($O 45) (($O 105) $K)))))))) (($B (_562 _536)) ((($C' _509) (($B _561) (_512 ((_531 _584) (($O 45) (($O 111) $K)))))) (($O (($O 111) (($O 117) (($O 116) (($O 46) (($O 99) (($O 111) (($O 109) (($O 98) $K))))))))) $K))))) (($B (($S (($C ((($C' _595) _526) 1)) (_607 (($O 85) (($O 115) (($O 97) (($O 103) (($O 101) (($O 58) (($O 32) (($O 117) (($O 104) (($O 115) (($O 32) (($O 91) (($O 45) (($O 118) (($O 93) (($O 32) (($O 91) (($O 45) (($O 114) (($O 93) (($O 32) (($O 91) (($O 45) (($O 105) (($O 80) (($O 65) (($O 84) (($O 72) (($O 93) (($O 32) (($O 91) (($O 45) (($O 111) (($O 70) (($O 73) (($O 76) (($O 69) (($O 93) (($O 32) (($O 77) (($O 111) (($O 100) (($O 117) (($O 108) (($O 101) (($O 78) (($O 97) (($O 109) (($O 101) $K)))))))))))))))))))))))))))))))))))))))))))))))))))) _536)) (_513 ((_563 _604) ((_563 (_470 (($O 45) $K))) (_524 1)))))))) (($A :1 (($O 118) (($O 50) (($O 46) (($O 50) (($O 10) $K)))))) (($A :2 ((($S' ($S' _477)) _16) (($B ($B ($B (_477 _505)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _478) (($B (_562 _496)) (($B (_562 (_525 1000000))) _38)))))) (($B ($B ($B ($B (_477 _505))))) ((($C' $B) (($B ($C' $B)) (($B
\ No newline at end of file
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -97,10 +97,8 @@
   t1 <- liftIO getTimeMilli
   let
     fn = map (\ c -> if eqChar c '.' then '/' else c) nm ++ ".hs"
-  mdl <- S.fmap (parseDie pTop fn) (liftIO (readFilePath (paths flags) fn))
+  mdl@(EModule nmn _ defs) <- S.fmap (parseDie pTop fn) (liftIO (readFilePath (paths flags) fn))
   --liftIO $ putStrLn $ showEModule mdl
-  let
-    EModule nmn _ defs = mdl
   S.when (not (eqIdent nm nmn)) $
     error $ "module name does not agree with file name: " ++ showIdent nm
   let
--- a/src/MicroHs/StateIO.hs
+++ b/src/MicroHs/StateIO.hs
@@ -71,3 +71,6 @@
           bs <- rec as
           MicroHs.StateIO.return (b : bs)
   in rec
+
+fail :: forall s a . String -> StateIO s a
+fail = error
--