Changeset 9

Timestamp:

02/11/05 11:12:24 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

1041

Message:

* various patches form viirya.

Files:

• AUTHORS (modified) (1 diff)
• MANIFEST (modified) (1 diff)
• Makefile.PL (modified) (3 diffs)
• src/Eval.hs (modified) (2 diffs)
• src/Lexer.hs (modified) (2 diffs)
• src/Parser.hs (modified) (4 diffs)
• src/Prim.hs (modified) (1 diff)

AUTHORS

@@ -11 +11 @@
 Kang-Min Liu            (GUGOD)
 Larry Wall              (LWALL)
+Liang-Qi Xie
 Luke Palmer             (LPALMER)
 Nicholas Clark          (NWCLARK)

MANIFEST

@@ -18 +18 @@
 SIGNATURE                       Public-key signature (added by MakeMaker)
 src/AST.hs
+src/Bind.hs
 src/Context.hs
 src/Eval.hs

Makefile.PL

@@ -3 +3 @@
 use strict;
 use FindBin;
+use Config;
 use inc::Module::Install;
 
@@ -12 +13 @@
 author          ('Autrijus Tang <autrijus@autrijus.org>');
 license         ('perl');
-install_script  ('pugs');
+install_script  ("pugs$Config{_exe}");
 build_requires  ('Test::More');
 
-can_run('ghc') or die << '.';
+(`ghc --version` =~ /Glasgow/) or die << '.';
 *** Cannot find a runnable 'ghc' from path.
 *** Please install GHC from http://haskell.org/ghc/.
@@ -66 +67 @@
 
 postamble(<< ".");
-pugs: @{[glob("src/*.hs")]}
+pugs$Config{_exe}: @{[glob("src/*.hs")]}
         ghc --make -o pugs -O src/Main.hs -isrc
 

src/Eval.hs

@@ -165 +165 @@
     = retVal $ VList $ concatMap (vCast . evaluate env{ cxt = "List" }) exps
     | name `isInfix` "[]"
-    , [listExp, rangeExp]   <- exps
+    , (listExp:rangeExp:errs)   <- exps
     , list      <- evaluate env{ cxt = "List" } listExp
     , range     <- evaluate env{ cxt = "List" } rangeExp
-    , slice     <- unfoldr (doSlice $ vCast list) (map vCast $ vCast range)
+    , slice     <- unfoldr (doSlice errs $ vCast list) (map vCast $ vCast range)
     = retVal $ VList slice
     where
-    doSlice :: [Val] -> [VInt] -> Maybe (Val, [VInt])
-    doSlice vs [] = Nothing
-    doSlice vs (n:ns)
-        | genericLength vs > n  = Just ((vs `genericIndex` n), ns)
-        | otherwise             = Nothing
+    doSlice :: [Exp] -> [Val] -> [VInt] -> Maybe (Val, [VInt])
+    doSlice errs vs (n:ns)
+        | (v:_)         <- n `genericDrop` vs
+        = Just (v, ns)
+        | ((Val err):_) <- errs
+        = Just (err, ns)
+        | otherwise
+        = Nothing
+    doSlice _ _ _ = Nothing
     buildStatements exps
         | ((Syn name' exps'):rest)  <- exps
@@ -186 +190 @@
     runStatement cxt (env, (Val val)) exp
         | VError _ _    <- val
+        = (env, Val val)
+        | NonTerm _     <- exp
         = (env, Val val)
         | (fenv, exp)   <- reduce env{ cxt = cxt } exp

src/Lexer.hs

@@ -91 +91 @@
             expo <- expo
             if expo < 1
-                then return (Left  $ n * numerator expo)
+                then return (Right $ (n % 1) * expo)
                 else return (Right $ (n % 1) * expo)
 
@@ -112 +112 @@
         <?> "exponent"
         where
-        power e | e < 0      = 1 % (10^e)
+        power e | e < 0      = 1 % (10^abs(e))
                 | otherwise  = (10^e) % 1
 

src/Parser.hs

@@ -49 +49 @@
 operators = concat $
     [ tightOperators
-    , [ listOps  " , " ]                                -- Comma
+    , [ listSyn  " , " ]                                -- Comma
     , looseOperators
     , [ listSyn  " ; " ]                                -- Terminator
@@ -99 +99 @@
     , parseApply
     , parseParens parseOp
+    , parseEof
     ]
     <?> "term"
+
+parseEof = do
+    eof
+    pos <- getPosition
+    return $ NonTerm pos
 
 parseLitTerm = choice
@@ -144 +150 @@
 
 parseParamList parse = do
-    formal <- maybeParens ((parse `sepBy` symbol ",") `sepBy` symbol ":")
+    formal <- maybeParens ((parse `sepEndBy` symbol ",") `sepEndBy` symbol ":")
     case formal of
         []                  -> return [[], []]
@@ -224 +230 @@
 
 arrayLiteral = do
-    items <- brackets $ parseOp `sepBy` symbol ","
-    return $ App "&prefix:\\" [] [(Parens $ foldl app (Val $ VList []) items)]
-    where
-    app :: Exp -> Exp -> Exp
-    app x y = App "&infix:," [] [x, y]
+    items <- brackets $ parseOp `sepEndBy` symbol ","
+    return $ App "&prefix:\\" [] [Syn "&infix:," items]
 
 pairLiteral = do

src/Prim.hs

@@ -62 +62 @@
 op2 "~<<"= \x y -> VStr $ mapStr (`shiftL` vCast y) (vCast x)
 op2 "~>>"= \x y -> VStr $ mapStr (`shiftR` vCast y) (vCast x)
-op2 "**" = op2Rat ((^) :: VRat -> VInt -> VRat)
+op2 "**" = op2Rat ((^^) :: VRat -> VInt -> VRat)
 op2 "+"  = op2Numeric (+)
 op2 "-"  = op2Numeric (-)