From b34232c6dc9fc9d3102eecbe9ab89bb1a779b51b Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Wed, 1 Aug 2012 09:21:59 +0000 Subject: [PATCH] the first draft of GF.Compile.Instructions --- src/compiler/GF/Compile/Instructions.hs | 1170 +++++++++++++++++ src/runtime/c/teyjus/tables_gen/Makefile | 6 +- .../tables_gen/instrformats/instrformats.y | 5 +- .../{instrgen-ocaml.c => instrgen-haskell.c} | 552 ++++---- .../{instrgen-ocaml.h => instrgen-haskell.h} | 0 5 files changed, 1454 insertions(+), 279 deletions(-) create mode 100644 src/compiler/GF/Compile/Instructions.hs rename src/runtime/c/teyjus/tables_gen/instrformats/{instrgen-ocaml.c => instrgen-haskell.c} (57%) rename src/runtime/c/teyjus/tables_gen/instrformats/{instrgen-ocaml.h => instrgen-haskell.h} (100%) diff --git a/src/compiler/GF/Compile/Instructions.hs b/src/compiler/GF/Compile/Instructions.hs new file mode 100644 index 000000000..700fe33c2 --- /dev/null +++ b/src/compiler/GF/Compile/Instructions.hs @@ -0,0 +1,1170 @@ +module GF.Compile.Instructions where + +import Data.IORef +import Data.Binary +import Data.Binary.Put +import Data.Binary.Get +import Data.Binary.IEEE754 +import PGF.CId +import PGF.Binary + +type IntRef = Int +type AConstant = CId +type AKind = CId + +ppE = undefined +ppF = undefined +ppL = undefined +ppC = undefined +ppN = undefined +ppR = undefined +ppK = undefined +ppS = undefined +ppI = undefined +ppI1 = undefined +ppIT = undefined +ppCE = undefined +ppMT = undefined +ppHT = undefined +ppSEG = undefined +ppBVT = undefined + +wordSize = 4 :: Int + +rSize = 255 :: Int +eSize = 255 :: Int +nSize = 255 :: Int +i1Size = 255 :: Int +ceSize = 255 :: Int +segSize = 255 :: Int +cSize = 65535 :: Int +kSize = 65535 :: Int +sSize = 65535 :: Int +mtSize = 65535 :: Int +itSize = 65535 :: Int +htSize = 65535 :: Int +bvtSize = 65535 :: Int +opcodeSize = 255 :: Int + + +type Rtype = Int +type Etype = Int +type Ntype = Int +type I1type = Int +type CEtype = Int +type SEGtype = Int +type Ctype = AConstant +type Ktype = AKind +type Ltype = IntRef +type Itype = Int +type Ftype = Float +type Stype = Int +type MTtype = Int +type ITtype = Int +type HTtype = Int +type BVTtype = Int + +putR = putWord8 . fromIntegral +putE = putWord8 . fromIntegral +putN = putWord8 . fromIntegral +putI1 = putWord8 . fromIntegral +putCE = putWord8 . fromIntegral +putSEG = putWord8 . fromIntegral +putC = put +putK = put +putL = putWord32be . fromIntegral +putI = putWord32be . fromIntegral +putF = putFloat32be +putS = putWord16be . fromIntegral +putMT = putWord16be . fromIntegral +putIT = putWord16be . fromIntegral +putHT = putWord16be . fromIntegral +putBVT = putWord16be . fromIntegral +putopcode = putWord8 . fromIntegral + + +getR = fmap fromIntegral $ getWord8 +getE = fmap fromIntegral $ getWord8 +getN = fmap fromIntegral $ getWord8 +getI1 = fmap fromIntegral $ getWord8 +getCE = fmap fromIntegral $ getWord8 +getSEG = fmap fromIntegral $ getWord8 +getC = get +getK = get +getL = fmap fromIntegral $ getWord32be +getI = fmap fromIntegral $ getWord32be +getF = getFloat32be +getS = fmap fromIntegral $ getWord16be +getMT = fmap fromIntegral $ getWord16be +getIT = fmap fromIntegral $ getWord16be +getHT = fmap fromIntegral $ getWord16be +getBVT = fmap fromIntegral $ getWord16be +getopcode = fmap fromIntegral $ getWord8 + + +type InscatRX = (Rtype) +type InscatEX = (Etype) +type InscatI1X = (I1type) +type InscatCX = (Ctype) +type InscatKX = (Ktype) +type InscatIX = (Itype) +type InscatFX = (Ftype) +type InscatSX = (Stype) +type InscatMTX = (MTtype) +type InscatLX = (Ltype) +type InscatRRX = (Rtype, Rtype) +type InscatERX = (Etype, Rtype) +type InscatRCX = (Rtype, Ctype) +type InscatRIX = (Rtype, Itype) +type InscatRFX = (Rtype, Ftype) +type InscatRSX = (Rtype, Stype) +type InscatRI1X = (Rtype, I1type) +type InscatRCEX = (Rtype, CEtype) +type InscatECEX = (Etype, CEtype) +type InscatCLX = (Ctype, Ltype) +type InscatRKX = (Rtype, Ktype) +type InscatECX = (Etype, Ctype) +type InscatI1ITX = (I1type, ITtype) +type InscatI1LX = (I1type, Ltype) +type InscatSEGLX = (SEGtype, Ltype) +type InscatI1LWPX = (I1type, Ltype) +type InscatI1NX = (I1type, Ntype) +type InscatI1HTX = (I1type, HTtype) +type InscatI1BVTX = (I1type, BVTtype) +type InscatCWPX = (Ctype) +type InscatI1WPX = (I1type) +type InscatRRI1X = (Rtype, Rtype, I1type) +type InscatRCLX = (Rtype, Ctype, Ltype) +type InscatRCI1X = (Rtype, Ctype, I1type) +type InscatSEGI1LX = (SEGtype, I1type, Ltype) +type InscatI1LLX = (I1type, Ltype, Ltype) +type InscatNLLX = (Ntype, Ltype, Ltype) +type InscatLLLLX = (Ltype, Ltype, Ltype, Ltype) +type InscatI1CWPX = (I1type, Ctype) +type InscatI1I1WPX = (I1type, I1type) + + +putRX (arg1) = putR arg1 +putEX (arg1) = putE arg1 +putI1X (arg1) = putI1 arg1 +putCX (arg1) = putC arg1 +putKX (arg1) = putK arg1 +putIX (arg1) = putI arg1 +putFX (arg1) = putF arg1 +putSX (arg1) = putS arg1 +putMTX (arg1) = putMT arg1 +putLX (arg1) = putL arg1 +putRRX (arg1, arg2) = putR arg1 >> putR arg2 +putERX (arg1, arg2) = putE arg1 >> putR arg2 +putRCX (arg1, arg2) = putR arg1 >> putC arg2 +putRIX (arg1, arg2) = putR arg1 >> putI arg2 +putRFX (arg1, arg2) = putR arg1 >> putF arg2 +putRSX (arg1, arg2) = putR arg1 >> putS arg2 +putRI1X (arg1, arg2) = putR arg1 >> putI1 arg2 +putRCEX (arg1, arg2) = putR arg1 >> putCE arg2 +putECEX (arg1, arg2) = putE arg1 >> putCE arg2 +putCLX (arg1, arg2) = putC arg1 >> putL arg2 +putRKX (arg1, arg2) = putR arg1 >> putK arg2 +putECX (arg1, arg2) = putE arg1 >> putC arg2 +putI1ITX (arg1, arg2) = putI1 arg1 >> putIT arg2 +putI1LX (arg1, arg2) = putI1 arg1 >> putL arg2 +putSEGLX (arg1, arg2) = putSEG arg1 >> putL arg2 +putI1LWPX (arg1, arg2) = putI1 arg1 >> putL arg2 +putI1NX (arg1, arg2) = putI1 arg1 >> putN arg2 +putI1HTX (arg1, arg2) = putI1 arg1 >> putHT arg2 +putI1BVTX (arg1, arg2) = putI1 arg1 >> putBVT arg2 +putCWPX (arg1) = putC arg1 +putI1WPX (arg1) = putI1 arg1 +putRRI1X (arg1, arg2, arg3) = putR arg1 >> putR arg2 >> putI1 arg3 +putRCLX (arg1, arg2, arg3) = putR arg1 >> putC arg2 >> putL arg3 +putRCI1X (arg1, arg2, arg3) = putR arg1 >> putC arg2 >> putI1 arg3 +putSEGI1LX (arg1, arg2, arg3) = putSEG arg1 >> putI1 arg2 >> putL arg3 +putI1LLX (arg1, arg2, arg3) = putI1 arg1 >> putL arg2 >> putL arg3 +putNLLX (arg1, arg2, arg3) = putN arg1 >> putL arg2 >> putL arg3 +putLLLLX (arg1, arg2, arg3, arg4) = putL arg1 >> putL arg2 >> putL arg3 >> putL arg4 +putI1CWPX (arg1, arg2) = putI1 arg1 >> putC arg2 +putI1I1WPX (arg1, arg2) = putI1 arg1 >> putI1 arg2 + +getRX = do + arg1 <- getR + return (arg1) +getEX = do + arg1 <- getE + return (arg1) +getI1X = do + arg1 <- getI1 + return (arg1) +getCX = do + arg1 <- getC + return (arg1) +getKX = do + arg1 <- getK + return (arg1) +getIX = do + arg1 <- getI + return (arg1) +getFX = do + arg1 <- getF + return (arg1) +getSX = do + arg1 <- getS + return (arg1) +getMTX = do + arg1 <- getMT + return (arg1) +getLX = do + arg1 <- getL + return (arg1) +getRRX = do + arg1 <- getR + arg2 <- getR + return (arg1, arg2) +getERX = do + arg1 <- getE + arg2 <- getR + return (arg1, arg2) +getRCX = do + arg1 <- getR + arg2 <- getC + return (arg1, arg2) +getRIX = do + arg1 <- getR + arg2 <- getI + return (arg1, arg2) +getRFX = do + arg1 <- getR + arg2 <- getF + return (arg1, arg2) +getRSX = do + arg1 <- getR + arg2 <- getS + return (arg1, arg2) +getRI1X = do + arg1 <- getR + arg2 <- getI1 + return (arg1, arg2) +getRCEX = do + arg1 <- getR + arg2 <- getCE + return (arg1, arg2) +getECEX = do + arg1 <- getE + arg2 <- getCE + return (arg1, arg2) +getCLX = do + arg1 <- getC + arg2 <- getL + return (arg1, arg2) +getRKX = do + arg1 <- getR + arg2 <- getK + return (arg1, arg2) +getECX = do + arg1 <- getE + arg2 <- getC + return (arg1, arg2) +getI1ITX = do + arg1 <- getI1 + arg2 <- getIT + return (arg1, arg2) +getI1LX = do + arg1 <- getI1 + arg2 <- getL + return (arg1, arg2) +getSEGLX = do + arg1 <- getSEG + arg2 <- getL + return (arg1, arg2) +getI1LWPX = do + arg1 <- getI1 + arg2 <- getL + return (arg1, arg2) +getI1NX = do + arg1 <- getI1 + arg2 <- getN + return (arg1, arg2) +getI1HTX = do + arg1 <- getI1 + arg2 <- getHT + return (arg1, arg2) +getI1BVTX = do + arg1 <- getI1 + arg2 <- getBVT + return (arg1, arg2) +getCWPX = do + arg1 <- getC + return (arg1) +getI1WPX = do + arg1 <- getI1 + return (arg1) +getRRI1X = do + arg1 <- getR + arg2 <- getR + arg3 <- getI1 + return (arg1, arg2, arg3) +getRCLX = do + arg1 <- getR + arg2 <- getC + arg3 <- getL + return (arg1, arg2, arg3) +getRCI1X = do + arg1 <- getR + arg2 <- getC + arg3 <- getI1 + return (arg1, arg2, arg3) +getSEGI1LX = do + arg1 <- getSEG + arg2 <- getI1 + arg3 <- getL + return (arg1, arg2, arg3) +getI1LLX = do + arg1 <- getI1 + arg2 <- getL + arg3 <- getL + return (arg1, arg2, arg3) +getNLLX = do + arg1 <- getN + arg2 <- getL + arg3 <- getL + return (arg1, arg2, arg3) +getLLLLX = do + arg1 <- getL + arg2 <- getL + arg3 <- getL + arg4 <- getL + return (arg1, arg2, arg3, arg4) +getI1CWPX = do + arg1 <- getI1 + arg2 <- getC + return (arg1, arg2) +getI1I1WPX = do + arg1 <- getI1 + arg2 <- getI1 + return (arg1, arg2) + +displayRX (arg1) = ppR arg1 +displayEX (arg1) = ppE arg1 +displayI1X (arg1) = ppI1 arg1 +displayCX (arg1) = ppC arg1 +displayKX (arg1) = ppK arg1 +displayIX (arg1) = ppI arg1 +displayFX (arg1) = ppF arg1 +displaySX (arg1) = ppS arg1 +displayMTX (arg1) = ppMT arg1 +displayLX (arg1) = ppL arg1 +displayRRX (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppR arg2) +displayERX (arg1, arg2) = (ppE arg1) ++ ", " ++ (ppR arg2) +displayRCX (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppC arg2) +displayRIX (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppI arg2) +displayRFX (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppF arg2) +displayRSX (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppS arg2) +displayRI1X (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppI1 arg2) +displayRCEX (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppCE arg2) +displayECEX (arg1, arg2) = (ppE arg1) ++ ", " ++ (ppCE arg2) +displayCLX (arg1, arg2) = (ppC arg1) ++ ", " ++ (ppL arg2) +displayRKX (arg1, arg2) = (ppR arg1) ++ ", " ++ (ppK arg2) +displayECX (arg1, arg2) = (ppE arg1) ++ ", " ++ (ppC arg2) +displayI1ITX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppIT arg2) +displayI1LX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppL arg2) +displaySEGLX (arg1, arg2) = (ppSEG arg1) ++ ", " ++ (ppL arg2) +displayI1LWPX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppL arg2) +displayI1NX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppN arg2) +displayI1HTX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppHT arg2) +displayI1BVTX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppBVT arg2) +displayCWPX (arg1) = ppC arg1 +displayI1WPX (arg1) = ppI1 arg1 +displayRRI1X (arg1, arg2, arg3) = ((ppR arg1) ++ ", " ++ (ppR arg2)) ++ ", " ++ (ppI1 arg3) +displayRCLX (arg1, arg2, arg3) = ((ppR arg1) ++ ", " ++ (ppC arg2)) ++ ", " ++ (ppL arg3) +displayRCI1X (arg1, arg2, arg3) = ((ppR arg1) ++ ", " ++ (ppC arg2)) ++ ", " ++ (ppI1 arg3) +displaySEGI1LX (arg1, arg2, arg3) = ((ppSEG arg1) ++ ", " ++ (ppI1 arg2)) ++ ", " ++ (ppL arg3) +displayI1LLX (arg1, arg2, arg3) = ((ppI1 arg1) ++ ", " ++ (ppL arg2)) ++ ", " ++ (ppL arg3) +displayNLLX (arg1, arg2, arg3) = ((ppN arg1) ++ ", " ++ (ppL arg2)) ++ ", " ++ (ppL arg3) +displayLLLLX (arg1, arg2, arg3, arg4) = (((ppL arg1) ++ ", " ++ (ppL arg2)) ++ ", " ++ (ppL arg3)) ++ ", " ++ (ppL arg4) +displayI1CWPX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppC arg2) +displayI1I1WPX (arg1, arg2) = (ppI1 arg1) ++ ", " ++ (ppI1 arg2) + +inscatX_LEN = 4 :: Int +inscatRX_LEN = 4 :: Int +inscatEX_LEN = 4 :: Int +inscatI1X_LEN = 4 :: Int +inscatCX_LEN = 4 :: Int +inscatKX_LEN = 4 :: Int +inscatIX_LEN = 8 :: Int +inscatFX_LEN = 8 :: Int +inscatSX_LEN = 8 :: Int +inscatMTX_LEN = 8 :: Int +inscatLX_LEN = 8 :: Int +inscatRRX_LEN = 4 :: Int +inscatERX_LEN = 4 :: Int +inscatRCX_LEN = 4 :: Int +inscatRIX_LEN = 8 :: Int +inscatRFX_LEN = 8 :: Int +inscatRSX_LEN = 8 :: Int +inscatRI1X_LEN = 4 :: Int +inscatRCEX_LEN = 4 :: Int +inscatECEX_LEN = 4 :: Int +inscatCLX_LEN = 8 :: Int +inscatRKX_LEN = 4 :: Int +inscatECX_LEN = 4 :: Int +inscatI1ITX_LEN = 8 :: Int +inscatI1LX_LEN = 8 :: Int +inscatSEGLX_LEN = 8 :: Int +inscatI1LWPX_LEN = 12 :: Int +inscatI1NX_LEN = 4 :: Int +inscatI1HTX_LEN = 8 :: Int +inscatI1BVTX_LEN = 8 :: Int +inscatCWPX_LEN = 8 :: Int +inscatI1WPX_LEN = 8 :: Int +inscatRRI1X_LEN = 4 :: Int +inscatRCLX_LEN = 8 :: Int +inscatRCI1X_LEN = 8 :: Int +inscatSEGI1LX_LEN = 8 :: Int +inscatI1LLX_LEN = 12 :: Int +inscatNLLX_LEN = 12 :: Int +inscatLLLLX_LEN = 20 :: Int +inscatI1CWPX_LEN = 8 :: Int +inscatI1I1WPX_LEN = 8 :: Int + + + +data Instruction + = Ins_put_variable_t InscatRRX + | Ins_put_variable_p InscatERX + | Ins_put_value_t InscatRRX + | Ins_put_value_p InscatERX + | Ins_put_unsafe_value InscatERX + | Ins_copy_value InscatERX + | Ins_put_m_const InscatRCX + | Ins_put_p_const InscatRCX + | Ins_put_nil InscatRX + | Ins_put_integer InscatRIX + | Ins_put_float InscatRFX + | Ins_put_string InscatRSX + | Ins_put_index InscatRI1X + | Ins_put_app InscatRRI1X + | Ins_put_list InscatRX + | Ins_put_lambda InscatRRI1X + | Ins_set_variable_t InscatRX + | Ins_set_variable_te InscatRX + | Ins_set_variable_p InscatEX + | Ins_set_value_t InscatRX + | Ins_set_value_p InscatEX + | Ins_globalize_pt InscatERX + | Ins_globalize_t InscatRX + | Ins_set_m_const InscatCX + | Ins_set_p_const InscatCX + | Ins_set_nil + | Ins_set_integer InscatIX + | Ins_set_float InscatFX + | Ins_set_string InscatSX + | Ins_set_index InscatI1X + | Ins_set_void InscatI1X + | Ins_deref InscatRX + | Ins_set_lambda InscatRI1X + | Ins_get_variable_t InscatRRX + | Ins_get_variable_p InscatERX + | Ins_init_variable_t InscatRCEX + | Ins_init_variable_p InscatECEX + | Ins_get_m_constant InscatRCX + | Ins_get_p_constant InscatRCLX + | Ins_get_integer InscatRIX + | Ins_get_float InscatRFX + | Ins_get_string InscatRSX + | Ins_get_nil InscatRX + | Ins_get_m_structure InscatRCI1X + | Ins_get_p_structure InscatRCI1X + | Ins_get_list InscatRX + | Ins_unify_variable_t InscatRX + | Ins_unify_variable_p InscatEX + | Ins_unify_value_t InscatRX + | Ins_unify_value_p InscatEX + | Ins_unify_local_value_t InscatRX + | Ins_unify_local_value_p InscatEX + | Ins_unify_m_constant InscatCX + | Ins_unify_p_constant InscatCLX + | Ins_unify_integer InscatIX + | Ins_unify_float InscatFX + | Ins_unify_string InscatSX + | Ins_unify_nil + | Ins_unify_void InscatI1X + | Ins_put_type_variable_t InscatRRX + | Ins_put_type_variable_p InscatERX + | Ins_put_type_value_t InscatRRX + | Ins_put_type_value_p InscatERX + | Ins_put_type_unsafe_value InscatERX + | Ins_put_type_const InscatRKX + | Ins_put_type_structure InscatRKX + | Ins_put_type_arrow InscatRX + | Ins_set_type_variable_t InscatRX + | Ins_set_type_variable_p InscatEX + | Ins_set_type_value_t InscatRX + | Ins_set_type_value_p InscatEX + | Ins_set_type_local_value_t InscatRX + | Ins_set_type_local_value_p InscatEX + | Ins_set_type_constant InscatKX + | Ins_get_type_variable_t InscatRRX + | Ins_get_type_variable_p InscatERX + | Ins_init_type_variable_t InscatRCEX + | Ins_init_type_variable_p InscatECEX + | Ins_get_type_value_t InscatRRX + | Ins_get_type_value_p InscatERX + | Ins_get_type_constant InscatRKX + | Ins_get_type_structure InscatRKX + | Ins_get_type_arrow InscatRX + | Ins_unify_type_variable_t InscatRX + | Ins_unify_type_variable_p InscatEX + | Ins_unify_type_value_t InscatRX + | Ins_unify_type_value_p InscatEX + | Ins_unify_envty_value_t InscatRX + | Ins_unify_envty_value_p InscatEX + | Ins_unify_type_local_value_t InscatRX + | Ins_unify_type_local_value_p InscatEX + | Ins_unify_envty_local_value_t InscatRX + | Ins_unify_envty_local_value_p InscatEX + | Ins_unify_type_constant InscatKX + | Ins_pattern_unify_t InscatRRX + | Ins_pattern_unify_p InscatERX + | Ins_finish_unify + | Ins_head_normalize_t InscatRX + | Ins_head_normalize_p InscatEX + | Ins_incr_universe + | Ins_decr_universe + | Ins_set_univ_tag InscatECX + | Ins_tag_exists_t InscatRX + | Ins_tag_exists_p InscatEX + | Ins_tag_variable InscatEX + | Ins_push_impl_point InscatI1ITX + | Ins_pop_impl_point + | Ins_add_imports InscatSEGI1LX + | Ins_remove_imports InscatSEGLX + | Ins_push_import InscatMTX + | Ins_pop_imports InscatI1X + | Ins_allocate InscatI1X + | Ins_deallocate + | Ins_call InscatI1LX + | Ins_call_name InscatI1CWPX + | Ins_execute InscatLX + | Ins_execute_name InscatCWPX + | Ins_proceed + | Ins_try_me_else InscatI1LX + | Ins_retry_me_else InscatI1LX + | Ins_trust_me InscatI1WPX + | Ins_try InscatI1LX + | Ins_retry InscatI1LX + | Ins_trust InscatI1LWPX + | Ins_trust_ext InscatI1NX + | Ins_try_else InscatI1LLX + | Ins_retry_else InscatI1LLX + | Ins_branch InscatLX + | Ins_switch_on_term InscatLLLLX + | Ins_switch_on_constant InscatI1HTX + | Ins_switch_on_bvar InscatI1BVTX + | Ins_switch_on_reg InscatNLLX + | Ins_neck_cut + | Ins_get_level InscatEX + | Ins_put_level InscatEX + | Ins_cut InscatEX + | Ins_call_builtin InscatI1I1WPX + | Ins_builtin InscatI1X + | Ins_stop + | Ins_halt + | Ins_fail + | Ins_create_type_variable InscatEX + | Ins_execute_link_only InscatCWPX + | Ins_call_link_only InscatI1CWPX + | Ins_put_variable_te InscatRRX + +getSize_put_variable_t = inscatRRX_LEN :: Int +getSize_put_variable_p = inscatERX_LEN :: Int +getSize_put_value_t = inscatRRX_LEN :: Int +getSize_put_value_p = inscatERX_LEN :: Int +getSize_put_unsafe_value = inscatERX_LEN :: Int +getSize_copy_value = inscatERX_LEN :: Int +getSize_put_m_const = inscatRCX_LEN :: Int +getSize_put_p_const = inscatRCX_LEN :: Int +getSize_put_nil = inscatRX_LEN :: Int +getSize_put_integer = inscatRIX_LEN :: Int +getSize_put_float = inscatRFX_LEN :: Int +getSize_put_string = inscatRSX_LEN :: Int +getSize_put_index = inscatRI1X_LEN :: Int +getSize_put_app = inscatRRI1X_LEN :: Int +getSize_put_list = inscatRX_LEN :: Int +getSize_put_lambda = inscatRRI1X_LEN :: Int +getSize_set_variable_t = inscatRX_LEN :: Int +getSize_set_variable_te = inscatRX_LEN :: Int +getSize_set_variable_p = inscatEX_LEN :: Int +getSize_set_value_t = inscatRX_LEN :: Int +getSize_set_value_p = inscatEX_LEN :: Int +getSize_globalize_pt = inscatERX_LEN :: Int +getSize_globalize_t = inscatRX_LEN :: Int +getSize_set_m_const = inscatCX_LEN :: Int +getSize_set_p_const = inscatCX_LEN :: Int +getSize_set_nil = inscatX_LEN :: Int +getSize_set_integer = inscatIX_LEN :: Int +getSize_set_float = inscatFX_LEN :: Int +getSize_set_string = inscatSX_LEN :: Int +getSize_set_index = inscatI1X_LEN :: Int +getSize_set_void = inscatI1X_LEN :: Int +getSize_deref = inscatRX_LEN :: Int +getSize_set_lambda = inscatRI1X_LEN :: Int +getSize_get_variable_t = inscatRRX_LEN :: Int +getSize_get_variable_p = inscatERX_LEN :: Int +getSize_init_variable_t = inscatRCEX_LEN :: Int +getSize_init_variable_p = inscatECEX_LEN :: Int +getSize_get_m_constant = inscatRCX_LEN :: Int +getSize_get_p_constant = inscatRCLX_LEN :: Int +getSize_get_integer = inscatRIX_LEN :: Int +getSize_get_float = inscatRFX_LEN :: Int +getSize_get_string = inscatRSX_LEN :: Int +getSize_get_nil = inscatRX_LEN :: Int +getSize_get_m_structure = inscatRCI1X_LEN :: Int +getSize_get_p_structure = inscatRCI1X_LEN :: Int +getSize_get_list = inscatRX_LEN :: Int +getSize_unify_variable_t = inscatRX_LEN :: Int +getSize_unify_variable_p = inscatEX_LEN :: Int +getSize_unify_value_t = inscatRX_LEN :: Int +getSize_unify_value_p = inscatEX_LEN :: Int +getSize_unify_local_value_t = inscatRX_LEN :: Int +getSize_unify_local_value_p = inscatEX_LEN :: Int +getSize_unify_m_constant = inscatCX_LEN :: Int +getSize_unify_p_constant = inscatCLX_LEN :: Int +getSize_unify_integer = inscatIX_LEN :: Int +getSize_unify_float = inscatFX_LEN :: Int +getSize_unify_string = inscatSX_LEN :: Int +getSize_unify_nil = inscatX_LEN :: Int +getSize_unify_void = inscatI1X_LEN :: Int +getSize_put_type_variable_t = inscatRRX_LEN :: Int +getSize_put_type_variable_p = inscatERX_LEN :: Int +getSize_put_type_value_t = inscatRRX_LEN :: Int +getSize_put_type_value_p = inscatERX_LEN :: Int +getSize_put_type_unsafe_value = inscatERX_LEN :: Int +getSize_put_type_const = inscatRKX_LEN :: Int +getSize_put_type_structure = inscatRKX_LEN :: Int +getSize_put_type_arrow = inscatRX_LEN :: Int +getSize_set_type_variable_t = inscatRX_LEN :: Int +getSize_set_type_variable_p = inscatEX_LEN :: Int +getSize_set_type_value_t = inscatRX_LEN :: Int +getSize_set_type_value_p = inscatEX_LEN :: Int +getSize_set_type_local_value_t = inscatRX_LEN :: Int +getSize_set_type_local_value_p = inscatEX_LEN :: Int +getSize_set_type_constant = inscatKX_LEN :: Int +getSize_get_type_variable_t = inscatRRX_LEN :: Int +getSize_get_type_variable_p = inscatERX_LEN :: Int +getSize_init_type_variable_t = inscatRCEX_LEN :: Int +getSize_init_type_variable_p = inscatECEX_LEN :: Int +getSize_get_type_value_t = inscatRRX_LEN :: Int +getSize_get_type_value_p = inscatERX_LEN :: Int +getSize_get_type_constant = inscatRKX_LEN :: Int +getSize_get_type_structure = inscatRKX_LEN :: Int +getSize_get_type_arrow = inscatRX_LEN :: Int +getSize_unify_type_variable_t = inscatRX_LEN :: Int +getSize_unify_type_variable_p = inscatEX_LEN :: Int +getSize_unify_type_value_t = inscatRX_LEN :: Int +getSize_unify_type_value_p = inscatEX_LEN :: Int +getSize_unify_envty_value_t = inscatRX_LEN :: Int +getSize_unify_envty_value_p = inscatEX_LEN :: Int +getSize_unify_type_local_value_t = inscatRX_LEN :: Int +getSize_unify_type_local_value_p = inscatEX_LEN :: Int +getSize_unify_envty_local_value_t = inscatRX_LEN :: Int +getSize_unify_envty_local_value_p = inscatEX_LEN :: Int +getSize_unify_type_constant = inscatKX_LEN :: Int +getSize_pattern_unify_t = inscatRRX_LEN :: Int +getSize_pattern_unify_p = inscatERX_LEN :: Int +getSize_finish_unify = inscatX_LEN :: Int +getSize_head_normalize_t = inscatRX_LEN :: Int +getSize_head_normalize_p = inscatEX_LEN :: Int +getSize_incr_universe = inscatX_LEN :: Int +getSize_decr_universe = inscatX_LEN :: Int +getSize_set_univ_tag = inscatECX_LEN :: Int +getSize_tag_exists_t = inscatRX_LEN :: Int +getSize_tag_exists_p = inscatEX_LEN :: Int +getSize_tag_variable = inscatEX_LEN :: Int +getSize_push_impl_point = inscatI1ITX_LEN :: Int +getSize_pop_impl_point = inscatX_LEN :: Int +getSize_add_imports = inscatSEGI1LX_LEN :: Int +getSize_remove_imports = inscatSEGLX_LEN :: Int +getSize_push_import = inscatMTX_LEN :: Int +getSize_pop_imports = inscatI1X_LEN :: Int +getSize_allocate = inscatI1X_LEN :: Int +getSize_deallocate = inscatX_LEN :: Int +getSize_call = inscatI1LX_LEN :: Int +getSize_call_name = inscatI1CWPX_LEN :: Int +getSize_execute = inscatLX_LEN :: Int +getSize_execute_name = inscatCWPX_LEN :: Int +getSize_proceed = inscatX_LEN :: Int +getSize_try_me_else = inscatI1LX_LEN :: Int +getSize_retry_me_else = inscatI1LX_LEN :: Int +getSize_trust_me = inscatI1WPX_LEN :: Int +getSize_try = inscatI1LX_LEN :: Int +getSize_retry = inscatI1LX_LEN :: Int +getSize_trust = inscatI1LWPX_LEN :: Int +getSize_trust_ext = inscatI1NX_LEN :: Int +getSize_try_else = inscatI1LLX_LEN :: Int +getSize_retry_else = inscatI1LLX_LEN :: Int +getSize_branch = inscatLX_LEN :: Int +getSize_switch_on_term = inscatLLLLX_LEN :: Int +getSize_switch_on_constant = inscatI1HTX_LEN :: Int +getSize_switch_on_bvar = inscatI1BVTX_LEN :: Int +getSize_switch_on_reg = inscatNLLX_LEN :: Int +getSize_neck_cut = inscatX_LEN :: Int +getSize_get_level = inscatEX_LEN :: Int +getSize_put_level = inscatEX_LEN :: Int +getSize_cut = inscatEX_LEN :: Int +getSize_call_builtin = inscatI1I1WPX_LEN :: Int +getSize_builtin = inscatI1X_LEN :: Int +getSize_stop = inscatX_LEN :: Int +getSize_halt = inscatX_LEN :: Int +getSize_fail = inscatX_LEN :: Int +getSize_create_type_variable = inscatEX_LEN :: Int +getSize_execute_link_only = inscatCWPX_LEN :: Int +getSize_call_link_only = inscatI1CWPX_LEN :: Int +getSize_put_variable_te = inscatRRX_LEN :: Int + +putInstruction :: Instruction -> Put +putInstruction inst = + case inst of + Ins_put_variable_t arg -> putopcode 0 >> putRRX arg + Ins_put_variable_p arg -> putopcode 1 >> putERX arg + Ins_put_value_t arg -> putopcode 2 >> putRRX arg + Ins_put_value_p arg -> putopcode 3 >> putERX arg + Ins_put_unsafe_value arg -> putopcode 4 >> putERX arg + Ins_copy_value arg -> putopcode 5 >> putERX arg + Ins_put_m_const arg -> putopcode 6 >> putRCX arg + Ins_put_p_const arg -> putopcode 7 >> putRCX arg + Ins_put_nil arg -> putopcode 8 >> putRX arg + Ins_put_integer arg -> putopcode 9 >> putRIX arg + Ins_put_float arg -> putopcode 10 >> putRFX arg + Ins_put_string arg -> putopcode 11 >> putRSX arg + Ins_put_index arg -> putopcode 12 >> putRI1X arg + Ins_put_app arg -> putopcode 13 >> putRRI1X arg + Ins_put_list arg -> putopcode 14 >> putRX arg + Ins_put_lambda arg -> putopcode 15 >> putRRI1X arg + Ins_set_variable_t arg -> putopcode 16 >> putRX arg + Ins_set_variable_te arg -> putopcode 17 >> putRX arg + Ins_set_variable_p arg -> putopcode 18 >> putEX arg + Ins_set_value_t arg -> putopcode 19 >> putRX arg + Ins_set_value_p arg -> putopcode 20 >> putEX arg + Ins_globalize_pt arg -> putopcode 21 >> putERX arg + Ins_globalize_t arg -> putopcode 22 >> putRX arg + Ins_set_m_const arg -> putopcode 23 >> putCX arg + Ins_set_p_const arg -> putopcode 24 >> putCX arg + Ins_set_nil -> putopcode 25 + Ins_set_integer arg -> putopcode 26 >> putIX arg + Ins_set_float arg -> putopcode 27 >> putFX arg + Ins_set_string arg -> putopcode 28 >> putSX arg + Ins_set_index arg -> putopcode 29 >> putI1X arg + Ins_set_void arg -> putopcode 30 >> putI1X arg + Ins_deref arg -> putopcode 31 >> putRX arg + Ins_set_lambda arg -> putopcode 32 >> putRI1X arg + Ins_get_variable_t arg -> putopcode 33 >> putRRX arg + Ins_get_variable_p arg -> putopcode 34 >> putERX arg + Ins_init_variable_t arg -> putopcode 35 >> putRCEX arg + Ins_init_variable_p arg -> putopcode 36 >> putECEX arg + Ins_get_m_constant arg -> putopcode 37 >> putRCX arg + Ins_get_p_constant arg -> putopcode 38 >> putRCLX arg + Ins_get_integer arg -> putopcode 39 >> putRIX arg + Ins_get_float arg -> putopcode 40 >> putRFX arg + Ins_get_string arg -> putopcode 41 >> putRSX arg + Ins_get_nil arg -> putopcode 42 >> putRX arg + Ins_get_m_structure arg -> putopcode 43 >> putRCI1X arg + Ins_get_p_structure arg -> putopcode 44 >> putRCI1X arg + Ins_get_list arg -> putopcode 45 >> putRX arg + Ins_unify_variable_t arg -> putopcode 46 >> putRX arg + Ins_unify_variable_p arg -> putopcode 47 >> putEX arg + Ins_unify_value_t arg -> putopcode 48 >> putRX arg + Ins_unify_value_p arg -> putopcode 49 >> putEX arg + Ins_unify_local_value_t arg -> putopcode 50 >> putRX arg + Ins_unify_local_value_p arg -> putopcode 51 >> putEX arg + Ins_unify_m_constant arg -> putopcode 52 >> putCX arg + Ins_unify_p_constant arg -> putopcode 53 >> putCLX arg + Ins_unify_integer arg -> putopcode 54 >> putIX arg + Ins_unify_float arg -> putopcode 55 >> putFX arg + Ins_unify_string arg -> putopcode 56 >> putSX arg + Ins_unify_nil -> putopcode 57 + Ins_unify_void arg -> putopcode 58 >> putI1X arg + Ins_put_type_variable_t arg -> putopcode 59 >> putRRX arg + Ins_put_type_variable_p arg -> putopcode 60 >> putERX arg + Ins_put_type_value_t arg -> putopcode 61 >> putRRX arg + Ins_put_type_value_p arg -> putopcode 62 >> putERX arg + Ins_put_type_unsafe_value arg -> putopcode 63 >> putERX arg + Ins_put_type_const arg -> putopcode 64 >> putRKX arg + Ins_put_type_structure arg -> putopcode 65 >> putRKX arg + Ins_put_type_arrow arg -> putopcode 66 >> putRX arg + Ins_set_type_variable_t arg -> putopcode 67 >> putRX arg + Ins_set_type_variable_p arg -> putopcode 68 >> putEX arg + Ins_set_type_value_t arg -> putopcode 69 >> putRX arg + Ins_set_type_value_p arg -> putopcode 70 >> putEX arg + Ins_set_type_local_value_t arg -> putopcode 71 >> putRX arg + Ins_set_type_local_value_p arg -> putopcode 72 >> putEX arg + Ins_set_type_constant arg -> putopcode 73 >> putKX arg + Ins_get_type_variable_t arg -> putopcode 74 >> putRRX arg + Ins_get_type_variable_p arg -> putopcode 75 >> putERX arg + Ins_init_type_variable_t arg -> putopcode 76 >> putRCEX arg + Ins_init_type_variable_p arg -> putopcode 77 >> putECEX arg + Ins_get_type_value_t arg -> putopcode 78 >> putRRX arg + Ins_get_type_value_p arg -> putopcode 79 >> putERX arg + Ins_get_type_constant arg -> putopcode 80 >> putRKX arg + Ins_get_type_structure arg -> putopcode 81 >> putRKX arg + Ins_get_type_arrow arg -> putopcode 82 >> putRX arg + Ins_unify_type_variable_t arg -> putopcode 83 >> putRX arg + Ins_unify_type_variable_p arg -> putopcode 84 >> putEX arg + Ins_unify_type_value_t arg -> putopcode 85 >> putRX arg + Ins_unify_type_value_p arg -> putopcode 86 >> putEX arg + Ins_unify_envty_value_t arg -> putopcode 87 >> putRX arg + Ins_unify_envty_value_p arg -> putopcode 88 >> putEX arg + Ins_unify_type_local_value_t arg -> putopcode 89 >> putRX arg + Ins_unify_type_local_value_p arg -> putopcode 90 >> putEX arg + Ins_unify_envty_local_value_t arg -> putopcode 91 >> putRX arg + Ins_unify_envty_local_value_p arg -> putopcode 92 >> putEX arg + Ins_unify_type_constant arg -> putopcode 93 >> putKX arg + Ins_pattern_unify_t arg -> putopcode 94 >> putRRX arg + Ins_pattern_unify_p arg -> putopcode 95 >> putERX arg + Ins_finish_unify -> putopcode 96 + Ins_head_normalize_t arg -> putopcode 97 >> putRX arg + Ins_head_normalize_p arg -> putopcode 98 >> putEX arg + Ins_incr_universe -> putopcode 99 + Ins_decr_universe -> putopcode 100 + Ins_set_univ_tag arg -> putopcode 101 >> putECX arg + Ins_tag_exists_t arg -> putopcode 102 >> putRX arg + Ins_tag_exists_p arg -> putopcode 103 >> putEX arg + Ins_tag_variable arg -> putopcode 104 >> putEX arg + Ins_push_impl_point arg -> putopcode 105 >> putI1ITX arg + Ins_pop_impl_point -> putopcode 106 + Ins_add_imports arg -> putopcode 107 >> putSEGI1LX arg + Ins_remove_imports arg -> putopcode 108 >> putSEGLX arg + Ins_push_import arg -> putopcode 109 >> putMTX arg + Ins_pop_imports arg -> putopcode 110 >> putI1X arg + Ins_allocate arg -> putopcode 111 >> putI1X arg + Ins_deallocate -> putopcode 112 + Ins_call arg -> putopcode 113 >> putI1LX arg + Ins_call_name arg -> putopcode 114 >> putI1CWPX arg + Ins_execute arg -> putopcode 115 >> putLX arg + Ins_execute_name arg -> putopcode 116 >> putCWPX arg + Ins_proceed -> putopcode 117 + Ins_try_me_else arg -> putopcode 118 >> putI1LX arg + Ins_retry_me_else arg -> putopcode 119 >> putI1LX arg + Ins_trust_me arg -> putopcode 120 >> putI1WPX arg + Ins_try arg -> putopcode 121 >> putI1LX arg + Ins_retry arg -> putopcode 122 >> putI1LX arg + Ins_trust arg -> putopcode 123 >> putI1LWPX arg + Ins_trust_ext arg -> putopcode 124 >> putI1NX arg + Ins_try_else arg -> putopcode 125 >> putI1LLX arg + Ins_retry_else arg -> putopcode 126 >> putI1LLX arg + Ins_branch arg -> putopcode 127 >> putLX arg + Ins_switch_on_term arg -> putopcode 128 >> putLLLLX arg + Ins_switch_on_constant arg -> putopcode 129 >> putI1HTX arg + Ins_switch_on_bvar arg -> putopcode 130 >> putI1BVTX arg + Ins_switch_on_reg arg -> putopcode 131 >> putNLLX arg + Ins_neck_cut -> putopcode 132 + Ins_get_level arg -> putopcode 133 >> putEX arg + Ins_put_level arg -> putopcode 134 >> putEX arg + Ins_cut arg -> putopcode 135 >> putEX arg + Ins_call_builtin arg -> putopcode 136 >> putI1I1WPX arg + Ins_builtin arg -> putopcode 137 >> putI1X arg + Ins_stop -> putopcode 138 + Ins_halt -> putopcode 139 + Ins_fail -> putopcode 140 + Ins_create_type_variable arg -> putopcode 141 >> putEX arg + Ins_execute_link_only arg -> putopcode 142 >> putCWPX arg + Ins_call_link_only arg -> putopcode 143 >> putI1CWPX arg + Ins_put_variable_te arg -> putopcode 144 >> putRRX arg + +getInstruction :: Get (Instruction,Int) +getInstruction = do + opcode <- getopcode + case opcode of + 0 -> getRRX >>= \x -> return (Ins_put_variable_t x, inscatRRX_LEN) + 1 -> getERX >>= \x -> return (Ins_put_variable_p x, inscatERX_LEN) + 2 -> getRRX >>= \x -> return (Ins_put_value_t x, inscatRRX_LEN) + 3 -> getERX >>= \x -> return (Ins_put_value_p x, inscatERX_LEN) + 4 -> getERX >>= \x -> return (Ins_put_unsafe_value x, inscatERX_LEN) + 5 -> getERX >>= \x -> return (Ins_copy_value x, inscatERX_LEN) + 6 -> getRCX >>= \x -> return (Ins_put_m_const x, inscatRCX_LEN) + 7 -> getRCX >>= \x -> return (Ins_put_p_const x, inscatRCX_LEN) + 8 -> getRX >>= \x -> return (Ins_put_nil x, inscatRX_LEN) + 9 -> getRIX >>= \x -> return (Ins_put_integer x, inscatRIX_LEN) + 10 -> getRFX >>= \x -> return (Ins_put_float x, inscatRFX_LEN) + 11 -> getRSX >>= \x -> return (Ins_put_string x, inscatRSX_LEN) + 12 -> getRI1X >>= \x -> return (Ins_put_index x, inscatRI1X_LEN) + 13 -> getRRI1X >>= \x -> return (Ins_put_app x, inscatRRI1X_LEN) + 14 -> getRX >>= \x -> return (Ins_put_list x, inscatRX_LEN) + 15 -> getRRI1X >>= \x -> return (Ins_put_lambda x, inscatRRI1X_LEN) + 16 -> getRX >>= \x -> return (Ins_set_variable_t x, inscatRX_LEN) + 17 -> getRX >>= \x -> return (Ins_set_variable_te x, inscatRX_LEN) + 18 -> getEX >>= \x -> return (Ins_set_variable_p x, inscatEX_LEN) + 19 -> getRX >>= \x -> return (Ins_set_value_t x, inscatRX_LEN) + 20 -> getEX >>= \x -> return (Ins_set_value_p x, inscatEX_LEN) + 21 -> getERX >>= \x -> return (Ins_globalize_pt x, inscatERX_LEN) + 22 -> getRX >>= \x -> return (Ins_globalize_t x, inscatRX_LEN) + 23 -> getCX >>= \x -> return (Ins_set_m_const x, inscatCX_LEN) + 24 -> getCX >>= \x -> return (Ins_set_p_const x, inscatCX_LEN) + 25 -> return (Ins_set_nil, inscatX_LEN) + 26 -> getIX >>= \x -> return (Ins_set_integer x, inscatIX_LEN) + 27 -> getFX >>= \x -> return (Ins_set_float x, inscatFX_LEN) + 28 -> getSX >>= \x -> return (Ins_set_string x, inscatSX_LEN) + 29 -> getI1X >>= \x -> return (Ins_set_index x, inscatI1X_LEN) + 30 -> getI1X >>= \x -> return (Ins_set_void x, inscatI1X_LEN) + 31 -> getRX >>= \x -> return (Ins_deref x, inscatRX_LEN) + 32 -> getRI1X >>= \x -> return (Ins_set_lambda x, inscatRI1X_LEN) + 33 -> getRRX >>= \x -> return (Ins_get_variable_t x, inscatRRX_LEN) + 34 -> getERX >>= \x -> return (Ins_get_variable_p x, inscatERX_LEN) + 35 -> getRCEX >>= \x -> return (Ins_init_variable_t x, inscatRCEX_LEN) + 36 -> getECEX >>= \x -> return (Ins_init_variable_p x, inscatECEX_LEN) + 37 -> getRCX >>= \x -> return (Ins_get_m_constant x, inscatRCX_LEN) + 38 -> getRCLX >>= \x -> return (Ins_get_p_constant x, inscatRCLX_LEN) + 39 -> getRIX >>= \x -> return (Ins_get_integer x, inscatRIX_LEN) + 40 -> getRFX >>= \x -> return (Ins_get_float x, inscatRFX_LEN) + 41 -> getRSX >>= \x -> return (Ins_get_string x, inscatRSX_LEN) + 42 -> getRX >>= \x -> return (Ins_get_nil x, inscatRX_LEN) + 43 -> getRCI1X >>= \x -> return (Ins_get_m_structure x, inscatRCI1X_LEN) + 44 -> getRCI1X >>= \x -> return (Ins_get_p_structure x, inscatRCI1X_LEN) + 45 -> getRX >>= \x -> return (Ins_get_list x, inscatRX_LEN) + 46 -> getRX >>= \x -> return (Ins_unify_variable_t x, inscatRX_LEN) + 47 -> getEX >>= \x -> return (Ins_unify_variable_p x, inscatEX_LEN) + 48 -> getRX >>= \x -> return (Ins_unify_value_t x, inscatRX_LEN) + 49 -> getEX >>= \x -> return (Ins_unify_value_p x, inscatEX_LEN) + 50 -> getRX >>= \x -> return (Ins_unify_local_value_t x, inscatRX_LEN) + 51 -> getEX >>= \x -> return (Ins_unify_local_value_p x, inscatEX_LEN) + 52 -> getCX >>= \x -> return (Ins_unify_m_constant x, inscatCX_LEN) + 53 -> getCLX >>= \x -> return (Ins_unify_p_constant x, inscatCLX_LEN) + 54 -> getIX >>= \x -> return (Ins_unify_integer x, inscatIX_LEN) + 55 -> getFX >>= \x -> return (Ins_unify_float x, inscatFX_LEN) + 56 -> getSX >>= \x -> return (Ins_unify_string x, inscatSX_LEN) + 57 -> return (Ins_unify_nil, inscatX_LEN) + 58 -> getI1X >>= \x -> return (Ins_unify_void x, inscatI1X_LEN) + 59 -> getRRX >>= \x -> return (Ins_put_type_variable_t x, inscatRRX_LEN) + 60 -> getERX >>= \x -> return (Ins_put_type_variable_p x, inscatERX_LEN) + 61 -> getRRX >>= \x -> return (Ins_put_type_value_t x, inscatRRX_LEN) + 62 -> getERX >>= \x -> return (Ins_put_type_value_p x, inscatERX_LEN) + 63 -> getERX >>= \x -> return (Ins_put_type_unsafe_value x, inscatERX_LEN) + 64 -> getRKX >>= \x -> return (Ins_put_type_const x, inscatRKX_LEN) + 65 -> getRKX >>= \x -> return (Ins_put_type_structure x, inscatRKX_LEN) + 66 -> getRX >>= \x -> return (Ins_put_type_arrow x, inscatRX_LEN) + 67 -> getRX >>= \x -> return (Ins_set_type_variable_t x, inscatRX_LEN) + 68 -> getEX >>= \x -> return (Ins_set_type_variable_p x, inscatEX_LEN) + 69 -> getRX >>= \x -> return (Ins_set_type_value_t x, inscatRX_LEN) + 70 -> getEX >>= \x -> return (Ins_set_type_value_p x, inscatEX_LEN) + 71 -> getRX >>= \x -> return (Ins_set_type_local_value_t x, inscatRX_LEN) + 72 -> getEX >>= \x -> return (Ins_set_type_local_value_p x, inscatEX_LEN) + 73 -> getKX >>= \x -> return (Ins_set_type_constant x, inscatKX_LEN) + 74 -> getRRX >>= \x -> return (Ins_get_type_variable_t x, inscatRRX_LEN) + 75 -> getERX >>= \x -> return (Ins_get_type_variable_p x, inscatERX_LEN) + 76 -> getRCEX >>= \x -> return (Ins_init_type_variable_t x, inscatRCEX_LEN) + 77 -> getECEX >>= \x -> return (Ins_init_type_variable_p x, inscatECEX_LEN) + 78 -> getRRX >>= \x -> return (Ins_get_type_value_t x, inscatRRX_LEN) + 79 -> getERX >>= \x -> return (Ins_get_type_value_p x, inscatERX_LEN) + 80 -> getRKX >>= \x -> return (Ins_get_type_constant x, inscatRKX_LEN) + 81 -> getRKX >>= \x -> return (Ins_get_type_structure x, inscatRKX_LEN) + 82 -> getRX >>= \x -> return (Ins_get_type_arrow x, inscatRX_LEN) + 83 -> getRX >>= \x -> return (Ins_unify_type_variable_t x, inscatRX_LEN) + 84 -> getEX >>= \x -> return (Ins_unify_type_variable_p x, inscatEX_LEN) + 85 -> getRX >>= \x -> return (Ins_unify_type_value_t x, inscatRX_LEN) + 86 -> getEX >>= \x -> return (Ins_unify_type_value_p x, inscatEX_LEN) + 87 -> getRX >>= \x -> return (Ins_unify_envty_value_t x, inscatRX_LEN) + 88 -> getEX >>= \x -> return (Ins_unify_envty_value_p x, inscatEX_LEN) + 89 -> getRX >>= \x -> return (Ins_unify_type_local_value_t x, inscatRX_LEN) + 90 -> getEX >>= \x -> return (Ins_unify_type_local_value_p x, inscatEX_LEN) + 91 -> getRX >>= \x -> return (Ins_unify_envty_local_value_t x, inscatRX_LEN) + 92 -> getEX >>= \x -> return (Ins_unify_envty_local_value_p x, inscatEX_LEN) + 93 -> getKX >>= \x -> return (Ins_unify_type_constant x, inscatKX_LEN) + 94 -> getRRX >>= \x -> return (Ins_pattern_unify_t x, inscatRRX_LEN) + 95 -> getERX >>= \x -> return (Ins_pattern_unify_p x, inscatERX_LEN) + 96 -> return (Ins_finish_unify, inscatX_LEN) + 97 -> getRX >>= \x -> return (Ins_head_normalize_t x, inscatRX_LEN) + 98 -> getEX >>= \x -> return (Ins_head_normalize_p x, inscatEX_LEN) + 99 -> return (Ins_incr_universe, inscatX_LEN) + 100 -> return (Ins_decr_universe, inscatX_LEN) + 101 -> getECX >>= \x -> return (Ins_set_univ_tag x, inscatECX_LEN) + 102 -> getRX >>= \x -> return (Ins_tag_exists_t x, inscatRX_LEN) + 103 -> getEX >>= \x -> return (Ins_tag_exists_p x, inscatEX_LEN) + 104 -> getEX >>= \x -> return (Ins_tag_variable x, inscatEX_LEN) + 105 -> getI1ITX >>= \x -> return (Ins_push_impl_point x, inscatI1ITX_LEN) + 106 -> return (Ins_pop_impl_point, inscatX_LEN) + 107 -> getSEGI1LX >>= \x -> return (Ins_add_imports x, inscatSEGI1LX_LEN) + 108 -> getSEGLX >>= \x -> return (Ins_remove_imports x, inscatSEGLX_LEN) + 109 -> getMTX >>= \x -> return (Ins_push_import x, inscatMTX_LEN) + 110 -> getI1X >>= \x -> return (Ins_pop_imports x, inscatI1X_LEN) + 111 -> getI1X >>= \x -> return (Ins_allocate x, inscatI1X_LEN) + 112 -> return (Ins_deallocate, inscatX_LEN) + 113 -> getI1LX >>= \x -> return (Ins_call x, inscatI1LX_LEN) + 114 -> getI1CWPX >>= \x -> return (Ins_call_name x, inscatI1CWPX_LEN) + 115 -> getLX >>= \x -> return (Ins_execute x, inscatLX_LEN) + 116 -> getCWPX >>= \x -> return (Ins_execute_name x, inscatCWPX_LEN) + 117 -> return (Ins_proceed, inscatX_LEN) + 118 -> getI1LX >>= \x -> return (Ins_try_me_else x, inscatI1LX_LEN) + 119 -> getI1LX >>= \x -> return (Ins_retry_me_else x, inscatI1LX_LEN) + 120 -> getI1WPX >>= \x -> return (Ins_trust_me x, inscatI1WPX_LEN) + 121 -> getI1LX >>= \x -> return (Ins_try x, inscatI1LX_LEN) + 122 -> getI1LX >>= \x -> return (Ins_retry x, inscatI1LX_LEN) + 123 -> getI1LWPX >>= \x -> return (Ins_trust x, inscatI1LWPX_LEN) + 124 -> getI1NX >>= \x -> return (Ins_trust_ext x, inscatI1NX_LEN) + 125 -> getI1LLX >>= \x -> return (Ins_try_else x, inscatI1LLX_LEN) + 126 -> getI1LLX >>= \x -> return (Ins_retry_else x, inscatI1LLX_LEN) + 127 -> getLX >>= \x -> return (Ins_branch x, inscatLX_LEN) + 128 -> getLLLLX >>= \x -> return (Ins_switch_on_term x, inscatLLLLX_LEN) + 129 -> getI1HTX >>= \x -> return (Ins_switch_on_constant x, inscatI1HTX_LEN) + 130 -> getI1BVTX >>= \x -> return (Ins_switch_on_bvar x, inscatI1BVTX_LEN) + 131 -> getNLLX >>= \x -> return (Ins_switch_on_reg x, inscatNLLX_LEN) + 132 -> return (Ins_neck_cut, inscatX_LEN) + 133 -> getEX >>= \x -> return (Ins_get_level x, inscatEX_LEN) + 134 -> getEX >>= \x -> return (Ins_put_level x, inscatEX_LEN) + 135 -> getEX >>= \x -> return (Ins_cut x, inscatEX_LEN) + 136 -> getI1I1WPX >>= \x -> return (Ins_call_builtin x, inscatI1I1WPX_LEN) + 137 -> getI1X >>= \x -> return (Ins_builtin x, inscatI1X_LEN) + 138 -> return (Ins_stop, inscatX_LEN) + 139 -> return (Ins_halt, inscatX_LEN) + 140 -> return (Ins_fail, inscatX_LEN) + 141 -> getEX >>= \x -> return (Ins_create_type_variable x, inscatEX_LEN) + 142 -> getCWPX >>= \x -> return (Ins_execute_link_only x, inscatCWPX_LEN) + 143 -> getI1CWPX >>= \x -> return (Ins_call_link_only x, inscatI1CWPX_LEN) + 144 -> getRRX >>= \x -> return (Ins_put_variable_te x, inscatRRX_LEN) + + +showInstruction :: Instruction -> (String, Int) +showInstruction inst = + case inst of + Ins_put_variable_t arg -> ("put_variable_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_put_variable_p arg -> ("put_variable_p " ++ displayERX arg, inscatERX_LEN) + Ins_put_value_t arg -> ("put_value_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_put_value_p arg -> ("put_value_p " ++ displayERX arg, inscatERX_LEN) + Ins_put_unsafe_value arg -> ("put_unsafe_value " ++ displayERX arg, inscatERX_LEN) + Ins_copy_value arg -> ("copy_value " ++ displayERX arg, inscatERX_LEN) + Ins_put_m_const arg -> ("put_m_const " ++ displayRCX arg, inscatRCX_LEN) + Ins_put_p_const arg -> ("put_p_const " ++ displayRCX arg, inscatRCX_LEN) + Ins_put_nil arg -> ("put_nil " ++ displayRX arg, inscatRX_LEN) + Ins_put_integer arg -> ("put_integer " ++ displayRIX arg, inscatRIX_LEN) + Ins_put_float arg -> ("put_float " ++ displayRFX arg, inscatRFX_LEN) + Ins_put_string arg -> ("put_string " ++ displayRSX arg, inscatRSX_LEN) + Ins_put_index arg -> ("put_index " ++ displayRI1X arg, inscatRI1X_LEN) + Ins_put_app arg -> ("put_app " ++ displayRRI1X arg, inscatRRI1X_LEN) + Ins_put_list arg -> ("put_list " ++ displayRX arg, inscatRX_LEN) + Ins_put_lambda arg -> ("put_lambda " ++ displayRRI1X arg, inscatRRI1X_LEN) + Ins_set_variable_t arg -> ("set_variable_t " ++ displayRX arg, inscatRX_LEN) + Ins_set_variable_te arg -> ("set_variable_te " ++ displayRX arg, inscatRX_LEN) + Ins_set_variable_p arg -> ("set_variable_p " ++ displayEX arg, inscatEX_LEN) + Ins_set_value_t arg -> ("set_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_set_value_p arg -> ("set_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_globalize_pt arg -> ("globalize_pt " ++ displayERX arg, inscatERX_LEN) + Ins_globalize_t arg -> ("globalize_t " ++ displayRX arg, inscatRX_LEN) + Ins_set_m_const arg -> ("set_m_const " ++ displayCX arg, inscatCX_LEN) + Ins_set_p_const arg -> ("set_p_const " ++ displayCX arg, inscatCX_LEN) + Ins_set_nil -> ("set_nil ", inscatX_LEN) + Ins_set_integer arg -> ("set_integer " ++ displayIX arg, inscatIX_LEN) + Ins_set_float arg -> ("set_float " ++ displayFX arg, inscatFX_LEN) + Ins_set_string arg -> ("set_string " ++ displaySX arg, inscatSX_LEN) + Ins_set_index arg -> ("set_index " ++ displayI1X arg, inscatI1X_LEN) + Ins_set_void arg -> ("set_void " ++ displayI1X arg, inscatI1X_LEN) + Ins_deref arg -> ("deref " ++ displayRX arg, inscatRX_LEN) + Ins_set_lambda arg -> ("set_lambda " ++ displayRI1X arg, inscatRI1X_LEN) + Ins_get_variable_t arg -> ("get_variable_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_get_variable_p arg -> ("get_variable_p " ++ displayERX arg, inscatERX_LEN) + Ins_init_variable_t arg -> ("init_variable_t " ++ displayRCEX arg, inscatRCEX_LEN) + Ins_init_variable_p arg -> ("init_variable_p " ++ displayECEX arg, inscatECEX_LEN) + Ins_get_m_constant arg -> ("get_m_constant " ++ displayRCX arg, inscatRCX_LEN) + Ins_get_p_constant arg -> ("get_p_constant " ++ displayRCLX arg, inscatRCLX_LEN) + Ins_get_integer arg -> ("get_integer " ++ displayRIX arg, inscatRIX_LEN) + Ins_get_float arg -> ("get_float " ++ displayRFX arg, inscatRFX_LEN) + Ins_get_string arg -> ("get_string " ++ displayRSX arg, inscatRSX_LEN) + Ins_get_nil arg -> ("get_nil " ++ displayRX arg, inscatRX_LEN) + Ins_get_m_structure arg -> ("get_m_structure " ++ displayRCI1X arg, inscatRCI1X_LEN) + Ins_get_p_structure arg -> ("get_p_structure " ++ displayRCI1X arg, inscatRCI1X_LEN) + Ins_get_list arg -> ("get_list " ++ displayRX arg, inscatRX_LEN) + Ins_unify_variable_t arg -> ("unify_variable_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_variable_p arg -> ("unify_variable_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_value_t arg -> ("unify_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_value_p arg -> ("unify_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_local_value_t arg -> ("unify_local_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_local_value_p arg -> ("unify_local_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_m_constant arg -> ("unify_m_constant " ++ displayCX arg, inscatCX_LEN) + Ins_unify_p_constant arg -> ("unify_p_constant " ++ displayCLX arg, inscatCLX_LEN) + Ins_unify_integer arg -> ("unify_integer " ++ displayIX arg, inscatIX_LEN) + Ins_unify_float arg -> ("unify_float " ++ displayFX arg, inscatFX_LEN) + Ins_unify_string arg -> ("unify_string " ++ displaySX arg, inscatSX_LEN) + Ins_unify_nil -> ("unify_nil ", inscatX_LEN) + Ins_unify_void arg -> ("unify_void " ++ displayI1X arg, inscatI1X_LEN) + Ins_put_type_variable_t arg -> ("put_type_variable_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_put_type_variable_p arg -> ("put_type_variable_p " ++ displayERX arg, inscatERX_LEN) + Ins_put_type_value_t arg -> ("put_type_value_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_put_type_value_p arg -> ("put_type_value_p " ++ displayERX arg, inscatERX_LEN) + Ins_put_type_unsafe_value arg -> ("put_type_unsafe_value " ++ displayERX arg, inscatERX_LEN) + Ins_put_type_const arg -> ("put_type_const " ++ displayRKX arg, inscatRKX_LEN) + Ins_put_type_structure arg -> ("put_type_structure " ++ displayRKX arg, inscatRKX_LEN) + Ins_put_type_arrow arg -> ("put_type_arrow " ++ displayRX arg, inscatRX_LEN) + Ins_set_type_variable_t arg -> ("set_type_variable_t " ++ displayRX arg, inscatRX_LEN) + Ins_set_type_variable_p arg -> ("set_type_variable_p " ++ displayEX arg, inscatEX_LEN) + Ins_set_type_value_t arg -> ("set_type_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_set_type_value_p arg -> ("set_type_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_set_type_local_value_t arg -> ("set_type_local_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_set_type_local_value_p arg -> ("set_type_local_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_set_type_constant arg -> ("set_type_constant " ++ displayKX arg, inscatKX_LEN) + Ins_get_type_variable_t arg -> ("get_type_variable_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_get_type_variable_p arg -> ("get_type_variable_p " ++ displayERX arg, inscatERX_LEN) + Ins_init_type_variable_t arg -> ("init_type_variable_t " ++ displayRCEX arg, inscatRCEX_LEN) + Ins_init_type_variable_p arg -> ("init_type_variable_p " ++ displayECEX arg, inscatECEX_LEN) + Ins_get_type_value_t arg -> ("get_type_value_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_get_type_value_p arg -> ("get_type_value_p " ++ displayERX arg, inscatERX_LEN) + Ins_get_type_constant arg -> ("get_type_constant " ++ displayRKX arg, inscatRKX_LEN) + Ins_get_type_structure arg -> ("get_type_structure " ++ displayRKX arg, inscatRKX_LEN) + Ins_get_type_arrow arg -> ("get_type_arrow " ++ displayRX arg, inscatRX_LEN) + Ins_unify_type_variable_t arg -> ("unify_type_variable_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_type_variable_p arg -> ("unify_type_variable_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_type_value_t arg -> ("unify_type_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_type_value_p arg -> ("unify_type_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_envty_value_t arg -> ("unify_envty_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_envty_value_p arg -> ("unify_envty_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_type_local_value_t arg -> ("unify_type_local_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_type_local_value_p arg -> ("unify_type_local_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_envty_local_value_t arg -> ("unify_envty_local_value_t " ++ displayRX arg, inscatRX_LEN) + Ins_unify_envty_local_value_p arg -> ("unify_envty_local_value_p " ++ displayEX arg, inscatEX_LEN) + Ins_unify_type_constant arg -> ("unify_type_constant " ++ displayKX arg, inscatKX_LEN) + Ins_pattern_unify_t arg -> ("pattern_unify_t " ++ displayRRX arg, inscatRRX_LEN) + Ins_pattern_unify_p arg -> ("pattern_unify_p " ++ displayERX arg, inscatERX_LEN) + Ins_finish_unify -> ("finish_unify ", inscatX_LEN) + Ins_head_normalize_t arg -> ("head_normalize_t " ++ displayRX arg, inscatRX_LEN) + Ins_head_normalize_p arg -> ("head_normalize_p " ++ displayEX arg, inscatEX_LEN) + Ins_incr_universe -> ("incr_universe ", inscatX_LEN) + Ins_decr_universe -> ("decr_universe ", inscatX_LEN) + Ins_set_univ_tag arg -> ("set_univ_tag " ++ displayECX arg, inscatECX_LEN) + Ins_tag_exists_t arg -> ("tag_exists_t " ++ displayRX arg, inscatRX_LEN) + Ins_tag_exists_p arg -> ("tag_exists_p " ++ displayEX arg, inscatEX_LEN) + Ins_tag_variable arg -> ("tag_variable " ++ displayEX arg, inscatEX_LEN) + Ins_push_impl_point arg -> ("push_impl_point " ++ displayI1ITX arg, inscatI1ITX_LEN) + Ins_pop_impl_point -> ("pop_impl_point ", inscatX_LEN) + Ins_add_imports arg -> ("add_imports " ++ displaySEGI1LX arg, inscatSEGI1LX_LEN) + Ins_remove_imports arg -> ("remove_imports " ++ displaySEGLX arg, inscatSEGLX_LEN) + Ins_push_import arg -> ("push_import " ++ displayMTX arg, inscatMTX_LEN) + Ins_pop_imports arg -> ("pop_imports " ++ displayI1X arg, inscatI1X_LEN) + Ins_allocate arg -> ("allocate " ++ displayI1X arg, inscatI1X_LEN) + Ins_deallocate -> ("deallocate ", inscatX_LEN) + Ins_call arg -> ("call " ++ displayI1LX arg, inscatI1LX_LEN) + Ins_call_name arg -> ("call_name " ++ displayI1CWPX arg, inscatI1CWPX_LEN) + Ins_execute arg -> ("execute " ++ displayLX arg, inscatLX_LEN) + Ins_execute_name arg -> ("execute_name " ++ displayCWPX arg, inscatCWPX_LEN) + Ins_proceed -> ("proceed ", inscatX_LEN) + Ins_try_me_else arg -> ("try_me_else " ++ displayI1LX arg, inscatI1LX_LEN) + Ins_retry_me_else arg -> ("retry_me_else " ++ displayI1LX arg, inscatI1LX_LEN) + Ins_trust_me arg -> ("trust_me " ++ displayI1WPX arg, inscatI1WPX_LEN) + Ins_try arg -> ("try " ++ displayI1LX arg, inscatI1LX_LEN) + Ins_retry arg -> ("retry " ++ displayI1LX arg, inscatI1LX_LEN) + Ins_trust arg -> ("trust " ++ displayI1LWPX arg, inscatI1LWPX_LEN) + Ins_trust_ext arg -> ("trust_ext " ++ displayI1NX arg, inscatI1NX_LEN) + Ins_try_else arg -> ("try_else " ++ displayI1LLX arg, inscatI1LLX_LEN) + Ins_retry_else arg -> ("retry_else " ++ displayI1LLX arg, inscatI1LLX_LEN) + Ins_branch arg -> ("branch " ++ displayLX arg, inscatLX_LEN) + Ins_switch_on_term arg -> ("switch_on_term " ++ displayLLLLX arg, inscatLLLLX_LEN) + Ins_switch_on_constant arg -> ("switch_on_constant " ++ displayI1HTX arg, inscatI1HTX_LEN) + Ins_switch_on_bvar arg -> ("switch_on_bvar " ++ displayI1BVTX arg, inscatI1BVTX_LEN) + Ins_switch_on_reg arg -> ("switch_on_reg " ++ displayNLLX arg, inscatNLLX_LEN) + Ins_neck_cut -> ("neck_cut ", inscatX_LEN) + Ins_get_level arg -> ("get_level " ++ displayEX arg, inscatEX_LEN) + Ins_put_level arg -> ("put_level " ++ displayEX arg, inscatEX_LEN) + Ins_cut arg -> ("cut " ++ displayEX arg, inscatEX_LEN) + Ins_call_builtin arg -> ("call_builtin " ++ displayI1I1WPX arg, inscatI1I1WPX_LEN) + Ins_builtin arg -> ("builtin " ++ displayI1X arg, inscatI1X_LEN) + Ins_stop -> ("stop ", inscatX_LEN) + Ins_halt -> ("halt ", inscatX_LEN) + Ins_fail -> ("fail ", inscatX_LEN) + Ins_create_type_variable arg -> ("create_type_variable " ++ displayEX arg, inscatEX_LEN) + Ins_execute_link_only arg -> ("execute_link_only " ++ displayCWPX arg, inscatCWPX_LEN) + Ins_call_link_only arg -> ("call_link_only " ++ displayI1CWPX arg, inscatI1CWPX_LEN) + Ins_put_variable_te arg -> ("put_variable_te " ++ displayRRX arg, inscatRRX_LEN) \ No newline at end of file diff --git a/src/runtime/c/teyjus/tables_gen/Makefile b/src/runtime/c/teyjus/tables_gen/Makefile index 7cf2c532a..3f1a2faaf 100644 --- a/src/runtime/c/teyjus/tables_gen/Makefile +++ b/src/runtime/c/teyjus/tables_gen/Makefile @@ -1,9 +1,11 @@ all: instrformats/gen pervasives/gen + (cd instrformats; ./gen) + (cd pervasives; ./gen) instrformats/gen: instrformats/y.tab.o instrformats/lex.yy.o \ - instrformats/instrgen-c.o instrformats/instrgen-ocaml.o \ + instrformats/instrgen-c.o instrformats/instrgen-haskell.o \ util/util.o - gcc -o instrformats/gen $^ + gcc -o instrformats/gen $^ -lm pervasives/gen: pervasives/y.tab.o pervasives/lex.yy.o \ pervasives/ccode.o pervasives/ocamlcode.o \ diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y index 348312732..3613eb686 100644 --- a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y +++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y @@ -21,7 +21,7 @@ #include #include "instrgen-c.h" -#include "instrgen-ocaml.h" +#include "instrgen-haskell.h" #include "../util/util.h" extern int yylex(); @@ -275,8 +275,7 @@ int main(argc, argv) cspitCInstructionsH(root); cspitCInstructionsC(root); cspitSimDispatch(root); - //ocSpitInstructionMLI(root); - //ocSpitInstructionML(root); + ocSpitInstructionHS(root); //printf("Done.\n"); return 0; diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.c b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.c similarity index 57% rename from src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.c rename to src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.c index 5309509c8..71e65fe79 100644 --- a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.c +++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.c @@ -1,25 +1,10 @@ ////////////////////////////////////////////////////////////////////////////// -//Copyright 2008 -// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow -////////////////////////////////////////////////////////////////////////////// -// This file is part of Teyjus. // -// // -// Teyjus is free software: you can redistribute it and/or modify // -// it under the terms of the GNU General Public License as published by // -// the Free Software Foundation, either version 3 of the License, or // -// (at your option) any later version. // -// // -// Teyjus is distributed in the hope that it will be useful, // -// but WITHOUT ANY WARRANTY; without even the implied warranty of // -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // -// GNU General Public License for more details. // -// // -// You should have received a copy of the GNU General Public License // -// along with Teyjus. If not, see . // +//Copyright 2012 +// Krasimir Angelov ////////////////////////////////////////////////////////////////////////////// /*************************************************************************/ -/* functions for generating ocaml instr.mli and instr.ml */ +/* functions for generating Haskell Instructions.hs */ /*************************************************************************/ #include "../util/util.h" #include @@ -36,7 +21,7 @@ static char* addLine(char* str, char* addOn) strcpy(newStr, str); strcat(newStr, addOn); } else strcpy(newStr, addOn); - strcat(newStr, "\n\n"); + strcat(newStr, "\n"); return newStr; } @@ -58,46 +43,34 @@ static char* addStr(char* str, char* addOn) /**********************************************************************/ #define TYPE_SUFFIX "type" #define SIZE_SUFFIX "Size" -#define WRITE_PREFIX "write" -#define READ_PREFIX "read" +#define PUT_PREFIX "put" +#define GET_PREFIX "get" #define DISPLAY_PREFIX "display" #define INDENT " " #define INDENT2 " " -#define WRITE "Bytecode.write" -#define READ "Bytecode.read" -#define DISPLAY "Bytecode.display" -#define INSCAT_PREFIX "inscat" +#define PUT "putWord" +#define GET "getWord" +#define DISPLAY "pp" +#define INSCAT_PREFIX1 "inscat" +#define INSCAT_PREFIX2 "Inscat" #define INS_PREFIX "Ins_" -static char* OC_mkVarDec(char* varName, char* varType) +static char* HS_mkVarDef(char* varName, char* varType, char* defs) { - size_t length = strlen(varName) + strlen(varType) + 10; - char* vardec = UTIL_mallocStr(length); - - strcpy(vardec, "val "); - strcat(vardec, varName); - strcat(vardec, " : "); - strcat(vardec, varType); - strcat(vardec, "\n"); - - return vardec; -} - -static char* OC_mkVarDef(char* varName, char* defs) -{ - size_t length = strlen(varName) + strlen(defs) + 10; + size_t length = strlen(varName) + strlen(defs) + strlen(varType) + 10; char* vardef = UTIL_mallocStr(length); - strcpy(vardef, "let "); - strcat(vardef, varName); + strcpy(vardef, varName); strcat(vardef, " = "); strcat(vardef, defs); + strcat(vardef, " :: "); + strcat(vardef, varType); strcat(vardef, "\n"); - + return vardef; } -static char* OC_mkTypeDec(char* typeName, char* defs) +static char* HS_mkTypeDec(char* typeName, char* defs) { size_t length = strlen(typeName) + strlen(defs) + 10; char* typedec = UTIL_mallocStr(length); @@ -111,13 +84,12 @@ static char* OC_mkTypeDec(char* typeName, char* defs) return typedec; } -static char* OC_mkFunc(char* funcName, char* arg, char* body) +static char* HS_mkFunc(char* funcName, char* arg, char* body) { size_t length = strlen(funcName) + strlen(arg) + strlen(body) + 20; char* func = UTIL_mallocStr(length); - strcpy(func, "let "); - strcat(func, funcName); + strcpy(func, funcName); strcat(func, " "); strcat(func, arg); strcat(func, " = "); @@ -127,30 +99,30 @@ static char* OC_mkFunc(char* funcName, char* arg, char* body) return func; } -static char* OC_mkCrossType(char *lop, char *rop) +static char* HS_mkCrossType(char *lop, char *rop) { size_t length = strlen(lop) + strlen(rop) + 5; char* crossType = UTIL_mallocStr(length); strcpy(crossType, lop); - strcat(crossType, " * "); + strcat(crossType, ", "); strcat(crossType, rop); return crossType; } -static char* OC_mkValueCtr(char* ctrName, char* types) +static char* HS_mkValueCtr(char* ctrName, char* types) { size_t length = strlen(ctrName) + strlen(types) + 10; char* ctr = UTIL_mallocStr(length); strcpy(ctr, ctrName); - strcat(ctr, " of "); + strcat(ctr, " "); strcat(ctr, types); return ctr; } -static char* OC_mkDisjValueCtrs(char* prev, char* next) +static char* HS_mkDisjValueCtrs(char* prev, char* next) { size_t length = strlen(prev) + strlen(next) + 10; char* ctr = UTIL_mallocStr(length); @@ -164,18 +136,32 @@ static char* OC_mkDisjValueCtrs(char* prev, char* next) return ctr; } -static char* OC_mkFuncSeq(char* prev, char* new) +static char* HS_mkCase(char* prev, char* next) +{ + size_t length = strlen(prev) + strlen(next) + 10; + char* ctr = UTIL_mallocStr(length); + + strcpy(ctr, prev); + strcat(ctr, "\n"); + strcat(ctr, INDENT); + strcat(ctr, " "); + strcat(ctr, next); + + return ctr; +} + +static char* HS_mkFuncSeq(char* prev, char* new) { size_t length = strlen(prev) + strlen(new) + 20; char* funcSeq = UTIL_mallocStr(length); strcpy(funcSeq, prev); - strcat(funcSeq, "; "); + strcat(funcSeq, " >> "); strcat(funcSeq, new); return funcSeq; } -static char* OC_mkArgList(char* prev, char* new) +static char* HS_mkArgList(char* prev, char* new) { size_t length = strlen(prev) + strlen(new) + 2; char* args = UTIL_mallocStr(length); @@ -187,14 +173,14 @@ static char* OC_mkArgList(char* prev, char* new) return args; } -static char* OC_mkStrConcat(char* prev, char* new) +static char* HS_mkStrConcat(char* prev, char* new) { - size_t length = strlen(prev) + strlen(new) + 20; + size_t length = strlen(prev) + strlen(new) + 25; char* str = UTIL_mallocStr(length); strcpy(str, "("); strcat(str, prev); - strcat(str, ") ^ \", \" ^ ("); + strcat(str, ") ++ \", \" ++ ("); strcat(str, new); strcat(str, ")"); @@ -202,7 +188,7 @@ static char* OC_mkStrConcat(char* prev, char* new) } -static char* OC_mkArrow(char* left, char* right) +static char* HS_mkArrow(char* left, char* right) { size_t length = strlen(left) + strlen(right) + 20; char* arrow = UTIL_mallocStr(length); @@ -214,47 +200,28 @@ static char* OC_mkArrow(char* left, char* right) return arrow; } -static char* OC_mkStructure(char* func, char* arg) +static char* HS_mkStructure(char* func, char* arg) { size_t length = strlen(func) + strlen(arg) + 5; char* app = UTIL_mallocStr(length); strcpy(app, func); - strcat(app, "("); + strcat(app, " "); strcat(app, arg); - strcat(app, ")"); return app; } -static char* OC_mkCond(char* cond, char* branch) -{ - size_t length = strlen(cond) + strlen(branch) + 20; - char* str = UTIL_mallocStr(length); - - strcpy(str, INDENT); - strcat(str, "if "); - strcat(str, cond); - strcat(str, " then "); - strcat(str, branch); - strcat(str, "\n"); - strcat(str, INDENT); - strcat(str, "else"); - - return str; -} - -static char* OC_mkLetIn(char* varName, char* def) +static char* HS_mkDO(char* varName, char* def) { size_t length = strlen(varName) + strlen(def) + 20; char* str = UTIL_mallocStr(length); strcpy(str, INDENT); - strcat(str, "let "); strcat(str, varName); - strcat(str, " = "); + strcat(str, " <- "); strcat(str, def); - strcat(str, " in\n"); + strcat(str, "\n"); return str; } @@ -273,55 +240,88 @@ void ocgenInclude(char* include) /* operand types */ /**************************************************************************/ static char* opTypes; -static char* opSizesMLI; -static char* opSizesML; +static char* opSizes; static char* writeFuncs; static char* readFuncs; static char* ocgenWriteOpFunc(char* typeName, char* compType, int numBytes) { - char* funcName = UTIL_appendStr(WRITE_PREFIX, typeName); - char* numBytesText = UTIL_itoa(numBytes); - char* arg = "arg"; - char* funcBody1 = UTIL_mallocStr(strlen(WRITE) + strlen(compType) + - strlen(numBytesText)); - char *funcBody2, *func; + char* funcName = UTIL_appendStr(PUT_PREFIX, typeName); + char* numBitsText = UTIL_itoa(numBytes*8); + char* funcBody = UTIL_mallocStr(strlen(PUT)+strlen(numBitsText)+20); + char* func; + + if (strcmp(typeName, "F") == 0) { + strcpy(funcBody, "putFloat"); + strcat(funcBody, numBitsText); + + if (numBytes > 1) + strcat(funcBody, "be"); + } else if (strcmp(typeName, "C") == 0 || strcmp(typeName, "K") == 0) { + strcpy(funcBody, "put"); + } else { + strcpy(funcBody, PUT); + strcat(funcBody, numBitsText); - strcpy(funcBody1, WRITE); - strcat(funcBody1, compType); - strcat(funcBody1, numBytesText); free(numBytesText); - - funcBody2 = UTIL_appendStr(funcBody1, " arg"); free(funcBody1); - func = OC_mkFunc(funcName, arg, funcBody2); - free(funcName); free(funcBody2); + if (numBytes > 1) + strcat(funcBody, "be"); + + strcat(funcBody, " . fromIntegral"); + } + + free(numBitsText); + + func = HS_mkFunc(funcName, "", funcBody); + free(funcName); + free(funcBody); return func; } static char* ocgenReadOpFunc(char* typeName, char* compType, int numBytes) { - char* funcName = UTIL_appendStr(READ_PREFIX, typeName); - char* numBytesText = UTIL_itoa(numBytes); - char* arg = "()"; - char* funcBody1 = UTIL_mallocStr(strlen(READ) + strlen(compType) + - strlen(numBytesText)); - char* funcBody2, *func; + char* funcName = UTIL_appendStr(GET_PREFIX, typeName); + char* numBitsText = UTIL_itoa(numBytes*8); + char* funcBody = UTIL_mallocStr(strlen(GET)+strlen(numBitsText)+30); + char* func; - strcpy(funcBody1, READ); - strcat(funcBody1, compType); - strcat(funcBody1, numBytesText); free(numBytesText); - - funcBody2 = UTIL_appendStr(funcBody1, " ()"); free(funcBody1); - func = OC_mkFunc(funcName, arg, funcBody2); - free(funcName); free(funcBody2); + if (strcmp(typeName, "F") == 0) { + strcpy(funcBody, "getFloat"); + strcat(funcBody, numBitsText); + + if (numBytes > 1) + strcat(funcBody, "be"); + } else if (strcmp(typeName, "C") == 0 || strcmp(typeName, "K") == 0) { + strcpy(funcBody, "get"); + } else { + strcpy(funcBody, "fmap fromIntegral $ "); + strcat(funcBody, GET); + strcat(funcBody, numBitsText); + + if (numBytes > 1) + strcat(funcBody, "be"); + } + + free(numBitsText); + + func = HS_mkFunc(funcName, "", funcBody); + free(funcName); + free(funcBody); return func; } void ocgenOpType(char* typeName, int numBytes, char* compType) { + char* myCompType = + (strcmp(compType, "int") == 0) ? "Int" : + (strcmp(compType, "float") == 0) ? "Float" : + (strcmp(compType, "aconstant") == 0) ? "AConstant" : + (strcmp(compType, "akind") == 0) ? "AKind" : + (strcmp(compType, "intref") == 0) ? "IntRef" : + NULL; + /* generate type declarations*/ - char* myName = UTIL_lowerCase(typeName); - char* myTypeName = UTIL_appendStr(myName, TYPE_SUFFIX); - char* myOpType = OC_mkTypeDec(myTypeName, compType); + char* myTypeName = UTIL_appendStr(typeName, TYPE_SUFFIX); + char* myOpType = HS_mkTypeDec(myTypeName, myCompType); char* myopTypes = addStr(opTypes, myOpType); /* generate write functions */ char* func = ocgenWriteOpFunc(typeName, compType, numBytes); @@ -332,19 +332,17 @@ void ocgenOpType(char* typeName, int numBytes, char* compType) /* generate sizes */ if (numBytes < 4) { + char* myName = UTIL_lowerCase(typeName); char* mySizeName = UTIL_appendStr(myName, SIZE_SUFFIX); - char* myOpSizeMLI = OC_mkVarDec(mySizeName, "int"); - char* size = UTIL_itoa((int)(0 /*pow(2,(numBytes * 8))-1*/)); - char* myOpSizeML = OC_mkVarDef(mySizeName, size); - char* myopSizesMLI = addStr(opSizesMLI, myOpSizeMLI); - char* myopSizesML = addStr(opSizesML, myOpSizeML); + char* size = UTIL_itoa((int)(pow(2,(numBytes * 8))-1)); + char* myOpSize = HS_mkVarDef(mySizeName, "Int", size); + char* myopSizes = addStr(opSizes, myOpSize); - free(mySizeName); free(size); free(myOpSizeMLI); free(myOpSizeML); - free(opSizesMLI); free(opSizesML); - opSizesMLI = myopSizesMLI; - opSizesML = myopSizesML; + free(myName); free(mySizeName); free(size); free(myOpSize); + free(opSizes); + opSizes = myopSizes; } - free(myTypeName); free(myName); + free(myTypeName); free(opTypes); free(myOpType); opTypes = myopTypes; free(writeFuncs); free(func); @@ -356,48 +354,40 @@ void ocgenOpType(char* typeName, int numBytes, char* compType) void ocgenOpCodeType(int numBytes) { char* mySizeName = UTIL_appendStr("opcode", SIZE_SUFFIX); - char* size = UTIL_itoa((int)(0 /*pow(2,(numBytes * 8))-1*/)); - char* myOpCodeSizeMLI = OC_mkVarDec(mySizeName, "int"); - char* myOpCodeSizeML = OC_mkVarDef(mySizeName, size); - char* myopSizeMLI = addLine(opSizesMLI, myOpCodeSizeMLI); - char* myopSizeML = addLine(opSizesML, myOpCodeSizeML); - char* func = ocgenWriteOpFunc("opcode", "int", numBytes); + char* size = UTIL_itoa((int)(pow(2,(numBytes * 8))-1)); + char* myOpCodeSize = HS_mkVarDef(mySizeName, "Int", size); + char* myopSizes = addLine(opSizes, myOpCodeSize); + char* func = ocgenWriteOpFunc("opcode", "Int", numBytes); char* myWriteFuncs = addLine(writeFuncs, func); - char* readFunc = ocgenReadOpFunc("opcode", "int", numBytes); + char* readFunc = ocgenReadOpFunc("opcode", "Int", numBytes); char* myReadFuncs = addLine(readFuncs, readFunc); free(size); free(mySizeName); - free(opSizesMLI); free(myOpCodeSizeMLI); - free(opSizesML); free(myOpCodeSizeML); + free(opSizes); free(myOpCodeSize); free(writeFuncs); free(func); free(readFuncs); free(readFunc); - opSizesMLI = myopSizeMLI; - opSizesML = myopSizeML; + opSizes = myopSizes; writeFuncs = myWriteFuncs; readFuncs = myReadFuncs; } -static char* opMLI; -static char* opML; +static char* opHS; void ocgenOps() { char* wordSizeName = "wordSize"; - char* wordSizeMLI = OC_mkVarDec(wordSizeName, "int"); char* wordSize = UTIL_itoa(sizeof(void*)); - char* wordSizeML = OC_mkVarDef(wordSizeName, wordSize); + char* wordSizeHS = HS_mkVarDef(wordSizeName, "Int", wordSize); char* text; - - free(wordSize); - opMLI = addLine(opMLI, wordSizeMLI); free(wordSizeMLI); - text = addLine(opMLI, opSizesMLI); free(opMLI); free(opSizesMLI); - opMLI = addLine(text, opTypes); free(text); - opML = addLine(opML, wordSizeML); free(wordSizeML); - text = addLine(opML, opSizesML); free(opML); free(opSizesML); - opML = addLine(text, writeFuncs); free(text); free(writeFuncs); - text = addLine(opML, readFuncs); free(opML); free(readFuncs); - opML = addLine(text, opTypes); free(text); free(opTypes); + free(wordSize); + opHS = addLine(NULL, wordSizeHS); free(wordSizeHS); + text = addLine(opHS, opSizes); free(opSizes); free(opHS); + + opHS = addLine(text, opTypes); free(opTypes); free(text); + + text = addLine(opHS, writeFuncs); free(writeFuncs); free(opHS); + opHS = addLine(text, readFuncs); free(readFuncs); free(text); } /****************************************************************************/ @@ -412,7 +402,7 @@ static char* argList = NULL; void ocgenInstrFormat(char* opName) { - char *myop, *myOpName, *myFuncName, *myArgInd, *myFuncCall, *myArg, + char *myOpName, *myFuncName, *myArgInd, *myFuncCall, *myArg, *myArgList, *myinstrCatType, *myinstrCatWriteFunc, *myReadBody, *myinstrCatReadFunc, * myinstrCatDisplayFunc; @@ -420,10 +410,9 @@ void ocgenInstrFormat(char* opName) strcmp(opName, "X") == 0) return; //type declaration - myop = UTIL_lowerCase(opName); - myOpName = UTIL_appendStr(myop, TYPE_SUFFIX); free(myop); + myOpName = UTIL_appendStr(opName, TYPE_SUFFIX); if (instrCatType) { - myinstrCatType = OC_mkCrossType(instrCatType, myOpName); + myinstrCatType = HS_mkCrossType(instrCatType, myOpName); free(instrCatType); free(myOpName); instrCatType = myinstrCatType; } else instrCatType = myOpName; @@ -434,29 +423,26 @@ void ocgenInstrFormat(char* opName) myArg = UTIL_appendStr("arg", myArgInd); free(myArgInd); //argument list if (argList) { - myArgList = OC_mkArgList(argList, myArg); free(argList); + myArgList = HS_mkArgList(argList, myArg); free(argList); argList = myArgList; } else argList = myArg; //write function - myFuncName = UTIL_appendStr(WRITE_PREFIX, opName); + myFuncName = UTIL_appendStr(PUT_PREFIX, opName); myFuncCall = UTIL_mallocStr(strlen(myFuncName) + strlen(myArg) + 5); strcpy(myFuncCall, myFuncName); free(myFuncName); strcat(myFuncCall, " "); strcat(myFuncCall, myArg); if (instrCatWriteFunc) { - myinstrCatWriteFunc = OC_mkFuncSeq(instrCatWriteFunc, myFuncCall); + myinstrCatWriteFunc = HS_mkFuncSeq(instrCatWriteFunc, myFuncCall); free(instrCatWriteFunc); instrCatWriteFunc = myinstrCatWriteFunc; free(myFuncCall); } else instrCatWriteFunc = myFuncCall; //read function - myFuncName = UTIL_appendStr(READ_PREFIX, opName); - myFuncCall = UTIL_mallocStr(strlen(myFuncName) + 5); - strcpy(myFuncCall, myFuncName); free(myFuncName); - strcat(myFuncCall, " ()"); - myReadBody = OC_mkLetIn(myArg, myFuncCall); free(myFuncCall); + myFuncName = UTIL_appendStr(GET_PREFIX, opName); + myReadBody = HS_mkDO(myArg, myFuncName); free(myFuncName); if (instrCatReadFunc) { myinstrCatReadFunc = UTIL_appendStr(instrCatReadFunc, myReadBody); free(instrCatReadFunc); @@ -471,7 +457,7 @@ void ocgenInstrFormat(char* opName) strcat(myFuncCall, " "); strcat(myFuncCall, myArg); if (instrCatDisplayFunc) { - myinstrCatDisplayFunc = OC_mkStrConcat(instrCatDisplayFunc, myFuncCall); + myinstrCatDisplayFunc = HS_mkStrConcat(instrCatDisplayFunc, myFuncCall); free(instrCatDisplayFunc); instrCatDisplayFunc = myinstrCatDisplayFunc; free(myFuncCall); @@ -492,8 +478,13 @@ void ocgenOneInstrCat(char* catName) *myDisplayFuncName, *myDisplayFunc, *myInstrCatDisplayFuncs, *myArgs2, *temp; if (instrCatType) { - myCatName = UTIL_appendStr(INSCAT_PREFIX, catName); - myInstrCatType = OC_mkTypeDec(myCatName, instrCatType); + char* instrCatType2 = UTIL_mallocStr(strlen(instrCatType) + 3); + strcpy(instrCatType2, "("); + strcat(instrCatType2, instrCatType); + strcat(instrCatType2, ")"); + + myCatName = UTIL_appendStr(INSCAT_PREFIX2, catName); + myInstrCatType = HS_mkTypeDec(myCatName, instrCatType2); myInstrCatTypes = addStr(instrCatTypes, myInstrCatType); myArgs = UTIL_mallocStr(strlen(argList) + 5); @@ -502,21 +493,22 @@ void ocgenOneInstrCat(char* catName) strcat(myArgs, ")"); /* write function */ - myWriteFuncName = UTIL_appendStr(WRITE_PREFIX, catName); - myWriteFunc = OC_mkFunc(myWriteFuncName, myArgs, instrCatWriteFunc); + myWriteFuncName = UTIL_appendStr(PUT_PREFIX, catName); + myWriteFunc = HS_mkFunc(myWriteFuncName, myArgs, instrCatWriteFunc); myInstrCatWriteFuncs = addStr(instrCatWriteFuncs, myWriteFunc); /* read function */ - myReadFuncName = UTIL_appendStr(READ_PREFIX, catName); - myArgs2 = UTIL_appendStr(INDENT, myArgs); + myReadFuncName = UTIL_appendStr(GET_PREFIX, catName); + temp = UTIL_appendStr(INDENT, "return "); + myArgs2 = UTIL_appendStr(temp, myArgs); free(temp); temp = UTIL_appendStr(instrCatReadFunc, myArgs2); free(myArgs2); - myReadFuncBody= UTIL_appendStr("\n", temp); free(temp); - myReadFunc = OC_mkFunc(myReadFuncName, "()", myReadFuncBody); + myReadFuncBody= UTIL_appendStr("do\n", temp); free(temp); + myReadFunc = HS_mkFunc(myReadFuncName, "", myReadFuncBody); myInstrCatReadFuncs = addStr(instrCatReadFuncs, myReadFunc); /* display function */ myDisplayFuncName = UTIL_appendStr(DISPLAY_PREFIX, catName); - myDisplayFunc = OC_mkFunc(myDisplayFuncName, myArgs, instrCatDisplayFunc); + myDisplayFunc = HS_mkFunc(myDisplayFuncName, myArgs, instrCatDisplayFunc); myInstrCatDisplayFuncs = addStr(instrCatDisplayFuncs, myDisplayFunc); @@ -544,24 +536,21 @@ void ocgenOneInstrCat(char* catName) static char* instrCatLength; void ocgenInstrLength(char* varName, char* numBytes) { - char* myVarName = UTIL_appendStr(INSCAT_PREFIX, varName); - char* varDef = OC_mkVarDef(myVarName, numBytes); + char* myVarName = UTIL_appendStr(INSCAT_PREFIX1, varName); + char* varDef = HS_mkVarDef(myVarName, "Int", numBytes); char* myInstrCatLength = addStr(instrCatLength, varDef); free(myVarName); free(varDef); free(instrCatLength); instrCatLength = myInstrCatLength; } -static char* instrCatMLI; -static char* instrCatML; +static char* instrCat; void ocgenInstrCat() { char* text = instrCatTypes; char* text2 = addLine(text, "\n"); - - instrCatMLI = text; - + text = addLine(text2, instrCatWriteFuncs); free(instrCatWriteFuncs); free(text2); @@ -571,7 +560,7 @@ void ocgenInstrCat() text = addLine(text2, instrCatDisplayFuncs); free(instrCatDisplayFuncs); free(text2); - instrCatML = addLine(text, instrCatLength); + instrCat = addLine(text, instrCatLength); free(text); free(instrCatLength); } @@ -579,7 +568,7 @@ void ocgenInstrCat() /* instructions */ /****************************************************************************/ #define GETSIZE_PREFIX "getSize_" -#define WRITEOPCODE "writeopcode " +#define PUTOPCODE "putopcode " static char* instructionTypes; static char* insWriteFuncBody; @@ -591,34 +580,44 @@ static char* insSizesDef; static void ocgenReadFuncBody(char* opcode, char* myInsName, char* myInsLength, char* insCat, int last) { - char *ins, *readArgs, *returnValue, *myReadFuncBody, *mycond, *tmp; + char *ins, *readArgs, *returnValue, *myReadFuncBody, *tmp; - if (strcmp(insCat, "X") == 0) ins = myInsName; - else { - readArgs = UTIL_appendStr(READ_PREFIX, insCat); + if (strcmp(insCat, "X") == 0) { + readArgs = strdup(""); + ins = myInsName; + } else { + readArgs = UTIL_mallocStr(strlen(GET_PREFIX) + + strlen(insCat) + + 20); + strcpy(readArgs, GET_PREFIX); + strcat(readArgs, insCat); + strcat(readArgs, " >>= \\x -> "); + ins = UTIL_mallocStr(strlen(readArgs) + strlen(myInsName) + 10); strcpy(ins, myInsName); - strcat(ins, " ("); - strcat(ins, readArgs); - strcat(ins, " ())"); - free(readArgs); + strcat(ins, " x"); } - returnValue = UTIL_mallocStr(strlen(ins) + strlen(myInsLength) + 5); - strcpy(returnValue, "("); - strcat(returnValue, ins); + + returnValue = UTIL_mallocStr(strlen(readArgs) + + strlen(ins) + + strlen(myInsLength) + + 20); + strcpy(returnValue, readArgs); + strcat(returnValue, "return ("); + strcat(returnValue, ins); strcat(returnValue, ", "); strcat(returnValue, myInsLength); strcat(returnValue, ")"); - - if (last) { - tmp = UTIL_appendStr(" ", returnValue); free(returnValue); - }else { - mycond = UTIL_mallocStr(strlen(opcode) + 10); - strcpy(mycond, "opcode = "); - strcat(mycond, opcode); - tmp = OC_mkCond(mycond, returnValue); - free(mycond); free(returnValue); - } + + free(readArgs); + + char *tmp2 = " "; + tmp = addStr(tmp2, opcode); + tmp2 = addStr(tmp, " -> "); free(tmp); + tmp = addStr(tmp2, returnValue); free(tmp2); + tmp2 = addStr(tmp, "\n"); free(tmp); + tmp = tmp2; + free(returnValue); if (insReadFuncBody) { myReadFuncBody = UTIL_appendStr(insReadFuncBody, tmp); @@ -660,9 +659,9 @@ static void ocgenDisplayFuncBody(char* pattern, char* insName, char* insLength, displayargs = UTIL_appendStr(DISPLAY_PREFIX, insCat); ins = UTIL_mallocStr(strlen(displayargs) + strlen(insText) + 10); strcpy(ins, insText); - strcat(ins, "^ ("); + strcat(ins, " ++ "); strcat(ins, displayargs); - strcat(ins, " arg)"); + strcat(ins, " arg"); free(displayargs); free(insText); } @@ -673,11 +672,11 @@ static void ocgenDisplayFuncBody(char* pattern, char* insName, char* insLength, strcat(returnValue, insLength); strcat(returnValue, ")"); - funcBody = OC_mkArrow(pattern, returnValue); + funcBody = HS_mkArrow(pattern, returnValue); free(returnValue); if (insDisplayFuncBody) { - myDisplayFuncBody = OC_mkDisjValueCtrs(insDisplayFuncBody, funcBody); + myDisplayFuncBody = HS_mkCase(insDisplayFuncBody, funcBody); free(insDisplayFuncBody); free(funcBody); insDisplayFuncBody = myDisplayFuncBody; } else { @@ -700,33 +699,33 @@ void ocgenOneInstr(char* opcode, char* insName, char* insCat, char* insLength, if (strcmp(insCat, "X") == 0) { myValueCtr = myInsName; } else { - myCatName = UTIL_appendStr(INSCAT_PREFIX, insCat); - myValueCtr = OC_mkValueCtr(myInsName, myCatName); free(myCatName); + myCatName = UTIL_appendStr(INSCAT_PREFIX2, insCat); + myValueCtr = HS_mkValueCtr(myInsName, myCatName); free(myCatName); } if (instructionTypes) { - myInstrTypes = OC_mkDisjValueCtrs(instructionTypes, myValueCtr); + myInstrTypes = HS_mkDisjValueCtrs(instructionTypes, myValueCtr); free(instructionTypes); instructionTypes = myInstrTypes; } else instructionTypes = myValueCtr; /* write function body */ - myWriteOpCodeFunc = UTIL_appendStr(WRITEOPCODE, opcode); + myWriteOpCodeFunc = UTIL_appendStr(PUTOPCODE, opcode); if (strcmp(insCat, "X") == 0) { myPattern = strdup(myInsName); myfuncBody = myWriteOpCodeFunc; } else { - char* myWriteArgsName = UTIL_appendStr(WRITE_PREFIX, insCat); + char* myWriteArgsName = UTIL_appendStr(PUT_PREFIX, insCat); char* myWriteArgs = UTIL_mallocStr(strlen(myWriteArgsName) + 5); - myPattern = OC_mkStructure(myInsName, "arg"); + myPattern = HS_mkStructure(myInsName, "arg"); strcpy(myWriteArgs, myWriteArgsName); free(myWriteArgsName); strcat(myWriteArgs, " arg"); - myfuncBody = OC_mkFuncSeq(myWriteOpCodeFunc, myWriteArgs); + myfuncBody = HS_mkFuncSeq(myWriteOpCodeFunc, myWriteArgs); free(myWriteArgs); } - myFunc = OC_mkArrow(myPattern, myfuncBody); + myFunc = HS_mkArrow(myPattern, myfuncBody); free(myfuncBody); if (insWriteFuncBody) { - myInsWriteFuncBody = OC_mkDisjValueCtrs(insWriteFuncBody, myFunc); + myInsWriteFuncBody = HS_mkCase(insWriteFuncBody, myFunc); free(insWriteFuncBody); free(myFunc); insWriteFuncBody = myInsWriteFuncBody; } else { @@ -735,17 +734,14 @@ void ocgenOneInstr(char* opcode, char* insName, char* insCat, char* insLength, } /* instruction sizes */ myInsSizeName = UTIL_appendStr(GETSIZE_PREFIX, insName); - myInsLength = UTIL_appendStr(INSCAT_PREFIX, insLength); - mySizeDef = OC_mkVarDef(myInsSizeName, myInsLength); - mySizeDec = OC_mkVarDec(myInsSizeName, "int"); free(myInsSizeName); - + myInsLength = UTIL_appendStr(INSCAT_PREFIX1, insLength); + mySizeDef = HS_mkVarDef(myInsSizeName, "Int", myInsLength); + free(myInsSizeName); + mySizeDefs = addStr(insSizesDef, mySizeDef); free(insSizesDef); free(mySizeDef); - mySizeDecs = addStr(insSizesDec, mySizeDec); - free(insSizesDec); free(mySizeDec); insSizesDef = mySizeDefs; - insSizesDec = mySizeDecs; ocgenReadFuncBody(opcode, myInsName, myInsLength, insCat, last); ocgenDisplayFuncBody(myPattern, insName, myInsLength, insCat); @@ -753,24 +749,23 @@ void ocgenOneInstr(char* opcode, char* insName, char* insCat, char* insLength, free(myInsName); free(myInsLength); free(myPattern); } -#define INSTRTYPE_HEAD "type instruction = " +#define INSTRTYPE_HEAD "data Instruction\n = " -#define INSTWRITEFUNC_DEF_HEAD "let writeInstruction inst =\n match inst with\n" -#define INSTWRITEFUNC_DEC "val writeInstruction : instruction -> unit\n" +#define INSTWRITEFUNC_DEF_HEAD "putInstruction :: Instruction -> Put\n" \ + "putInstruction inst =\n" \ + " case inst of\n" -#define INSTREADFUNC_DEF_HEAD \ -"let readInstruction getKindFunc getConstantFunc = \n Bytecode.setGetKindFn getKindFunc; \n Bytecode.setGetConstantFn getConstantFunc; \n let opcode = readopcode () in\n" - -#define INSTREADFUNC_DEC \ -"val readInstruction : \n(int -> int -> Absyn.akind option) -> (int -> int -> Absyn.aconstant option) ->\n(instruction * int)\n" +#define INSTREADFUNC_DEF_HEAD "getInstruction :: Get (Instruction,Int)\n" \ + "getInstruction = do\n" \ + " opcode <- getopcode\n" \ + " case opcode of\n" #define INSTDISPLAYFUNC_DEF_HEAD \ -"let displayInstruction inst =\n match inst with\n" -#define INSTDISPLAYFUNC_DEC \ -"val displayInstruction : instruction -> (string * int)\n" + "showInstruction :: Instruction -> (String, Int)\n" \ + "showInstruction inst =\n" \ + " case inst of\n" -static char* instrMLI; -static char* instrML; +static char* instrHS; void ocgenInstr() { @@ -778,23 +773,18 @@ void ocgenInstr() char* text2 = UTIL_appendStr(text, "\n\n"); free(instructionTypes); free(text); - - text = addLine(text2, insSizesDec); free(insSizesDec); - instrMLI = addStr(text, INSTWRITEFUNC_DEC); free(text); - text = addStr(instrMLI, INSTREADFUNC_DEC); free(instrMLI); - instrMLI = addStr(text, INSTDISPLAYFUNC_DEC); free(text); text = addLine(text2, insSizesDef); free(text2); free(insSizesDef); text2 = addStr(text, INSTWRITEFUNC_DEF_HEAD); free(text); - instrML = addStr(text2, insWriteFuncBody); + instrHS = addStr(text2, insWriteFuncBody); free(text2); free(insWriteFuncBody); - text = addStr(instrML, "\n\n"); free(instrML); + text = addStr(instrHS, "\n\n"); free(instrHS); text2 = addStr(text, INSTREADFUNC_DEF_HEAD); free(text); - instrML = addStr(text2, insReadFuncBody); + instrHS = addStr(text2, insReadFuncBody); free(text2); free(insReadFuncBody); - text = addStr(instrML, "\n\n"); free(instrML); + text = addStr(instrHS, "\n\n"); free(instrHS); text2 = addStr(text, INSTDISPLAYFUNC_DEF_HEAD); free(text); - instrML = addStr(text2, insDisplayFuncBody); + instrHS = addStr(text2, insDisplayFuncBody); free(text2); free(insDisplayFuncBody); } @@ -802,40 +792,54 @@ void ocgenInstr() /* dump files */ /****************************************************************************/ /* dump files */ -void ocSpitInstructionMLI(char * root) +void ocSpitInstructionHS(char * root) { FILE* outFile; - char * filename = malloc(strlen(root) + 32); + char * loc_path = "../../../compiler/GF/Compile/Instructions.hs"; + char * filename = malloc(strlen(root) + strlen(loc_path)+1); strcpy(filename, root); - strcat(filename, "compiler/instr.mli"); + strcat(filename, loc_path); outFile = UTIL_fopenW(filename); - fprintf(outFile, typeDefs); - fprintf(outFile, opMLI); free(opMLI); - fprintf(outFile, instrCatMLI); free(instrCatMLI); - fprintf(outFile, "\n\n"); - fprintf(outFile, instrMLI); free(instrMLI); - UTIL_fclose(outFile); + fputs("module GF.Compile.Instructions where\n", outFile); + fputs("\n", outFile); + fputs("import Data.IORef\n", outFile); + fputs("import Data.Binary\n", outFile); + fputs("import Data.Binary.Put\n", outFile); + fputs("import Data.Binary.Get\n", outFile); + fputs("import Data.Binary.IEEE754\n", outFile); + fputs("import PGF.CId\n", outFile); + fputs("import PGF.Binary\n", outFile); + fputs("\n", outFile); + fputs("type IntRef = Int\n", outFile); + fputs("type AConstant = CId\n", outFile); + fputs("type AKind = CId\n", outFile); + fputs("\n", outFile); + fputs("ppE = undefined\n", outFile); + fputs("ppF = undefined\n", outFile); + fputs("ppL = undefined\n", outFile); + fputs("ppC = undefined\n", outFile); + fputs("ppN = undefined\n", outFile); + fputs("ppR = undefined\n", outFile); + fputs("ppK = undefined\n", outFile); + fputs("ppS = undefined\n", outFile); + fputs("ppI = undefined\n", outFile); + fputs("ppI1 = undefined\n", outFile); + fputs("ppIT = undefined\n", outFile); + fputs("ppCE = undefined\n", outFile); + fputs("ppMT = undefined\n", outFile); + fputs("ppHT = undefined\n", outFile); + fputs("ppSEG = undefined\n", outFile); + fputs("ppBVT = undefined\n", outFile); + fputs("\n", outFile); + + fputs(opHS, outFile); free(opHS); + fputs(instrCat, outFile); free(instrCat); + fputs("\n\n", outFile); + fputs(instrHS, outFile); free(instrHS); + free(typeDefs); + + UTIL_fclose(outFile); free(filename); } - -/* dump files */ -void ocSpitInstructionML(char * root) -{ - FILE* outFile; - - char * filename = malloc(strlen(root) + 32); - strcpy(filename, root); - strcat(filename, "compiler/instr.ml"); - - outFile = UTIL_fopenW(filename); - fprintf(outFile, typeDefs); free(typeDefs); - fprintf(outFile, opML); free(opML); - fprintf(outFile, instrCatML); free(instrCatML); - fprintf(outFile, instrML); free(instrML); - UTIL_fclose(outFile); - - free(filename); -} - diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.h b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.h similarity index 100% rename from src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.h rename to src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.h