zeolite-lang 0.1.1.0 → 0.1.2.0

raw patch · 12 files changed

+117/−39 lines, 12 files

Files

• ChangeLog.md +13/−1
• bin/zeolite-setup.hs +2/−2
• example/hello/README.md +1/−1
• example/regex/README.md +1/−1
• example/tree/README.md +1/−1
• src/Cli/Compiler.hs +2/−3
• src/Compilation/CompilerState.hs +5/−0
• src/Compilation/ProcedureContext.hs +3/−0
• src/CompilerCxx/Procedure.hs +31/−24
• src/Parser/Procedure.hs +1/−1
• tests/scoped.0rt +56/−4
• zeolite-lang.cabal +1/−1

@@ -1,4 +1,16 @@-# Revision history for zeolite+# Revision history for zeolite-lang++## 0.1.2.0  -- 2020-04-28++* **[fix]** Fixes a parser issue with empty `{}` blocks following `scoped`.++* **[behavior]** Updates `cleanup` procedures to allow setting named-return+  values. Previously, initializing a named return in `cleanup` was not+  sufficient.++* **[behavior]** Updates `zeolite-setup` to unconditionally rebuild supporting+  libraries. Incidentally, this causes all existing user modules to be out of+  date.  ## 0.1.1.0  -- 2020-04-27 

@@ -94,7 +94,7 @@                    Just n' | n' > 0 && n' <= length cs' -> return n'                    _ -> getChoice     getResponse = do-      hPutStrLn stderr "Enter the full path: "+      hPutStr stderr "Enter the full path: "       getInput     check [(cm,"")] = Just cm     check _         = Nothing@@ -122,6 +122,6 @@       coSourcePrefix = "",       coMode = CompileRecompile,       coOutputName = "",-      coForce = ForceRecompile+      coForce = ForceAll     }   runCompiler options

@@ -10,5 +10,5 @@ zeolite -i lib/util -p "$ZEOLITE_PATH" -m HelloDemo example/hello  # Execute the compiled binary.-$ZEOLITE_PATH/HelloDemo+$ZEOLITE_PATH/example/hello/HelloDemo ```

@@ -16,5 +16,5 @@ zeolite -p "$ZEOLITE_PATH" -t example/regex  # Execute the compiled binary.-$ZEOLITE_PATH/RegexDemo+$ZEOLITE_PATH/example/regex/RegexDemo ```

@@ -16,5 +16,5 @@ zeolite -p "$ZEOLITE_PATH" -t example/tree  # Execute the compiled binary.-$ZEOLITE_PATH/TreeDemo+$ZEOLITE_PATH/example/tree/TreeDemo ```

@@ -348,9 +348,8 @@       includeNewTypes tm cs     mergeInternal ds = (concat $ map fst ds,concat $ map snd ds)     getBinaryName (CompileBinary n _)-      | null o              = canonicalizePath $ p </> head ds </> n-      | o == takeFileName o = canonicalizePath $ p </> head ds </> o-      | otherwise           = canonicalizePath o+      | null o    = canonicalizePath $ p </> head ds </> n+      | otherwise = canonicalizePath $ p </> head ds </> o     getBinaryName _ = return ""     createBinary b r deps ma@(CompileBinary n _) ms       | length ms > 1 = do

@@ -44,6 +44,7 @@   csGetTypeFunction,   csGetVariable,   csInheritReturns,+  csIsNamedReturns,   csIsUnreachable,   csPrimNamedReturns,   csPushCleanup,@@ -99,6 +100,7 @@   ccRegisterReturn :: a -> [c] -> Maybe ExpressionType -> m a   ccPrimNamedReturns :: a -> m [ReturnVariable]   ccIsUnreachable :: a -> m Bool+  ccIsNamedReturns :: a -> m Bool   ccSetNoReturn :: a -> m a   ccStartLoop :: a -> LoopSetup s -> m a   ccGetLoop :: a -> m (LoopSetup s)@@ -210,6 +212,9 @@  csIsUnreachable :: CompilerContext c m s a => CompilerState a m Bool csIsUnreachable = fmap ccIsUnreachable get >>= lift++csIsNamedReturns :: CompilerContext c m s a => CompilerState a m Bool+csIsNamedReturns = fmap ccIsNamedReturns get >>= lift  csSetNoReturn :: CompilerContext c m s a => CompilerState a m () csSetNoReturn = fmap ccSetNoReturn get >>= lift >>= put

@@ -403,6 +403,9 @@   ccIsUnreachable ctx = return $ match (pcReturns ctx) where     match UnreachableCode = True     match _                 = False+  ccIsNamedReturns ctx = return $ match (pcReturns ctx) where+    match (ValidateNames _ _) = True+    match _                   = False   ccSetNoReturn ctx =     return $ ProcedureContext {         pcScope = pcScope ctx,

@@ -66,9 +66,10 @@     compileWithReturn = do       ctx0 <- getCleanContext       compileProcedure ctx0 p >>= put-      csRegisterReturn c Nothing `reviseErrorStateT`-        ("In implicit return from " ++ show n ++ formatFullContextBrace c)-      doNamedReturn+      unreachable <- csIsUnreachable+      when (not unreachable) $+        doImplicitReturn [] `reviseErrorStateT`+          ("In implicit return from " ++ show n ++ formatFullContextBrace c)     wrapProcedure output =       mergeAll $ [           onlyCode header2,@@ -98,7 +99,9 @@         "(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {"     returnType = "ReturnTuple"     setProcedureTrace = startFunctionTracing $ show t ++ "." ++ show n-    defineReturns = [returnType ++ " returns(" ++ show (length $ pValues rs1) ++ ");"]+    defineReturns+      | isUnnamedReturns rs2 = []+      | otherwise            = [returnType ++ " returns(" ++ show (length $ pValues rs1) ++ ");"]     nameParams = flip map (zip [0..] $ pValues ps1) $       (\(i,p) -> paramType ++ " " ++ paramName (vpParam p) ++ " = *params.At(" ++ show i ++ ");")     nameArgs = flip map (zip [0..] $ filter (not . isDiscardedInput . snd) $ zip (pValues as1) (pValues $ avNames as2)) $@@ -149,9 +152,8 @@                      CompilerContext c m [String] a) =>   Statement c -> CompilerState a m () compileStatement (EmptyReturn c) = do-  csRegisterReturn c Nothing   csWrite $ setTraceContext c-  doNamedReturn+  doImplicitReturn c compileStatement (ExplicitReturn c es) = do   es' <- sequence $ map compileExpression $ pValues es   getReturn $ zip (map getExpressionContext $ pValues es) es'@@ -160,23 +162,18 @@     getReturn [(_,(Positional ts,e))] = do       csRegisterReturn c $ Just (Positional ts)       csWrite $ setTraceContext c-      csWrite ["returns = " ++ useAsReturns e ++ ";"]-      doReturnCleanup-      csWrite ["return returns;"]+      autoPositionalCleanup e     -- Multi-expression => must all be singles.     getReturn rs = do       lift $ mergeAllM (map checkArity $ zip [1..] $ map (fst . snd) rs) `reviseError`         ("In return at " ++ formatFullContext c)       csRegisterReturn c $ Just $ Positional $ map (head . pValues . fst . snd) rs-      csWrite $ concat $ map bindReturn $ zip [0..] rs-      doReturnCleanup-      csWrite ["return returns;"]+      let e = OpaqueMulti $ "ReturnTuple(" ++ intercalate "," (map (useAsUnwrapped . snd . snd) rs) ++ ")"+      csWrite $ setTraceContext c+      autoPositionalCleanup e     checkArity (_,Positional [_]) = return ()     checkArity (i,Positional ts)  =       compileError $ "Return position " ++ show i ++ " has " ++ show (length ts) ++ " values but should have 1"-    bindReturn (i,(c0,(_,e))) = setTraceContext c0 ++ [-        "returns.At(" ++ show i ++ ") = " ++ useAsUnwrapped e ++ ";"-      ] compileStatement (LoopBreak c) = do   loop <- csGetLoop   case loop of@@ -848,21 +845,31 @@   scoped <- autoScope s   return $ scoped ++ paramName p -doNamedReturn :: (CompilerContext c m [String] a) => CompilerState a m ()-doNamedReturn = do-  vars <- csPrimNamedReturns-  sequence $ map (csWrite . (:[]) . assign) vars-  doReturnCleanup-  csWrite ["return returns;"]+doImplicitReturn :: (Show c,CompilerContext c m [String] a) => [c] -> CompilerState a m ()+doImplicitReturn c = do+  named <- csIsNamedReturns+  (CleanupSetup cs ss) <- csGetCleanup+  when (not $ null ss) $ do+    sequence $ map (csInheritReturns . (:[])) cs+    csWrite ss+  csRegisterReturn c Nothing+  if not named+     then csWrite ["return ReturnTuple(0);"]+     else do+       vars <- csPrimNamedReturns+       sequence $ map (csWrite . (:[]) . assign) vars+       csWrite ["return returns;"]   where     assign (ReturnVariable i n t) =       "returns.At(" ++ show i ++ ") = " ++ useAsUnwrapped (readStoredVariable False t $ variableName n) ++ ";" -doReturnCleanup :: (CompilerContext c m [String] a) => CompilerState a m ()-doReturnCleanup = do+autoPositionalCleanup :: (CompilerContext c m [String] a) => ExprValue -> CompilerState a m ()+autoPositionalCleanup e = do   (CleanupSetup cs ss) <- csGetCleanup   if null ss-     then return ()+     then csWrite ["return " ++ useAsReturns e ++ ";"]      else do+       csWrite ["{","ReturnTuple returns = " ++ useAsReturns e ++ ";"]        sequence $ map (csInheritReturns . (:[])) cs        csWrite ss+       csWrite ["return returns;","}"]

@@ -236,7 +236,7 @@       p <- between (sepAfter $ string "{") (sepAfter $ string "}") sourceParser       cl <- fmap Just parseCleanup <|> return Nothing       kwIn-      s <- sourceParser <|> unconditional+      s <- unconditional <|> sourceParser       return $ ScopedBlock [c] p cl s     justCleanup = do       c <- getPosition

@@ -260,9 +260,8 @@ }  -testcase "cleanup does not initialize return" {-  error-  require "value.+before return"+testcase "cleanup initializes named return" {+  success Test$run() }  define Test {@@ -275,7 +274,10 @@   }    run () {-    ~ get()+    Int value <- get()+    if (value != 1) {+      fail(value)+    }   } } @@ -284,6 +286,33 @@ }  +testcase "cleanup overrides named return" {+  success Test$run()+}++define Test {+  @type get () -> (Int)+  get () (value) {+    value <- 1+    scoped {+    } cleanup {+      value <- 2+    } in return _+  }++  run () {+    Int value <- get()+    if (value != 2) {+      fail(value)+    }+  }+}++concrete Test {+  @type run () -> ()+}++ testcase "cannot refer to cleanup variables" {   error   require "value.+not defined"@@ -589,6 +618,29 @@       Int x <- 1     } in {       ~ x+    }+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "scoped empty blocks" {+  success Test$run()+}++@value interface Value {}++define Test {+  run () {+    scoped {+      // empty+    } cleanup {+      // empty+    } in {+      // empty     }   } }

@@ -1,5 +1,5 @@ name:                zeolite-lang-version:             0.1.1.0+version:             0.1.2.0 synopsis:            Zeolite is a statically-typed, general-purpose programming language.  description: