Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update #10

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Update #10

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions src/LuaCommon.idr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,6 @@ import Data.String
import Data.Vect
import Data.Zippable

import Libraries.Utils.Hex

infixl 100 |>

||| Flipped tightly bound function application
Expand Down
45 changes: 17 additions & 28 deletions src/LuaGen.idr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@ import Compiler.CompileExpr
import Core.Context
import Core.Directory

import Libraries.Utils.Hex
import Libraries.Utils.Path

import Idris.Driver
Expand Down Expand Up @@ -511,9 +510,9 @@ pushFrame =
s <- get Stack
let frame = nextFrame s
let index = nextIndex s
put Stack (record{ nextFrame $= (+1)
, nextIndex = indexLowest
, stack $= (index ::) } s)
put Stack ({ nextFrame $= (+1)
, nextIndex := indexLowest
, stack $= (index ::) } s)
pure (MkStackFrame frame)

pushLocal :
Expand All @@ -524,7 +523,7 @@ pushLocal =
do
s <- get Stack
let i = nextIndex s
put Stack (record{nextIndex $= (+1)} s)
put Stack ({nextIndex $= (+1)} s)
pure (LIndex (LLVar (frameName frame)) (LNumber (show i)))

||| Returns the number of local variables in the popped frame
Expand All @@ -536,7 +535,7 @@ popFrame =
let v = nextIndex s
case (i <= frameLowest, stack s) of
(False, (nextIndex :: other)) => do
put Stack (record{nextFrame $= (\i => i - 1), nextIndex = nextIndex, stack = other} s)
put Stack ({nextFrame $= (\i => i - 1), nextIndex := nextIndex, stack := other} s)
pure (v - 1)
(_, _) => throw (UserError "Attempt to pop from an empty stack")

Expand All @@ -549,7 +548,7 @@ popName =
if i <= indexLowest then
throw (UserError "attempt to pop from an empty stack frame")
else
put Stack (record{nextIndex $= (\i => i - 1)} s)
put Stack ({nextIndex $= (\i => i - 1)} s)


getPreamble :
Expand Down Expand Up @@ -581,20 +580,18 @@ addDefToPreamble name def okIfDefined = do
else
pure ()


constantTy : Constant -> Maybe Constant
constantTy (I _) = Just IntType
constantTy (BI _) = Just IntegerType
constantTy (B8 _) = Just Bits8Type
constantTy (B16 _) = Just Bits16Type
constantTy (B32 _) = Just Bits32Type
constantTy (B64 _) = Just Bits64Type
constantTy (Str _) = Just StringType
constantTy (Ch _) = Just CharType
constantTy (Db _) = Just DoubleType
constantTy (I _) = Just (PrT IntType)
constantTy (BI _) = Just (PrT IntegerType)
constantTy (B8 _) = Just (PrT Bits8Type)
constantTy (B16 _) = Just (PrT Bits16Type)
constantTy (B32 _) = Just (PrT Bits32Type)
constantTy (B64 _) = Just (PrT Bits64Type)
constantTy (Str _) = Just (PrT StringType)
constantTy (Ch _) = Just (PrT CharType)
constantTy (Db _) = Just (PrT DoubleType)
constantTy _ = Nothing


processConstant : Constant -> Core LuaExpr
processConstant (I x) = pure $ LNumber (show x)
processConstant (BI x) = pure $ LBigInt (show x)
Expand Down Expand Up @@ -628,7 +625,6 @@ mkCaseImpl retn [] (Just (blockA, els)) =
mkCaseImpl retn [] Nothing =
pure $ mkErrorAst "Impossible else branch"


mkCase :
{auto stack : Ref Stack StackSt}
-> {auto frame : StackFrame}
Expand Down Expand Up @@ -934,10 +930,6 @@ mutual -- TODO try remove in favour of forward declarions ?
-- notDefined = throw $ InternalError $ "external primitive not implemented: " ++ show name
processExtCall name args = processCustomExtCall name args





readCCPart : String -> (String, String)
readCCPart x =
let (cc, def) = break (== ':') x
Expand Down Expand Up @@ -1045,7 +1037,7 @@ mutual -- TODO try remove in favour of forward declarions ?
constCaseIndex : NamedConstAlt -> LuaExpr -> Core LuaExpr
constCaseIndex (MkNConstAlt const _) index =
case constantTy const of
(Just IntegerType) => pure $ LPrimFn (Cast IntegerType StringType) [index]
(Just (PrT IntegerType)) => pure $ LPrimFn (Cast IntegerType StringType) [index]
(Just other) => pure index
Nothing => throw $ UserError ("Cannot match on " ++ show const)

Expand Down Expand Up @@ -1210,7 +1202,6 @@ mutual -- TODO try remove in favour of forward declarions ?
<+> blockA {-blockA uses those bindings-}
<+> LReturn res)


processConstAlt :
{auto stack : Ref Stack StackSt}
-> {auto frame : StackFrame}
Expand All @@ -1231,11 +1222,9 @@ mutual -- TODO try remove in favour of forward declarions ?
<+> blockA
<+> LReturn res)


indexConstructorArg : Nat -> LuaExpr
indexConstructorArg i = LString $ "arg" ++ (show i)


processTag : Name -> Maybe Int -> String
processTag n Nothing = stringifyName Global n
processTag _ (Just i) = show i
Expand Down Expand Up @@ -1413,7 +1402,7 @@ build defs outputDir term file = do
strbuf <- translate defs term
let luaFile = file ++ ".lua"
Right () <- coreLift $ writeBufferToFile (outputDir </> luaFile) strbuf.get strbuf.offset
| Left err => throw $ FileErr (outputDir </> luaFile) err
| Left err => throw $ FileErr (outputDir </> luaFile) (fst err)

luaExe <- coreLift getLuaExe

Expand Down