alpha 1.0.8 → 1.0.9

raw patch · 6 files changed

+27/−29 lines, 6 files

Files

• alpha.cabal +1/−1
• src/Alpha.hs +5/−4
• src/Compile.hs +7/−4
• src/Context/Language.hs +10/−12
• src/Context/Types.hs +1/−1
• src/Serialize.hs +3/−7

@@ -1,5 +1,5 @@ name:           alpha-version:        1.0.8+version:        1.0.9 synopsis:       A compiler for the Alpha language description:    Alpha is a programming language that aims at being very simple and                  low-level, so as to be efficient, while at the same time

@@ -127,12 +127,13 @@   ("->"     ,Left $ Axiom XReturn),   ("do"     ,Left $ Axiom XDo), -  ("verb"   ,Left $ Axiom XVerb),-  ("noun"   ,Left $ Axiom XNoun),+  ("@"      ,Left $ Axiom XAddr),+  ("#"      ,Left $ Axiom XSize),    ("id"     ,Left $ Axiom XID),-  ("@"      ,Left $ Axiom XAddr),-  ("#"      ,Left $ Axiom XSize)] ++ [+  ("verb"   ,Left $ Axiom XVerb),+  ("noun"   ,Left $ Axiom XNoun),+  ("lang"   ,Left $ Axiom XLang)] ++ [    ("alpha/c@"            , Right $ exportAlpha callStub1 alpha_compAddr),       ("alpha/create-symbol" , Right $ exportAlpha callStub0 alpha_createSym),

@@ -93,6 +93,10 @@ compileAxiom XRestart _ [arg] = withInfo $ \(_,alts,_,_) ->   compile' Nothing arg *>>= \v -> makeBackBranch v alts +compileAxiom XAddr dest [Symbol s] = compileValue dest (SymVal Address s)+compileAxiom XSize dest [Symbol s] = compileValue dest (SymVal Size s)++compileAxiom XID dest [Symbol s] = compileValue dest (SymVal SymID s) compileAxiom XVerb dest [Group (name:args),expr] = do   bv@BindVar { bindSym = sym } <- bindFromSyntax name   ret <- case bindSubs bv of@@ -110,10 +114,9 @@   codeInit <- compileExpr [Symbol sym] Nothing init   lift $ modify $ exportSymVal sym $ Noun codeSz codeInit   compile' dest (Symbol sym)--compileAxiom XID dest [Symbol s] = compileValue dest (SymVal SymID s)-compileAxiom XAddr dest [Symbol s] = compileValue dest (SymVal Address s)-compileAxiom XSize dest [Symbol s] = compileValue dest (SymVal Size s)+compileAxiom XLang dest [Symbol sym] = do+  [impSym,idSym] <- lift $ mapM (state . internSym) ["alpha/import","id"]+  compile' dest (Group [Symbol impSym,Group [Symbol idSym,Symbol sym]])  compileAxiom a _ args = error $ "Couldn't compile axiom "++show a++" with args "++show args 

@@ -35,13 +35,13 @@           Range (r,_) <- BM.lookup m (languagesL l)           Range (r',_) <- BM.lookup m (languagesL l')           return $ s'-r'+r-        Range (mi,_) = fromJust $ BM.lookup (nameL l') (languagesL l)+        Range (mi,_) = languagesL l BM.! nameL l' instance Monoid Language where-  mempty = Language "" (toEnum 0) BM.empty M.empty M.empty BM.empty M.empty S.empty+  mempty = Language undefined (toEnum 0) BM.empty M.empty M.empty BM.empty M.empty S.empty   mappend l l' = flip execState l $ do     mapM_ (state . internSym) $ BM.keys (symbolsL l')     modify $ \l ->-      let aliases = [(i'+mi,fromJust $ BM.lookup s' (symbolsL l)) +      let aliases = [(i'+mi,symbolsL l BM.! s')                      | (s',i') <- BM.toList (symbolsL l')]           mi = maxIDL l ; nmi = mi + maxIDL l'       in l { maxIDL = nmi,@@ -78,17 +78,15 @@ importLanguage getImport loadImport imp = merge imp   where      merge imp = gets language >>= \l -> ifThenElse (imp`isImport`l) (return False) $ do-      (l',(comp,recomp)) <- tryCompile False imp-      (l',init) <- if not comp && recomp then fst $< tryCompile True imp else return l'-      loadImport =<< mergeLanguage imp (l'{ nameL = imp },init)+      (contents,(comp,recomp)) <- tryCompile False imp+      (l',init) <- if not comp && recomp then fst $< tryCompile True imp else return contents+      init' <- viewing language_ $ modify (<>l') >> gets (\l -> translate (translateFromTo l' l) init)+      loadImport init'       return $ comp || recomp-    mergeLanguage imp (l',init) = viewing language_ $ do-      modify (<>l')-      gets $ \l -> translate (translateFromTo l' l) init     tryCompile force imp = do-      (comp,l') <- getImport force imp-      comps <- mapM merge (getImports $ fst l')-      return (l',(comp,or comps))+      (comp,(l',init)) <- getImport force imp+      comps <- mapM merge (getImports l')+      return ((l'{ nameL = imp },init),(comp,or comps))  set2Map s = M.fromAscList (zip (S.toAscList s) (repeat undefined)) purgeLanguage l = mempty {

@@ -15,7 +15,7 @@ data Axiom = XAlter | XBind            | XReturn | XRestart | XChoose | XDo            | XAddr | XSize-           | XVerb | XNoun | XID+           | XLang | XVerb | XNoun | XID            deriving Show  data Value = Axiom Axiom

@@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric, StandaloneDeriving #-}- module Serialize where  import Context as C@@ -11,9 +10,6 @@ import ID import My.Control.Monad import PCode-import Translate-import qualified Data.Map as M-import qualified Data.Set as S  deriving instance Generic ValType deriving instance Generic PCode.Value@@ -25,7 +21,6 @@ deriving instance Generic Axiom deriving instance Generic ID deriving instance Generic (Range a)-deriving instance Generic Language  instance Serialize ValType instance Serialize PCode.Value@@ -41,5 +36,6 @@   get = BM.fromList $< get    put = put . BM.toList   -instance Serialize Language        -+instance Serialize Language where+  put l = put (maxIDL l,symbolsL l,valuesL l,languagesL l)+  get = get >§ \(mi,syms,vals,langs) -> mempty{ maxIDL = mi, symbolsL = syms, valuesL = vals, languagesL = langs }