Changeset 7843

Timestamp:

11/05/05 11:41:57 (3 years ago)

Author:

autrijus

Message:

[Massive backport from svn.perl.org now openfoundry is back]

* theorbtwo notes that FIRST {} blocks did not

desugar into anything that passes PIL compilation,
as it's useing a Stmt in LValue position.
Fixed by desugaring using ternary if.

* Squash an empty import warning for precompiled preludes.

* Support for "./pugs -C PIL2".

Currently, "-C PIL" and "-C PIL1" both maps to PIL1,
but some day "-C PIL" may change to PIL2.

* Repo copy Pugs.CodeGen?.PIL to Pugs.CodeGen?.PIL2
* Also rename CodeGen?.PIL to CodeGen?.PIL1

* Add DrIFT-generated source of PIL2.hs.

* Repo copy PIL1 to PIL2 for the long-much-overdue PIL2

refactoring. The goals are:

• Compile time object serialization
• Lexical hoisting
• Static creation of Code objects with scope (no PSub forms)
• Full Cxt information
• PIL2 is *after* type erasure -- *no* static type annotation should be left after that -- it's somewhere between F<: and ANF, so to speak.

* Adds support for "./pugs -BPugs -e ...", which just takes

-CPugs output and feed to the "runghc" executable in PATH.

* pugscc: chase the s/MainCC.mainCC/Main.main/ change

as the now-cabalized Pugs package no longer exports "main".

* Compile-time objects now survives "./pugs -CPugs" compilation.

This means the line below works now:

pugscc -e 'class F {}; my $x ::= F.new; say $x'

Previously, the ::= would prevent compilation because we
did not have a serialization protocol for VObject types.
(This work is going to be carried over to PIL.)

Files:

• Pugs.cabal.in (modified) (1 diff)
• docs/AES/S22draft.pod (modified) (5 diffs)
• script/pugscc (modified) (1 diff)
• src/Pugs/CodeGen.hs (modified) (4 diffs)
• src/Pugs/CodeGen/PIL.hs (deleted)
• src/Pugs/CodeGen/PIL1.hs (added)
• src/Pugs/CodeGen/PIL2.hs (added)
• src/Pugs/Compile/Pugs.hs (modified) (7 diffs)
• src/Pugs/Embed.hs (modified) (3 diffs)
• src/Pugs/Embed/Pugs.hs (added)
• src/Pugs/PIL2.hs (added)
• src/Pugs/PIL2.hs-drift (added)
• src/Pugs/Parser.hs (modified) (2 diffs)
• src/Pugs/PreludePC.hs-null (modified) (1 diff)
• src/Pugs/Run.hs (modified) (1 diff)

Pugs.cabal.in

@@ -12 +12 @@
 author: Autrijus Tang <autrijus@autrijus.org>
 tested-with: GHC -any
-exposed-modules: Pugs Pugs.AST Pugs.AST.Internals Pugs.AST.Pad Pugs.AST.Pos Pugs.AST.Prag Pugs.AST.SIO Pugs.AST.Scope Pugs.Bind Pugs.CodeGen Pugs.CodeGen.Binary Pugs.CodeGen.JSON Pugs.CodeGen.PIL Pugs.CodeGen.PIR Pugs.CodeGen.PIR.Prelude Pugs.CodeGen.Perl5 Pugs.Compat Pugs.Compile Pugs.Compile.Haskell Pugs.Compile.Pugs Pugs.Config Pugs.Cont Pugs.Embed Pugs.Embed.Haskell Pugs.Embed.Parrot Pugs.Embed.Perl5 Pugs.Eval Pugs.Eval.Var Pugs.External Pugs.External.Haskell Pugs.Help Pugs.Internals Pugs.Junc Pugs.Lexer Pugs.Monads Pugs.PIL1 Pugs.Parser Pugs.Parser.Number Pugs.Parser.Program Pugs.Parser.Types Pugs.Parser.Unsafe Pugs.Pretty Pugs.Prim Pugs.Prim.Code Pugs.Prim.Eval Pugs.Prim.FileTest Pugs.Prim.Keyed Pugs.Prim.Lifts Pugs.Prim.List Pugs.Prim.Match Pugs.Prim.Numeric Pugs.Prim.Param Pugs.Prim.Yaml Pugs.Rule Pugs.Rule.Char Pugs.Rule.Combinator Pugs.Rule.Error Pugs.Rule.Expr Pugs.Rule.Language Pugs.Rule.Pos Pugs.Rule.Prim Pugs.Rule.Token Pugs.Run Pugs.Run.Args Pugs.Run.Perl5 Pugs.Shell Pugs.Types Pugs.Version Emit.Common Emit.PIR 
+exposed-modules: Pugs Pugs.AST Pugs.AST.Internals Pugs.AST.Pad Pugs.AST.Pos Pugs.AST.Prag Pugs.AST.SIO Pugs.AST.Scope Pugs.Bind Pugs.CodeGen Pugs.CodeGen.Binary Pugs.CodeGen.JSON Pugs.CodeGen.PIL1 Pugs.CodeGen.PIL2 Pugs.CodeGen.PIR Pugs.CodeGen.PIR.Prelude Pugs.CodeGen.Perl5 Pugs.Compat Pugs.Compile Pugs.Compile.Haskell Pugs.Compile.Pugs Pugs.Config Pugs.Cont Pugs.Embed Pugs.Embed.Haskell Pugs.Embed.Parrot Pugs.Embed.Perl5 Pugs.Embed.Pugs Pugs.Eval Pugs.Eval.Var Pugs.External Pugs.External.Haskell Pugs.Help Pugs.Internals Pugs.Junc Pugs.Lexer Pugs.Monads Pugs.PIL1 Pugs.PIL2 Pugs.Parser Pugs.Parser.Number Pugs.Parser.Program Pugs.Parser.Types Pugs.Parser.Unsafe Pugs.Pretty Pugs.Prim Pugs.Prim.Code Pugs.Prim.Eval Pugs.Prim.FileTest Pugs.Prim.Keyed Pugs.Prim.Lifts Pugs.Prim.List Pugs.Prim.Match Pugs.Prim.Numeric Pugs.Prim.Param Pugs.Prim.Yaml Pugs.Rule Pugs.Rule.Char Pugs.Rule.Combinator Pugs.Rule.Error Pugs.Rule.Expr Pugs.Rule.Language Pugs.Rule.Pos Pugs.Rule.Prim Pugs.Rule.Token Pugs.Run Pugs.Run.Args Pugs.Run.Perl5 Pugs.Shell Pugs.Types Pugs.Version Emit.Common Emit.PIR 
 buildable: True
 c-sources: src/cbits/fpstring.c src/pcre/pcre.c __UNICODE_C__

docs/AES/S22draft.pod

@@ -9 +9 @@
 Jos Boumans <kane@cpan.org>
 Autrijus Tang <autrijus@autrijus.org>
-Florian Ragwitz <rafl@debian.org>
 
 =head1 VERSION
@@ -24 +23 @@
 
 'package management means several things':
-    - metadata collection                           (1) perl6-thingy or maybe debtags?
+    - metadata collection                           (1) perl6-thingy
     - package building                              (2) make dist
         - intermediate format for transport
@@ -30 +29 @@
             - decomposed to hooks and probes
         - uploading package to central area         (3) CPAN
-        - indexing                                  (4) apt-ftparchive
-                    - I don't think apt-ftparchive is enough here. I think we'll need to set up
-                          or even wright something like dak, the Debian archive maintaince scripts
-                          packages.debian.org/dak
-        - understanding/querying index              (5) apt-cache, debtags
+        - indexing                                  (4) aptftp-archive
+        - understanding/querying index              (5) apt-cache
         - fetching package
         - building final package                    (6) dpkg-deb
@@ -116 +112 @@
 
 =head3 Repositories
-
-My ideas for the repository layout look like this. It's modeled after the
-Debian archive structure.
-
- /
- |- dists/                  This directory only contains so called Packages files.
- |  |                       They know some meta-information about the packages (description, ...)
- |  |                       and a path to the real package inside pool/. Using this Packages
- |  |                       files modules can be categorized very well. There are more then the
- |  |                       showed categories possible, of course. It's only an example.
- |  |
- |  |- authors/             The whole archive sorted by authors
- |  |  |- stevan.gz         Stevan's modules
- |  |  |- autrijus.gz       All of autrijus modules
- |  |  |- autrijus/
- |  |  |  |- Perl6-Pugs.gz  Individual modules
- |  |  |  `- Acme-Hello.gz
- |  |  `- rafl.gz           rafl's modules.
- |  |
- |  |- languages/           The archive sorted by language
- |  |  |- perl.gz           All available perl modules
- |  |  |- perl/
- |  |  |  |- kane.gz        kane's modules
- |  |  |  `- gbarr.gz       gbarr's modules
- |  |  |- js.gz             All js modules
- |  |  |- js/
- |  |  |- ruby.gz
- |  |  `- ruby/             Ruby stuff
- |  |
- |  `- modules/             Categorized by modules
- |     |- DBI/
- |     |  |- timb.gz        Tim's DBI
- |     |  `- rafl.gz        My DBI
- |     |- Net-SMTP/
- |     `- Net-IMCP/
- |
- `- pool/                       The real modules are stored here. The Packages files point here.
-    |- a/                       Modules startihg with 'a'
-    |  |- Acme-Foo/             All Acme-Foo versions
-    |  |  |- Acme-Foo-0.1.deb   Packages for specific Acme-Foo versions
-    |  |  `- Acme-Foo-0.2.deb
-    |  |- Acme-Bar/
-    |  `- Acme-Hello/
-    |- b/
-    |- c/
-    |- ./
-    |- ./
-    |- ./
-    |- y/
-    `- z/
 
 =head3 Probing
@@ -261 +207 @@
             - without which we can't possibly roll this out
 
-rafl thinks:
-- dpkg seems to be not the optimal choice
-    - maybe only adopt the package and metadata format from the .deb format version 2
-          and write the tools to manipulate and install it ourself. Preferably in Perl 6.
-        - I fear that tools like dpkg/apt/.. aren't portable as we need it because they
-          were mainly written for use with a single Linux distribution.
-        - The Debian tools can be useful as a provisional solutions until we wrote
-          something own or as a reference implementation.
-
 =head2 Policy File
 

script/pugscc

@@ -91 +91 @@
     my $rv = system(
         $ghc_exe,
-        "-v0", "-o", $out, "--make", "-main-is", "MainCC.mainCC",
-        "$base/MainCC.hs"
+        "-v0", "-O", "-o", $out, "--make", "$base/MainCC.hs"
     );
 

src/Pugs/CodeGen.hs

@@ -13 +13 @@
 import Pugs.AST
 import Pugs.Internals
-import Pugs.CodeGen.PIL (genPIL)
+import Pugs.CodeGen.PIL1 (genPIL1)
+import Pugs.CodeGen.PIL2 (genPIL2)
 import Pugs.CodeGen.PIR (genPIR)
 import Pugs.CodeGen.Perl5 (genPerl5)
@@ -20 +21 @@
 import Pugs.Compile.Pugs (genPugs)
 import Pugs.Compile.Haskell (genGHC)
--- import Pugs.CodeGen.PIL2 (genPIL2)
 -- import Pugs.CodeGen.XML (genXML)
 import qualified Data.Map as Map
@@ -31 +31 @@
     , ("Parrot",      genPIR)
     , ("PIR",         genPIR)
-    , ("PIL",         genPIL)
---  , ("PIL2",        genPIL2)
+    , ("PIL1",        genPIL1)
+    , ("PIL2",        genPIL2)
     , ("Perl5",       genPerl5)
     , ("Pugs",        genPugs)
@@ -49 +49 @@
     norm' "parrot" = "Parrot"
     norm' "pir"    = "PIR"
-    norm' "pil"    = "PIL"
-    -- norm' "pil2"   = "PIL2"
+    norm' "pil"    = "PIL1" -- XXX - this will change
+    norm' "pil1"   = "PIL1"
+    norm' "pil2"   = "PIL2"
     norm' "perl5"  = "Perl5"
     norm' "pugs"   = "Pugs"

src/Pugs/Compile/Pugs.hs

@@ -1 @@
-{-# OPTIONS_GHC -cpp -fglasgow-exts -fth #-}
+{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
 
 #include "../pugs_config.h"
@@ -8 +8 @@
 import Pugs.Internals
 import Text.PrettyPrint
+import qualified Data.Map as Map
 
 class (Show x) => Compile x where
@@ -25 +26 @@
 
 prettyDo :: [Doc] -> Doc
-prettyDo docs = parens $ sep (text "do":punctuate semi docs)
+prettyDo docs = parens $ text "do" <+> braces (sep $ punctuate semi docs)
 
 prettyRecord :: String -> [(String, Doc)] -> Doc
@@ -32 +33 @@
 
 prettyBind :: String -> Doc -> Doc
-prettyBind var doc = text var `sep1` nest 1 (text "<-" <+> doc)
-
+prettyBind var doc = text var <+> text "<-" <+> doc
 
 instance Compile (Maybe Exp) where
@@ -127 +127 @@
                 ]
 
-instance Compile (TVar Bool) where
-    compile fresh = do
-        bool <- liftSTM $ readTVar fresh
-        return $ text "liftSTM" <+> parens (text "newTVar" <+> text (show bool))
-
-instance Compile (TVar VRef) where
+instance Compile Bool where
+    compile bool = return $ text "return" <+> parens (text $ show bool)
+
+instance Compile a => Compile (Map VStr a) where
+    compile map | Map.null map = return (text "return Map.empty")
+    compile map = error (show map) 
+
+instance Compile (IVar VScalar) where
+    compile iv = do
+        val     <- readIVar iv
+        valC    <- compile val
+        return $ prettyDo
+            [ prettyBind "val" valC
+            , text "newScalar val"
+            ]
+
+instance (Typeable a, Compile a) => Compile (TVar a) where
     compile fresh = do
         vref    <- liftSTM $ readTVar fresh
@@ -169 +180 @@
             , text "return $ VCode code"
             ]
+    compile (VObject obj) = do
+        objC <- compile obj
+        return $ prettyDo
+            [ prettyBind "obj" objC
+            , text "return $ VObject obj"
+            ]
     compile x = return $ text "return" $+$ parens (text $ show x)
 
--- We need a compile VObject!
+instance Compile VObject where
+    compile (MkObject typ attrs Nothing _) = do
+        attrsC <- compile attrs
+        let vobj = prettyRecord "MkObject" $
+                [ ("objType",   text (show typ))
+                , ("objAttrs",  text "attrs")
+                , ("objOpaque", text "Nothing")
+                , ("objId",     text "id")
+                ]
+        return $ prettyDo
+            [ prettyBind "attrs" attrsC
+            , prettyBind "id" (text "liftIO newUnique")
+            , text "return" <+> parens vobj
+            ]
+    compile obj = fail $ "Cannot compile Object of Dynamic type: " ++ show obj
 
 -- Haddock can't cope with Template Haskell
@@ -207 +238 @@
     expC    <- compile exp
     return . VStr . unlines $
-        [ "{-# OPTIONS_GHC -fglasgow-exts -fno-warn-unused-imports -fno-warn-unused-binds -O #-}"
-        , "module MainCC where"
+        [ "{-# OPTIONS_GHC -fglasgow-exts -fno-warn-unused-imports -fno-warn-unused-binds #-}"
+        , "module Main where"
         , "import Pugs.Run"
         , "import Pugs.AST"
         , "import Pugs.Types"
         , "import Pugs.Internals"
-        , ""
-        , "mainCC = do"
+        , "import qualified Data.Map as Map"
+        , ""
+        , "main = do"
         , "    glob <- globC"
         , "    exp  <- expC"

src/Pugs/Embed.hs

@@ -14 +14 @@
     module Pugs.Embed.Haskell,
     module Pugs.Embed.Parrot,
+    module Pugs.Embed.Pugs,
     evalEmbedded
     -- module Pugs.Embed.Ponie,
@@ -20 +21 @@
 import Pugs.Embed.Haskell
 import Pugs.Embed.Parrot
--- import Pugs.Embed.Ponie
+import Pugs.Embed.Pugs
 
 evalEmbedded :: String -> String -> IO ()
@@ -26 +27 @@
 evalEmbedded "PIR" = evalParrot
 evalEmbedded "Parrot" = evalParrot
+evalEmbedded "Pugs" = evalPugs
 {- evalEmbedded "Haskell" code = do
     evalHaskell code

src/Pugs/Parser.hs

@@ -984 +984 @@
     --   state $?FIRST_RESULT;
     --   state $?FIRST_RUN;
-    --   $?FIRST_RUN || { $?FIRST_RUN++; $?FIRST_RESULT = { 42 }() };
-    --   $?FIRST_RESULT;
+    --   $?FIRST_RUN++ ?? $?FIRST_RESULT !! $?FIRST_RESULT = { 42 }();
     -- }
     -- These are the two state variables we need.
@@ -994 +993 @@
     return $ Syn "block"        -- The outer block
         [ Pad SState lexDiff $  -- state ($?FIRST_RESULT, $?FIRST_RUN);
-            Stmts (App (Var "&infix:||")    --  $?FIRST_RUN ||
-                Nothing
-                [ Var "$?FIRST_RUN"
-                , Stmts (App (Var "&postfix:++") Nothing [Var "$?FIRST_RUN"])
-                        (Syn "=" [Var "$?FIRST_RESULT", App (Val code) Nothing []])
-                ])   --  { $?FIRST_RUN++; $?FIRST_RESULT = { 42 }() };
-            (Var "$?FIRST_RESULT") --  $?FIRST_RESULT;
+            Syn "if"
+                [ App (Var "&postfix:++") Nothing [Var "$?FIRST_RUN"]
+                , Var "$?FIRST_RESULT"
+                , Syn "=" [Var "$?FIRST_RESULT", App (Val code) Nothing []]
+                ]   --  { $?FIRST_RUN++; $?FIRST_RESULT = { 42 }() };
         ]
 

src/Pugs/PreludePC.hs-null

@@ -1 +1 @@
 {-# OPTIONS_GHC -fglasgow-exts -fno-full-laziness -fno-cse #-}
+
+import Pugs.Prim.Eval
 
 {-

src/Pugs/Run.hs

@@ -26 +26 @@
 import Pugs.Eval
 import Pugs.Prim
-import Pugs.Prim.Eval
 import Pugs.Embed
 import Data.IORef