Changeset 2621

Show
Ignore:
Timestamp:
05/02/05 16:07:13 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
4152
Message:

* eval_yaml() support.

Files:
19 added
6 modified

Legend:

Unmodified
Added
Removed

  • Makefile.PL

    r2614 r2621  
    9191    my $hasktags = $ENV{HASKTAGS} || 'hasktags'; 
    9292 
     93    my $pcre_c = "src/pcre/pcre.c"; 
     94    my @syck_c = glob("src/syck/*.c"); 
    9395    my $pcre = "src/pcre/pcre.o"; 
    94     my $pcre_c = "src/pcre/pcre.c"; 
     96    my @syck = map { substr($_, 0, -1) . 'o' } @syck_c; 
    9597    my $unicode = "src/UnicodeC.o"; 
    9698    my $unicode_c = "src/UnicodeC.c"; 
    9799 
    98     my @prereqs = ($config_h, $pcre, $unicode); 
    99     $ghc_output .= " $pcre $unicode"; 
     100    my @prereqs = ($config_h, $pcre, @syck, $unicode); 
     101    $ghc_output .= " $pcre @syck $unicode"; 
    100102 
    101103    my $config = get_pugs_config(); 
    … …  
    108110    $profiled_flags =~ s{-DPUGS_HAVE_HSPLUGINS=1}{}; 
    109111 
     112    my $emit = sub { 
     113        my $c = shift; 
     114        my $o = substr($c, 0, -1) . 'o'; 
     115        return "$o : $c\n\t$ghc $threaded -no-link -no-hs-main -O -o $o $c\n"; 
     116    }; 
     117 
    110118    postamble(fixpaths(<< ".")); 
    111119$config_h : lib/Perl6/Pugs.pm util/config_h.pl 
    … …  
    118126        \$(NOOP) 
    119127 
    120 $pcre : $pcre_c 
    121         $ghc $threaded -no-link -no-hs-main -O -o $pcre $pcre_c 
    122  
    123 $unicode : $unicode_c 
    124         $ghc $threaded -no-link -no-hs-main -O -o $unicode $unicode_c 
     128@{[join("\n", map {$emit->($_)} ($unicode_c, $pcre_c, @syck_c))]} 
    125129 
    126130src/Pugs/Config.hs : util/PugsConfig.pm 

  • README

    r2359 r2621  
    1616The "PCRE" subsystem is derived from PCRE 5.0 by Philip Hazel, 
    1717under a BSD-style license.  See src/pcre/LICENCE. 
     18 
     19The "Syck" subsystem is derived from Syck 0.54 by "why the lucky stiff", 
     20under a BSD-style license.  See src/syck/COPYING. 
    1821 
    1922The "Rule" subsystem is derived from Parsec 2.0 by Daan Leijen, 

  • inc/Module/Install/Pugs.pm

    r2460 r2621  
    163163. 
    164164    } 
    165     my $ghc_flags = "-H0 -L. -Lsrc -Lsrc/pcre -I. -Isrc -Isrc/pcre "; 
    166     $ghc_flags .= " -i. -isrc -isrc/pcre -static "; 
     165    my $ghc_flags = "-H0 -L. -Lsrc -Lsrc/syck -Lsrc/pcre -I. -Isrc -Isrc/pcre -Isrc/syck"; 
     166    $ghc_flags .= " -i. -isrc -isrc/pcre -isrc/syck -static "; 
    167167    $ghc_flags .= " -Wall -Werror " 
    168168      unless $self->is_extension_build; 

  • script/pugscc

    r2602 r2621  
    7979    # XXX - This chunk should be read off Pugs config anyway. 
    8080    my @ghc_flags = ( 
    81         "-L$base", "-L$core", "-L$core/pcre", 
    82         "-I$base", "-I$core", "-I$core/pcre", 
    83         "-i$base", "-i$core", "-i$core/pcre", 
     81        "-L$base", "-L$core", "-L$core/pcre", "-L$core/syck", 
     82        "-I$base", "-I$core", "-I$core/pcre", "-I$core/syck", 
     83        "-i$base", "-i$core", "-i$core/pcre", "-i$core/syck", 
    8484        qw(-static -Wall -fno-warn-unused-imports -fno-warn-unused-binds -fno-warn-missing-signatures -fno-warn-name-shadowing), 
    8585    ); 
    … …  
    9090 
    9191    push @ghc_flags, "$core/pcre/pcre.o"; 
     92    push @ghc_flags, "$core/syck/syck.o"; 
    9293    push @ghc_flags, "$core/UnicodeC.o"; 
    9394 

  • src/Pugs/AST.hs

    r2619 r2621  
    11981198writeIVar :: IVar v -> v -> Eval () 
    11991199writeIVar (IScalar x) = scalar_store x 
     1200writeIVar (IArray x) = array_store x 
     1201writeIVar (IHash x) = hash_store x 
    12001202writeIVar _ = error "writeIVar" 
    12011203 

  • src/Pugs/Prim.hs

    r2607 r2621  
    2020import Pugs.External 
    2121import Text.Printf 
     22import Data.Yaml.Syck 
    2223import qualified Data.Set as Set 
    2324import qualified Data.Map as Map 
    … …  
    201202op1 "eval_perl5" = boolIO evalPerl5 
    202203op1 "eval_haskell" = op1EvalHaskell 
     204op1 "eval_yaml" = op1EvalYaml 
    203205op1 "defined" = op1Cast (VBool . defined) 
    204206op1 "last" = \v -> return (VError "cannot last() outside a loop" (Val v)) 
    … …  
    388390op1 other   = return . (\x -> VError ("unimplemented unaryOp: " ++ other) (App other [Val x] [])) 
    389391 
     392op1EvalYaml :: Val -> Eval Val 
     393op1EvalYaml cv = do 
     394    str     <- fromVal cv 
     395    yaml    <- liftIO $ parseYaml str 
     396    fromYaml yaml 
     397 
     398fromYaml :: YamlNode -> Eval Val 
     399fromYaml (YamlStr str) = return $ VStr str 
     400fromYaml (YamlSeq nodes) = do 
     401    vals    <- forM nodes $ \node -> do 
     402        newScalar =<< fromYaml node 
     403    av      <- liftSTM $ (newTVar vals :: STM IArray) 
     404    return $ VRef (arrayRef av) 
     405fromYaml (YamlMap nodes) = do 
     406    vals    <- forM nodes $ \(keyNode, valNode) -> do 
     407        key <- fromVal =<< fromYaml keyNode 
     408        val <- newScalar =<< fromYaml valNode 
     409        return (key, val) 
     410    hv      <- liftSTM $ (newTVar (Map.fromList vals) :: STM IHash) 
     411    return $ VRef (hashRef hv) 
     412 
    390413op1EvalHaskell :: Val -> Eval Val 
    391414op1EvalHaskell cv = do 
    392     cstr <- (fromVal cv) :: Eval String 
    393     ret <- liftIO (evalHaskell cstr) 
    394     glob <- askGlobal 
    395     errSV <- findSymRef "$!" glob 
     415    str     <- fromVal cv :: Eval String 
     416    ret     <- liftIO (evalHaskell str) 
     417    glob    <- askGlobal 
     418    errSV   <- findSymRef "$!" glob 
    396419    case ret of 
    397420        Right str -> do 
    … …  
    14221445\\n   Any       pre     eval_perl5   (Str)\ 
    14231446\\n   Any       pre     eval_haskell (Str)\ 
     1447\\n   Any       pre     eval_yaml    (Str)\ 
    14241448\\n   Any       pre     require (?Str=$_)\ 
    14251449\\n   Any       pre     require_haskell (Str)\